diff --git a/.mailmap b/.mailmap --- a/.mailmap +++ b/.mailmap @@ -1,6 +1,7 @@ -Joey Hess http://joey.kitenet.net/ -Joey Hess http://joeyh.name/ -Joey Hess http://joeyh.name/ +Joey Hess http://joey.kitenet.net/ +Joey Hess http://joeyh.name/ +Joey Hess http://joeyh.name/ Yaroslav Halchenko Yaroslav Halchenko http://yarikoptic.myopenid.com/ Yaroslav Halchenko https://www.google.com/accounts/o8/id?id=AItOawnx8kHW66N3BqmkVpgtXDlYMvr8TJ5VvfY +Richard Hartmann https://www.google.com/accounts/o8/id?id=AItOawl9sYlePmv1xK-VvjBdN-5doOa_Xw-jH4U diff --git a/Annex.hs b/Annex.hs --- a/Annex.hs +++ b/Annex.hs @@ -1,6 +1,6 @@ {- git-annex monad - - - Copyright 2010-2013 Joey Hess + - Copyright 2010-2013 Joey Hess - - Licensed under the GNU GPL version 3 or higher. -} @@ -85,9 +85,7 @@ MonadReader (MVar AnnexState), MonadCatch, MonadThrow, -#if MIN_VERSION_exceptions(0,6,0) MonadMask, -#endif Functor, Applicative ) diff --git a/Annex/AutoMerge.hs b/Annex/AutoMerge.hs --- a/Annex/AutoMerge.hs +++ b/Annex/AutoMerge.hs @@ -1,6 +1,6 @@ {- git-annex automatic merge conflict resolution - - - Copyright 2012-2014 Joey Hess + - Copyright 2012-2014 Joey Hess - - Licensed under the GNU GPL version 3 or higher. -} @@ -134,7 +134,7 @@ makelink key = do let dest = variantFile file key - l <- inRepo $ gitAnnexLink dest key + l <- calcRepo $ gitAnnexLink dest key replacewithlink dest l stageSymlink dest =<< hashSymlink l diff --git a/Annex/Branch.hs b/Annex/Branch.hs --- a/Annex/Branch.hs +++ b/Annex/Branch.hs @@ -1,6 +1,6 @@ {- management of the git-annex branch - - - Copyright 2011-2013 Joey Hess + - Copyright 2011-2013 Joey Hess - - Licensed under the GNU GPL version 3 or higher. -} @@ -49,9 +49,11 @@ import Logs import Logs.Transitions import Logs.Trust.Pure +import Logs.Difference.Pure import Annex.ReplaceFile import qualified Annex.Queue import Annex.Branch.Transitions +import qualified Annex {- Name of the branch that is used to store git-annex's information. -} name :: Git.Ref @@ -160,6 +162,7 @@ <$> getLocal transitionsLog unless (null branches) $ do showSideAction merge_desc + mapM_ checkBranchDifferences refs mergeIndex jl refs let commitrefs = nub $ fullname:refs unlessM (handleTransitions jl localtransitions commitrefs) $ do @@ -537,3 +540,11 @@ apply rest hasher file content' trustmap PreserveFile -> apply rest hasher file content trustmap + +checkBranchDifferences :: Git.Ref -> Annex () +checkBranchDifferences ref = do + theirdiffs <- allDifferences . parseDifferencesLog . decodeBS + <$> catFile ref differenceLog + mydiffs <- annexDifferences <$> Annex.getGitConfig + when (theirdiffs /= mydiffs) $ + error "Remote repository is tuned in incompatable way; cannot be merged with local repository." diff --git a/Annex/Branch/Transitions.hs b/Annex/Branch/Transitions.hs --- a/Annex/Branch/Transitions.hs +++ b/Annex/Branch/Transitions.hs @@ -1,6 +1,6 @@ {- git-annex branch transitions - - - Copyright 2013 Joey Hess + - Copyright 2013 Joey Hess - - Licensed under the GNU GPL version 3 or higher. -} diff --git a/Annex/BranchState.hs b/Annex/BranchState.hs --- a/Annex/BranchState.hs +++ b/Annex/BranchState.hs @@ -2,7 +2,7 @@ - - Runtime state about the git-annex branch. - - - Copyright 2011-2012 Joey Hess + - Copyright 2011-2012 Joey Hess - - Licensed under the GNU GPL version 3 or higher. -} diff --git a/Annex/CatFile.hs b/Annex/CatFile.hs --- a/Annex/CatFile.hs +++ b/Annex/CatFile.hs @@ -1,6 +1,6 @@ {- git cat-file interface, with handle automatically stored in the Annex monad - - - Copyright 2011-2013 Joey Hess + - Copyright 2011-2013 Joey Hess - - Licensed under the GNU GPL version 3 or higher. -} diff --git a/Annex/CheckAttr.hs b/Annex/CheckAttr.hs --- a/Annex/CheckAttr.hs +++ b/Annex/CheckAttr.hs @@ -1,6 +1,6 @@ {- git check-attr interface, with handle automatically stored in the Annex monad - - - Copyright 2012 Joey Hess + - Copyright 2012 Joey Hess - - Licensed under the GNU GPL version 3 or higher. -} diff --git a/Annex/CheckIgnore.hs b/Annex/CheckIgnore.hs --- a/Annex/CheckIgnore.hs +++ b/Annex/CheckIgnore.hs @@ -1,7 +1,7 @@ {- git check-ignore interface, with handle automatically stored in - the Annex monad - - - Copyright 2013 Joey Hess + - Copyright 2013 Joey Hess - - Licensed under the GNU GPL version 3 or higher. -} diff --git a/Annex/Content.hs b/Annex/Content.hs --- a/Annex/Content.hs +++ b/Annex/Content.hs @@ -1,6 +1,6 @@ {- git-annex file content managing - - - Copyright 2010-2014 Joey Hess + - Copyright 2010-2014 Joey Hess - - Licensed under the GNU GPL version 3 or higher. -} @@ -110,10 +110,10 @@ ( checkOr is_unlocked lockfile , return is_missing ) - checkOr def lockfile = do + checkOr d lockfile = do v <- checkLocked lockfile return $ case v of - Nothing -> def + Nothing -> d Just True -> is_locked Just False -> is_unlocked #else @@ -234,8 +234,8 @@ tmp <- fromRepo $ gitAnnexTmpObjectLocation key e <- liftIO $ doesFileExist tmp - alreadythere <- if e - then fromIntegral . fileSize <$> liftIO (getFileStatus tmp) + alreadythere <- liftIO $ if e + then getFileSize tmp else return 0 ifM (checkDiskSpace Nothing key alreadythere) ( do @@ -446,7 +446,7 @@ removeInodeCache key mapM_ (resetfile cache) fs resetfile cache f = whenM (sameInodeCache f cache) $ do - l <- inRepo $ gitAnnexLink f key + l <- calcRepo $ gitAnnexLink f key secureErase f replaceFile f $ makeAnnexLink l diff --git a/Annex/Content/Direct.hs b/Annex/Content/Direct.hs --- a/Annex/Content/Direct.hs +++ b/Annex/Content/Direct.hs @@ -1,6 +1,6 @@ {- git-annex file content managing for direct mode - - - Copyright 2012-2014 Joey Hess + - Copyright 2012-2014 Joey Hess - - Licensed under the GNU GPL version 3 or higher. -} @@ -174,10 +174,10 @@ go (Just curr) = elemInodeCaches curr old {- Checks if a FileStatus matches the recorded InodeCache of a file. -} -sameFileStatus :: Key -> FileStatus -> Annex Bool -sameFileStatus key status = do +sameFileStatus :: Key -> FilePath -> FileStatus -> Annex Bool +sameFileStatus key f status = do old <- recordedInodeCache key - curr <- withTSDelta $ \delta -> liftIO $ toInodeCache delta status + curr <- withTSDelta $ \delta -> liftIO $ toInodeCache delta f status case (old, curr) of (_, Just c) -> elemInodeCaches c old ([], Nothing) -> return True diff --git a/Annex/Difference.hs b/Annex/Difference.hs new file mode 100644 --- /dev/null +++ b/Annex/Difference.hs @@ -0,0 +1,58 @@ +{- git-annex repository differences + - + - Copyright 2015 Joey Hess + - + - Licensed under the GNU GPL version 3 or higher. + -} + +module Annex.Difference ( + module Types.Difference, + setDifferences, +) where + +import Common.Annex +import Types.Difference +import Logs.Difference +import Config +import Annex.UUID +import Logs.UUID +import Annex.Version +import qualified Annex + +import qualified Data.Map as M + +-- Differences are only allowed to be tweaked when initializing a +-- repository for the first time, and then only if there is not another +-- known uuid. If the repository was cloned from elsewhere, it inherits +-- the existing settings. +-- +-- Must be called before setVersion, so it can check if this is the first +-- time the repository is being initialized. +setDifferences :: Annex () +setDifferences = do + u <- getUUID + otherds <- allDifferences <$> recordedDifferences + ds <- mappend otherds . annexDifferences <$> Annex.getGitConfig + when (ds /= mempty) $ do + ds' <- ifM (isJust <$> getVersion) + ( do + oldds <- recordedDifferencesFor u + when (ds /= oldds) $ + warning $ "Cannot change tunable parameters in already initialized repository." + return oldds + , if otherds == mempty + then ifM (not . null . filter (/= u) . M.keys <$> uuidMap) + ( do + warning "Cannot change tunable parameters in a clone of an existing repository." + return mempty + , return ds + ) + else if otherds /= ds + then do + warning "The specified tunable parameters differ from values being used in other clones of this repository." + return otherds + else return ds + ) + forM_ (listDifferences ds') $ \d -> + setConfig (ConfigKey $ differenceConfigKey d) (differenceConfigVal d) + recordDifferences ds' u diff --git a/Annex/DirHashes.hs b/Annex/DirHashes.hs new file mode 100644 --- /dev/null +++ b/Annex/DirHashes.hs @@ -0,0 +1,86 @@ +{- git-annex file locations + - + - Copyright 2010-2015 Joey Hess + - + - Licensed under the GNU GPL version 3 or higher. + -} + +module Annex.DirHashes ( + Hasher, + HashLevels(..), + objectHashLevels, + branchHashLevels, + branchHashDir, + dirHashes, + hashDirMixed, + hashDirLower, +) where + +import Data.Bits +import Data.Word +import Data.Hash.MD5 +import Data.Default + +import Common +import Types.Key +import Types.GitConfig +import Types.Difference + +type Hasher = Key -> FilePath + +-- Number of hash levels to use. 2 is the default. +newtype HashLevels = HashLevels Int + +instance Default HashLevels where + def = HashLevels 2 + +objectHashLevels :: GitConfig -> HashLevels +objectHashLevels = configHashLevels OneLevelObjectHash + +branchHashLevels :: GitConfig -> HashLevels +branchHashLevels = configHashLevels OneLevelBranchHash + +configHashLevels :: Difference -> GitConfig -> HashLevels +configHashLevels d config + | hasDifference d (annexDifferences config) = HashLevels 1 + | otherwise = def + +branchHashDir :: GitConfig -> Key -> String +branchHashDir config key = hashDirLower (branchHashLevels config) key + +{- Two different directory hashes may be used. The mixed case hash + - came first, and is fine, except for the problem of case-strict + - filesystems such as Linux VFAT (mounted with shortname=mixed), + - which do not allow using a directory "XX" when "xx" already exists. + - To support that, most repositories use the lower case hash for new data. -} +dirHashes :: [HashLevels -> Hasher] +dirHashes = [hashDirLower, hashDirMixed] + +hashDirs :: HashLevels -> Int -> String -> FilePath +hashDirs (HashLevels 1) sz s = addTrailingPathSeparator $ take sz s +hashDirs _ sz s = addTrailingPathSeparator $ take sz s drop sz s + +hashDirMixed :: HashLevels -> Hasher +hashDirMixed n k = hashDirs n 2 $ take 4 $ display_32bits_as_dir =<< [a,b,c,d] + where + ABCD (a,b,c,d) = md5 $ md5FilePath $ key2file $ nonChunkKey k + +hashDirLower :: HashLevels -> Hasher +hashDirLower n k = hashDirs n 3 $ take 6 $ md5s $ md5FilePath $ key2file $ nonChunkKey k + +{- modified version of display_32bits_as_hex from Data.Hash.MD5 + - Copyright (C) 2001 Ian Lynagh + - License: Either BSD or GPL + -} +display_32bits_as_dir :: Word32 -> String +display_32bits_as_dir w = trim $ swap_pairs cs + where + -- Need 32 characters to use. To avoid inaverdently making + -- a real word, use letters that appear less frequently. + chars = ['0'..'9'] ++ "zqjxkmvwgpfZQJXKMVWGPF" + cs = map (\x -> getc $ (shiftR w (6*x)) .&. 31) [0..7] + getc n = chars !! fromIntegral n + swap_pairs (x1:x2:xs) = x2:x1:swap_pairs xs + swap_pairs _ = [] + -- Last 2 will always be 00, so omit. + trim = take 6 diff --git a/Annex/Direct.hs b/Annex/Direct.hs --- a/Annex/Direct.hs +++ b/Annex/Direct.hs @@ -1,6 +1,6 @@ {- git-annex direct mode - - - Copyright 2012-2014 Joey Hess + - Copyright 2012-2014 Joey Hess - - Licensed under the GNU GPL version 3 or higher. -} @@ -56,7 +56,7 @@ go (file, Just sha, Just mode) = withTSDelta $ \delta -> do shakey <- catKey sha mode mstat <- liftIO $ catchMaybeIO $ getSymbolicLinkStatus file - mcache <- liftIO $ maybe (pure Nothing) (toInodeCache delta) mstat + mcache <- liftIO $ maybe (pure Nothing) (toInodeCache delta file) mstat filekey <- isAnnexLink file case (shakey, filekey, mstat, mcache) of (_, Just key, _, _) @@ -86,7 +86,7 @@ deletegit file stageannexlink file key = do - l <- inRepo $ gitAnnexLink file key + l <- calcRepo $ gitAnnexLink file key stageSymlink file =<< hashSymlink l void $ addAssociatedFile key file @@ -131,7 +131,7 @@ return False got (Just (key, _)) = ifM (sameInodeCache file [cache]) ( do - l <- inRepo $ gitAnnexLink file key + l <- calcRepo $ gitAnnexLink file key stageSymlink file =<< hashSymlink l addInodeCache key cache void $ addAssociatedFile key file @@ -282,7 +282,7 @@ - with the content. -} movein item makeabs k f = unlessM (goodContent k f) $ do preserveUnannexed item makeabs f oldref - l <- inRepo $ gitAnnexLink f k + l <- calcRepo $ gitAnnexLink f k replaceFile f $ makeAnnexLink l toDirect k f diff --git a/Annex/Direct/Fixup.hs b/Annex/Direct/Fixup.hs --- a/Annex/Direct/Fixup.hs +++ b/Annex/Direct/Fixup.hs @@ -1,6 +1,6 @@ {- git-annex direct mode guard fixup - - - Copyright 2013 Joey Hess + - Copyright 2013 Joey Hess - - Licensed under the GNU GPL version 3 or higher. -} diff --git a/Annex/Drop.hs b/Annex/Drop.hs --- a/Annex/Drop.hs +++ b/Annex/Drop.hs @@ -1,6 +1,6 @@ {- dropping of unwanted content - - - Copyright 2012-2014 Joey Hess + - Copyright 2012-2014 Joey Hess - - Licensed under the GNU GPL version 3 or higher. -} diff --git a/Annex/Environment.hs b/Annex/Environment.hs --- a/Annex/Environment.hs +++ b/Annex/Environment.hs @@ -1,6 +1,6 @@ {- git-annex environment - - - Copyright 2012, 2013 Joey Hess + - Copyright 2012, 2013 Joey Hess - - Licensed under the GNU GPL version 3 or higher. -} diff --git a/Annex/FileMatcher.hs b/Annex/FileMatcher.hs --- a/Annex/FileMatcher.hs +++ b/Annex/FileMatcher.hs @@ -1,6 +1,6 @@ {- git-annex file matching - - - Copyright 2012-2014 Joey Hess + - Copyright 2012-2014 Joey Hess - - Licensed under the GNU GPL version 3 or higher. -} @@ -28,12 +28,12 @@ checkFileMatcher matcher file = checkMatcher matcher Nothing (Just file) S.empty True checkMatcher :: (FileMatcher Annex) -> Maybe Key -> AssociatedFile -> AssumeNotPresent -> Bool -> Annex Bool -checkMatcher matcher mkey afile notpresent def - | isEmpty matcher = return def +checkMatcher matcher mkey afile notpresent d + | isEmpty matcher = return d | otherwise = case (mkey, afile) of (_, Just file) -> go =<< fileMatchInfo file (Just key, _) -> go (MatchingKey key) - _ -> return def + _ -> return d where go mi = matchMrun matcher $ \a -> a notpresent mi diff --git a/Annex/Hook.hs b/Annex/Hook.hs --- a/Annex/Hook.hs +++ b/Annex/Hook.hs @@ -4,7 +4,7 @@ - not change, otherwise removing old hooks using an old version of - the script would fail. - - - Copyright 2013-2014 Joey Hess + - Copyright 2013-2014 Joey Hess - - Licensed under the GNU GPL version 3 or higher. -} @@ -16,7 +16,6 @@ import Config import qualified Annex import Utility.Shell -import Utility.FileMode import qualified Data.Map as M @@ -53,19 +52,16 @@ - the existing hooks are cached. -} runAnnexHook :: Git.Hook -> Annex () runAnnexHook hook = do - cmd <- fromRepo $ Git.hookFile hook m <- Annex.getState Annex.existinghooks case M.lookup hook m of - Just True -> run cmd + Just True -> run Just False -> noop Nothing -> do - exists <- hookexists cmd + exists <- inRepo $ Git.hookExists hook Annex.changeState $ \s -> s { Annex.existinghooks = M.insert hook exists m } - when exists $ - run cmd + when exists run where - hookexists f = liftIO $ catchBoolIO $ - isExecutable . fileMode <$> getFileStatus f - run cmd = unlessM (liftIO $ boolSystem cmd []) $ - warning $ cmd ++ " failed" + run = unlessM (inRepo $ Git.runHook hook) $ do + h <- fromRepo $ Git.hookFile hook + warning $ h ++ " failed" diff --git a/Annex/Index.hs b/Annex/Index.hs --- a/Annex/Index.hs +++ b/Annex/Index.hs @@ -1,6 +1,6 @@ {- Using other git index files - - - Copyright 2014 Joey Hess + - Copyright 2014 Joey Hess - - Licensed under the GNU GPL version 3 or higher. -} diff --git a/Annex/Init.hs b/Annex/Init.hs --- a/Annex/Init.hs +++ b/Annex/Init.hs @@ -1,6 +1,6 @@ {- git-annex repository initialization - - - Copyright 2011 Joey Hess + - Copyright 2011 Joey Hess - - Licensed under the GNU GPL version 3 or higher. -} @@ -27,6 +27,7 @@ import Logs.Trust.Basic import Types.TrustLevel import Annex.Version +import Annex.Difference import Annex.UUID import Config import Annex.Direct @@ -44,7 +45,7 @@ genDescription :: Maybe String -> Annex String genDescription (Just d) = return d genDescription Nothing = do - reldir <- liftIO . relHome =<< fromRepo Git.repoPath + reldir <- liftIO . relHome =<< liftIO . absPath =<< fromRepo Git.repoPath hostname <- fromMaybe "" <$> liftIO getHostname #ifndef mingw32_HOST_OS let at = if null hostname then "" else "@" @@ -73,6 +74,7 @@ checkCrippledFileSystem unlessM isBare $ hookWrite preCommitHook + setDifferences setVersion supportedVersion ifM (crippledFileSystem <&&> not <$> isBare) ( do diff --git a/Annex/Journal.hs b/Annex/Journal.hs --- a/Annex/Journal.hs +++ b/Annex/Journal.hs @@ -4,7 +4,7 @@ - git-annex branch. Among other things, it ensures that if git-annex is - interrupted, its recorded data is not lost. - - - Copyright 2011-2013 Joey Hess + - Copyright 2011-2013 Joey Hess - - Licensed under the GNU GPL version 3 or higher. -} diff --git a/Annex/Link.hs b/Annex/Link.hs --- a/Annex/Link.hs +++ b/Annex/Link.hs @@ -5,7 +5,7 @@ - On other filesystems, git instead stores the symlink target in a regular - file. - - - Copyright 2013 Joey Hess + - Copyright 2013 Joey Hess - - Licensed under the GNU GPL version 3 or higher. -} diff --git a/Annex/LockFile.hs b/Annex/LockFile.hs --- a/Annex/LockFile.hs +++ b/Annex/LockFile.hs @@ -1,6 +1,6 @@ {- git-annex lock files. - - - Copyright 2012, 2014 Joey Hess + - Copyright 2012, 2014 Joey Hess - - Licensed under the GNU GPL version 3 or higher. -} diff --git a/Annex/MakeRepo.hs b/Annex/MakeRepo.hs --- a/Annex/MakeRepo.hs +++ b/Annex/MakeRepo.hs @@ -1,6 +1,6 @@ {- making local repositories (used by webapp mostly) - - - Copyright 2012-2014 Joey Hess + - Copyright 2012-2014 Joey Hess - - Licensed under the GNU GPL version 3 or higher. -} diff --git a/Annex/MetaData.hs b/Annex/MetaData.hs --- a/Annex/MetaData.hs +++ b/Annex/MetaData.hs @@ -1,6 +1,6 @@ {- git-annex metadata - - - Copyright 2014 Joey Hess + - Copyright 2014 Joey Hess - - Licensed under the GNU GPL version 3 or higher. -} diff --git a/Annex/MetaData/StandardFields.hs b/Annex/MetaData/StandardFields.hs --- a/Annex/MetaData/StandardFields.hs +++ b/Annex/MetaData/StandardFields.hs @@ -1,6 +1,6 @@ {- git-annex metadata, standard fields - - - Copyright 2014 Joey Hess + - Copyright 2014 Joey Hess - - Licensed under the GNU GPL version 3 or higher. -} diff --git a/Annex/Notification.hs b/Annex/Notification.hs --- a/Annex/Notification.hs +++ b/Annex/Notification.hs @@ -1,6 +1,6 @@ {- git-annex desktop notifications - - - Copyright 2014 Joey Hess + - Copyright 2014 Joey Hess - - Licensed under the GNU GPL version 3 or higher. -} diff --git a/Annex/Path.hs b/Annex/Path.hs --- a/Annex/Path.hs +++ b/Annex/Path.hs @@ -1,6 +1,6 @@ {- git-annex program path - - - Copyright 2013 Joey Hess + - Copyright 2013 Joey Hess - - Licensed under the GNU GPL version 3 or higher. -} diff --git a/Annex/Perms.hs b/Annex/Perms.hs --- a/Annex/Perms.hs +++ b/Annex/Perms.hs @@ -1,6 +1,6 @@ {- git-annex file permissions - - - Copyright 2012 Joey Hess + - Copyright 2012 Joey Hess - - Licensed under the GNU GPL version 3 or higher. -} diff --git a/Annex/Queue.hs b/Annex/Queue.hs --- a/Annex/Queue.hs +++ b/Annex/Queue.hs @@ -1,6 +1,6 @@ {- git-annex command queue - - - Copyright 2011, 2012 Joey Hess + - Copyright 2011, 2012 Joey Hess - - Licensed under the GNU GPL version 3 or higher. -} diff --git a/Annex/Quvi.hs b/Annex/Quvi.hs --- a/Annex/Quvi.hs +++ b/Annex/Quvi.hs @@ -1,6 +1,6 @@ {- quvi options for git-annex - - - Copyright 2013 Joey Hess + - Copyright 2013 Joey Hess - - Licensed under the GNU GPL version 3 or higher. -} diff --git a/Annex/ReplaceFile.hs b/Annex/ReplaceFile.hs --- a/Annex/ReplaceFile.hs +++ b/Annex/ReplaceFile.hs @@ -1,6 +1,6 @@ {- git-annex file replacing - - - Copyright 2013 Joey Hess + - Copyright 2013 Joey Hess - - Licensed under the GNU GPL version 3 or higher. -} diff --git a/Annex/Ssh.hs b/Annex/Ssh.hs --- a/Annex/Ssh.hs +++ b/Annex/Ssh.hs @@ -1,6 +1,6 @@ {- git-annex ssh interface, with connection caching - - - Copyright 2012-2014 Joey Hess + - Copyright 2012-2014 Joey Hess - - Licensed under the GNU GPL version 3 or higher. -} diff --git a/Annex/TaggedPush.hs b/Annex/TaggedPush.hs --- a/Annex/TaggedPush.hs +++ b/Annex/TaggedPush.hs @@ -1,6 +1,6 @@ {- git-annex tagged pushes - - - Copyright 2012 Joey Hess + - Copyright 2012 Joey Hess - - Licensed under the GNU GPL version 3 or higher. -} diff --git a/Annex/Transfer.hs b/Annex/Transfer.hs --- a/Annex/Transfer.hs +++ b/Annex/Transfer.hs @@ -1,6 +1,6 @@ {- git-annex transfers - - - Copyright 2012-2014 Joey Hess + - Copyright 2012-2014 Joey Hess - - Licensed under the GNU GPL version 3 or higher. -} @@ -132,8 +132,7 @@ liftIO $ readMVar metervar | otherwise = do f <- fromRepo $ gitAnnexTmpObjectLocation (transferKey t) - liftIO $ catchDefaultIO 0 $ - fromIntegral . fileSize <$> getFileStatus f + liftIO $ catchDefaultIO 0 $ getFileSize f type RetryDecider = TransferInfo -> TransferInfo -> Bool diff --git a/Annex/UUID.hs b/Annex/UUID.hs --- a/Annex/UUID.hs +++ b/Annex/UUID.hs @@ -6,7 +6,7 @@ - UUIDs of remotes are cached in git config, using keys named - remote..annex-uuid - - - Copyright 2010-2013 Joey Hess + - Copyright 2010-2013 Joey Hess - - Licensed under the GNU GPL version 3 or higher. -} diff --git a/Annex/Url.hs b/Annex/Url.hs --- a/Annex/Url.hs +++ b/Annex/Url.hs @@ -1,7 +1,7 @@ {- Url downloading, with git-annex user agent and configured http - headers and wget/curl options. - - - Copyright 2013-2014 Joey Hess + - Copyright 2013-2014 Joey Hess - - Licensed under the GNU GPL version 3 or higher. -} diff --git a/Annex/VariantFile.hs b/Annex/VariantFile.hs --- a/Annex/VariantFile.hs +++ b/Annex/VariantFile.hs @@ -1,6 +1,6 @@ {- git-annex .variant files for automatic merge conflict resolution - - - Copyright 2014 Joey Hess + - Copyright 2014 Joey Hess - - Licensed under the GNU GPL version 3 or higher. -} diff --git a/Annex/Version.hs b/Annex/Version.hs --- a/Annex/Version.hs +++ b/Annex/Version.hs @@ -1,6 +1,6 @@ {- git-annex repository versioning - - - Copyright 2010,2013 Joey Hess + - Copyright 2010,2013 Joey Hess - - Licensed under the GNU GPL version 3 or higher. -} diff --git a/Annex/View.hs b/Annex/View.hs --- a/Annex/View.hs +++ b/Annex/View.hs @@ -1,6 +1,6 @@ {- metadata based branch views - - - Copyright 2014 Joey Hess + - Copyright 2014 Joey Hess - - Licensed under the GNU GPL version 3 or higher. -} @@ -354,7 +354,7 @@ let metadata' = getfilemetadata f `unionMetaData` metadata forM_ (genviewedfiles f metadata') $ \fv -> do f' <- fromRepo $ fromTopFilePath $ asTopFilePath fv - stagesymlink uh hasher f' =<< inRepo (gitAnnexLink f' k) + stagesymlink uh hasher f' =<< calcRepo (gitAnnexLink f' k) go uh hasher f Nothing | "." `isPrefixOf` f = do s <- liftIO $ getSymbolicLinkStatus f diff --git a/Annex/View/ViewedFile.hs b/Annex/View/ViewedFile.hs --- a/Annex/View/ViewedFile.hs +++ b/Annex/View/ViewedFile.hs @@ -1,6 +1,6 @@ {- filenames (not paths) used in views - - - Copyright 2014 Joey Hess + - Copyright 2014 Joey Hess - - Licensed under the GNU GPL version 3 or higher. -} diff --git a/Annex/Wanted.hs b/Annex/Wanted.hs --- a/Annex/Wanted.hs +++ b/Annex/Wanted.hs @@ -1,6 +1,6 @@ {- git-annex checking whether content is wanted - - - Copyright 2012 Joey Hess + - Copyright 2012 Joey Hess - - Licensed under the GNU GPL version 3 or higher. -} @@ -15,15 +15,15 @@ {- Check if a file is preferred content for the local repository. -} wantGet :: Bool -> Maybe Key -> AssociatedFile -> Annex Bool -wantGet def key file = isPreferredContent Nothing S.empty key file def +wantGet d key file = isPreferredContent Nothing S.empty key file d {- Check if a file is preferred content for a remote. -} wantSend :: Bool -> Maybe Key -> AssociatedFile -> UUID -> Annex Bool -wantSend def key file to = isPreferredContent (Just to) S.empty key file def +wantSend d key file to = isPreferredContent (Just to) S.empty key file d {- Check if a file can be dropped, maybe from a remote. - Don't drop files that are preferred content. -} wantDrop :: Bool -> Maybe UUID -> Maybe Key -> AssociatedFile -> Annex Bool -wantDrop def from key file = do +wantDrop d from key file = do u <- maybe getUUID (return . id) from - not <$> isPreferredContent (Just u) (S.singleton u) key file def + not <$> isPreferredContent (Just u) (S.singleton u) key file d diff --git a/Assistant.hs b/Assistant.hs --- a/Assistant.hs +++ b/Assistant.hs @@ -1,6 +1,6 @@ {- git-annex assistant daemon - - - Copyright 2012-2013 Joey Hess + - Copyright 2012-2013 Joey Hess - - Licensed under the GNU GPL version 3 or higher. -} diff --git a/Assistant/Alert.hs b/Assistant/Alert.hs --- a/Assistant/Alert.hs +++ b/Assistant/Alert.hs @@ -1,6 +1,6 @@ {- git-annex assistant alerts - - - Copyright 2012-2014 Joey Hess + - Copyright 2012-2014 Joey Hess - - Licensed under the GNU GPL version 3 or higher. -} diff --git a/Assistant/Alert/Utility.hs b/Assistant/Alert/Utility.hs --- a/Assistant/Alert/Utility.hs +++ b/Assistant/Alert/Utility.hs @@ -1,6 +1,6 @@ {- git-annex assistant alert utilities - - - Copyright 2012, 2013 Joey Hess + - Copyright 2012, 2013 Joey Hess - - Licensed under the GNU GPL version 3 or higher. -} diff --git a/Assistant/BranchChange.hs b/Assistant/BranchChange.hs --- a/Assistant/BranchChange.hs +++ b/Assistant/BranchChange.hs @@ -1,6 +1,6 @@ {- git-annex assistant git-annex branch change tracking - - - Copyright 2012 Joey Hess + - Copyright 2012 Joey Hess - - Licensed under the GNU GPL version 3 or higher. -} diff --git a/Assistant/Changes.hs b/Assistant/Changes.hs --- a/Assistant/Changes.hs +++ b/Assistant/Changes.hs @@ -1,6 +1,6 @@ {- git-annex assistant change tracking - - - Copyright 2012-2013 Joey Hess + - Copyright 2012-2013 Joey Hess - - Licensed under the GNU GPL version 3 or higher. -} diff --git a/Assistant/Commits.hs b/Assistant/Commits.hs --- a/Assistant/Commits.hs +++ b/Assistant/Commits.hs @@ -1,6 +1,6 @@ {- git-annex assistant commit tracking - - - Copyright 2012 Joey Hess + - Copyright 2012 Joey Hess - - Licensed under the GNU GPL version 3 or higher. -} diff --git a/Assistant/Common.hs b/Assistant/Common.hs --- a/Assistant/Common.hs +++ b/Assistant/Common.hs @@ -1,6 +1,6 @@ {- Common infrastructure for the git-annex assistant. - - - Copyright 2012 Joey Hess + - Copyright 2012 Joey Hess - - Licensed under the GNU GPL version 3 or higher. -} diff --git a/Assistant/CredPairCache.hs b/Assistant/CredPairCache.hs --- a/Assistant/CredPairCache.hs +++ b/Assistant/CredPairCache.hs @@ -1,6 +1,6 @@ {- git-annex assistant CredPair cache. - - - Copyright 2014 Joey Hess + - Copyright 2014 Joey Hess - - Licensed under the GNU GPL version 3 or higher. -} diff --git a/Assistant/DaemonStatus.hs b/Assistant/DaemonStatus.hs --- a/Assistant/DaemonStatus.hs +++ b/Assistant/DaemonStatus.hs @@ -1,6 +1,6 @@ {- git-annex assistant daemon status - - - Copyright 2012 Joey Hess + - Copyright 2012 Joey Hess - - Licensed under the GNU GPL version 3 or higher. -} diff --git a/Assistant/DeleteRemote.hs b/Assistant/DeleteRemote.hs --- a/Assistant/DeleteRemote.hs +++ b/Assistant/DeleteRemote.hs @@ -1,6 +1,6 @@ {- git-annex assistant remote deletion utilities - - - Copyright 2012 Joey Hess + - Copyright 2012 Joey Hess - - Licensed under the GNU GPL version 3 or higher. -} diff --git a/Assistant/Drop.hs b/Assistant/Drop.hs --- a/Assistant/Drop.hs +++ b/Assistant/Drop.hs @@ -1,6 +1,6 @@ {- git-annex assistant dropping of unwanted content - - - Copyright 2012 Joey Hess + - Copyright 2012 Joey Hess - - Licensed under the GNU GPL version 3 or higher. -} diff --git a/Assistant/Fsck.hs b/Assistant/Fsck.hs --- a/Assistant/Fsck.hs +++ b/Assistant/Fsck.hs @@ -1,6 +1,6 @@ {- git-annex assistant fscking - - - Copyright 2013 Joey Hess + - Copyright 2013 Joey Hess - - Licensed under the GNU AGPL version 3 or higher. -} diff --git a/Assistant/Gpg.hs b/Assistant/Gpg.hs --- a/Assistant/Gpg.hs +++ b/Assistant/Gpg.hs @@ -1,6 +1,6 @@ {- git-annex assistant gpg stuff - - - Copyright 2013 Joey Hess + - Copyright 2013 Joey Hess - - Licensed under the GNU AGPL version 3 or higher. -} diff --git a/Assistant/Install.hs b/Assistant/Install.hs --- a/Assistant/Install.hs +++ b/Assistant/Install.hs @@ -1,6 +1,6 @@ {- Assistant installation - - - Copyright 2012 Joey Hess + - Copyright 2012 Joey Hess - - Licensed under the GNU GPL version 3 or higher. -} diff --git a/Assistant/Install/AutoStart.hs b/Assistant/Install/AutoStart.hs --- a/Assistant/Install/AutoStart.hs +++ b/Assistant/Install/AutoStart.hs @@ -1,6 +1,6 @@ {- Assistant autostart file installation - - - Copyright 2012 Joey Hess + - Copyright 2012 Joey Hess - - Licensed under the GNU GPL version 3 or higher. -} diff --git a/Assistant/Install/Menu.hs b/Assistant/Install/Menu.hs --- a/Assistant/Install/Menu.hs +++ b/Assistant/Install/Menu.hs @@ -1,6 +1,6 @@ {- Assistant menu installation. - - - Copyright 2013 Joey Hess + - Copyright 2013 Joey Hess - - Licensed under the GNU GPL version 3 or higher. -} diff --git a/Assistant/MakeRemote.hs b/Assistant/MakeRemote.hs --- a/Assistant/MakeRemote.hs +++ b/Assistant/MakeRemote.hs @@ -1,6 +1,6 @@ {- git-annex assistant remote creation utilities - - - Copyright 2012, 2013 Joey Hess + - Copyright 2012, 2013 Joey Hess - - Licensed under the GNU GPL version 3 or higher. -} diff --git a/Assistant/Monad.hs b/Assistant/Monad.hs --- a/Assistant/Monad.hs +++ b/Assistant/Monad.hs @@ -1,6 +1,6 @@ {- git-annex assistant monad - - - Copyright 2012 Joey Hess + - Copyright 2012 Joey Hess - - Licensed under the GNU GPL version 3 or higher. -} diff --git a/Assistant/NamedThread.hs b/Assistant/NamedThread.hs --- a/Assistant/NamedThread.hs +++ b/Assistant/NamedThread.hs @@ -1,6 +1,6 @@ {- git-annex assistant named threads. - - - Copyright 2012 Joey Hess + - Copyright 2012 Joey Hess - - Licensed under the GNU GPL version 3 or higher. -} diff --git a/Assistant/NetMessager.hs b/Assistant/NetMessager.hs --- a/Assistant/NetMessager.hs +++ b/Assistant/NetMessager.hs @@ -1,6 +1,6 @@ {- git-annex assistant out of band network messager interface - - - Copyright 2012-2013 Joey Hess + - Copyright 2012-2013 Joey Hess - - Licensed under the GNU GPL version 3 or higher. -} diff --git a/Assistant/Pairing.hs b/Assistant/Pairing.hs --- a/Assistant/Pairing.hs +++ b/Assistant/Pairing.hs @@ -1,6 +1,6 @@ {- git-annex assistant repo pairing, core data types - - - Copyright 2012 Joey Hess + - Copyright 2012 Joey Hess - - Licensed under the GNU GPL version 3 or higher. -} diff --git a/Assistant/Pairing/MakeRemote.hs b/Assistant/Pairing/MakeRemote.hs --- a/Assistant/Pairing/MakeRemote.hs +++ b/Assistant/Pairing/MakeRemote.hs @@ -1,6 +1,6 @@ {- git-annex assistant pairing remote creation - - - Copyright 2012 Joey Hess + - Copyright 2012 Joey Hess - - Licensed under the GNU GPL version 3 or higher. -} @@ -23,12 +23,11 @@ {- Authorized keys are set up before pairing is complete, so that the other - side can immediately begin syncing. -} setupAuthorizedKeys :: PairMsg -> FilePath -> IO () -setupAuthorizedKeys msg repodir = do - validateSshPubKey pubkey - unlessM (liftIO $ addAuthorizedKeys True repodir pubkey) $ - error "failed setting up ssh authorized keys" - where - pubkey = remoteSshPubKey $ pairMsgData msg +setupAuthorizedKeys msg repodir = case validateSshPubKey $ remoteSshPubKey $ pairMsgData msg of + Left err -> error err + Right pubkey -> + unlessM (liftIO $ addAuthorizedKeys True repodir pubkey) $ + error "failed setting up ssh authorized keys" {- When local pairing is complete, this is used to set up the remote for - the host we paired with. -} diff --git a/Assistant/Pairing/Network.hs b/Assistant/Pairing/Network.hs --- a/Assistant/Pairing/Network.hs +++ b/Assistant/Pairing/Network.hs @@ -4,7 +4,7 @@ - each message is repeated until acknowledged. This is done using a - thread, that gets stopped before the next message is sent. - - - Copyright 2012 Joey Hess + - Copyright 2012 Joey Hess - - Licensed under the GNU GPL version 3 or higher. -} diff --git a/Assistant/Pushes.hs b/Assistant/Pushes.hs --- a/Assistant/Pushes.hs +++ b/Assistant/Pushes.hs @@ -1,6 +1,6 @@ {- git-annex assistant push tracking - - - Copyright 2012 Joey Hess + - Copyright 2012 Joey Hess - - Licensed under the GNU GPL version 3 or higher. -} diff --git a/Assistant/RemoteControl.hs b/Assistant/RemoteControl.hs --- a/Assistant/RemoteControl.hs +++ b/Assistant/RemoteControl.hs @@ -1,6 +1,6 @@ {- git-annex assistant RemoteDaemon control - - - Copyright 2014 Joey Hess + - Copyright 2014 Joey Hess - - Licensed under the GNU GPL version 3 or higher. -} diff --git a/Assistant/Repair.hs b/Assistant/Repair.hs --- a/Assistant/Repair.hs +++ b/Assistant/Repair.hs @@ -1,6 +1,6 @@ {- git-annex assistant repository repair - - - Copyright 2013 Joey Hess + - Copyright 2013 Joey Hess - - Licensed under the GNU AGPL version 3 or higher. -} @@ -140,8 +140,7 @@ repairStaleLocks :: [FilePath] -> Assistant () repairStaleLocks lockfiles = go =<< getsizes where - getsize lf = catchMaybeIO $ - (\s -> (lf, fileSize s)) <$> getFileStatus lf + getsize lf = catchMaybeIO $ (\s -> (lf, s)) <$> getFileSize lf getsizes = liftIO $ catMaybes <$> mapM getsize lockfiles go [] = return () go l = ifM (liftIO $ null <$> Lsof.query ("--" : map fst l)) diff --git a/Assistant/RepoProblem.hs b/Assistant/RepoProblem.hs --- a/Assistant/RepoProblem.hs +++ b/Assistant/RepoProblem.hs @@ -1,6 +1,6 @@ {- git-annex assistant remote problem handling - - - Copyright 2013 Joey Hess + - Copyright 2013 Joey Hess - - Licensed under the GNU GPL version 3 or higher. -} diff --git a/Assistant/Restart.hs b/Assistant/Restart.hs --- a/Assistant/Restart.hs +++ b/Assistant/Restart.hs @@ -1,6 +1,6 @@ {- git-annex assistant restarting - - - Copyright 2013 Joey Hess + - Copyright 2013 Joey Hess - - Licensed under the GNU AGPL version 3 or higher. -} @@ -29,7 +29,6 @@ #else import Utility.WinProcess #endif -import Data.Default import Network.URI {- Before the assistant can be restarted, have to remove our @@ -96,7 +95,7 @@ - warp-tls listens to http, in order to show an error page, so this works. -} assistantListening :: URLString -> IO Bool -assistantListening url = catchBoolIO $ fst <$> exists url' def +assistantListening url = catchBoolIO $ exists url' def where url' = case parseURI url of Nothing -> url diff --git a/Assistant/ScanRemotes.hs b/Assistant/ScanRemotes.hs --- a/Assistant/ScanRemotes.hs +++ b/Assistant/ScanRemotes.hs @@ -1,6 +1,6 @@ {- git-annex assistant remotes needing scanning - - - Copyright 2012 Joey Hess + - Copyright 2012 Joey Hess - - Licensed under the GNU GPL version 3 or higher. -} diff --git a/Assistant/Ssh.hs b/Assistant/Ssh.hs --- a/Assistant/Ssh.hs +++ b/Assistant/Ssh.hs @@ -1,6 +1,6 @@ {- git-annex assistant ssh utilities - - - Copyright 2012-2013 Joey Hess + - Copyright 2012-2013 Joey Hess - - Licensed under the GNU GPL version 3 or higher. -} @@ -111,33 +111,25 @@ sshTranscript opts input = processTranscript "ssh" opts input {- Ensure that the ssh public key doesn't include any ssh options, like - - command=foo, or other weirdness -} -validateSshPubKey :: SshPubKey -> IO () + - command=foo, or other weirdness. + - + - The returned version of the key has its comment removed. + -} +validateSshPubKey :: SshPubKey -> Either String SshPubKey validateSshPubKey pubkey - | length (lines pubkey) == 1 = - either error return $ check $ words pubkey - | otherwise = error "too many lines in ssh public key" + | length (lines pubkey) == 1 = check $ words pubkey + | otherwise = Left "too many lines in ssh public key" where - check [prefix, _key, comment] = do - checkprefix prefix - checkcomment comment - check [prefix, _key] = - checkprefix prefix + check (prefix:key:_) = checkprefix prefix (unwords [prefix, key]) check _ = err "wrong number of words in ssh public key" - ok = Right () err msg = Left $ unwords [msg, pubkey] - checkprefix prefix - | ssh == "ssh" && all isAlphaNum keytype = ok + checkprefix prefix validpubkey + | ssh == "ssh" && all isAlphaNum keytype = Right validpubkey | otherwise = err "bad ssh public key prefix" where (ssh, keytype) = separate (== '-') prefix - - checkcomment comment = case filter (not . safeincomment) comment of - [] -> ok - badstuff -> err $ "bad comment in ssh public key (contains: \"" ++ badstuff ++ "\")" - safeincomment c = isAlphaNum c || c == '@' || c == '-' || c == '_' || c == '.' addAuthorizedKeys :: Bool -> FilePath -> SshPubKey -> IO Bool addAuthorizedKeys gitannexshellonly dir pubkey = boolSystem "sh" diff --git a/Assistant/Sync.hs b/Assistant/Sync.hs --- a/Assistant/Sync.hs +++ b/Assistant/Sync.hs @@ -1,6 +1,6 @@ {- git-annex assistant repo syncing - - - Copyright 2012 Joey Hess + - Copyright 2012 Joey Hess - - Licensed under the GNU GPL version 3 or higher. -} diff --git a/Assistant/Threads/Committer.hs b/Assistant/Threads/Committer.hs --- a/Assistant/Threads/Committer.hs +++ b/Assistant/Threads/Committer.hs @@ -1,6 +1,6 @@ {- git-annex assistant commit thread - - - Copyright 2012 Joey Hess + - Copyright 2012 Joey Hess - - Licensed under the GNU GPL version 3 or higher. -} @@ -352,7 +352,7 @@ done change mcache file key = liftAnnex $ do logStatus key InfoPresent link <- ifM isDirect - ( inRepo $ gitAnnexLink file key + ( calcRepo $ gitAnnexLink file key , Command.Add.link file key mcache ) whenM (pure DirWatcher.eventsCoalesce <||> isDirect) $ diff --git a/Assistant/Threads/ConfigMonitor.hs b/Assistant/Threads/ConfigMonitor.hs --- a/Assistant/Threads/ConfigMonitor.hs +++ b/Assistant/Threads/ConfigMonitor.hs @@ -1,6 +1,6 @@ {- git-annex assistant config monitor thread - - - Copyright 2012 Joey Hess + - Copyright 2012 Joey Hess - - Licensed under the GNU GPL version 3 or higher. -} diff --git a/Assistant/Threads/Cronner.hs b/Assistant/Threads/Cronner.hs --- a/Assistant/Threads/Cronner.hs +++ b/Assistant/Threads/Cronner.hs @@ -1,6 +1,6 @@ {- git-annex assistant sceduled jobs runner - - - Copyright 2013 Joey Hess + - Copyright 2013 Joey Hess - - Licensed under the GNU GPL version 3 or higher. -} diff --git a/Assistant/Threads/DaemonStatus.hs b/Assistant/Threads/DaemonStatus.hs --- a/Assistant/Threads/DaemonStatus.hs +++ b/Assistant/Threads/DaemonStatus.hs @@ -1,6 +1,6 @@ {- git-annex assistant daemon status thread - - - Copyright 2012 Joey Hess + - Copyright 2012 Joey Hess - - Licensed under the GNU GPL version 3 or higher. -} diff --git a/Assistant/Threads/Glacier.hs b/Assistant/Threads/Glacier.hs --- a/Assistant/Threads/Glacier.hs +++ b/Assistant/Threads/Glacier.hs @@ -1,6 +1,6 @@ {- git-annex assistant Amazon Glacier retrieval - - - Copyright 2012 Joey Hess + - Copyright 2012 Joey Hess - - Licensed under the GNU GPL version 3 or higher. -} diff --git a/Assistant/Threads/Merger.hs b/Assistant/Threads/Merger.hs --- a/Assistant/Threads/Merger.hs +++ b/Assistant/Threads/Merger.hs @@ -1,6 +1,6 @@ {- git-annex assistant git merge thread - - - Copyright 2012 Joey Hess + - Copyright 2012 Joey Hess - - Licensed under the GNU GPL version 3 or higher. -} diff --git a/Assistant/Threads/MountWatcher.hs b/Assistant/Threads/MountWatcher.hs --- a/Assistant/Threads/MountWatcher.hs +++ b/Assistant/Threads/MountWatcher.hs @@ -1,6 +1,6 @@ {- git-annex assistant mount watcher, using either dbus or mtab polling - - - Copyright 2012 Joey Hess + - Copyright 2012 Joey Hess - - Licensed under the GNU GPL version 3 or higher. -} diff --git a/Assistant/Threads/NetWatcher.hs b/Assistant/Threads/NetWatcher.hs --- a/Assistant/Threads/NetWatcher.hs +++ b/Assistant/Threads/NetWatcher.hs @@ -1,6 +1,6 @@ {- git-annex assistant network connection watcher, using dbus - - - Copyright 2012 Joey Hess + - Copyright 2012 Joey Hess - - Licensed under the GNU GPL version 3 or higher. -} diff --git a/Assistant/Threads/PairListener.hs b/Assistant/Threads/PairListener.hs --- a/Assistant/Threads/PairListener.hs +++ b/Assistant/Threads/PairListener.hs @@ -1,6 +1,6 @@ {- git-annex assistant thread to listen for incoming pairing traffic - - - Copyright 2012 Joey Hess + - Copyright 2012 Joey Hess - - Licensed under the GNU GPL version 3 or higher. -} diff --git a/Assistant/Threads/ProblemFixer.hs b/Assistant/Threads/ProblemFixer.hs --- a/Assistant/Threads/ProblemFixer.hs +++ b/Assistant/Threads/ProblemFixer.hs @@ -1,6 +1,6 @@ {- git-annex assistant thread to handle fixing problems with repositories - - - Copyright 2013 Joey Hess + - Copyright 2013 Joey Hess - - Licensed under the GNU GPL version 3 or higher. -} diff --git a/Assistant/Threads/Pusher.hs b/Assistant/Threads/Pusher.hs --- a/Assistant/Threads/Pusher.hs +++ b/Assistant/Threads/Pusher.hs @@ -1,6 +1,6 @@ {- git-annex assistant git pushing thread - - - Copyright 2012 Joey Hess + - Copyright 2012 Joey Hess - - Licensed under the GNU GPL version 3 or higher. -} diff --git a/Assistant/Threads/RemoteControl.hs b/Assistant/Threads/RemoteControl.hs --- a/Assistant/Threads/RemoteControl.hs +++ b/Assistant/Threads/RemoteControl.hs @@ -1,6 +1,6 @@ {- git-annex assistant communication with remotedaemon - - - Copyright 2014 Joey Hess + - Copyright 2014 Joey Hess - - Licensed under the GNU GPL version 3 or higher. -} diff --git a/Assistant/Threads/SanityChecker.hs b/Assistant/Threads/SanityChecker.hs --- a/Assistant/Threads/SanityChecker.hs +++ b/Assistant/Threads/SanityChecker.hs @@ -1,6 +1,6 @@ {- git-annex assistant sanity checker - - - Copyright 2012, 2013 Joey Hess + - Copyright 2012, 2013 Joey Hess - - Licensed under the GNU GPL version 3 or higher. -} @@ -225,7 +225,7 @@ checkLogSize n = do f <- liftAnnex $ fromRepo gitAnnexLogFile logs <- liftIO $ listLogs f - totalsize <- liftIO $ sum <$> mapM filesize logs + totalsize <- liftIO $ sum <$> mapM getFileSize logs when (totalsize > 2 * oneMegabyte) $ do notice ["Rotated logs due to size:", show totalsize] liftIO $ openLog f >>= handleToFd >>= redirLog @@ -237,9 +237,7 @@ checkLogSize (n + 1) _ -> noop where - filesize f = fromIntegral . fileSize <$> liftIO (getFileStatus f) - - oneMegabyte :: Int + oneMegabyte :: Integer oneMegabyte = 1000000 #endif diff --git a/Assistant/Threads/TransferPoller.hs b/Assistant/Threads/TransferPoller.hs --- a/Assistant/Threads/TransferPoller.hs +++ b/Assistant/Threads/TransferPoller.hs @@ -1,6 +1,6 @@ {- git-annex assistant transfer polling thread - - - Copyright 2012 Joey Hess + - Copyright 2012 Joey Hess - - Licensed under the GNU GPL version 3 or higher. -} @@ -36,8 +36,7 @@ - temp file being used for the transfer. -} | transferDirection t == Download = do let f = gitAnnexTmpObjectLocation (transferKey t) g - sz <- liftIO $ catchMaybeIO $ - fromIntegral . fileSize <$> getFileStatus f + sz <- liftIO $ catchMaybeIO $ getFileSize f newsize t info sz {- Uploads don't need to be polled for when the TransferWatcher - thread can track file modifications. -} diff --git a/Assistant/Threads/TransferScanner.hs b/Assistant/Threads/TransferScanner.hs --- a/Assistant/Threads/TransferScanner.hs +++ b/Assistant/Threads/TransferScanner.hs @@ -1,6 +1,6 @@ {- git-annex assistant thread to scan remotes to find needed transfers - - - Copyright 2012 Joey Hess + - Copyright 2012 Joey Hess - - Licensed under the GNU GPL version 3 or higher. -} diff --git a/Assistant/Threads/TransferWatcher.hs b/Assistant/Threads/TransferWatcher.hs --- a/Assistant/Threads/TransferWatcher.hs +++ b/Assistant/Threads/TransferWatcher.hs @@ -1,6 +1,6 @@ {- git-annex assistant transfer watching thread - - - Copyright 2012 Joey Hess + - Copyright 2012 Joey Hess - - Licensed under the GNU GPL version 3 or higher. -} diff --git a/Assistant/Threads/Transferrer.hs b/Assistant/Threads/Transferrer.hs --- a/Assistant/Threads/Transferrer.hs +++ b/Assistant/Threads/Transferrer.hs @@ -1,6 +1,6 @@ {- git-annex assistant data transferrer thread - - - Copyright 2012 Joey Hess + - Copyright 2012 Joey Hess - - Licensed under the GNU GPL version 3 or higher. -} diff --git a/Assistant/Threads/UpgradeWatcher.hs b/Assistant/Threads/UpgradeWatcher.hs --- a/Assistant/Threads/UpgradeWatcher.hs +++ b/Assistant/Threads/UpgradeWatcher.hs @@ -1,6 +1,6 @@ {- git-annex assistant thread to detect when git-annex is upgraded - - - Copyright 2013 Joey Hess + - Copyright 2013 Joey Hess - - Licensed under the GNU GPL version 3 or higher. -} diff --git a/Assistant/Threads/Upgrader.hs b/Assistant/Threads/Upgrader.hs --- a/Assistant/Threads/Upgrader.hs +++ b/Assistant/Threads/Upgrader.hs @@ -1,6 +1,6 @@ {- git-annex assistant thread to detect when upgrade is available - - - Copyright 2013 Joey Hess + - Copyright 2013 Joey Hess - - Licensed under the GNU GPL version 3 or higher. -} diff --git a/Assistant/Threads/Watcher.hs b/Assistant/Threads/Watcher.hs --- a/Assistant/Threads/Watcher.hs +++ b/Assistant/Threads/Watcher.hs @@ -1,6 +1,6 @@ {- git-annex assistant tree watcher - - - Copyright 2012-2013 Joey Hess + - Copyright 2012-2013 Joey Hess - - Licensed under the GNU GPL version 3 or higher. -} @@ -224,7 +224,7 @@ v <- liftAnnex $ catKeyFile file case (v, fs) of (Just key, Just filestatus) -> - ifM (liftAnnex $ sameFileStatus key filestatus) + ifM (liftAnnex $ sameFileStatus key file filestatus) {- It's possible to get an add event for - an existing file that is not - really modified, but it might have @@ -232,7 +232,7 @@ - so it symlink is restaged to make sure. -} ( ifM (shouldRestage <$> getDaemonStatus) ( do - link <- liftAnnex $ inRepo $ gitAnnexLink file key + link <- liftAnnex $ calcRepo $ gitAnnexLink file key addLink file link (Just key) , noChange ) @@ -279,7 +279,7 @@ go (Just key) = do when isdirect $ liftAnnex $ void $ addAssociatedFile key file - link <- liftAnnex $ inRepo $ gitAnnexLink file key + link <- liftAnnex $ calcRepo $ gitAnnexLink file key if linktarget == Just link then ensurestaged (Just link) =<< getDaemonStatus else do diff --git a/Assistant/Threads/WebApp.hs b/Assistant/Threads/WebApp.hs --- a/Assistant/Threads/WebApp.hs +++ b/Assistant/Threads/WebApp.hs @@ -1,6 +1,6 @@ {- git-annex assistant webapp thread - - - Copyright 2012-2014 Joey Hess + - Copyright 2012-2014 Joey Hess - - Licensed under the GNU GPL version 3 or higher. -} diff --git a/Assistant/Threads/XMPPClient.hs b/Assistant/Threads/XMPPClient.hs --- a/Assistant/Threads/XMPPClient.hs +++ b/Assistant/Threads/XMPPClient.hs @@ -1,6 +1,6 @@ {- git-annex XMPP client - - - Copyright 2012, 2013 Joey Hess + - Copyright 2012, 2013 Joey Hess - - Licensed under the GNU GPL version 3 or higher. -} diff --git a/Assistant/Threads/XMPPPusher.hs b/Assistant/Threads/XMPPPusher.hs --- a/Assistant/Threads/XMPPPusher.hs +++ b/Assistant/Threads/XMPPPusher.hs @@ -9,7 +9,7 @@ - they would deadlock with only one thread. For larger numbers of - clients, the two threads are also sufficient. - - - Copyright 2013 Joey Hess + - Copyright 2013 Joey Hess - - Licensed under the GNU GPL version 3 or higher. -} diff --git a/Assistant/TransferQueue.hs b/Assistant/TransferQueue.hs --- a/Assistant/TransferQueue.hs +++ b/Assistant/TransferQueue.hs @@ -1,6 +1,6 @@ {- git-annex assistant pending transfer queue - - - Copyright 2012-2014 Joey Hess + - Copyright 2012-2014 Joey Hess - - Licensed under the GNU GPL version 3 or higher. -} diff --git a/Assistant/TransferSlots.hs b/Assistant/TransferSlots.hs --- a/Assistant/TransferSlots.hs +++ b/Assistant/TransferSlots.hs @@ -1,6 +1,6 @@ {- git-annex assistant transfer slots - - - Copyright 2012 Joey Hess + - Copyright 2012 Joey Hess - - Licensed under the GNU GPL version 3 or higher. -} diff --git a/Assistant/TransferrerPool.hs b/Assistant/TransferrerPool.hs --- a/Assistant/TransferrerPool.hs +++ b/Assistant/TransferrerPool.hs @@ -1,6 +1,6 @@ {- A pool of "git-annex transferkeys" processes - - - Copyright 2013 Joey Hess + - Copyright 2013 Joey Hess - - Licensed under the GNU GPL version 3 or higher. -} diff --git a/Assistant/Types/Alert.hs b/Assistant/Types/Alert.hs --- a/Assistant/Types/Alert.hs +++ b/Assistant/Types/Alert.hs @@ -1,6 +1,6 @@ {- git-annex assistant alert types - - - Copyright 2013 Joey Hess + - Copyright 2013 Joey Hess - - Licensed under the GNU GPL version 3 or higher. -} diff --git a/Assistant/Types/BranchChange.hs b/Assistant/Types/BranchChange.hs --- a/Assistant/Types/BranchChange.hs +++ b/Assistant/Types/BranchChange.hs @@ -1,6 +1,6 @@ {- git-annex assistant git-annex branch change tracking - - - Copyright 2012 Joey Hess + - Copyright 2012 Joey Hess - - Licensed under the GNU GPL version 3 or higher. -} diff --git a/Assistant/Types/Buddies.hs b/Assistant/Types/Buddies.hs --- a/Assistant/Types/Buddies.hs +++ b/Assistant/Types/Buddies.hs @@ -1,6 +1,6 @@ {- git-annex assistant buddies - - - Copyright 2012 Joey Hess + - Copyright 2012 Joey Hess - - Licensed under the GNU GPL version 3 or higher. -} diff --git a/Assistant/Types/Changes.hs b/Assistant/Types/Changes.hs --- a/Assistant/Types/Changes.hs +++ b/Assistant/Types/Changes.hs @@ -1,6 +1,6 @@ {- git-annex assistant change tracking - - - Copyright 2012-2013 Joey Hess + - Copyright 2012-2013 Joey Hess - - Licensed under the GNU GPL version 3 or higher. -} diff --git a/Assistant/Types/Commits.hs b/Assistant/Types/Commits.hs --- a/Assistant/Types/Commits.hs +++ b/Assistant/Types/Commits.hs @@ -1,6 +1,6 @@ {- git-annex assistant commit tracking - - - Copyright 2012 Joey Hess + - Copyright 2012 Joey Hess - - Licensed under the GNU GPL version 3 or higher. -} diff --git a/Assistant/Types/CredPairCache.hs b/Assistant/Types/CredPairCache.hs --- a/Assistant/Types/CredPairCache.hs +++ b/Assistant/Types/CredPairCache.hs @@ -1,6 +1,6 @@ {- git-annex assistant CredPair cache. - - - Copyright 2014 Joey Hess + - Copyright 2014 Joey Hess - - Licensed under the GNU GPL version 3 or higher. -} diff --git a/Assistant/Types/DaemonStatus.hs b/Assistant/Types/DaemonStatus.hs --- a/Assistant/Types/DaemonStatus.hs +++ b/Assistant/Types/DaemonStatus.hs @@ -1,6 +1,6 @@ {- git-annex assistant daemon status - - - Copyright 2012 Joey Hess + - Copyright 2012 Joey Hess - - Licensed under the GNU GPL version 3 or higher. -} diff --git a/Assistant/Types/NamedThread.hs b/Assistant/Types/NamedThread.hs --- a/Assistant/Types/NamedThread.hs +++ b/Assistant/Types/NamedThread.hs @@ -1,6 +1,6 @@ {- named threads - - - Copyright 2012 Joey Hess + - Copyright 2012 Joey Hess - - Licensed under the GNU GPL version 3 or higher. -} diff --git a/Assistant/Types/NetMessager.hs b/Assistant/Types/NetMessager.hs --- a/Assistant/Types/NetMessager.hs +++ b/Assistant/Types/NetMessager.hs @@ -1,6 +1,6 @@ {- git-annex assistant out of band network messager types - - - Copyright 2012 Joey Hess + - Copyright 2012 Joey Hess - - Licensed under the GNU GPL version 3 or higher. -} diff --git a/Assistant/Types/Pushes.hs b/Assistant/Types/Pushes.hs --- a/Assistant/Types/Pushes.hs +++ b/Assistant/Types/Pushes.hs @@ -1,6 +1,6 @@ {- git-annex assistant push tracking - - - Copyright 2012 Joey Hess + - Copyright 2012 Joey Hess - - Licensed under the GNU GPL version 3 or higher. -} diff --git a/Assistant/Types/RemoteControl.hs b/Assistant/Types/RemoteControl.hs --- a/Assistant/Types/RemoteControl.hs +++ b/Assistant/Types/RemoteControl.hs @@ -1,6 +1,6 @@ {- git-annex assistant RemoteDaemon control - - - Copyright 2014 Joey Hess + - Copyright 2014 Joey Hess - - Licensed under the GNU GPL version 3 or higher. -} diff --git a/Assistant/Types/RepoProblem.hs b/Assistant/Types/RepoProblem.hs --- a/Assistant/Types/RepoProblem.hs +++ b/Assistant/Types/RepoProblem.hs @@ -1,6 +1,6 @@ {- git-annex assistant repository problem tracking - - - Copyright 2013 Joey Hess + - Copyright 2013 Joey Hess - - Licensed under the GNU GPL version 3 or higher. -} diff --git a/Assistant/Types/ScanRemotes.hs b/Assistant/Types/ScanRemotes.hs --- a/Assistant/Types/ScanRemotes.hs +++ b/Assistant/Types/ScanRemotes.hs @@ -1,6 +1,6 @@ {- git-annex assistant remotes needing scanning - - - Copyright 2012 Joey Hess + - Copyright 2012 Joey Hess - - Licensed under the GNU GPL version 3 or higher. -} diff --git a/Assistant/Types/ThreadName.hs b/Assistant/Types/ThreadName.hs --- a/Assistant/Types/ThreadName.hs +++ b/Assistant/Types/ThreadName.hs @@ -1,6 +1,6 @@ {- name of a thread - - - Copyright 2012 Joey Hess + - Copyright 2012 Joey Hess - - Licensed under the GNU GPL version 3 or higher. -} diff --git a/Assistant/Types/ThreadedMonad.hs b/Assistant/Types/ThreadedMonad.hs --- a/Assistant/Types/ThreadedMonad.hs +++ b/Assistant/Types/ThreadedMonad.hs @@ -1,6 +1,6 @@ {- making the Annex monad available across threads - - - Copyright 2012 Joey Hess + - Copyright 2012 Joey Hess - - Licensed under the GNU GPL version 3 or higher. -} diff --git a/Assistant/Types/TransferQueue.hs b/Assistant/Types/TransferQueue.hs --- a/Assistant/Types/TransferQueue.hs +++ b/Assistant/Types/TransferQueue.hs @@ -1,6 +1,6 @@ {- git-annex assistant pending transfer queue - - - Copyright 2012 Joey Hess + - Copyright 2012 Joey Hess - - Licensed under the GNU GPL version 3 or higher. -} diff --git a/Assistant/Types/TransferSlots.hs b/Assistant/Types/TransferSlots.hs --- a/Assistant/Types/TransferSlots.hs +++ b/Assistant/Types/TransferSlots.hs @@ -1,6 +1,6 @@ {- git-annex assistant transfer slots - - - Copyright 2012 Joey Hess + - Copyright 2012 Joey Hess - - Licensed under the GNU GPL version 3 or higher. -} diff --git a/Assistant/Types/TransferrerPool.hs b/Assistant/Types/TransferrerPool.hs --- a/Assistant/Types/TransferrerPool.hs +++ b/Assistant/Types/TransferrerPool.hs @@ -1,6 +1,6 @@ {- A pool of "git-annex transferkeys" processes available for use - - - Copyright 2013 Joey Hess + - Copyright 2013 Joey Hess - - Licensed under the GNU GPL version 3 or higher. -} diff --git a/Assistant/Types/UrlRenderer.hs b/Assistant/Types/UrlRenderer.hs --- a/Assistant/Types/UrlRenderer.hs +++ b/Assistant/Types/UrlRenderer.hs @@ -1,6 +1,6 @@ {- webapp url renderer access from the assistant - - - Copyright 2013 Joey Hess + - Copyright 2013 Joey Hess - - Licensed under the GNU GPL version 3 or higher. -} diff --git a/Assistant/Unused.hs b/Assistant/Unused.hs --- a/Assistant/Unused.hs +++ b/Assistant/Unused.hs @@ -1,6 +1,6 @@ {- git-annex assistant unused files - - - Copyright 2014 Joey Hess + - Copyright 2014 Joey Hess - - Licensed under the GNU GPL version 3 or higher. -} diff --git a/Assistant/Upgrade.hs b/Assistant/Upgrade.hs --- a/Assistant/Upgrade.hs +++ b/Assistant/Upgrade.hs @@ -1,6 +1,6 @@ {- git-annex assistant upgrading - - - Copyright 2013 Joey Hess + - Copyright 2013 Joey Hess - - Licensed under the GNU AGPL version 3 or higher. -} diff --git a/Assistant/WebApp.hs b/Assistant/WebApp.hs --- a/Assistant/WebApp.hs +++ b/Assistant/WebApp.hs @@ -1,6 +1,6 @@ {- git-annex assistant webapp core - - - Copyright 2012, 2013 Joey Hess + - Copyright 2012, 2013 Joey Hess - - Licensed under the GNU AGPL version 3 or higher. -} diff --git a/Assistant/WebApp/Common.hs b/Assistant/WebApp/Common.hs --- a/Assistant/WebApp/Common.hs +++ b/Assistant/WebApp/Common.hs @@ -1,6 +1,6 @@ {- git-annex assistant webapp, common imports - - - Copyright 2012 Joey Hess + - Copyright 2012 Joey Hess - - Licensed under the GNU AGPL version 3 or higher. -} diff --git a/Assistant/WebApp/Configurators.hs b/Assistant/WebApp/Configurators.hs --- a/Assistant/WebApp/Configurators.hs +++ b/Assistant/WebApp/Configurators.hs @@ -1,6 +1,6 @@ {- git-annex assistant webapp configurators - - - Copyright 2012 Joey Hess + - Copyright 2012 Joey Hess - - Licensed under the GNU AGPL version 3 or higher. -} diff --git a/Assistant/WebApp/Configurators/AWS.hs b/Assistant/WebApp/Configurators/AWS.hs --- a/Assistant/WebApp/Configurators/AWS.hs +++ b/Assistant/WebApp/Configurators/AWS.hs @@ -1,6 +1,6 @@ {- git-annex assistant webapp configurators for Amazon AWS services - - - Copyright 2012 Joey Hess + - Copyright 2012 Joey Hess - - Licensed under the GNU AGPL version 3 or higher. -} diff --git a/Assistant/WebApp/Configurators/Delete.hs b/Assistant/WebApp/Configurators/Delete.hs --- a/Assistant/WebApp/Configurators/Delete.hs +++ b/Assistant/WebApp/Configurators/Delete.hs @@ -1,6 +1,6 @@ {- git-annex assistant webapp repository deletion - - - Copyright 2013 Joey Hess + - Copyright 2013 Joey Hess - - Licensed under the GNU AGPL version 3 or higher. -} diff --git a/Assistant/WebApp/Configurators/Edit.hs b/Assistant/WebApp/Configurators/Edit.hs --- a/Assistant/WebApp/Configurators/Edit.hs +++ b/Assistant/WebApp/Configurators/Edit.hs @@ -1,6 +1,6 @@ {- git-annex assistant webapp configurator for editing existing repos - - - Copyright 2012 Joey Hess + - Copyright 2012 Joey Hess - - Licensed under the GNU AGPL version 3 or higher. -} @@ -144,13 +144,13 @@ legalName = makeLegalName . T.unpack . repoName editRepositoryAForm :: Maybe Remote -> RepoConfig -> MkAForm RepoConfig -editRepositoryAForm mremote def = RepoConfig +editRepositoryAForm mremote d = RepoConfig <$> areq (if ishere then readonlyTextField else textField) - (bfs "Name") (Just $ repoName def) - <*> aopt textField (bfs "Description") (Just $ repoDescription def) - <*> areq (selectFieldList groups `withNote` help) (bfs "Repository group") (Just $ repoGroup def) + (bfs "Name") (Just $ repoName d) + <*> aopt textField (bfs "Description") (Just $ repoDescription d) + <*> areq (selectFieldList groups `withNote` help) (bfs "Repository group") (Just $ repoGroup d) <*> associateddirectory - <*> areq checkBoxField "Syncing enabled" (Just $ repoSyncable def) + <*> areq checkBoxField "Syncing enabled" (Just $ repoSyncable d) where ishere = isNothing mremote isspecial = fromMaybe False $ @@ -163,14 +163,14 @@ | isspecial = const True | otherwise = not . specialRemoteOnly customgroups :: [(Text, RepoGroup)] - customgroups = case repoGroup def of + customgroups = case repoGroup d of RepoGroupCustom s -> [(T.pack s, RepoGroupCustom s)] _ -> [] help = [whamlet|What's this?|] - associateddirectory = case repoAssociatedDirectory def of + associateddirectory = case repoAssociatedDirectory d of Nothing -> aopt hiddenField "" Nothing - Just d -> aopt textField (bfs "Associated directory") (Just $ Just d) + Just dir -> aopt textField (bfs "Associated directory") (Just $ Just dir) getEditRepositoryR :: RepoId -> Handler Html getEditRepositoryR = postEditRepositoryR diff --git a/Assistant/WebApp/Configurators/Fsck.hs b/Assistant/WebApp/Configurators/Fsck.hs --- a/Assistant/WebApp/Configurators/Fsck.hs +++ b/Assistant/WebApp/Configurators/Fsck.hs @@ -1,6 +1,6 @@ {- git-annex assistant fsck configuration - - - Copyright 2013 Joey Hess + - Copyright 2013 Joey Hess - - Licensed under the GNU AGPL version 3 or higher. -} @@ -167,8 +167,8 @@ <$> (annexFsckNudge <$> Annex.getGitConfig) fsckPreferencesAForm :: FsckPreferences -> MkAForm FsckPreferences -fsckPreferencesAForm def = FsckPreferences - <$> areq (checkBoxField `withNote` nudgenote) "Reminders" (Just $ enableFsckNudge def) +fsckPreferencesAForm d = FsckPreferences + <$> areq (checkBoxField `withNote` nudgenote) "Reminders" (Just $ enableFsckNudge d) where nudgenote = [whamlet|Remind me when using repositories that lack consistency checks.|] diff --git a/Assistant/WebApp/Configurators/IA.hs b/Assistant/WebApp/Configurators/IA.hs --- a/Assistant/WebApp/Configurators/IA.hs +++ b/Assistant/WebApp/Configurators/IA.hs @@ -1,6 +1,6 @@ {- git-annex assistant webapp configurators for Internet Archive - - - Copyright 2013 Joey Hess + - Copyright 2013 Joey Hess - - Licensed under the GNU AGPL version 3 or higher. -} @@ -191,7 +191,7 @@ getRepoInfo :: RemoteConfig -> Widget getRepoInfo c = do uo <- liftAnnex Url.getUrlOptions - exists <- liftIO $ catchDefaultIO False $ fst <$> Url.exists url uo + exists <- liftIO $ catchDefaultIO False $ Url.exists url uo [whamlet| Internet Archive item diff --git a/Assistant/WebApp/Configurators/Local.hs b/Assistant/WebApp/Configurators/Local.hs --- a/Assistant/WebApp/Configurators/Local.hs +++ b/Assistant/WebApp/Configurators/Local.hs @@ -1,6 +1,6 @@ {- git-annex assistant webapp configurators for making local repositories - - - Copyright 2012-2014 Joey Hess + - Copyright 2012-2014 Joey Hess - - Licensed under the GNU AGPL version 3 or higher. -} diff --git a/Assistant/WebApp/Configurators/Pairing.hs b/Assistant/WebApp/Configurators/Pairing.hs --- a/Assistant/WebApp/Configurators/Pairing.hs +++ b/Assistant/WebApp/Configurators/Pairing.hs @@ -1,6 +1,6 @@ {- git-annex assistant webapp configurator for pairing - - - Copyright 2012 Joey Hess + - Copyright 2012 Joey Hess - - Licensed under the GNU AGPL version 3 or higher. -} diff --git a/Assistant/WebApp/Configurators/Preferences.hs b/Assistant/WebApp/Configurators/Preferences.hs --- a/Assistant/WebApp/Configurators/Preferences.hs +++ b/Assistant/WebApp/Configurators/Preferences.hs @@ -1,6 +1,6 @@ {- git-annex assistant general preferences - - - Copyright 2013 Joey Hess + - Copyright 2013 Joey Hess - - Licensed under the GNU AGPL version 3 or higher. -} @@ -34,17 +34,17 @@ } prefsAForm :: PrefsForm -> MkAForm PrefsForm -prefsAForm def = PrefsForm +prefsAForm d = PrefsForm <$> areq (storageField `withNote` diskreservenote) - (bfs "Disk reserve") (Just $ diskReserve def) + (bfs "Disk reserve") (Just $ diskReserve d) <*> areq (positiveIntField `withNote` numcopiesnote) - (bfs "Number of copies") (Just $ numCopies def) + (bfs "Number of copies") (Just $ numCopies d) <*> areq (checkBoxField `withNote` autostartnote) - "Auto start" (Just $ autoStart def) + "Auto start" (Just $ autoStart d) <*> areq (selectFieldList autoUpgradeChoices) - (bfs autoUpgradeLabel) (Just $ autoUpgrade def) + (bfs autoUpgradeLabel) (Just $ autoUpgrade d) <*> areq (checkBoxField `withNote` debugnote) - "Enable debug logging" (Just $ debugEnabled def) + "Enable debug logging" (Just $ debugEnabled d) where diskreservenote = [whamlet|
Avoid downloading files from other repositories when there is too little free disk space.|] numcopiesnote = [whamlet|
Only drop a file after verifying that other repositories contain this many copies.|] diff --git a/Assistant/WebApp/Configurators/Ssh.hs b/Assistant/WebApp/Configurators/Ssh.hs --- a/Assistant/WebApp/Configurators/Ssh.hs +++ b/Assistant/WebApp/Configurators/Ssh.hs @@ -1,6 +1,6 @@ {- git-annex assistant webapp configurator for ssh-based remotes - - - Copyright 2012-2014 Joey Hess + - Copyright 2012-2014 Joey Hess - - Licensed under the GNU AGPL version 3 or higher. -} @@ -91,15 +91,15 @@ #else sshInputAForm :: Field WebApp WebApp Text -> SshInput -> AForm WebApp WebApp SshInput #endif -sshInputAForm hostnamefield def = normalize <$> gen +sshInputAForm hostnamefield d = normalize <$> gen where gen = SshInput - <$> aopt check_hostname (bfs "Host name") (Just $ inputHostname def) - <*> aopt check_username (bfs "User name") (Just $ inputUsername def) - <*> areq (selectFieldList authmethods) (bfs "Authenticate with") (Just $ inputAuthMethod def) + <$> aopt check_hostname (bfs "Host name") (Just $ inputHostname d) + <*> aopt check_username (bfs "User name") (Just $ inputUsername d) + <*> areq (selectFieldList authmethods) (bfs "Authenticate with") (Just $ inputAuthMethod d) <*> aopt passwordField (bfs "Password") Nothing - <*> aopt textField (bfs "Directory") (Just $ Just $ fromMaybe (T.pack gitAnnexAssistantDefaultDir) $ inputDirectory def) - <*> areq intField (bfs "Port") (Just $ inputPort def) + <*> aopt textField (bfs "Directory") (Just $ Just $ fromMaybe (T.pack gitAnnexAssistantDefaultDir) $ inputDirectory d) + <*> areq intField (bfs "Port") (Just $ inputPort d) authmethods :: [(Text, AuthMethod)] authmethods = @@ -133,10 +133,10 @@ -- The directory is implicitly in home, so remove any leading ~/ normalize i = i { inputDirectory = normalizedir <$> inputDirectory i } - normalizedir d - | "~/" `T.isPrefixOf` d = T.drop 2 d - | "/~/" `T.isPrefixOf` d = T.drop 3 d - | otherwise = d + normalizedir dir + | "~/" `T.isPrefixOf` dir = T.drop 2 dir + | "/~/" `T.isPrefixOf` dir = T.drop 3 dir + | otherwise = dir data ServerStatus = UntestedServer diff --git a/Assistant/WebApp/Configurators/Unused.hs b/Assistant/WebApp/Configurators/Unused.hs --- a/Assistant/WebApp/Configurators/Unused.hs +++ b/Assistant/WebApp/Configurators/Unused.hs @@ -1,6 +1,6 @@ {- git-annex assistant unused file preferences - - - Copyright 2014 Joey Hess + - Copyright 2014 Joey Hess - - Licensed under the GNU AGPL version 3 or higher. -} @@ -26,11 +26,11 @@ } unusedForm :: UnusedForm -> Hamlet.Html -> MkMForm UnusedForm -unusedForm def msg = do +unusedForm d msg = do (enableRes, enableView) <- mreq (selectFieldList enabledisable) (bfs "") - (Just $ enableExpire def) + (Just $ enableExpire d) (whenRes, whenView) <- mreq intField (bfs "") - (Just $ expireWhen def) + (Just $ expireWhen d) let form = do webAppFormAuthToken $(widgetFile "configurators/unused/form") diff --git a/Assistant/WebApp/Configurators/Upgrade.hs b/Assistant/WebApp/Configurators/Upgrade.hs --- a/Assistant/WebApp/Configurators/Upgrade.hs +++ b/Assistant/WebApp/Configurators/Upgrade.hs @@ -1,6 +1,6 @@ {- git-annex assistant webapp upgrade UI - - - Copyright 2013 Joey Hess + - Copyright 2013 Joey Hess - - Licensed under the GNU AGPL version 3 or higher. -} diff --git a/Assistant/WebApp/Configurators/WebDAV.hs b/Assistant/WebApp/Configurators/WebDAV.hs --- a/Assistant/WebApp/Configurators/WebDAV.hs +++ b/Assistant/WebApp/Configurators/WebDAV.hs @@ -1,6 +1,6 @@ {- git-annex assistant webapp configurators for WebDAV remotes - - - Copyright 2012, 2013 Joey Hess + - Copyright 2012, 2013 Joey Hess - - Licensed under the GNU AGPL version 3 or higher. -} diff --git a/Assistant/WebApp/Configurators/XMPP.hs b/Assistant/WebApp/Configurators/XMPP.hs --- a/Assistant/WebApp/Configurators/XMPP.hs +++ b/Assistant/WebApp/Configurators/XMPP.hs @@ -1,6 +1,6 @@ {- git-annex assistant XMPP configuration - - - Copyright 2012 Joey Hess + - Copyright 2012 Joey Hess - - Licensed under the GNU AGPL version 3 or higher. -} @@ -161,8 +161,8 @@ creds2Form c = XMPPForm (xmppJID c) (xmppPassword c) xmppAForm :: (Maybe XMPPForm) -> MkAForm XMPPForm -xmppAForm def = XMPPForm - <$> areq jidField (bfs "Jabber address") (formJID <$> def) +xmppAForm d = XMPPForm + <$> areq jidField (bfs "Jabber address") (formJID <$> d) <*> areq passwordField (bfs "Password") Nothing jidField :: MkField Text diff --git a/Assistant/WebApp/Control.hs b/Assistant/WebApp/Control.hs --- a/Assistant/WebApp/Control.hs +++ b/Assistant/WebApp/Control.hs @@ -1,6 +1,6 @@ {- git-annex assistant webapp control - - - Copyright 2012, 2013 Joey Hess + - Copyright 2012, 2013 Joey Hess - - Licensed under the GNU AGPL version 3 or higher. -} diff --git a/Assistant/WebApp/DashBoard.hs b/Assistant/WebApp/DashBoard.hs --- a/Assistant/WebApp/DashBoard.hs +++ b/Assistant/WebApp/DashBoard.hs @@ -1,6 +1,6 @@ {- git-annex assistant webapp dashboard - - - Copyright 2012 Joey Hess + - Copyright 2012 Joey Hess - - Licensed under the GNU AGPL version 3 or higher. -} diff --git a/Assistant/WebApp/Documentation.hs b/Assistant/WebApp/Documentation.hs --- a/Assistant/WebApp/Documentation.hs +++ b/Assistant/WebApp/Documentation.hs @@ -1,6 +1,6 @@ {- git-annex assistant webapp documentation - - - Copyright 2012 Joey Hess + - Copyright 2012 Joey Hess - - Licensed under the GNU AGPL version 3 or higher. -} diff --git a/Assistant/WebApp/Form.hs b/Assistant/WebApp/Form.hs --- a/Assistant/WebApp/Form.hs +++ b/Assistant/WebApp/Form.hs @@ -1,6 +1,6 @@ {- git-annex assistant webapp form utilities - - - Copyright 2012 Joey Hess + - Copyright 2012 Joey Hess - - Licensed under the GNU AGPL version 3 or higher. -} diff --git a/Assistant/WebApp/Gpg.hs b/Assistant/WebApp/Gpg.hs --- a/Assistant/WebApp/Gpg.hs +++ b/Assistant/WebApp/Gpg.hs @@ -1,6 +1,6 @@ {- git-annex webapp gpg stuff - - - Copyright 2013 Joey Hess + - Copyright 2013 Joey Hess - - Licensed under the GNU AGPL version 3 or higher. -} diff --git a/Assistant/WebApp/MakeRemote.hs b/Assistant/WebApp/MakeRemote.hs --- a/Assistant/WebApp/MakeRemote.hs +++ b/Assistant/WebApp/MakeRemote.hs @@ -1,6 +1,6 @@ {- git-annex assistant webapp making remotes - - - Copyright 2012 Joey Hess + - Copyright 2012 Joey Hess - - Licensed under the GNU AGPL version 3 or higher. -} diff --git a/Assistant/WebApp/Notifications.hs b/Assistant/WebApp/Notifications.hs --- a/Assistant/WebApp/Notifications.hs +++ b/Assistant/WebApp/Notifications.hs @@ -1,6 +1,6 @@ {- git-annex assistant webapp notifications - - - Copyright 2012 Joey Hess + - Copyright 2012 Joey Hess - - Licensed under the GNU AGPL version 3 or higher. -} diff --git a/Assistant/WebApp/OtherRepos.hs b/Assistant/WebApp/OtherRepos.hs --- a/Assistant/WebApp/OtherRepos.hs +++ b/Assistant/WebApp/OtherRepos.hs @@ -1,6 +1,6 @@ {- git-annex assistant webapp switching to other repos - - - Copyright 2012 Joey Hess + - Copyright 2012 Joey Hess - - Licensed under the GNU AGPL version 3 or higher. -} diff --git a/Assistant/WebApp/Page.hs b/Assistant/WebApp/Page.hs --- a/Assistant/WebApp/Page.hs +++ b/Assistant/WebApp/Page.hs @@ -1,6 +1,6 @@ {- git-annex assistant webapp page display - - - Copyright 2012 Joey Hess + - Copyright 2012 Joey Hess - - Licensed under the GNU AGPL version 3 or higher. -} diff --git a/Assistant/WebApp/Repair.hs b/Assistant/WebApp/Repair.hs --- a/Assistant/WebApp/Repair.hs +++ b/Assistant/WebApp/Repair.hs @@ -1,6 +1,6 @@ {- git-annex assistant repository repair - - - Copyright 2013 Joey Hess + - Copyright 2013 Joey Hess - - Licensed under the GNU AGPL version 3 or higher. -} diff --git a/Assistant/WebApp/RepoId.hs b/Assistant/WebApp/RepoId.hs --- a/Assistant/WebApp/RepoId.hs +++ b/Assistant/WebApp/RepoId.hs @@ -1,6 +1,6 @@ {- git-annex assistant webapp RepoId type - - - Copyright 2012,2013 Joey Hess + - Copyright 2012,2013 Joey Hess - - Licensed under the GNU AGPL version 3 or higher. -} diff --git a/Assistant/WebApp/RepoList.hs b/Assistant/WebApp/RepoList.hs --- a/Assistant/WebApp/RepoList.hs +++ b/Assistant/WebApp/RepoList.hs @@ -1,6 +1,6 @@ {- git-annex assistant webapp repository list - - - Copyright 2012,2013 Joey Hess + - Copyright 2012,2013 Joey Hess - - Licensed under the GNU AGPL version 3 or higher. -} diff --git a/Assistant/WebApp/SideBar.hs b/Assistant/WebApp/SideBar.hs --- a/Assistant/WebApp/SideBar.hs +++ b/Assistant/WebApp/SideBar.hs @@ -1,6 +1,6 @@ {- git-annex assistant webapp sidebar - - - Copyright 2012 Joey Hess + - Copyright 2012 Joey Hess - - Licensed under the GNU AGPL version 3 or higher. -} diff --git a/Assistant/WebApp/Types.hs b/Assistant/WebApp/Types.hs --- a/Assistant/WebApp/Types.hs +++ b/Assistant/WebApp/Types.hs @@ -1,6 +1,6 @@ {- git-annex assistant webapp types - - - Copyright 2012 Joey Hess + - Copyright 2012 Joey Hess - - Licensed under the GNU AGPL version 3 or higher. -} diff --git a/Assistant/XMPP.hs b/Assistant/XMPP.hs --- a/Assistant/XMPP.hs +++ b/Assistant/XMPP.hs @@ -1,6 +1,6 @@ {- core xmpp support - - - Copyright 2012-2013 Joey Hess + - Copyright 2012-2013 Joey Hess - - Licensed under the GNU GPL version 3 or higher. -} diff --git a/Assistant/XMPP/Buddies.hs b/Assistant/XMPP/Buddies.hs --- a/Assistant/XMPP/Buddies.hs +++ b/Assistant/XMPP/Buddies.hs @@ -1,6 +1,6 @@ {- xmpp buddies - - - Copyright 2012 Joey Hess + - Copyright 2012 Joey Hess - - Licensed under the GNU GPL version 3 or higher. -} diff --git a/Assistant/XMPP/Client.hs b/Assistant/XMPP/Client.hs --- a/Assistant/XMPP/Client.hs +++ b/Assistant/XMPP/Client.hs @@ -1,6 +1,6 @@ {- xmpp client support - - - Copyright 2012 Joey Hess + - Copyright 2012 Joey Hess - - Licensed under the GNU GPL version 3 or higher. -} diff --git a/Assistant/XMPP/Git.hs b/Assistant/XMPP/Git.hs --- a/Assistant/XMPP/Git.hs +++ b/Assistant/XMPP/Git.hs @@ -1,6 +1,6 @@ {- git over XMPP - - - Copyright 2012 Joey Hess + - Copyright 2012 Joey Hess - - Licensed under the GNU GPL version 3 or higher. -} diff --git a/Backend.hs b/Backend.hs --- a/Backend.hs +++ b/Backend.hs @@ -1,6 +1,6 @@ {- git-annex key/value backends - - - Copyright 2010-2014 Joey Hess + - Copyright 2010-2014 Joey Hess - - Licensed under the GNU GPL version 3 or higher. -} diff --git a/Backend/Hash.hs b/Backend/Hash.hs --- a/Backend/Hash.hs +++ b/Backend/Hash.hs @@ -1,12 +1,10 @@ {- git-tnnex hashing backends - - - Copyright 2011-2013 Joey Hess + - Copyright 2011-2013 Joey Hess - - Licensed under the GNU GPL version 3 or higher. -} -{-# LANGUAGE CPP #-} - module Backend.Hash ( backends, testKeyBackend, @@ -24,7 +22,7 @@ import qualified Data.ByteString.Lazy as L import Data.Char -data Hash = SHAHash HashSize | SkeinHash HashSize +data Hash = SHAHash HashSize | SkeinHash HashSize | MD5Hash type HashSize = Int {- Order is slightly significant; want SHA256 first, and more general @@ -32,9 +30,8 @@ hashes :: [Hash] hashes = concat [ map SHAHash [256, 1, 512, 224, 384] -#ifdef WITH_CRYPTOHASH , map SkeinHash [256, 512] -#endif + , [MD5Hash] ] {- The SHA256E backend is the default, so genBackendE comes first. -} @@ -60,6 +57,7 @@ hashName :: Hash -> String hashName (SHAHash size) = "SHA" ++ show size hashName (SkeinHash size) = "SKEIN" ++ show size +hashName MD5Hash = "MD5" hashNameE :: Hash -> String hashNameE hash = hashName hash ++ "E" @@ -68,8 +66,7 @@ keyValue :: Hash -> KeySource -> Annex (Maybe Key) keyValue hash source = do let file = contentLocation source - stat <- liftIO $ getFileStatus file - let filesize = fromIntegral $ fileSize stat + filesize <- liftIO $ getFileSize file s <- hashFile hash file filesize return $ Just $ stubKey { keyName = s @@ -103,7 +100,7 @@ mstat <- liftIO $ catchMaybeIO $ getFileStatus file case (mstat, fast) of (Just stat, False) -> do - let filesize = fromIntegral $ fileSize stat + filesize <- liftIO $ getFileSize' file stat showSideAction "checksum" check <$> hashFile hash file filesize _ -> return True @@ -157,6 +154,7 @@ either error return =<< externalSHA command hashsize file go (SkeinHash hashsize) = skeinHasher hashsize <$> L.readFile file + go MD5Hash = md5Hasher <$> L.readFile file shaHasher :: HashSize -> Integer -> Either (L.ByteString -> String) String shaHasher hashsize filesize @@ -179,11 +177,12 @@ skeinHasher :: HashSize -> (L.ByteString -> String) skeinHasher hashsize -#ifdef WITH_CRYPTOHASH | hashsize == 256 = show . skein256 | hashsize == 512 = show . skein512 -#endif | otherwise = error $ "unsupported skein size " ++ show hashsize + +md5Hasher :: L.ByteString -> String +md5Hasher = show . md5 {- A varient of the SHA256E backend, for testing that needs special keys - that cannot collide with legitimate keys in the repository. diff --git a/Backend/URL.hs b/Backend/URL.hs --- a/Backend/URL.hs +++ b/Backend/URL.hs @@ -1,6 +1,6 @@ {- git-annex "URL" backend -- keys whose content is available from urls. - - - Copyright 2011 Joey Hess + - Copyright 2011 Joey Hess - - Licensed under the GNU GPL version 3 or higher. -} diff --git a/Backend/Utilities.hs b/Backend/Utilities.hs --- a/Backend/Utilities.hs +++ b/Backend/Utilities.hs @@ -1,6 +1,6 @@ {- git-annex backend utilities - - - Copyright 2012 Joey Hess + - Copyright 2012 Joey Hess - - Licensed under the GNU GPL version 3 or higher. -} diff --git a/Backend/WORM.hs b/Backend/WORM.hs --- a/Backend/WORM.hs +++ b/Backend/WORM.hs @@ -1,6 +1,6 @@ {- git-annex "WORM" backend -- Write Once, Read Many - - - Copyright 2010 Joey Hess + - Copyright 2010 Joey Hess - - Licensed under the GNU GPL version 3 or higher. -} @@ -32,11 +32,13 @@ -} keyValue :: KeySource -> Annex (Maybe Key) keyValue source = do - stat <- liftIO $ getFileStatus $ contentLocation source + let f = contentLocation source + stat <- liftIO $ getFileStatus f + sz <- liftIO $ getFileSize' f stat relf <- getTopFilePath <$> inRepo (toTopFilePath $ keyFilename source) return $ Just $ stubKey { keyName = genKeyName relf , keyBackendName = name backend - , keySize = Just $ fromIntegral $ fileSize stat + , keySize = Just sz , keyMtime = Just $ modificationTime stat } diff --git a/Build/BundledPrograms.hs b/Build/BundledPrograms.hs --- a/Build/BundledPrograms.hs +++ b/Build/BundledPrograms.hs @@ -1,6 +1,6 @@ {- Bundled programs - - - Copyright 2013 Joey Hess + - Copyright 2013 Joey Hess - - Licensed under the GNU GPL version 3 or higher. -} diff --git a/Build/Configure.hs b/Build/Configure.hs --- a/Build/Configure.hs +++ b/Build/Configure.hs @@ -15,6 +15,7 @@ import Utility.SafeCommand import Utility.ExternalSHA import Utility.Env +import Utility.Exception import qualified Git.Version import Utility.DottedVersion @@ -106,7 +107,8 @@ <$> getWgetVersion getWgetVersion :: IO (Maybe DottedVersion) -getWgetVersion = extract <$> readProcess "wget" ["--version"] +getWgetVersion = catchDefaultIO Nothing $ + extract <$> readProcess "wget" ["--version"] where extract s = case lines s of [] -> Nothing diff --git a/Build/DesktopFile.hs b/Build/DesktopFile.hs --- a/Build/DesktopFile.hs +++ b/Build/DesktopFile.hs @@ -1,7 +1,7 @@ {- Generating and installing a desktop menu entry file and icon, - and a desktop autostart file. (And OSX equivilants.) - - - Copyright 2012 Joey Hess + - Copyright 2012 Joey Hess - - Licensed under the GNU GPL version 3 or higher. -} diff --git a/Build/DistributionUpdate.hs b/Build/DistributionUpdate.hs --- a/Build/DistributionUpdate.hs +++ b/Build/DistributionUpdate.hs @@ -22,6 +22,7 @@ import Data.Default import Data.Time.Clock import Data.Char +import System.Posix.Directory -- git-annex distribution signing key (for Joey Hess) signingKey :: String @@ -49,10 +50,12 @@ main :: IO () main = do + version <- liftIO getChangelogVersion repodir <- getRepoDir + changeWorkingDirectory repodir updated <- catMaybes <$> mapM (getbuild repodir) autobuilds - state <- Annex.new =<< Git.Construct.fromPath repodir - Annex.eval state (makeinfos updated) + state <- Annex.new =<< Git.Construct.fromPath "." + Annex.eval state (makeinfos updated version) -- Download a build from the autobuilder, and return its version. -- It's very important that the version matches the build, otherwise @@ -91,26 +94,25 @@ return $ if null bv || any (not . versionchar) bv then Nothing else Just bv versionchar c = isAlphaNum c || c == '.' || c == '-' -makeinfos :: [(FilePath, Version)] -> Annex () -makeinfos updated = do +makeinfos :: [(FilePath, Version)] -> Version -> Annex () +makeinfos updated version = do mapM_ (\f -> inRepo $ runBool [Param "annex", Param "add", File f]) (map fst updated) - version <- liftIO getChangelogVersion void $ inRepo $ runBool [ Param "commit" , Param "-a" + , Param "-S89C809CB" -- git-annex distribution signing key , Param "-m" , Param $ "publishing git-annex " ++ version ] - basedir <- liftIO getRepoDir now <- liftIO getCurrentTime - liftIO $ putStrLn $ "building info files in " ++ basedir + liftIO $ putStrLn $ "building info files" forM_ updated $ \(f, bv) -> do - v <- lookupFile (basedir f) + v <- lookupFile f case v of Nothing -> noop Just k -> whenM (inAnnex k) $ do liftIO $ putStrLn f - let infofile = basedir f ++ ".info" + let infofile = f ++ ".info" liftIO $ writeFile infofile $ show $ GitAnnexDistribution { distributionUrl = mkUrl f , distributionKey = k @@ -120,10 +122,11 @@ } void $ inRepo $ runBool [Param "add", File infofile] signFile infofile - signFile (basedir f) + signFile f void $ inRepo $ runBool [ Param "commit" , Param "-m" + , Param "-S89C809CB" -- git-annex distribution signing key , Param $ "updated info files for git-annex " ++ version ] void $ inRepo $ runBool @@ -137,14 +140,14 @@ -- Check for out of date info files. infos <- liftIO $ filter (".info" `isSuffixOf`) - <$> dirContentsRecursive (basedir "git-annex") + <$> dirContentsRecursive "git-annex" ds <- liftIO $ forM infos (readish <$$> readFile) let dis = zip infos ds - let ood = filter (outofdate version) dis + let ood = filter outofdate dis unless (null ood) $ error $ "Some info files are out of date: " ++ show (map fst ood) where - outofdate version (_, md) = case md of + outofdate (_, md) = case md of Nothing -> True Just d -> distributionVersion d /= version diff --git a/Build/EvilLinker.hs b/Build/EvilLinker.hs --- a/Build/EvilLinker.hs +++ b/Build/EvilLinker.hs @@ -3,7 +3,7 @@ - - See https://ghc.haskell.org/trac/ghc/ticket/8596 - - - Copyright 2013 Joey Hess + - Copyright 2013 Joey Hess - - Licensed under the GNU GPL version 3 or higher. -} diff --git a/Build/EvilSplicer.hs b/Build/EvilSplicer.hs --- a/Build/EvilSplicer.hs +++ b/Build/EvilSplicer.hs @@ -23,7 +23,7 @@ - need modifications to compile. - - - - Copyright 2013 Joey Hess + - Copyright 2013 Joey Hess - - Licensed under the GNU GPL version 3 or higher. -} diff --git a/Build/InstallDesktopFile.hs b/Build/InstallDesktopFile.hs --- a/Build/InstallDesktopFile.hs +++ b/Build/InstallDesktopFile.hs @@ -1,7 +1,7 @@ {- Generating and installing a desktop menu entry file and icon, - and a desktop autostart file. (And OSX equivilants.) - - - Copyright 2012 Joey Hess + - Copyright 2012 Joey Hess - - Licensed under the GNU GPL version 3 or higher. -} diff --git a/Build/LinuxMkLibs.hs b/Build/LinuxMkLibs.hs --- a/Build/LinuxMkLibs.hs +++ b/Build/LinuxMkLibs.hs @@ -1,6 +1,6 @@ {- Linux library copier and binary shimmer - - - Copyright 2013 Joey Hess + - Copyright 2013 Joey Hess - - Licensed under the GNU GPL version 3 or higher. -} diff --git a/Build/NullSoftInstaller.hs b/Build/NullSoftInstaller.hs --- a/Build/NullSoftInstaller.hs +++ b/Build/NullSoftInstaller.hs @@ -11,7 +11,7 @@ - exception of git. The user needs to install git separately, - and the installer checks for that. - - - Copyright 2013 Joey Hess + - Copyright 2013 Joey Hess - - Licensed under the GNU GPL version 3 or higher. -} @@ -44,7 +44,9 @@ return p webappscript <- vbsLauncher tmpdir "git-annex-webapp" "git-annex webapp" autostartscript <- vbsLauncher tmpdir "git-annex-autostart" "git annex assistant --autostart" - writeFile nsifile $ makeInstaller gitannex license + let htmlhelp = tmpdir "git-annex.html" + writeFile htmlhelp htmlHelpText + writeFile nsifile $ makeInstaller gitannex license htmlhelp (catMaybes extrabins) [ webappscript, autostartscript ] mustSucceed "makensis" [File nsifile] @@ -98,8 +100,8 @@ , fromString "You can install git from http:////git-scm.com//" ] -makeInstaller :: FilePath -> FilePath -> [FilePath] -> [FilePath] -> String -makeInstaller gitannex license extrabins launchers = nsis $ do +makeInstaller :: FilePath -> FilePath -> FilePath -> [FilePath] -> [FilePath] -> String +makeInstaller gitannex license htmlhelp extrabins launchers = nsis $ do name "git-annex" outFile $ str installer {- Installing into the same directory as git avoids needing to modify @@ -137,6 +139,8 @@ setOutPath "$INSTDIR\\cmd" mapM_ addfile (gitannex:extrabins) section "meta" [] $ do + setOutPath "$INSTDIR\\doc\\git\\html" + addfile htmlhelp setOutPath "$INSTDIR" addfile license mapM_ addfile launchers @@ -145,6 +149,7 @@ delete [RebootOK] $ startMenuItem delete [RebootOK] $ autoStartItem removefilesFrom "$INSTDIR/cmd" (gitannex:extrabins) + removefilesFrom "$INSTDIR\\doc\\git\\html" [htmlhelp] removefilesFrom "$INSTDIR" $ launchers ++ [ license @@ -195,4 +200,17 @@ , "cygreadline7.dll" , "cygncursesw-10.dll" , "cygusb0.dll" + ] + +-- msysgit opens Program Files/Git/doc/git/html/git-annex.html +-- when git annex --help is run. +htmlHelpText :: String +htmlHelpText = unlines + [ "" + , "git-annex help" + , "" + , "For help on git-annex, run \"git annex help\", or" + , "read the man page." + , "" + , " + - Copyright 2012 Joey Hess - - Licensed under the GNU GPL version 3 or higher. -} diff --git a/Build/Standalone.hs b/Build/Standalone.hs --- a/Build/Standalone.hs +++ b/Build/Standalone.hs @@ -1,6 +1,6 @@ {- Makes standalone bundle. - - - Copyright 2012 Joey Hess + - Copyright 2012 Joey Hess - - Licensed under the GNU GPL version 3 or higher. -} diff --git a/BuildFlags.hs b/BuildFlags.hs --- a/BuildFlags.hs +++ b/BuildFlags.hs @@ -1,6 +1,6 @@ {- git-annex build flags reporting - - - Copyright 2013 Joey Hess + - Copyright 2013 Joey Hess - - Licensed under the GNU GPL version 3 or higher. -} @@ -80,11 +80,6 @@ #endif #ifdef WITH_TDFA , "TDFA" -#endif -#ifdef WITH_CRYPTOHASH - , "CryptoHash" -#else -#warning Building without CryptoHash. #endif #ifdef WITH_TORRENTPARSER , "TorrentParser" diff --git a/CHANGELOG b/CHANGELOG --- a/CHANGELOG +++ b/CHANGELOG @@ -1,3 +1,40 @@ +git-annex (5.20150205) unstable; urgency=medium + + * info: Can now display info about a given uuid. + * Added to remote/uuid info: Count of the number of keys present + on the remote, and their size. This is rather expensive to calculate, + so comes last and --fast will disable it. + * info remote: Include the date of the last sync with the remote. + * sync: Added --message/-m option like git commit. + * remotedaemon: Fix problem that could prevent ssh connections being + made after two LOSTNET messages were received in a row (perhaps due to + two different network interfaces being brought down). + * Fix build failure when wget is not installed. + * Fix wording of message displayed when unable to get a file that + is available in untrusted repositories. + * addurl: When a Content-Disposition header suggests a filename to use, + addurl will consider using it, if it's reasonable and doesn't conflict + with an existing file. (--file overrides this) + * Fix default repository description created by git annex init, + which got broken by the relative path changes in the last release. + * init: Repository tuning parameters can now be passed when initializing a + repository for the first time. For details, see + http://git-annex.branchable.com/tuning/ + * merge: Refuse to merge changes from a git-annex branch of a repo + that has been tuned in incompatible ways. + * Support annex.tune.objecthash1, annex.tune.objecthashlower, and + annex.tune.branchhash1. + * Remove support for building without cryptohash. + * Added MD5 and MD5E backends. + * assistant: Fix local pairing when ssh pubkey comment contains spaces. + * Avoid using fileSize which maxes out at just 2 gb on Windows. + Instead, use hFileSize, which doesn't have a bounded size. + Fixes support for files > 2 gb on Windows. + * Windows: Fix running of the pre-commit-annex hook. + * Windows: Fix S3 special remote; need to call withSocketsDo. Thanks, Trent. + + -- Joey Hess Thu, 05 Feb 2015 14:08:33 -0400 + git-annex (5.20150113) unstable; urgency=medium * unlock: Don't allow unlocking files that have never been committed to git diff --git a/COPYRIGHT b/COPYRIGHT --- a/COPYRIGHT +++ b/COPYRIGHT @@ -2,30 +2,30 @@ Source: native package Files: * -Copyright: © 2010-2014 Joey Hess +Copyright: © 2010-2015 Joey Hess License: GPL-3+ Files: Assistant/WebApp.hs Assistant/WebApp/* templates/* static/* -Copyright: © 2012-2014 Joey Hess +Copyright: © 2012-2014 Joey Hess © 2014 Sören Brunk License: AGPL-3+ Files: Remote/Ddar.hs -Copyright: © 2011 Joey Hess +Copyright: © 2011 Joey Hess © 2014 Robie Basak License: GPL-3+ Files: Utility/ThreadScheduler.hs Copyright: 2011 Bas van Dijk & Roel van Dijk - 2012, 2013 Joey Hess + 2012, 2013 Joey Hess License: BSD-2-clause Files: Utility/* -Copyright: 2012-2014 Joey Hess +Copyright: 2012-2015 Joey Hess License: BSD-2-clause Files: Utility/Gpg.hs Utility/DirWatcher* -Copyright: © 2010-2014 Joey Hess +Copyright: © 2010-2014 Joey Hess License: GPL-3+ Files: Assistant/WebApp/Bootstrap3.hs @@ -34,7 +34,7 @@ Files: doc/logo* */favicon.ico standalone/osx/git-annex.app/Contents/Resources/git-annex.icns standalone/android/icons/* Copyright: 2007 Henrik Nyh - 2010 Joey Hess + 2010 Joey Hess 2013 John Lawrence License: other Free to modify and redistribute with due credit, and obviously free to use. @@ -46,14 +46,14 @@ Files: Utility/libmounts.c Copyright: 1980, 1989, 1993, 1994 The Regents of the University of California 2001 David Rufino - 2012 Joey Hess + 2012 Joey Hess License: BSD-3-clause * Copyright (c) 1980, 1989, 1993, 1994 * The Regents of the University of California. All rights reserved. * Copyright (c) 2001 * David Rufino * Copyright 2012 - * Joey Hess + * Joey Hess * * Redistribution and use in source and binary forms, with or without * modification, are permitted provided that the following conditions diff --git a/Checks.hs b/Checks.hs --- a/Checks.hs +++ b/Checks.hs @@ -3,7 +3,7 @@ - Common sanity checks for commands, and an interface to selectively - remove them, or add others. - - - Copyright 2011-2013 Joey Hess + - Copyright 2011-2013 Joey Hess - - Licensed under the GNU GPL version 3 or higher. -} diff --git a/CmdLine.hs b/CmdLine.hs --- a/CmdLine.hs +++ b/CmdLine.hs @@ -1,6 +1,6 @@ {- git-annex command line parsing and dispatch - - - Copyright 2010-2012 Joey Hess + - Copyright 2010-2012 Joey Hess - - Licensed under the GNU GPL version 3 or higher. -} diff --git a/CmdLine/Action.hs b/CmdLine/Action.hs --- a/CmdLine/Action.hs +++ b/CmdLine/Action.hs @@ -1,6 +1,6 @@ {- git-annex command-line actions - - - Copyright 2010-2014 Joey Hess + - Copyright 2010-2014 Joey Hess - - Licensed under the GNU GPL version 3 or higher. -} diff --git a/CmdLine/GitAnnex.hs b/CmdLine/GitAnnex.hs --- a/CmdLine/GitAnnex.hs +++ b/CmdLine/GitAnnex.hs @@ -1,6 +1,6 @@ {- git-annex main program - - - Copyright 2010-2014 Joey Hess + - Copyright 2010-2014 Joey Hess - - Licensed under the GNU GPL version 3 or higher. -} diff --git a/CmdLine/GitAnnex/Options.hs b/CmdLine/GitAnnex/Options.hs --- a/CmdLine/GitAnnex/Options.hs +++ b/CmdLine/GitAnnex/Options.hs @@ -1,6 +1,6 @@ {- git-annex options - - - Copyright 2010, 2013 Joey Hess + - Copyright 2010, 2013 Joey Hess - - Licensed under the GNU GPL version 3 or higher. -} diff --git a/CmdLine/GitAnnexShell.hs b/CmdLine/GitAnnexShell.hs --- a/CmdLine/GitAnnexShell.hs +++ b/CmdLine/GitAnnexShell.hs @@ -1,6 +1,6 @@ {- git-annex-shell main program - - - Copyright 2010-2012 Joey Hess + - Copyright 2010-2012 Joey Hess - - Licensed under the GNU GPL version 3 or higher. -} diff --git a/CmdLine/GitAnnexShell/Fields.hs b/CmdLine/GitAnnexShell/Fields.hs --- a/CmdLine/GitAnnexShell/Fields.hs +++ b/CmdLine/GitAnnexShell/Fields.hs @@ -1,6 +1,6 @@ {- git-annex-shell fields - - - Copyright 2012 Joey Hess + - Copyright 2012 Joey Hess - - Licensed under the GNU GPL version 3 or higher. -} diff --git a/CmdLine/Option.hs b/CmdLine/Option.hs --- a/CmdLine/Option.hs +++ b/CmdLine/Option.hs @@ -1,6 +1,6 @@ {- common command-line options - - - Copyright 2010-2011 Joey Hess + - Copyright 2010-2011 Joey Hess - - Licensed under the GNU GPL version 3 or higher. -} diff --git a/CmdLine/Seek.hs b/CmdLine/Seek.hs --- a/CmdLine/Seek.hs +++ b/CmdLine/Seek.hs @@ -4,7 +4,7 @@ - the values a user passes to a command, and prepare actions operating - on them. - - - Copyright 2010-2014 Joey Hess + - Copyright 2010-2014 Joey Hess - - Licensed under the GNU GPL version 3 or higher. -} diff --git a/CmdLine/Usage.hs b/CmdLine/Usage.hs --- a/CmdLine/Usage.hs +++ b/CmdLine/Usage.hs @@ -1,6 +1,6 @@ {- git-annex usage messages - - - Copyright 2010-2011 Joey Hess + - Copyright 2010-2011 Joey Hess - - Licensed under the GNU GPL version 3 or higher. -} diff --git a/Command.hs b/Command.hs --- a/Command.hs +++ b/Command.hs @@ -1,6 +1,6 @@ {- git-annex command infrastructure - - - Copyright 2010-2014 Joey Hess + - Copyright 2010-2014 Joey Hess - - Licensed under the GNU GPL version 3 or higher. -} diff --git a/Command/Add.hs b/Command/Add.hs --- a/Command/Add.hs +++ b/Command/Add.hs @@ -1,6 +1,6 @@ {- git-annex command - - - Copyright 2010, 2013 Joey Hess + - Copyright 2010, 2013 Joey Hess - - Licensed under the GNU GPL version 3 or higher. -} @@ -160,8 +160,9 @@ ingest (Just source) = withTSDelta $ \delta -> do backend <- chooseBackend $ keyFilename source k <- genKey source backend - ms <- liftIO $ catchMaybeIO $ getFileStatus $ contentLocation source - mcache <- maybe (pure Nothing) (liftIO . toInodeCache delta) ms + let src = contentLocation source + ms <- liftIO $ catchMaybeIO $ getFileStatus src + mcache <- maybe (pure Nothing) (liftIO . toInodeCache delta src) ms case (mcache, inodeCache source) of (_, Nothing) -> go k mcache ms (Just newc, Just c) | compareStrong c newc -> go k mcache ms @@ -229,7 +230,7 @@ {- Creates the symlink to the annexed content, returns the link target. -} link :: FilePath -> Key -> Maybe InodeCache -> Annex String link file key mcache = flip catchNonAsync (undo file key) $ do - l <- inRepo $ gitAnnexLink file key + l <- calcRepo $ gitAnnexLink file key replaceFile file $ makeAnnexLink l -- touch symlink to have same time as the original file, @@ -271,7 +272,7 @@ cleanup file key mcache hascontent = do ifM (isDirect <&&> pure hascontent) ( do - l <- inRepo $ gitAnnexLink file key + l <- calcRepo $ gitAnnexLink file key stageSymlink file =<< hashSymlink l , addLink file key mcache ) diff --git a/Command/AddUnused.hs b/Command/AddUnused.hs --- a/Command/AddUnused.hs +++ b/Command/AddUnused.hs @@ -1,6 +1,6 @@ {- git-annex command - - - Copyright 2012 Joey Hess + - Copyright 2012 Joey Hess - - Licensed under the GNU GPL version 3 or higher. -} diff --git a/Command/AddUrl.hs b/Command/AddUrl.hs --- a/Command/AddUrl.hs +++ b/Command/AddUrl.hs @@ -1,6 +1,6 @@ {- git-annex command - - - Copyright 2011-2014 Joey Hess + - Copyright 2011-2014 Joey Hess - - Licensed under the GNU GPL version 3 or higher. -} @@ -120,17 +120,16 @@ loguri = setDownloader uri OtherDownloader startWeb :: Bool -> Maybe FilePath -> Maybe Int -> String -> CommandStart -startWeb relaxed optfile pathdepth s = go $ fromMaybe bad $ parseURI s +startWeb relaxed optfile pathdepth s = go $ fromMaybe bad $ parseURI urlstring where - (s', downloader) = getDownloader s - bad = fromMaybe (error $ "bad url " ++ s') $ - parseURI $ escapeURIString isUnescapedInURI s' - choosefile = flip fromMaybe optfile + (urlstring, downloader) = getDownloader s + bad = fromMaybe (error $ "bad url " ++ urlstring) $ + parseURI $ escapeURIString isUnescapedInURI urlstring go url = case downloader of QuviDownloader -> usequvi _ -> #ifdef WITH_QUVI - ifM (quviSupported s') + ifM (quviSupported urlstring) ( usequvi , regulardownload url ) @@ -139,30 +138,44 @@ #endif regulardownload url = do pathmax <- liftIO $ fileNameLengthLimit "." - let file = choosefile $ url2file url pathdepth pathmax + urlinfo <- if relaxed + then pure $ Url.UrlInfo True Nothing Nothing + else Url.withUrlOptions (Url.getUrlInfo urlstring) + file <- case optfile of + Just f -> pure f + Nothing -> case Url.urlSuggestedFile urlinfo of + Nothing -> pure $ url2file url pathdepth pathmax + Just sf -> do + let f = truncateFilePath pathmax $ + sanitizeFilePath sf + ifM (liftIO $ doesFileExist f <||> doesDirectoryExist f) + ( pure $ url2file url pathdepth pathmax + , pure f + ) showStart "addurl" file - next $ performWeb relaxed s' file + next $ performWeb relaxed urlstring file urlinfo #ifdef WITH_QUVI - badquvi = error $ "quvi does not know how to download url " ++ s' + badquvi = error $ "quvi does not know how to download url " ++ urlstring usequvi = do page <- fromMaybe badquvi - <$> withQuviOptions Quvi.forceQuery [Quvi.quiet, Quvi.httponly] s' + <$> withQuviOptions Quvi.forceQuery [Quvi.quiet, Quvi.httponly] urlstring let link = fromMaybe badquvi $ headMaybe $ Quvi.pageLinks page pathmax <- liftIO $ fileNameLengthLimit "." - let file = choosefile $ truncateFilePath pathmax $ sanitizeFilePath $ - Quvi.pageTitle page ++ "." ++ Quvi.linkSuffix link + let file = flip fromMaybe optfile $ + truncateFilePath pathmax $ sanitizeFilePath $ + Quvi.pageTitle page ++ "." ++ Quvi.linkSuffix link showStart "addurl" file - next $ performQuvi relaxed s' (Quvi.linkUrl link) file + next $ performQuvi relaxed urlstring (Quvi.linkUrl link) file #else usequvi = error "not built with quvi support" #endif -performWeb :: Bool -> URLString -> FilePath -> CommandPerform -performWeb relaxed url file = ifAnnexed file addurl geturl +performWeb :: Bool -> URLString -> FilePath -> Url.UrlInfo -> CommandPerform +performWeb relaxed url file urlinfo = ifAnnexed file addurl geturl where - geturl = next $ isJust <$> addUrlFile relaxed url file - addurl = addUrlChecked relaxed url webUUID checkexistssize - checkexistssize = Url.withUrlOptions . Url.check url . keySize + geturl = next $ isJust <$> addUrlFile relaxed url urlinfo file + addurl = addUrlChecked relaxed url webUUID $ \k -> return $ + (Url.urlExists urlinfo, Url.urlSize urlinfo == keySize k) #ifdef WITH_QUVI performQuvi :: Bool -> URLString -> URLString -> FilePath -> CommandPerform @@ -189,7 +202,8 @@ - retained, because the size of a video stream - might change and we want to be able to download - it later. -} - sizedkey <- addSizeUrlKey videourl key + urlinfo <- Url.withUrlOptions (Url.getUrlInfo videourl) + let sizedkey = addSizeUrlKey urlinfo key prepGetViaTmpChecked sizedkey Nothing $ do tmp <- fromRepo $ gitAnnexTmpObjectLocation key showOutput @@ -225,17 +239,17 @@ stop ) -addUrlFile :: Bool -> URLString -> FilePath -> Annex (Maybe Key) -addUrlFile relaxed url file = do +addUrlFile :: Bool -> URLString -> Url.UrlInfo -> FilePath -> Annex (Maybe Key) +addUrlFile relaxed url urlinfo file = do liftIO $ createDirectoryIfMissing True (parentDir file) ifM (Annex.getState Annex.fast <||> pure relaxed) - ( nodownload relaxed url file - , downloadWeb url file + ( nodownload url urlinfo file + , downloadWeb url urlinfo file ) -downloadWeb :: URLString -> FilePath -> Annex (Maybe Key) -downloadWeb url file = do - dummykey <- addSizeUrlKey url =<< Backend.URL.fromUrl url Nothing +downloadWeb :: URLString -> Url.UrlInfo -> FilePath -> Annex (Maybe Key) +downloadWeb url urlinfo file = do + dummykey <- addSizeUrlKey urlinfo <$> Backend.URL.fromUrl url Nothing let downloader f _ = do showOutput downloadUrl [url] f @@ -272,15 +286,9 @@ liftIO $ createDirectoryIfMissing True (parentDir tmp) downloader tmp p -{- Hits the url to get the size, if available. - - - - This is needed to avoid exceeding the diskreserve when downloading, - - and so the assistant can display a pretty progress bar. - -} -addSizeUrlKey :: URLString -> Key -> Annex Key -addSizeUrlKey url key = do - size <- snd <$> Url.withUrlOptions (Url.exists url) - return $ key { keySize = size } +{- Adds the url size to the Key. -} +addSizeUrlKey :: Url.UrlInfo -> Key -> Key +addSizeUrlKey urlinfo key = key { keySize = Url.urlSize urlinfo } cleanup :: UUID -> URLString -> FilePath -> Key -> Maybe FilePath -> Annex () cleanup u url file key mtmp = do @@ -295,19 +303,15 @@ Annex.Queue.flush maybe noop (moveAnnex key) mtmp -nodownload :: Bool -> URLString -> FilePath -> Annex (Maybe Key) -nodownload relaxed url file = do - (exists, size) <- if relaxed - then pure (True, Nothing) - else Url.withUrlOptions (Url.exists url) - if exists - then do - key <- Backend.URL.fromUrl url size - cleanup webUUID url file key Nothing - return (Just key) - else do - warning $ "unable to access url: " ++ url - return Nothing +nodownload :: URLString -> Url.UrlInfo -> FilePath -> Annex (Maybe Key) +nodownload url urlinfo file + | Url.urlExists urlinfo = do + key <- Backend.URL.fromUrl url (Url.urlSize urlinfo) + cleanup webUUID url file key Nothing + return (Just key) + | otherwise = do + warning $ "unable to access url: " ++ url + return Nothing url2file :: URI -> Maybe Int -> Int -> FilePath url2file url pathdepth pathmax = case pathdepth of diff --git a/Command/Assistant.hs b/Command/Assistant.hs --- a/Command/Assistant.hs +++ b/Command/Assistant.hs @@ -1,6 +1,6 @@ {- git-annex assistant - - - Copyright 2012 Joey Hess + - Copyright 2012 Joey Hess - - Licensed under the GNU GPL version 3 or higher. -} diff --git a/Command/Commit.hs b/Command/Commit.hs --- a/Command/Commit.hs +++ b/Command/Commit.hs @@ -1,6 +1,6 @@ {- git-annex command - - - Copyright 2012 Joey Hess + - Copyright 2012 Joey Hess - - Licensed under the GNU GPL version 3 or higher. -} diff --git a/Command/ConfigList.hs b/Command/ConfigList.hs --- a/Command/ConfigList.hs +++ b/Command/ConfigList.hs @@ -1,6 +1,6 @@ {- git-annex command - - - Copyright 2010-2014 Joey Hess + - Copyright 2010-2014 Joey Hess - - Licensed under the GNU GPL version 3 or higher. -} diff --git a/Command/Copy.hs b/Command/Copy.hs --- a/Command/Copy.hs +++ b/Command/Copy.hs @@ -1,6 +1,6 @@ {- git-annex command - - - Copyright 2010 Joey Hess + - Copyright 2010 Joey Hess - - Licensed under the GNU GPL version 3 or higher. -} diff --git a/Command/Dead.hs b/Command/Dead.hs --- a/Command/Dead.hs +++ b/Command/Dead.hs @@ -1,6 +1,6 @@ {- git-annex command - - - Copyright 2011 Joey Hess + - Copyright 2011 Joey Hess - - Licensed under the GNU GPL version 3 or higher. -} diff --git a/Command/Describe.hs b/Command/Describe.hs --- a/Command/Describe.hs +++ b/Command/Describe.hs @@ -1,6 +1,6 @@ {- git-annex command - - - Copyright 2011 Joey Hess + - Copyright 2011 Joey Hess - - Licensed under the GNU GPL version 3 or higher. -} diff --git a/Command/DiffDriver.hs b/Command/DiffDriver.hs --- a/Command/DiffDriver.hs +++ b/Command/DiffDriver.hs @@ -1,6 +1,6 @@ {- git-annex command - - - Copyright 2014 Joey Hess + - Copyright 2014 Joey Hess - - Licensed under the GNU GPL version 3 or higher. -} diff --git a/Command/Direct.hs b/Command/Direct.hs --- a/Command/Direct.hs +++ b/Command/Direct.hs @@ -1,6 +1,6 @@ {- git-annex command - - - Copyright 2012 Joey Hess + - Copyright 2012 Joey Hess - - Licensed under the GNU GPL version 3 or higher. -} diff --git a/Command/Drop.hs b/Command/Drop.hs --- a/Command/Drop.hs +++ b/Command/Drop.hs @@ -1,6 +1,6 @@ {- git-annex command - - - Copyright 2010 Joey Hess + - Copyright 2010 Joey Hess - - Licensed under the GNU GPL version 3 or higher. -} @@ -156,7 +156,7 @@ show (length have) ++ " out of " ++ show (fromNumCopies need) ++ " necessary copies" Remote.showTriedRemotes bad - Remote.showLocations key (have++skip) + Remote.showLocations True key (have++skip) "Rather than dropping this file, try using: git annex move" hint return False diff --git a/Command/DropKey.hs b/Command/DropKey.hs --- a/Command/DropKey.hs +++ b/Command/DropKey.hs @@ -1,6 +1,6 @@ {- git-annex command - - - Copyright 2010 Joey Hess + - Copyright 2010 Joey Hess - - Licensed under the GNU GPL version 3 or higher. -} diff --git a/Command/DropUnused.hs b/Command/DropUnused.hs --- a/Command/DropUnused.hs +++ b/Command/DropUnused.hs @@ -1,6 +1,6 @@ {- git-annex command - - - Copyright 2010,2012 Joey Hess + - Copyright 2010,2012 Joey Hess - - Licensed under the GNU GPL version 3 or higher. -} diff --git a/Command/EnableRemote.hs b/Command/EnableRemote.hs --- a/Command/EnableRemote.hs +++ b/Command/EnableRemote.hs @@ -1,6 +1,6 @@ {- git-annex command - - - Copyright 2013 Joey Hess + - Copyright 2013 Joey Hess - - Licensed under the GNU GPL version 3 or higher. -} diff --git a/Command/ExamineKey.hs b/Command/ExamineKey.hs --- a/Command/ExamineKey.hs +++ b/Command/ExamineKey.hs @@ -1,6 +1,6 @@ {- git-annex command - - - Copyright 2013 Joey Hess + - Copyright 2013 Joey Hess - - Licensed under the GNU GPL version 3 or higher. -} diff --git a/Command/Find.hs b/Command/Find.hs --- a/Command/Find.hs +++ b/Command/Find.hs @@ -1,12 +1,13 @@ {- git-annex command - - - Copyright 2010-2012 Joey Hess + - Copyright 2010-2012 Joey Hess - - Licensed under the GNU GPL version 3 or higher. -} module Command.Find where +import Data.Default import qualified Data.Map as M import Common.Annex @@ -65,8 +66,8 @@ , ("bytesize", size show) , ("humansize", size $ roughSize storageUnits True) , ("keyname", keyName key) - , ("hashdirlower", hashDirLower key) - , ("hashdirmixed", hashDirMixed key) + , ("hashdirlower", hashDirLower def key) + , ("hashdirmixed", hashDirMixed def key) , ("mtime", whenavail show $ keyMtime key) ] where diff --git a/Command/FindRef.hs b/Command/FindRef.hs --- a/Command/FindRef.hs +++ b/Command/FindRef.hs @@ -1,6 +1,6 @@ {- git-annex command - - - Copyright 2014 Joey Hess + - Copyright 2014 Joey Hess - - Licensed under the GNU GPL version 3 or higher. -} diff --git a/Command/Fix.hs b/Command/Fix.hs --- a/Command/Fix.hs +++ b/Command/Fix.hs @@ -1,6 +1,6 @@ {- git-annex command - - - Copyright 2010 Joey Hess + - Copyright 2010 Joey Hess - - Licensed under the GNU GPL version 3 or higher. -} @@ -28,7 +28,7 @@ {- Fixes the symlink to an annexed file. -} start :: FilePath -> Key -> CommandStart start file key = do - link <- inRepo $ gitAnnexLink file key + link <- calcRepo $ gitAnnexLink file key stopUnless ((/=) (Just link) <$> liftIO (catchMaybeIO $ readSymbolicLink file)) $ do showStart "fix" file next $ perform file link diff --git a/Command/Forget.hs b/Command/Forget.hs --- a/Command/Forget.hs +++ b/Command/Forget.hs @@ -1,6 +1,6 @@ {- git-annex command - - - Copyright 2013 Joey Hess + - Copyright 2013 Joey Hess - - Licensed under the GNU GPL version 3 or higher. -} diff --git a/Command/FromKey.hs b/Command/FromKey.hs --- a/Command/FromKey.hs +++ b/Command/FromKey.hs @@ -1,6 +1,6 @@ {- git-annex command - - - Copyright 2010 Joey Hess + - Copyright 2010 Joey Hess - - Licensed under the GNU GPL version 3 or higher. -} @@ -33,7 +33,7 @@ perform :: Key -> FilePath -> CommandPerform perform key file = do - link <- inRepo $ gitAnnexLink file key + link <- calcRepo $ gitAnnexLink file key liftIO $ createDirectoryIfMissing True (parentDir file) liftIO $ createSymbolicLink link file next $ cleanup file diff --git a/Command/Fsck.hs b/Command/Fsck.hs --- a/Command/Fsck.hs +++ b/Command/Fsck.hs @@ -1,6 +1,6 @@ {- git-annex command - - - Copyright 2010-2013 Joey Hess + - Copyright 2010-2013 Joey Hess - - Licensed under the GNU GPL version 3 or higher. -} @@ -192,7 +192,7 @@ -} fixLink :: Key -> FilePath -> Annex Bool fixLink key file = do - want <- inRepo $ gitAnnexLink file key + want <- calcRepo $ gitAnnexLink file key have <- getAnnexLinkTarget file maybe noop (go want) have return True @@ -303,8 +303,7 @@ checkKeySizeOr bad key file = case Types.Key.keySize key of Nothing -> return True Just size -> do - size' <- fromIntegral . fileSize - <$> liftIO (getFileStatus file) + size' <- liftIO $ getFileSize file comparesizes size size' where comparesizes a b = do diff --git a/Command/FuzzTest.hs b/Command/FuzzTest.hs --- a/Command/FuzzTest.hs +++ b/Command/FuzzTest.hs @@ -1,6 +1,6 @@ {- git-annex fuzz generator - - - Copyright 2013 Joey Hess + - Copyright 2013 Joey Hess - - Licensed under the GNU GPL version 3 or higher. -} diff --git a/Command/GCryptSetup.hs b/Command/GCryptSetup.hs --- a/Command/GCryptSetup.hs +++ b/Command/GCryptSetup.hs @@ -1,6 +1,6 @@ {- git-annex command - - - Copyright 2013 Joey Hess + - Copyright 2013 Joey Hess - - Licensed under the GNU GPL version 3 or higher. -} diff --git a/Command/Get.hs b/Command/Get.hs --- a/Command/Get.hs +++ b/Command/Get.hs @@ -1,6 +1,6 @@ {- git-annex command - - - Copyright 2010, 2013 Joey Hess + - Copyright 2010, 2013 Joey Hess - - Licensed under the GNU GPL version 3 or higher. -} @@ -79,7 +79,7 @@ ( docopy r witness <||> trycopy full rs witness , trycopy full rs witness ) - showlocs = Remote.showLocations key [] + showlocs = Remote.showLocations False key [] "No other repository is known to contain the file." -- This check is to avoid an ugly message if a remote is a -- drive that is not mounted. diff --git a/Command/Group.hs b/Command/Group.hs --- a/Command/Group.hs +++ b/Command/Group.hs @@ -1,6 +1,6 @@ {- git-annex command - - - Copyright 2012 Joey Hess + - Copyright 2012 Joey Hess - - Licensed under the GNU GPL version 3 or higher. -} diff --git a/Command/Help.hs b/Command/Help.hs --- a/Command/Help.hs +++ b/Command/Help.hs @@ -1,6 +1,6 @@ {- git-annex command - - - Copyright 2012 Joey Hess + - Copyright 2012 Joey Hess - - Licensed under the GNU GPL version 3 or higher. -} diff --git a/Command/Import.hs b/Command/Import.hs --- a/Command/Import.hs +++ b/Command/Import.hs @@ -1,6 +1,6 @@ {- git-annex command - - - Copyright 2012-2013 Joey Hess + - Copyright 2012-2013 Joey Hess - - Licensed under the GNU GPL version 3 or higher. -} diff --git a/Command/ImportFeed.hs b/Command/ImportFeed.hs --- a/Command/ImportFeed.hs +++ b/Command/ImportFeed.hs @@ -1,6 +1,6 @@ {- git-annex command - - - Copyright 2013 Joey Hess + - Copyright 2013 Joey Hess - - Licensed under the GNU GPL version 3 or higher. -} @@ -144,7 +144,9 @@ rundownload url (takeExtension url) $ \f -> do r <- Remote.claimingUrl url if Remote.uuid r == webUUID - then maybeToList <$> addUrlFile relaxed url f + then do + urlinfo <- Url.withUrlOptions (Url.getUrlInfo url) + maybeToList <$> addUrlFile relaxed url urlinfo f else do res <- tryNonAsync $ maybe (error $ "unable to checkUrl of " ++ Remote.name r) diff --git a/Command/InAnnex.hs b/Command/InAnnex.hs --- a/Command/InAnnex.hs +++ b/Command/InAnnex.hs @@ -1,6 +1,6 @@ {- git-annex command - - - Copyright 2010 Joey Hess + - Copyright 2010 Joey Hess - - Licensed under the GNU GPL version 3 or higher. -} diff --git a/Command/Indirect.hs b/Command/Indirect.hs --- a/Command/Indirect.hs +++ b/Command/Indirect.hs @@ -1,6 +1,6 @@ {- git-annex command - - - Copyright 2012 Joey Hess + - Copyright 2012 Joey Hess - - Licensed under the GNU GPL version 3 or higher. -} @@ -88,7 +88,7 @@ v <- tryNonAsync (moveAnnex k f) case v of Right _ -> do - l <- inRepo $ gitAnnexLink f k + l <- calcRepo $ gitAnnexLink f k liftIO $ createSymbolicLink l f Left e -> catchNonAsync (Command.Add.undo f k e) warnlocked diff --git a/Command/Info.hs b/Command/Info.hs --- a/Command/Info.hs +++ b/Command/Info.hs @@ -1,6 +1,6 @@ {- git-annex command - - - Copyright 2011-2014 Joey Hess + - Copyright 2011-2014 Joey Hess - - Licensed under the GNU GPL version 3 or higher. -} @@ -29,6 +29,7 @@ import Types.Key import Logs.UUID import Logs.Trust +import Logs.Location import Config.NumCopies import Remote import Config @@ -65,11 +66,12 @@ data StatInfo = StatInfo { presentData :: Maybe KeyData , referencedData :: Maybe KeyData + , remoteData :: M.Map UUID KeyData , numCopiesStats :: Maybe NumCopiesStats } - + emptyStatInfo :: StatInfo -emptyStatInfo = StatInfo Nothing Nothing Nothing +emptyStatInfo = StatInfo Nothing Nothing M.empty Nothing -- a state monad for running Stats in type StatState = StateT StatInfo Annex @@ -104,11 +106,16 @@ v <- Remote.byName' p case v of Right r -> remoteInfo r - Left _ -> maybe noinfo (fileInfo p) =<< isAnnexLink p + Left _ -> do + v' <- Remote.nameToUUID' p + case v' of + Right u -> uuidInfo u + Left _ -> maybe noinfo (fileInfo p) + =<< isAnnexLink p ) where isdir = liftIO . catchBoolIO . (isDirectory <$$> getFileStatus) - noinfo = error $ p ++ " is not a directory or an annexed file or a remote" + noinfo = error $ p ++ " is not a directory or an annexed file or a remote or a uuid" dirInfo :: FilePath -> Annex () dirInfo dir = showCustom (unwords ["info", dir]) $ do @@ -126,9 +133,16 @@ remoteInfo :: Remote -> Annex () remoteInfo r = showCustom (unwords ["info", Remote.name r]) $ do info <- map (\(k, v) -> simpleStat k (pure v)) <$> Remote.getInfo r - evalStateT (mapM_ showStat (remote_stats r ++ info)) emptyStatInfo + l <- selStats (remote_fast_stats r ++ info) (uuid_slow_stats (Remote.uuid r)) + evalStateT (mapM_ showStat l) emptyStatInfo return True +uuidInfo :: UUID -> Annex () +uuidInfo u = showCustom (unwords ["info", fromUUID u]) $ do + l <- selStats [] ((uuid_slow_stats u)) + evalStateT (mapM_ showStat l) emptyStatInfo + return True + selStats :: [Stat] -> [Stat] -> Annex [Stat] selStats fast_stats slow_stats = do fast <- Annex.getState Annex.fast @@ -179,8 +193,8 @@ , key_name k ] -remote_stats :: Remote -> [Stat] -remote_stats r = map (\s -> s r) +remote_fast_stats :: Remote -> [Stat] +remote_fast_stats r = map (\s -> s r) [ remote_name , remote_description , remote_uuid @@ -188,6 +202,12 @@ , remote_type ] +uuid_slow_stats :: UUID -> [Stat] +uuid_slow_stats u = map (\s -> s u) + [ remote_annex_keys + , remote_annex_size + ] + stat :: String -> (String -> StatState String) -> Stat stat desc a = return $ Just (desc, a desc) @@ -262,6 +282,14 @@ local_annex_size = simpleStat "local annex size" $ showSizeKeys <$> cachedPresentData +remote_annex_keys :: UUID -> Stat +remote_annex_keys u = stat "remote annex keys" $ json show $ + countKeys <$> cachedRemoteData u + +remote_annex_size :: UUID -> Stat +remote_annex_size u = simpleStat "remote annex size" $ + showSizeKeys <$> cachedRemoteData u + known_annex_files :: Stat known_annex_files = stat "annexed files in working tree" $ json show $ countKeys <$> cachedReferencedData @@ -361,6 +389,16 @@ put s { presentData = Just v } return v +cachedRemoteData :: UUID -> StatState KeyData +cachedRemoteData u = do + s <- get + case M.lookup u (remoteData s) of + Just v -> return v + Nothing -> do + v <- foldKeys <$> lift (loggedKeysFor u) + put s { remoteData = M.insert u v (remoteData s) } + return v + cachedReferencedData :: StatState KeyData cachedReferencedData = do s <- get @@ -383,7 +421,7 @@ (presentdata, referenceddata, numcopiesstats) <- Command.Unused.withKeysFilesReferencedIn dir initial (update matcher fast) - return $ StatInfo (Just presentdata) (Just referenceddata) (Just numcopiesstats) + return $ StatInfo (Just presentdata) (Just referenceddata) M.empty (Just numcopiesstats) where initial = (emptyKeyData, emptyKeyData, emptyNumCopiesStats) update matcher fast key file vs@(presentdata, referenceddata, numcopiesstats) = @@ -451,8 +489,7 @@ keysizes keys = do dir <- lift $ fromRepo dirspec liftIO $ forM keys $ \k -> catchDefaultIO 0 $ - fromIntegral . fileSize - <$> getFileStatus (dir keyFile k) + getFileSize (dir keyFile k) aside :: String -> String aside s = " (" ++ s ++ ")" diff --git a/Command/Init.hs b/Command/Init.hs --- a/Command/Init.hs +++ b/Command/Init.hs @@ -1,6 +1,6 @@ {- git-annex command - - - Copyright 2010 Joey Hess + - Copyright 2010 Joey Hess - - Licensed under the GNU GPL version 3 or higher. -} diff --git a/Command/InitRemote.hs b/Command/InitRemote.hs --- a/Command/InitRemote.hs +++ b/Command/InitRemote.hs @@ -1,6 +1,6 @@ {- git-annex command - - - Copyright 2011,2013 Joey Hess + - Copyright 2011,2013 Joey Hess - - Licensed under the GNU GPL version 3 or higher. -} diff --git a/Command/List.hs b/Command/List.hs --- a/Command/List.hs +++ b/Command/List.hs @@ -1,6 +1,6 @@ {- git-annex command - - - Copyright 2013 Joey Hess + - Copyright 2013 Joey Hess - Copyright 2013 Antoine Beaupré - - Licensed under the GNU GPL version 3 or higher. diff --git a/Command/Lock.hs b/Command/Lock.hs --- a/Command/Lock.hs +++ b/Command/Lock.hs @@ -1,6 +1,6 @@ {- git-annex command - - - Copyright 2010 Joey Hess + - Copyright 2010 Joey Hess - - Licensed under the GNU GPL version 3 or higher. -} diff --git a/Command/Log.hs b/Command/Log.hs --- a/Command/Log.hs +++ b/Command/Log.hs @@ -1,6 +1,6 @@ {- git-annex command - - - Copyright 2012 Joey Hess + - Copyright 2012 Joey Hess - - Licensed under the GNU GPL version 3 or higher. -} @@ -141,7 +141,8 @@ getLog key os = do top <- fromRepo Git.repoPath p <- liftIO $ relPathCwdToFile top - let logfile = p locationLogFile key + config <- Annex.getGitConfig + let logfile = p locationLogFile config key inRepo $ pipeNullSplitZombie $ [ Params "log -z --pretty=format:%ct --raw --abbrev=40" , Param "--remove-empty" diff --git a/Command/LookupKey.hs b/Command/LookupKey.hs --- a/Command/LookupKey.hs +++ b/Command/LookupKey.hs @@ -1,6 +1,6 @@ {- git-annex command - - - Copyright 2013 Joey Hess + - Copyright 2013 Joey Hess - - Licensed under the GNU GPL version 3 or higher. -} diff --git a/Command/Map.hs b/Command/Map.hs --- a/Command/Map.hs +++ b/Command/Map.hs @@ -1,6 +1,6 @@ {- git-annex command - - - Copyright 2010 Joey Hess + - Copyright 2010 Joey Hess - - Licensed under the GNU GPL version 3 or higher. -} diff --git a/Command/Merge.hs b/Command/Merge.hs --- a/Command/Merge.hs +++ b/Command/Merge.hs @@ -1,6 +1,6 @@ {- git-annex command - - - Copyright 2011, 2013 Joey Hess + - Copyright 2011, 2013 Joey Hess - - Licensed under the GNU GPL version 3 or higher. -} diff --git a/Command/MetaData.hs b/Command/MetaData.hs --- a/Command/MetaData.hs +++ b/Command/MetaData.hs @@ -1,6 +1,6 @@ {- git-annex command - - - Copyright 2014 Joey Hess + - Copyright 2014 Joey Hess - - Licensed under the GNU GPL version 3 or higher. -} diff --git a/Command/Migrate.hs b/Command/Migrate.hs --- a/Command/Migrate.hs +++ b/Command/Migrate.hs @@ -1,6 +1,6 @@ {- git-annex command - - - Copyright 2011 Joey Hess + - Copyright 2011 Joey Hess - - Licensed under the GNU GPL version 3 or higher. -} diff --git a/Command/Mirror.hs b/Command/Mirror.hs --- a/Command/Mirror.hs +++ b/Command/Mirror.hs @@ -1,6 +1,6 @@ {- git-annex command - - - Copyright 2013 Joey Hess + - Copyright 2013 Joey Hess - - Licensed under the GNU GPL version 3 or higher. -} diff --git a/Command/Move.hs b/Command/Move.hs --- a/Command/Move.hs +++ b/Command/Move.hs @@ -1,6 +1,6 @@ {- git-annex command - - - Copyright 2010-2013 Joey Hess + - Copyright 2010-2013 Joey Hess - - Licensed under the GNU GPL version 3 or higher. -} diff --git a/Command/NotifyChanges.hs b/Command/NotifyChanges.hs --- a/Command/NotifyChanges.hs +++ b/Command/NotifyChanges.hs @@ -1,6 +1,6 @@ {- git-annex-shell command - - - Copyright 2014 Joey Hess + - Copyright 2014 Joey Hess - - Licensed under the GNU GPL version 3 or higher. -} diff --git a/Command/NumCopies.hs b/Command/NumCopies.hs --- a/Command/NumCopies.hs +++ b/Command/NumCopies.hs @@ -1,6 +1,6 @@ {- git-annex command - - - Copyright 2014 Joey Hess + - Copyright 2014 Joey Hess - - Licensed under the GNU GPL version 3 or higher. -} diff --git a/Command/PreCommit.hs b/Command/PreCommit.hs --- a/Command/PreCommit.hs +++ b/Command/PreCommit.hs @@ -1,6 +1,6 @@ {- git-annex command - - - Copyright 2010-2014 Joey Hess + - Copyright 2010-2014 Joey Hess - - Licensed under the GNU GPL version 3 or higher. -} diff --git a/Command/Proxy.hs b/Command/Proxy.hs --- a/Command/Proxy.hs +++ b/Command/Proxy.hs @@ -1,6 +1,6 @@ {- git-annex command - - - Copyright 2014 Joey Hess + - Copyright 2014 Joey Hess - - Licensed under the GNU GPL version 3 or higher. -} diff --git a/Command/ReKey.hs b/Command/ReKey.hs --- a/Command/ReKey.hs +++ b/Command/ReKey.hs @@ -1,6 +1,6 @@ {- git-annex command - - - Copyright 2012 Joey Hess + - Copyright 2012 Joey Hess - - Licensed under the GNU GPL version 3 or higher. -} diff --git a/Command/RecvKey.hs b/Command/RecvKey.hs --- a/Command/RecvKey.hs +++ b/Command/RecvKey.hs @@ -1,6 +1,6 @@ {- git-annex command - - - Copyright 2010 Joey Hess + - Copyright 2010 Joey Hess - - Licensed under the GNU GPL version 3 or higher. -} @@ -62,8 +62,7 @@ oksize <- case Types.Key.keySize key of Nothing -> return True Just size -> do - size' <- fromIntegral . fileSize - <$> liftIO (getFileStatus tmp) + size' <- liftIO $ getFileSize tmp return $ size == size' if oksize then case Backend.maybeLookupBackendName (Types.Key.keyBackendName key) of diff --git a/Command/Reinit.hs b/Command/Reinit.hs --- a/Command/Reinit.hs +++ b/Command/Reinit.hs @@ -1,6 +1,6 @@ {- git-annex command - - - Copyright 2014 Joey Hess + - Copyright 2014 Joey Hess - - Licensed under the GNU GPL version 3 or higher. -} diff --git a/Command/Reinject.hs b/Command/Reinject.hs --- a/Command/Reinject.hs +++ b/Command/Reinject.hs @@ -1,6 +1,6 @@ {- git-annex command - - - Copyright 2011 Joey Hess + - Copyright 2011 Joey Hess - - Licensed under the GNU GPL version 3 or higher. -} diff --git a/Command/RemoteDaemon.hs b/Command/RemoteDaemon.hs --- a/Command/RemoteDaemon.hs +++ b/Command/RemoteDaemon.hs @@ -1,6 +1,6 @@ {- git-annex command - - - Copyright 2014 Joey Hess + - Copyright 2014 Joey Hess - - Licensed under the GNU GPL version 3 or higher. -} diff --git a/Command/Repair.hs b/Command/Repair.hs --- a/Command/Repair.hs +++ b/Command/Repair.hs @@ -1,6 +1,6 @@ {- git-annex command - - - Copyright 2013 Joey Hess + - Copyright 2013 Joey Hess - - Licensed under the GNU GPL version 3 or higher. -} diff --git a/Command/ResolveMerge.hs b/Command/ResolveMerge.hs --- a/Command/ResolveMerge.hs +++ b/Command/ResolveMerge.hs @@ -1,6 +1,6 @@ {- git-annex command - - - Copyright 2014 Joey Hess + - Copyright 2014 Joey Hess - - Licensed under the GNU GPL version 3 or higher. -} diff --git a/Command/RmUrl.hs b/Command/RmUrl.hs --- a/Command/RmUrl.hs +++ b/Command/RmUrl.hs @@ -1,6 +1,6 @@ {- git-annex command - - - Copyright 2013 Joey Hess + - Copyright 2013 Joey Hess - - Licensed under the GNU GPL version 3 or higher. -} diff --git a/Command/Schedule.hs b/Command/Schedule.hs --- a/Command/Schedule.hs +++ b/Command/Schedule.hs @@ -1,6 +1,6 @@ {- git-annex command - - - Copyright 2013 Joey Hess + - Copyright 2013 Joey Hess - - Licensed under the GNU GPL version 3 or higher. -} diff --git a/Command/Semitrust.hs b/Command/Semitrust.hs --- a/Command/Semitrust.hs +++ b/Command/Semitrust.hs @@ -1,6 +1,6 @@ {- git-annex command - - - Copyright 2010 Joey Hess + - Copyright 2010 Joey Hess - - Licensed under the GNU GPL version 3 or higher. -} diff --git a/Command/SendKey.hs b/Command/SendKey.hs --- a/Command/SendKey.hs +++ b/Command/SendKey.hs @@ -1,6 +1,6 @@ {- git-annex command - - - Copyright 2010,2012 Joey Hess + - Copyright 2010,2012 Joey Hess - - Licensed under the GNU GPL version 3 or higher. -} diff --git a/Command/SetPresentKey.hs b/Command/SetPresentKey.hs --- a/Command/SetPresentKey.hs +++ b/Command/SetPresentKey.hs @@ -1,6 +1,6 @@ {- git-annex command - - - Copyright 2014 Joey Hess + - Copyright 2014 Joey Hess - - Licensed under the GNU GPL version 3 or higher. -} diff --git a/Command/Status.hs b/Command/Status.hs --- a/Command/Status.hs +++ b/Command/Status.hs @@ -1,6 +1,6 @@ {- git-annex command - - - Copyright 2013 Joey Hess + - Copyright 2013 Joey Hess - - Licensed under the GNU GPL version 3 or higher. -} @@ -70,7 +70,7 @@ | not (isSymbolicLink s) = checkkey s =<< catKeyFile f | otherwise = Just <$> checkNew f - checkkey s (Just k) = ifM (sameFileStatus k s) + checkkey s (Just k) = ifM (sameFileStatus k f s) ( return Nothing , return $ Just ModifiedFile ) diff --git a/Command/Sync.hs b/Command/Sync.hs --- a/Command/Sync.hs +++ b/Command/Sync.hs @@ -1,7 +1,7 @@ {- git-annex command - - Copyright 2011 Joachim Breitner - - Copyright 2011-2014 Joey Hess + - Copyright 2011-2014 Joey Hess - - Licensed under the GNU GPL version 3 or higher. -} @@ -52,11 +52,17 @@ seek SectionCommon "synchronize local repository with remotes"] syncOptions :: [Option] -syncOptions = [ contentOption ] +syncOptions = + [ contentOption + , messageOption + ] contentOption :: Option contentOption = flagOption [] "content" "also transfer file contents" +messageOption :: Option +messageOption = fieldOption ['m'] "message" "MSG" "specify commit message" + seek :: CommandSeek seek rs = do prepMerge @@ -139,6 +145,8 @@ commit :: CommandStart commit = next $ next $ do + commitmessage <- fromMaybe "git-annex automatic sync" + <$> Annex.getField (optionName messageOption) showStart "commit" "" Annex.Branch.commit "update" ifM isDirect @@ -154,8 +162,6 @@ ] return True ) - where - commitmessage = "git-annex automatic sync" commitStaged :: Git.Branch.CommitMode -> String -> Annex Bool commitStaged commitmode commitmessage = go =<< inRepo Git.Branch.currentUnsafe diff --git a/Command/Test.hs b/Command/Test.hs --- a/Command/Test.hs +++ b/Command/Test.hs @@ -1,6 +1,6 @@ {- git-annex command - - - Copyright 2013 Joey Hess + - Copyright 2013 Joey Hess - - Licensed under the GNU GPL version 3 or higher. -} diff --git a/Command/TestRemote.hs b/Command/TestRemote.hs --- a/Command/TestRemote.hs +++ b/Command/TestRemote.hs @@ -1,6 +1,6 @@ {- git-annex command - - - Copyright 2014 Joey Hess + - Copyright 2014 Joey Hess - - Licensed under the GNU GPL version 3 or higher. -} diff --git a/Command/TransferInfo.hs b/Command/TransferInfo.hs --- a/Command/TransferInfo.hs +++ b/Command/TransferInfo.hs @@ -1,6 +1,6 @@ {- git-annex command - - - Copyright 2012 Joey Hess + - Copyright 2012 Joey Hess - - Licensed under the GNU GPL version 3 or higher. -} diff --git a/Command/TransferKey.hs b/Command/TransferKey.hs --- a/Command/TransferKey.hs +++ b/Command/TransferKey.hs @@ -1,6 +1,6 @@ {- git-annex plumbing command (for use by old assistant, and users) - - - Copyright 2012 Joey Hess + - Copyright 2012 Joey Hess - - Licensed under the GNU GPL version 3 or higher. -} diff --git a/Command/TransferKeys.hs b/Command/TransferKeys.hs --- a/Command/TransferKeys.hs +++ b/Command/TransferKeys.hs @@ -1,6 +1,6 @@ {- git-annex command, used internally by assistant - - - Copyright 2012, 2013 Joey Hess + - Copyright 2012, 2013 Joey Hess - - Licensed under the GNU GPL version 3 or higher. -} diff --git a/Command/Trust.hs b/Command/Trust.hs --- a/Command/Trust.hs +++ b/Command/Trust.hs @@ -1,6 +1,6 @@ {- git-annex command - - - Copyright 2010, 2014 Joey Hess + - Copyright 2010, 2014 Joey Hess - - Licensed under the GNU GPL version 3 or higher. -} diff --git a/Command/Unannex.hs b/Command/Unannex.hs --- a/Command/Unannex.hs +++ b/Command/Unannex.hs @@ -1,6 +1,6 @@ {- git-annex command - - - Copyright 2010-2013 Joey Hess + - Copyright 2010-2013 Joey Hess - - Licensed under the GNU GPL version 3 or higher. -} diff --git a/Command/Undo.hs b/Command/Undo.hs --- a/Command/Undo.hs +++ b/Command/Undo.hs @@ -1,6 +1,6 @@ {- git-annex command - - - Copyright 2014 Joey Hess + - Copyright 2014 Joey Hess - - Licensed under the GNU GPL version 3 or higher. -} diff --git a/Command/Ungroup.hs b/Command/Ungroup.hs --- a/Command/Ungroup.hs +++ b/Command/Ungroup.hs @@ -1,6 +1,6 @@ {- git-annex command - - - Copyright 2012 Joey Hess + - Copyright 2012 Joey Hess - - Licensed under the GNU GPL version 3 or higher. -} diff --git a/Command/Uninit.hs b/Command/Uninit.hs --- a/Command/Uninit.hs +++ b/Command/Uninit.hs @@ -1,6 +1,6 @@ {- git-annex command - - - Copyright 2010 Joey Hess + - Copyright 2010 Joey Hess - - Licensed under the GNU GPL version 3 or higher. -} diff --git a/Command/Unlock.hs b/Command/Unlock.hs --- a/Command/Unlock.hs +++ b/Command/Unlock.hs @@ -1,6 +1,6 @@ {- git-annex command - - - Copyright 2010 Joey Hess + - Copyright 2010 Joey Hess - - Licensed under the GNU GPL version 3 or higher. -} diff --git a/Command/Untrust.hs b/Command/Untrust.hs --- a/Command/Untrust.hs +++ b/Command/Untrust.hs @@ -1,6 +1,6 @@ {- git-annex command - - - Copyright 2010 Joey Hess + - Copyright 2010 Joey Hess - - Licensed under the GNU GPL version 3 or higher. -} diff --git a/Command/Unused.hs b/Command/Unused.hs --- a/Command/Unused.hs +++ b/Command/Unused.hs @@ -1,6 +1,6 @@ {- git-annex command - - - Copyright 2010-2012 Joey Hess + - Copyright 2010-2012 Joey Hess - - Licensed under the GNU GPL version 3 or higher. -} diff --git a/Command/Upgrade.hs b/Command/Upgrade.hs --- a/Command/Upgrade.hs +++ b/Command/Upgrade.hs @@ -1,6 +1,6 @@ {- git-annex command - - - Copyright 2011 Joey Hess + - Copyright 2011 Joey Hess - - Licensed under the GNU GPL version 3 or higher. -} diff --git a/Command/VAdd.hs b/Command/VAdd.hs --- a/Command/VAdd.hs +++ b/Command/VAdd.hs @@ -1,6 +1,6 @@ {- git-annex command - - - Copyright 2014 Joey Hess + - Copyright 2014 Joey Hess - - Licensed under the GNU GPL version 3 or higher. -} diff --git a/Command/VCycle.hs b/Command/VCycle.hs --- a/Command/VCycle.hs +++ b/Command/VCycle.hs @@ -1,6 +1,6 @@ {- git-annex command - - - Copyright 2014 Joey Hess + - Copyright 2014 Joey Hess - - Licensed under the GNU GPL version 3 or higher. -} diff --git a/Command/VFilter.hs b/Command/VFilter.hs --- a/Command/VFilter.hs +++ b/Command/VFilter.hs @@ -1,6 +1,6 @@ {- git-annex command - - - Copyright 2014 Joey Hess + - Copyright 2014 Joey Hess - - Licensed under the GNU GPL version 3 or higher. -} diff --git a/Command/VPop.hs b/Command/VPop.hs --- a/Command/VPop.hs +++ b/Command/VPop.hs @@ -1,6 +1,6 @@ {- git-annex command - - - Copyright 2014 Joey Hess + - Copyright 2014 Joey Hess - - Licensed under the GNU GPL version 3 or higher. -} diff --git a/Command/Version.hs b/Command/Version.hs --- a/Command/Version.hs +++ b/Command/Version.hs @@ -1,6 +1,6 @@ {- git-annex command - - - Copyright 2010 Joey Hess + - Copyright 2010 Joey Hess - - Licensed under the GNU GPL version 3 or higher. -} diff --git a/Command/Vicfg.hs b/Command/Vicfg.hs --- a/Command/Vicfg.hs +++ b/Command/Vicfg.hs @@ -1,6 +1,6 @@ {- git-annex command - - - Copyright 2012-2014 Joey Hess + - Copyright 2012-2014 Joey Hess - - Licensed under the GNU GPL version 3 or higher. -} diff --git a/Command/View.hs b/Command/View.hs --- a/Command/View.hs +++ b/Command/View.hs @@ -1,6 +1,6 @@ {- git-annex command - - - Copyright 2014 Joey Hess + - Copyright 2014 Joey Hess - - Licensed under the GNU GPL version 3 or higher. -} diff --git a/Command/Wanted.hs b/Command/Wanted.hs --- a/Command/Wanted.hs +++ b/Command/Wanted.hs @@ -1,6 +1,6 @@ {- git-annex command - - - Copyright 2013 Joey Hess + - Copyright 2013 Joey Hess - - Licensed under the GNU GPL version 3 or higher. -} diff --git a/Command/Watch.hs b/Command/Watch.hs --- a/Command/Watch.hs +++ b/Command/Watch.hs @@ -1,6 +1,6 @@ {- git-annex watch command - - - Copyright 2012 Joey Hess + - Copyright 2012 Joey Hess - - Licensed under the GNU GPL version 3 or higher. -} diff --git a/Command/WebApp.hs b/Command/WebApp.hs --- a/Command/WebApp.hs +++ b/Command/WebApp.hs @@ -1,6 +1,6 @@ {- git-annex webapp launcher - - - Copyright 2012 Joey Hess + - Copyright 2012 Joey Hess - - Licensed under the GNU GPL version 3 or higher. -} diff --git a/Command/Whereis.hs b/Command/Whereis.hs --- a/Command/Whereis.hs +++ b/Command/Whereis.hs @@ -1,6 +1,6 @@ {- git-annex command - - - Copyright 2010-2014 Joey Hess + - Copyright 2010-2014 Joey Hess - - Licensed under the GNU GPL version 3 or higher. -} diff --git a/Command/XMPPGit.hs b/Command/XMPPGit.hs --- a/Command/XMPPGit.hs +++ b/Command/XMPPGit.hs @@ -1,6 +1,6 @@ {- git-annex command - - - Copyright 2012 Joey Hess + - Copyright 2012 Joey Hess - - Licensed under the GNU GPL version 3 or higher. -} diff --git a/Common.hs b/Common.hs --- a/Common.hs +++ b/Common.hs @@ -11,6 +11,7 @@ import Data.List as X hiding (head, tail, init, last) import Data.String.Utils as X hiding (join) import Data.Monoid as X +import Data.Default as X import System.FilePath as X import System.Directory as X @@ -30,7 +31,8 @@ import Utility.Data as X import Utility.Applicative as X import Utility.FileSystemEncoding as X -import Utility.PosixFiles as X +import Utility.PosixFiles as X hiding (fileSize) +import Utility.FileSize as X import Utility.Network as X import Utility.PartialPrelude as X diff --git a/Config.hs b/Config.hs --- a/Config.hs +++ b/Config.hs @@ -1,6 +1,6 @@ {- Git configuration - - - Copyright 2011-2014 Joey Hess + - Copyright 2011-2014 Joey Hess - - Licensed under the GNU GPL version 3 or higher. -} @@ -23,7 +23,7 @@ {- Looks up a setting in git config. -} getConfig :: ConfigKey -> String -> Annex String -getConfig (ConfigKey key) def = fromRepo $ Git.Config.get key def +getConfig (ConfigKey key) d = fromRepo $ Git.Config.get key d getConfigMaybe :: ConfigKey -> Annex (Maybe String) getConfigMaybe (ConfigKey key) = fromRepo $ Git.Config.getMaybe key @@ -58,7 +58,7 @@ - by remote..annex-cost, or if remote..annex-cost-command - is set and prints a number, that is used. -} remoteCost :: RemoteGitConfig -> Cost -> Annex Cost -remoteCost c def = fromMaybe def <$> remoteCost' c +remoteCost c d = fromMaybe d <$> remoteCost' c remoteCost' :: RemoteGitConfig -> Annex (Maybe Cost) remoteCost' c = case remoteAnnexCostCommand c of diff --git a/Config/Cost.hs b/Config/Cost.hs --- a/Config/Cost.hs +++ b/Config/Cost.hs @@ -1,6 +1,6 @@ {- Remote costs. - - - Copyright 2011-2013 Joey Hess + - Copyright 2011-2013 Joey Hess - - Licensed under the GNU GPL version 3 or higher. -} diff --git a/Config/Files.hs b/Config/Files.hs --- a/Config/Files.hs +++ b/Config/Files.hs @@ -1,6 +1,6 @@ {- git-annex extra config files - - - Copyright 2012 Joey Hess + - Copyright 2012 Joey Hess - - Licensed under the GNU GPL version 3 or higher. -} diff --git a/Config/NumCopies.hs b/Config/NumCopies.hs --- a/Config/NumCopies.hs +++ b/Config/NumCopies.hs @@ -1,6 +1,6 @@ {- git-annex numcopies configuration - - - Copyright 2014 Joey Hess + - Copyright 2014 Joey Hess - - Licensed under the GNU GPL version 3 or higher. -} diff --git a/Creds.hs b/Creds.hs --- a/Creds.hs +++ b/Creds.hs @@ -1,6 +1,6 @@ {- Credentials storage - - - Copyright 2012-2014 Joey Hess + - Copyright 2012-2014 Joey Hess - - Licensed under the GNU GPL version 3 or higher. -} diff --git a/Crypto.hs b/Crypto.hs --- a/Crypto.hs +++ b/Crypto.hs @@ -3,7 +3,7 @@ - Currently using gpg; could later be modified to support different - crypto backends if neccessary. - - - Copyright 2011-2014 Joey Hess + - Copyright 2011-2014 Joey Hess - - Licensed under the GNU GPL version 3 or higher. -} diff --git a/Git.hs b/Git.hs --- a/Git.hs +++ b/Git.hs @@ -3,7 +3,7 @@ - This is written to be completely independant of git-annex and should be - suitable for other uses. - - - Copyright 2010-2012 Joey Hess + - Copyright 2010-2012 Joey Hess - - Licensed under the GNU GPL version 3 or higher. -} diff --git a/Git/AutoCorrect.hs b/Git/AutoCorrect.hs --- a/Git/AutoCorrect.hs +++ b/Git/AutoCorrect.hs @@ -1,6 +1,6 @@ {- git autocorrection using Damerau-Levenshtein edit distance - - - Copyright 2012 Joey Hess + - Copyright 2012 Joey Hess - - Licensed under the GNU GPL version 3 or higher. -} diff --git a/Git/Branch.hs b/Git/Branch.hs --- a/Git/Branch.hs +++ b/Git/Branch.hs @@ -1,6 +1,6 @@ {- git branch stuff - - - Copyright 2011 Joey Hess + - Copyright 2011 Joey Hess - - Licensed under the GNU GPL version 3 or higher. -} diff --git a/Git/BuildVersion.hs b/Git/BuildVersion.hs --- a/Git/BuildVersion.hs +++ b/Git/BuildVersion.hs @@ -1,6 +1,6 @@ {- git build version - - - Copyright 2011 Joey Hess + - Copyright 2011 Joey Hess - - Licensed under the GNU GPL version 3 or higher. -} diff --git a/Git/CatFile.hs b/Git/CatFile.hs --- a/Git/CatFile.hs +++ b/Git/CatFile.hs @@ -1,6 +1,6 @@ {- git cat-file interface - - - Copyright 2011, 2013 Joey Hess + - Copyright 2011, 2013 Joey Hess - - Licensed under the GNU GPL version 3 or higher. -} diff --git a/Git/CheckAttr.hs b/Git/CheckAttr.hs --- a/Git/CheckAttr.hs +++ b/Git/CheckAttr.hs @@ -1,6 +1,6 @@ {- git check-attr interface - - - Copyright 2010-2012 Joey Hess + - Copyright 2010-2012 Joey Hess - - Licensed under the GNU GPL version 3 or higher. -} diff --git a/Git/CheckIgnore.hs b/Git/CheckIgnore.hs --- a/Git/CheckIgnore.hs +++ b/Git/CheckIgnore.hs @@ -1,6 +1,6 @@ {- git check-ignore interface - - - Copyright 2013 Joey Hess + - Copyright 2013 Joey Hess - - Licensed under the GNU GPL version 3 or higher. -} diff --git a/Git/Command.hs b/Git/Command.hs --- a/Git/Command.hs +++ b/Git/Command.hs @@ -1,6 +1,6 @@ {- running git commands - - - Copyright 2010-2013 Joey Hess + - Copyright 2010-2013 Joey Hess - - Licensed under the GNU GPL version 3 or higher. -} diff --git a/Git/Command/Batch.hs b/Git/Command/Batch.hs --- a/Git/Command/Batch.hs +++ b/Git/Command/Batch.hs @@ -1,6 +1,6 @@ {- running batch git commands - - - Copyright 2010-2013 Joey Hess + - Copyright 2010-2013 Joey Hess - - Licensed under the GNU GPL version 3 or higher. -} diff --git a/Git/Config.hs b/Git/Config.hs --- a/Git/Config.hs +++ b/Git/Config.hs @@ -1,6 +1,6 @@ {- git repository configuration handling - - - Copyright 2010-2012 Joey Hess + - Copyright 2010-2012 Joey Hess - - Licensed under the GNU GPL version 3 or higher. -} diff --git a/Git/Construct.hs b/Git/Construct.hs --- a/Git/Construct.hs +++ b/Git/Construct.hs @@ -1,6 +1,6 @@ {- Construction of Git Repo objects - - - Copyright 2010-2012 Joey Hess + - Copyright 2010-2012 Joey Hess - - Licensed under the GNU GPL version 3 or higher. -} diff --git a/Git/CurrentRepo.hs b/Git/CurrentRepo.hs --- a/Git/CurrentRepo.hs +++ b/Git/CurrentRepo.hs @@ -1,6 +1,6 @@ {- The current git repository. - - - Copyright 2012 Joey Hess + - Copyright 2012 Joey Hess - - Licensed under the GNU GPL version 3 or higher. -} diff --git a/Git/DiffTree.hs b/Git/DiffTree.hs --- a/Git/DiffTree.hs +++ b/Git/DiffTree.hs @@ -1,6 +1,6 @@ {- git diff-tree interface - - - Copyright 2012 Joey Hess + - Copyright 2012 Joey Hess - - Licensed under the GNU GPL version 3 or higher. -} diff --git a/Git/DiffTreeItem.hs b/Git/DiffTreeItem.hs --- a/Git/DiffTreeItem.hs +++ b/Git/DiffTreeItem.hs @@ -1,6 +1,6 @@ {- git diff-tree item - - - Copyright 2012 Joey Hess + - Copyright 2012 Joey Hess - - Licensed under the GNU GPL version 3 or higher. -} diff --git a/Git/FileMode.hs b/Git/FileMode.hs --- a/Git/FileMode.hs +++ b/Git/FileMode.hs @@ -1,6 +1,6 @@ {- git file modes - - - Copyright 2013 Joey Hess + - Copyright 2013 Joey Hess - - Licensed under the GNU GPL version 3 or higher. -} diff --git a/Git/FilePath.hs b/Git/FilePath.hs --- a/Git/FilePath.hs +++ b/Git/FilePath.hs @@ -5,7 +5,7 @@ - top of the repository even when run in a subdirectory. Adding some - types helps keep that straight. - - - Copyright 2012-2013 Joey Hess + - Copyright 2012-2013 Joey Hess - - Licensed under the GNU GPL version 3 or higher. -} diff --git a/Git/Filename.hs b/Git/Filename.hs --- a/Git/Filename.hs +++ b/Git/Filename.hs @@ -1,7 +1,7 @@ {- Some git commands output encoded filenames, in a rather annoyingly complex - C-style encoding. - - - Copyright 2010, 2011 Joey Hess + - Copyright 2010, 2011 Joey Hess - - Licensed under the GNU GPL version 3 or higher. -} diff --git a/Git/Fsck.hs b/Git/Fsck.hs --- a/Git/Fsck.hs +++ b/Git/Fsck.hs @@ -1,6 +1,6 @@ {- git fsck interface - - - Copyright 2013 Joey Hess + - Copyright 2013 Joey Hess - - Licensed under the GNU GPL version 3 or higher. -} diff --git a/Git/GCrypt.hs b/Git/GCrypt.hs --- a/Git/GCrypt.hs +++ b/Git/GCrypt.hs @@ -2,7 +2,7 @@ - - https://github.com/blake2-ppc/git-remote-gcrypt - - - Copyright 2013 Joey Hess + - Copyright 2013 Joey Hess - - Licensed under the GNU GPL version 3 or higher. -} diff --git a/Git/HashObject.hs b/Git/HashObject.hs --- a/Git/HashObject.hs +++ b/Git/HashObject.hs @@ -1,6 +1,6 @@ {- git hash-object interface - - - Copyright 2011-2014 Joey Hess + - Copyright 2011-2014 Joey Hess - - Licensed under the GNU GPL version 3 or higher. -} diff --git a/Git/Hook.hs b/Git/Hook.hs --- a/Git/Hook.hs +++ b/Git/Hook.hs @@ -1,15 +1,20 @@ {- git hooks - - - Copyright 2013 Joey Hess + - Copyright 2013-2015 Joey Hess - - Licensed under the GNU GPL version 3 or higher. -} +{-# LANGUAGE CPP #-} + module Git.Hook where import Common import Git import Utility.Tmp +#ifndef mingw32_HOST_OS +import Utility.FileMode +#endif data Hook = Hook { hookName :: FilePath @@ -56,3 +61,37 @@ expectedContent h r = do content <- readFile $ hookFile h r return $ content == hookScript h + +hookExists :: Hook -> Repo -> IO Bool +hookExists h r = do + let f = hookFile h r + catchBoolIO $ +#ifndef mingw32_HOST_OS + isExecutable . fileMode <$> getFileStatus f +#else + doesFileExist f +#endif + +runHook :: Hook -> Repo -> IO Bool +runHook h r = do + let f = hookFile h r + (c, ps) <- findcmd f + boolSystem c ps + where +#ifndef mingw32_HOST_OS + findcmd = defcmd +#else + {- Like msysgit, parse the first line of the hook file, + - look for "#!", and dispatch the interpreter on the file. -} + findcmd f = do + l <- headMaybe . lines <$> catchDefaultIO "" (readFile f) + case l of + Just ('#':'!':rest) -> case words rest of + [] -> defcmd f + (c:ps) -> do + let ps' = map Param (ps ++ [f]) + ok <- inPath c + return (if ok then c else takeFileName c, ps') + _ -> defcmd f +#endif + defcmd f = return (f, []) diff --git a/Git/Index.hs b/Git/Index.hs --- a/Git/Index.hs +++ b/Git/Index.hs @@ -1,6 +1,6 @@ {- git index file stuff - - - Copyright 2011 Joey Hess + - Copyright 2011 Joey Hess - - Licensed under the GNU GPL version 3 or higher. -} diff --git a/Git/LsFiles.hs b/Git/LsFiles.hs --- a/Git/LsFiles.hs +++ b/Git/LsFiles.hs @@ -1,6 +1,6 @@ {- git ls-files interface - - - Copyright 2010,2012 Joey Hess + - Copyright 2010,2012 Joey Hess - - Licensed under the GNU GPL version 3 or higher. -} diff --git a/Git/LsTree.hs b/Git/LsTree.hs --- a/Git/LsTree.hs +++ b/Git/LsTree.hs @@ -1,6 +1,6 @@ {- git ls-tree interface - - - Copyright 2011 Joey Hess + - Copyright 2011 Joey Hess - - Licensed under the GNU GPL version 3 or higher. -} diff --git a/Git/Merge.hs b/Git/Merge.hs --- a/Git/Merge.hs +++ b/Git/Merge.hs @@ -1,6 +1,6 @@ {- git merging - - - Copyright 2012, 2014 Joey Hess + - Copyright 2012, 2014 Joey Hess - - Licensed under the GNU GPL version 3 or higher. -} diff --git a/Git/Objects.hs b/Git/Objects.hs --- a/Git/Objects.hs +++ b/Git/Objects.hs @@ -1,6 +1,6 @@ {- .git/objects - - - Copyright 2013 Joey Hess + - Copyright 2013 Joey Hess - - Licensed under the GNU GPL version 3 or higher. -} diff --git a/Git/Queue.hs b/Git/Queue.hs --- a/Git/Queue.hs +++ b/Git/Queue.hs @@ -1,6 +1,6 @@ {- git repository command queue - - - Copyright 2010,2012 Joey Hess + - Copyright 2010,2012 Joey Hess - - Licensed under the GNU GPL version 3 or higher. -} diff --git a/Git/Ref.hs b/Git/Ref.hs --- a/Git/Ref.hs +++ b/Git/Ref.hs @@ -1,6 +1,6 @@ {- git ref stuff - - - Copyright 2011-2013 Joey Hess + - Copyright 2011-2013 Joey Hess - - Licensed under the GNU GPL version 3 or higher. -} diff --git a/Git/RefLog.hs b/Git/RefLog.hs --- a/Git/RefLog.hs +++ b/Git/RefLog.hs @@ -1,6 +1,6 @@ {- git reflog interface - - - Copyright 2013 Joey Hess + - Copyright 2013 Joey Hess - - Licensed under the GNU GPL version 3 or higher. -} diff --git a/Git/Remote.hs b/Git/Remote.hs --- a/Git/Remote.hs +++ b/Git/Remote.hs @@ -1,6 +1,6 @@ {- git remote stuff - - - Copyright 2012 Joey Hess + - Copyright 2012 Joey Hess - - Licensed under the GNU GPL version 3 or higher. -} diff --git a/Git/Remote/Remove.hs b/Git/Remote/Remove.hs --- a/Git/Remote/Remove.hs +++ b/Git/Remote/Remove.hs @@ -1,6 +1,6 @@ {- git remote stuff - - - Copyright 2012 Joey Hess + - Copyright 2012 Joey Hess - - Licensed under the GNU GPL version 3 or higher. -} diff --git a/Git/Repair.hs b/Git/Repair.hs --- a/Git/Repair.hs +++ b/Git/Repair.hs @@ -1,6 +1,6 @@ {- git repository recovery - - - Copyright 2013-2014 Joey Hess + - Copyright 2013-2014 Joey Hess - - Licensed under the GNU GPL version 3 or higher. -} diff --git a/Git/Sha.hs b/Git/Sha.hs --- a/Git/Sha.hs +++ b/Git/Sha.hs @@ -1,6 +1,6 @@ {- git SHA stuff - - - Copyright 2011 Joey Hess + - Copyright 2011 Joey Hess - - Licensed under the GNU GPL version 3 or higher. -} diff --git a/Git/SharedRepository.hs b/Git/SharedRepository.hs --- a/Git/SharedRepository.hs +++ b/Git/SharedRepository.hs @@ -1,6 +1,6 @@ {- git core.sharedRepository handling - - - Copyright 2012 Joey Hess + - Copyright 2012 Joey Hess - - Licensed under the GNU GPL version 3 or higher. -} diff --git a/Git/Types.hs b/Git/Types.hs --- a/Git/Types.hs +++ b/Git/Types.hs @@ -1,6 +1,6 @@ {- git data types - - - Copyright 2010-2012 Joey Hess + - Copyright 2010-2012 Joey Hess - - Licensed under the GNU GPL version 3 or higher. -} diff --git a/Git/UnionMerge.hs b/Git/UnionMerge.hs --- a/Git/UnionMerge.hs +++ b/Git/UnionMerge.hs @@ -1,6 +1,6 @@ {- git-union-merge library - - - Copyright 2011 Joey Hess + - Copyright 2011 Joey Hess - - Licensed under the GNU GPL version 3 or higher. -} diff --git a/Git/UpdateIndex.hs b/Git/UpdateIndex.hs --- a/Git/UpdateIndex.hs +++ b/Git/UpdateIndex.hs @@ -1,6 +1,6 @@ {- git-update-index library - - - Copyright 2011-2013 Joey Hess + - Copyright 2011-2013 Joey Hess - - Licensed under the GNU GPL version 3 or higher. -} diff --git a/Git/Url.hs b/Git/Url.hs --- a/Git/Url.hs +++ b/Git/Url.hs @@ -1,6 +1,6 @@ {- git repository urls - - - Copyright 2010, 2011 Joey Hess + - Copyright 2010, 2011 Joey Hess - - Licensed under the GNU GPL version 3 or higher. -} diff --git a/Git/Version.hs b/Git/Version.hs --- a/Git/Version.hs +++ b/Git/Version.hs @@ -1,6 +1,6 @@ {- git versions - - - Copyright 2011, 2013 Joey Hess + - Copyright 2011, 2013 Joey Hess - - Licensed under the GNU GPL version 3 or higher. -} diff --git a/Limit.hs b/Limit.hs --- a/Limit.hs +++ b/Limit.hs @@ -1,6 +1,6 @@ {- user-specified limits on files to act on - - - Copyright 2011-2014 Joey Hess + - Copyright 2011-2014 Joey Hess - - Licensed under the GNU GPL version 3 or higher. -} @@ -239,9 +239,7 @@ checkkey sz key = return $ keySize key `vs` Just sz check _ sz (Just key) = checkkey sz key check fi sz Nothing = do - filesize <- liftIO $ catchMaybeIO $ - fromIntegral . fileSize - <$> getFileStatus (relFile fi) + filesize <- liftIO $ catchMaybeIO $ getFileSize (relFile fi) return $ filesize `vs` Just sz addMetaData :: String -> Annex () diff --git a/Limit/Wanted.hs b/Limit/Wanted.hs --- a/Limit/Wanted.hs +++ b/Limit/Wanted.hs @@ -1,6 +1,6 @@ {- git-annex limits by wanted status - - - Copyright 2012 Joey Hess + - Copyright 2012 Joey Hess - - Licensed under the GNU GPL version 3 or higher. -} diff --git a/Locations.hs b/Locations.hs --- a/Locations.hs +++ b/Locations.hs @@ -1,6 +1,6 @@ {- git-annex file locations - - - Copyright 2010-2013 Joey Hess + - Copyright 2010-2015 Joey Hess - - Licensed under the GNU GPL version 3 or higher. -} @@ -20,7 +20,6 @@ gitAnnexInodeSentinal, gitAnnexInodeSentinalCache, annexLocations, - annexLocation, gitAnnexDir, gitAnnexObjectDir, gitAnnexTmpMiscDir, @@ -59,7 +58,7 @@ gitAnnexRemotesDir, gitAnnexAssistantDefaultDir, isLinkToAnnex, - annexHashes, + HashLevels(..), hashDirMixed, hashDirLower, preSanitizeKeyName, @@ -67,16 +66,16 @@ prop_idempotent_fileKey ) where -import Data.Bits -import Data.Word -import Data.Hash.MD5 import Data.Char +import Data.Default import Common -import Types +import Types.GitConfig import Types.Key import Types.UUID +import Types.Difference import qualified Git +import Annex.DirHashes {- Conventions: - @@ -102,12 +101,16 @@ objectDir = addTrailingPathSeparator $ annexDir "objects" {- Annexed file's possible locations relative to the .git directory. - - There are two different possibilities, using different hashes. -} -annexLocations :: Key -> [FilePath] -annexLocations key = map (annexLocation key) annexHashes -annexLocation :: Key -> Hasher -> FilePath -annexLocation key hasher = objectDir keyPath key hasher + - There are two different possibilities, using different hashes. + - + - Also, some repositories have a Difference in hash directory depth. + -} +annexLocations :: GitConfig -> Key -> [FilePath] +annexLocations config key = map (annexLocation config key) dirHashes +annexLocation :: GitConfig -> Key -> (HashLevels -> Hasher) -> FilePath +annexLocation config key hasher = objectDir keyPath key (hasher $ objectHashLevels config) + {- Annexed object's location in a repository. - - When there are multiple possible locations, returns the one where the @@ -120,32 +123,37 @@ - the actual location of the file's content. -} gitAnnexLocation :: Key -> Git.Repo -> GitConfig -> IO FilePath -gitAnnexLocation key r config = gitAnnexLocation' key r (annexCrippledFileSystem config) -gitAnnexLocation' :: Key -> Git.Repo -> Bool -> IO FilePath -gitAnnexLocation' key r crippled +gitAnnexLocation key r config = gitAnnexLocation' key r config (annexCrippledFileSystem config) +gitAnnexLocation' :: Key -> Git.Repo -> GitConfig -> Bool -> IO FilePath +gitAnnexLocation' key r config crippled {- Bare repositories default to hashDirLower for new - content, as it's more portable. - - Repositories on filesystems that are crippled also use - hashDirLower, since they do not use symlinks and it's - - more portable. -} - | Git.repoIsLocalBare r || crippled = - check $ map inrepo $ annexLocations key + - more portable. + - + - ObjectHashLower can also be set to force it. + -} + | Git.repoIsLocalBare r + || crippled + || hasDifference ObjectHashLower (annexDifferences config) = + check $ map inrepo $ annexLocations config key {- Non-bare repositories only use hashDirMixed, so - don't need to do any work to check if the file is - present. -} - | otherwise = return $ inrepo $ annexLocation key hashDirMixed + | otherwise = return $ inrepo $ annexLocation config key hashDirMixed where inrepo d = Git.localGitDir r d check locs@(l:_) = fromMaybe l <$> firstM doesFileExist locs check [] = error "internal" {- Calculates a symlink to link a file to an annexed object. -} -gitAnnexLink :: FilePath -> Key -> Git.Repo -> IO FilePath -gitAnnexLink file key r = do +gitAnnexLink :: FilePath -> Key -> Git.Repo -> GitConfig -> IO FilePath +gitAnnexLink file key r config = do currdir <- getCurrentDirectory let absfile = fromMaybe whoops $ absNormPathUnix currdir file - loc <- gitAnnexLocation' key r False + loc <- gitAnnexLocation' key r config False relPathDirToFile (parentDir absfile) loc where whoops = error $ "unable to normalize " ++ file @@ -399,9 +407,9 @@ where k = stubKey { keyName = s, keyBackendName = "test" } -{- A location to store a key on the filesystem. A directory hash is used, - - to protect against filesystems that dislike having many items in a - - single directory. +{- A location to store a key on a special remote that uses a filesystem. + - A directory hash is used, to protect against filesystems that dislike + - having many items in a single directory. - - The file is put in a directory with the same name, this allows - write-protecting the directory to avoid accidental deletion of the file. @@ -411,44 +419,11 @@ where f = keyFile key -{- All possibile locations to store a key using different directory hashes. -} -keyPaths :: Key -> [FilePath] -keyPaths key = map (keyPath key) annexHashes - -{- Two different directory hashes may be used. The mixed case hash - - came first, and is fine, except for the problem of case-strict - - filesystems such as Linux VFAT (mounted with shortname=mixed), - - which do not allow using a directory "XX" when "xx" already exists. - - To support that, most repositories use the lower case hash for new data. -} -type Hasher = Key -> FilePath - -annexHashes :: [Hasher] -annexHashes = [hashDirLower, hashDirMixed] - -hashDirMixed :: Hasher -hashDirMixed k = addTrailingPathSeparator $ take 2 dir drop 2 dir - where - dir = take 4 $ display_32bits_as_dir =<< [a,b,c,d] - ABCD (a,b,c,d) = md5 $ md5FilePath $ key2file $ nonChunkKey k - -hashDirLower :: Hasher -hashDirLower k = addTrailingPathSeparator $ take 3 dir drop 3 dir - where - dir = take 6 $ md5s $ md5FilePath $ key2file $ nonChunkKey k - -{- modified version of display_32bits_as_hex from Data.Hash.MD5 - - Copyright (C) 2001 Ian Lynagh - - License: Either BSD or GPL +{- All possibile locations to store a key in a special remote + - using different directory hashes. + - + - This is compatible with the annexLocations, for interoperability between + - special remotes and git-annex repos. -} -display_32bits_as_dir :: Word32 -> String -display_32bits_as_dir w = trim $ swap_pairs cs - where - -- Need 32 characters to use. To avoid inaverdently making - -- a real word, use letters that appear less frequently. - chars = ['0'..'9'] ++ "zqjxkmvwgpfZQJXKMVWGPF" - cs = map (\x -> getc $ (shiftR w (6*x)) .&. 31) [0..7] - getc n = chars !! fromIntegral n - swap_pairs (x1:x2:xs) = x2:x1:swap_pairs xs - swap_pairs _ = [] - -- Last 2 will always be 00, so omit. - trim = take 6 +keyPaths :: Key -> [FilePath] +keyPaths key = map (\h -> keyPath key (h def)) dirHashes diff --git a/Logs.hs b/Logs.hs --- a/Logs.hs +++ b/Logs.hs @@ -1,6 +1,6 @@ {- git-annex log file names - - - Copyright 2013-2014 Joey Hess + - Copyright 2013-2014 Joey Hess - - Licensed under the GNU GPL version 3 or higher. -} @@ -9,6 +9,7 @@ import Common.Annex import Types.Key +import Annex.DirHashes {- There are several varieties of log file formats. -} data LogVariety @@ -39,6 +40,7 @@ , preferredContentLog , requiredContentLog , scheduleLog + , differenceLog ] {- All the ways to get a key from a presence log file -} @@ -82,9 +84,12 @@ scheduleLog :: FilePath scheduleLog = "schedule.log" +differenceLog :: FilePath +differenceLog = "difference.log" + {- The pathname of the location log file for a given key. -} -locationLogFile :: Key -> String -locationLogFile key = hashDirLower key ++ keyFile key ++ ".log" +locationLogFile :: GitConfig -> Key -> String +locationLogFile config key = branchHashDir config key keyFile key ++ ".log" {- Converts a pathname into a key if it's a location log. -} locationLogFileKey :: FilePath -> Maybe Key @@ -97,15 +102,17 @@ (base, ext) = splitAt (length file - 4) file {- The filename of the url log for a given key. -} -urlLogFile :: Key -> FilePath -urlLogFile key = hashDirLower key keyFile key ++ urlLogExt +urlLogFile :: GitConfig -> Key -> FilePath +urlLogFile config key = branchHashDir config key keyFile key ++ urlLogExt {- Old versions stored the urls elsewhere. -} -oldurlLogs :: Key -> [FilePath] -oldurlLogs key = - [ "remote/web" hashDirLower key key2file key ++ ".log" - , "remote/web" hashDirLower key keyFile key ++ ".log" +oldurlLogs :: GitConfig -> Key -> [FilePath] +oldurlLogs config key = + [ "remote/web" hdir key2file key ++ ".log" + , "remote/web" hdir keyFile key ++ ".log" ] + where + hdir = branchHashDir config key urlLogExt :: String urlLogExt = ".log.web" @@ -126,8 +133,9 @@ isUrlLog file = urlLogExt `isSuffixOf` file {- The filename of the remote state log for a given key. -} -remoteStateLogFile :: Key -> FilePath -remoteStateLogFile key = hashDirLower key keyFile key ++ remoteStateLogExt +remoteStateLogFile :: GitConfig -> Key -> FilePath +remoteStateLogFile config key = branchHashDir config key + keyFile key ++ remoteStateLogExt remoteStateLogExt :: String remoteStateLogExt = ".log.rmt" @@ -136,8 +144,8 @@ isRemoteStateLog path = remoteStateLogExt `isSuffixOf` path {- The filename of the chunk log for a given key. -} -chunkLogFile :: Key -> FilePath -chunkLogFile key = hashDirLower key keyFile key ++ chunkLogExt +chunkLogFile :: GitConfig -> Key -> FilePath +chunkLogFile config key = branchHashDir config key keyFile key ++ chunkLogExt chunkLogFileKey :: FilePath -> Maybe Key chunkLogFileKey path @@ -155,35 +163,11 @@ isChunkLog path = chunkLogExt `isSuffixOf` path {- The filename of the metadata log for a given key. -} -metaDataLogFile :: Key -> FilePath -metaDataLogFile key = hashDirLower key keyFile key ++ metaDataLogExt +metaDataLogFile :: GitConfig -> Key -> FilePath +metaDataLogFile config key = branchHashDir config key keyFile key ++ metaDataLogExt metaDataLogExt :: String metaDataLogExt = ".log.met" isMetaDataLog :: FilePath -> Bool isMetaDataLog path = metaDataLogExt `isSuffixOf` path - -prop_logs_sane :: Key -> Bool -prop_logs_sane dummykey = and - [ isNothing (getLogVariety "unknown") - , expect gotUUIDBasedLog (getLogVariety uuidLog) - , expect gotPresenceLog (getLogVariety $ locationLogFile dummykey) - , expect gotPresenceLog (getLogVariety $ urlLogFile dummykey) - , expect gotNewUUIDBasedLog (getLogVariety $ remoteStateLogFile dummykey) - , expect gotChunkLog (getLogVariety $ chunkLogFile dummykey) - , expect gotOtherLog (getLogVariety $ metaDataLogFile dummykey) - , expect gotOtherLog (getLogVariety numcopiesLog) - ] - where - expect = maybe False - gotUUIDBasedLog UUIDBasedLog = True - gotUUIDBasedLog _ = False - gotNewUUIDBasedLog NewUUIDBasedLog = True - gotNewUUIDBasedLog _ = False - gotChunkLog (ChunkLog k) = k == dummykey - gotChunkLog _ = False - gotPresenceLog (PresenceLog k) = k == dummykey - gotPresenceLog _ = False - gotOtherLog OtherLog = True - gotOtherLog _ = False diff --git a/Logs/Chunk.hs b/Logs/Chunk.hs --- a/Logs/Chunk.hs +++ b/Logs/Chunk.hs @@ -10,7 +10,7 @@ - - Format: "timestamp uuid:chunksize chunkcount" - - - Copyright 2014 Joey Hess + - Copyright 2014 Joey Hess - - Licensed under the GNU GPL version 3 or higher. -} @@ -29,6 +29,7 @@ import Logs.MapLog import qualified Annex.Branch import Logs.Chunk.Pure +import qualified Annex import qualified Data.Map as M import Data.Time.Clock.POSIX @@ -36,14 +37,17 @@ chunksStored :: UUID -> Key -> ChunkMethod -> ChunkCount -> Annex () chunksStored u k chunkmethod chunkcount = do ts <- liftIO getPOSIXTime - Annex.Branch.change (chunkLogFile k) $ + config <- Annex.getGitConfig + Annex.Branch.change (chunkLogFile config k) $ showLog . changeMapLog ts (u, chunkmethod) chunkcount . parseLog chunksRemoved :: UUID -> Key -> ChunkMethod -> Annex () chunksRemoved u k chunkmethod = chunksStored u k chunkmethod 0 getCurrentChunks :: UUID -> Key -> Annex [(ChunkMethod, ChunkCount)] -getCurrentChunks u k = select . parseLog <$> Annex.Branch.get (chunkLogFile k) +getCurrentChunks u k = do + config <- Annex.getGitConfig + select . parseLog <$> Annex.Branch.get (chunkLogFile config k) where select = filter (\(_m, ct) -> ct > 0) . map (\((_ku, m), l) -> (m, value l)) diff --git a/Logs/Chunk/Pure.hs b/Logs/Chunk/Pure.hs --- a/Logs/Chunk/Pure.hs +++ b/Logs/Chunk/Pure.hs @@ -1,6 +1,6 @@ {- Chunk logs, pure operations. - - - Copyright 2014 Joey Hess + - Copyright 2014 Joey Hess - - Licensed under the GNU GPL version 3 or higher. -} diff --git a/Logs/Difference.hs b/Logs/Difference.hs new file mode 100644 --- /dev/null +++ b/Logs/Difference.hs @@ -0,0 +1,41 @@ +{- git-annex difference log + - + - Copyright 2015 Joey Hess + - + - Licensed under the GNU GPL version 3 or higher. + -} + +module Logs.Difference ( + recordDifferences, + recordedDifferences, + recordedDifferencesFor, + module Logs.Difference.Pure +) where + +import Data.Monoid +import Data.Time.Clock.POSIX +import qualified Data.Map as M + +import Common.Annex +import Types.Difference +import qualified Annex.Branch +import Logs +import Logs.UUIDBased +import Logs.Difference.Pure + +recordDifferences :: Differences -> UUID -> Annex () +recordDifferences (Differences differences) uuid = do + ts <- liftIO getPOSIXTime + Annex.Branch.change differenceLog $ + showLog id . changeLog ts uuid (show differences) . parseLog Just +recordDifferences UnknownDifferences _ = return () + +-- Map of UUIDs that have Differences recorded. +-- If a new version of git-annex has added a Difference this version +-- doesn't know about, it will contain UnknownDifferences. +recordedDifferences :: Annex (M.Map UUID Differences) +recordedDifferences = parseDifferencesLog <$> Annex.Branch.get differenceLog + +recordedDifferencesFor :: UUID -> Annex Differences +recordedDifferencesFor u = fromMaybe mempty . M.lookup u + <$> recordedDifferences diff --git a/Logs/Difference/Pure.hs b/Logs/Difference/Pure.hs new file mode 100644 --- /dev/null +++ b/Logs/Difference/Pure.hs @@ -0,0 +1,25 @@ +{- git-annex difference log, pure functions + - + - Copyright 2015 Joey Hess + - + - Licensed under the GNU GPL version 3 or higher. + -} + +module Logs.Difference.Pure ( + allDifferences, + parseDifferencesLog, +) where + +import Data.Monoid +import qualified Data.Map as M + +import Common.Annex +import Types.Difference +import Logs.UUIDBased + +parseDifferencesLog :: String -> (M.Map UUID Differences) +parseDifferencesLog = simpleMap . parseLog (Just . readDifferences) + +-- The sum of all recorded differences, across all UUIDs. +allDifferences :: M.Map UUID Differences -> Differences +allDifferences = mconcat . M.elems diff --git a/Logs/FsckResults.hs b/Logs/FsckResults.hs --- a/Logs/FsckResults.hs +++ b/Logs/FsckResults.hs @@ -1,6 +1,6 @@ {- git-annex fsck results log files - - - Copyright 2013 Joey Hess + - Copyright 2013 Joey Hess - - Licensed under the GNU GPL version 3 or higher. -} diff --git a/Logs/Group.hs b/Logs/Group.hs --- a/Logs/Group.hs +++ b/Logs/Group.hs @@ -1,6 +1,6 @@ {- git-annex group log - - - Copyright 2012 Joey Hess + - Copyright 2012 Joey Hess - - Licensed under the GNU GPL version 3 or higher. -} diff --git a/Logs/Location.hs b/Logs/Location.hs --- a/Logs/Location.hs +++ b/Logs/Location.hs @@ -8,7 +8,7 @@ - Repositories record their UUID and the date when they --get or --drop - a value. - - - Copyright 2010-2014 Joey Hess + - Copyright 2010-2014 Joey Hess - - Licensed under the GNU GPL version 3 or higher. -} @@ -29,6 +29,7 @@ import Logs.Presence import Annex.UUID import Git.Types (RefDate) +import qualified Annex {- Log a change in the presence of a key's value in current repository. -} logStatus :: Key -> LogStatus -> Annex () @@ -38,7 +39,9 @@ {- Log a change in the presence of a key's value in a repository. -} logChange :: Key -> UUID -> LogStatus -> Annex () -logChange key (UUID u) s = addLog (locationLogFile key) =<< logNow s u +logChange key (UUID u) s = do + config <- Annex.getGitConfig + addLog (locationLogFile config key) =<< logNow s u logChange _ NoUUID _ = noop {- Returns a list of repository UUIDs that, according to the log, have @@ -51,7 +54,9 @@ loggedLocationsHistorical = getLoggedLocations . historicalLog getLoggedLocations :: (FilePath -> Annex [String]) -> Key -> Annex [UUID] -getLoggedLocations getter key = map toUUID <$> (getter . locationLogFile) key +getLoggedLocations getter key = do + config <- Annex.getGitConfig + map toUUID <$> (getter . locationLogFile config) key {- Finds all keys that have location log information. - (There may be duplicate keys in the list.) -} diff --git a/Logs/MapLog.hs b/Logs/MapLog.hs --- a/Logs/MapLog.hs +++ b/Logs/MapLog.hs @@ -4,7 +4,7 @@ - - A line of the log will look like: "timestamp field value" - - - Copyright 2014 Joey Hess + - Copyright 2014 Joey Hess - - Licensed under the GNU GPL version 3 or higher. -} diff --git a/Logs/MetaData.hs b/Logs/MetaData.hs --- a/Logs/MetaData.hs +++ b/Logs/MetaData.hs @@ -18,7 +18,7 @@ - and so foo currently has no value. - - - - Copyright 2014 Joey Hess + - Copyright 2014 Joey Hess - - Licensed under the GNU GPL version 3 or higher. -} @@ -38,6 +38,7 @@ import Types.MetaData import Annex.MetaData.StandardFields import qualified Annex.Branch +import qualified Annex import Logs import Logs.SingleValue @@ -52,7 +53,9 @@ deserialize = Types.MetaData.deserialize getMetaDataLog :: Key -> Annex (Log MetaData) -getMetaDataLog = readLog . metaDataLogFile +getMetaDataLog key = do + config <- Annex.getGitConfig + readLog $ metaDataLogFile config key {- Go through the log from oldest to newest, and combine it all - into a single MetaData representing the current state. @@ -97,10 +100,12 @@ addMetaData' :: Key -> MetaData -> POSIXTime -> Annex () addMetaData' k d@(MetaData m) now | d == emptyMetaData = noop - | otherwise = Annex.Branch.change (metaDataLogFile k) $ - showLog . simplifyLog - . S.insert (LogEntry now metadata) - . parseLog + | otherwise = do + config <- Annex.getGitConfig + Annex.Branch.change (metaDataLogFile config k) $ + showLog . simplifyLog + . S.insert (LogEntry now metadata) + . parseLog where metadata = MetaData $ M.filterWithKey (\f _ -> not (isLastChangedField f)) m @@ -181,6 +186,7 @@ | oldkey == newkey = noop | otherwise = do l <- getMetaDataLog oldkey - unless (S.null l) $ - Annex.Branch.change (metaDataLogFile newkey) $ + unless (S.null l) $ do + config <- Annex.getGitConfig + Annex.Branch.change (metaDataLogFile config newkey) $ const $ showLog l diff --git a/Logs/NumCopies.hs b/Logs/NumCopies.hs --- a/Logs/NumCopies.hs +++ b/Logs/NumCopies.hs @@ -1,6 +1,6 @@ {- git-annex numcopies log - - - Copyright 2014 Joey Hess + - Copyright 2014 Joey Hess - - Licensed under the GNU GPL version 3 or higher. -} diff --git a/Logs/PreferredContent.hs b/Logs/PreferredContent.hs --- a/Logs/PreferredContent.hs +++ b/Logs/PreferredContent.hs @@ -1,6 +1,6 @@ {- git-annex preferred content matcher configuration - - - Copyright 2012-2014 Joey Hess + - Copyright 2012-2014 Joey Hess - - Licensed under the GNU GPL version 3 or higher. -} @@ -52,12 +52,12 @@ isRequiredContent = checkMap requiredContentMap checkMap :: Annex (FileMatcherMap Annex) -> Maybe UUID -> AssumeNotPresent -> Maybe Key -> AssociatedFile -> Bool -> Annex Bool -checkMap getmap mu notpresent mkey afile def = do +checkMap getmap mu notpresent mkey afile d = do u <- maybe getUUID return mu m <- getmap case M.lookup u m of - Nothing -> return def - Just matcher -> checkMatcher matcher mkey afile notpresent def + Nothing -> return d + Just matcher -> checkMatcher matcher mkey afile notpresent d preferredContentMap :: Annex (FileMatcherMap Annex) preferredContentMap = maybe (fst <$> preferredRequiredMapsLoad) return diff --git a/Logs/PreferredContent/Raw.hs b/Logs/PreferredContent/Raw.hs --- a/Logs/PreferredContent/Raw.hs +++ b/Logs/PreferredContent/Raw.hs @@ -1,6 +1,6 @@ {- unparsed preferred content expressions - - - Copyright 2012-2014 Joey Hess + - Copyright 2012-2014 Joey Hess - - Licensed under the GNU GPL version 3 or higher. -} diff --git a/Logs/Presence.hs b/Logs/Presence.hs --- a/Logs/Presence.hs +++ b/Logs/Presence.hs @@ -6,7 +6,7 @@ - A line of the log will look like: "date N INFO" - Where N=1 when the INFO is present, and 0 otherwise. - - - Copyright 2010-2014 Joey Hess + - Copyright 2010-2014 Joey Hess - - Licensed under the GNU GPL version 3 or higher. -} diff --git a/Logs/Presence/Pure.hs b/Logs/Presence/Pure.hs --- a/Logs/Presence/Pure.hs +++ b/Logs/Presence/Pure.hs @@ -1,6 +1,6 @@ {- git-annex presence log, pure operations - - - Copyright 2010-2013 Joey Hess + - Copyright 2010-2013 Joey Hess - - Licensed under the GNU GPL version 3 or higher. -} diff --git a/Logs/Remote.hs b/Logs/Remote.hs --- a/Logs/Remote.hs +++ b/Logs/Remote.hs @@ -1,6 +1,6 @@ {- git-annex remote log - - - Copyright 2011 Joey Hess + - Copyright 2011 Joey Hess - - Licensed under the GNU GPL version 3 or higher. -} diff --git a/Logs/RemoteState.hs b/Logs/RemoteState.hs --- a/Logs/RemoteState.hs +++ b/Logs/RemoteState.hs @@ -1,6 +1,6 @@ {- Remote state logs. - - - Copyright 2014 Joey Hess + - Copyright 2014 Joey Hess - - Licensed under the GNU GPL version 3 or higher. -} @@ -14,6 +14,7 @@ import Logs import Logs.UUIDBased import qualified Annex.Branch +import qualified Annex import qualified Data.Map as M import Data.Time.Clock.POSIX @@ -23,11 +24,14 @@ setRemoteState :: UUID -> Key -> RemoteState -> Annex () setRemoteState u k s = do ts <- liftIO getPOSIXTime - Annex.Branch.change (remoteStateLogFile k) $ + config <- Annex.getGitConfig + Annex.Branch.change (remoteStateLogFile config k) $ showLogNew id . changeLog ts u s . parseLogNew Just getRemoteState :: UUID -> Key -> Annex (Maybe RemoteState) -getRemoteState u k = extract . parseLogNew Just - <$> Annex.Branch.get (remoteStateLogFile k) +getRemoteState u k = do + config <- Annex.getGitConfig + extract . parseLogNew Just + <$> Annex.Branch.get (remoteStateLogFile config k) where extract m = value <$> M.lookup u m diff --git a/Logs/Schedule.hs b/Logs/Schedule.hs --- a/Logs/Schedule.hs +++ b/Logs/Schedule.hs @@ -1,6 +1,6 @@ {- git-annex scheduled activities log - - - Copyright 2013 Joey Hess + - Copyright 2013 Joey Hess - - Licensed under the GNU GPL version 3 or higher. -} diff --git a/Logs/SingleValue.hs b/Logs/SingleValue.hs --- a/Logs/SingleValue.hs +++ b/Logs/SingleValue.hs @@ -6,7 +6,7 @@ - - The line with the newest timestamp wins. - - - Copyright 2014 Joey Hess + - Copyright 2014 Joey Hess - - Licensed under the GNU GPL version 3 or higher. -} diff --git a/Logs/Transfer.hs b/Logs/Transfer.hs --- a/Logs/Transfer.hs +++ b/Logs/Transfer.hs @@ -1,6 +1,6 @@ {- git-annex transfer information files and lock files - - - Copyright 2012 Joey Hess + - Copyright 2012 Joey Hess - - Licensed under the GNU GPL version 3 or higher. -} diff --git a/Logs/Transitions.hs b/Logs/Transitions.hs --- a/Logs/Transitions.hs +++ b/Logs/Transitions.hs @@ -7,7 +7,7 @@ - done that is listed in the remote branch by checking that the local - branch contains the same transition, with the same or newer start time. - - - Copyright 2013 Joey Hess + - Copyright 2013 Joey Hess - - Licensed under the GNU GPL version 3 or higher. -} diff --git a/Logs/Trust.hs b/Logs/Trust.hs --- a/Logs/Trust.hs +++ b/Logs/Trust.hs @@ -1,6 +1,6 @@ {- git-annex trust log - - - Copyright 2010-2012 Joey Hess + - Copyright 2010-2012 Joey Hess - - Licensed under the GNU GPL version 3 or higher. -} diff --git a/Logs/Trust/Basic.hs b/Logs/Trust/Basic.hs --- a/Logs/Trust/Basic.hs +++ b/Logs/Trust/Basic.hs @@ -1,6 +1,6 @@ {- git-annex trust log, basics - - - Copyright 2010-2012 Joey Hess + - Copyright 2010-2012 Joey Hess - - Licensed under the GNU GPL version 3 or higher. -} diff --git a/Logs/Trust/Pure.hs b/Logs/Trust/Pure.hs --- a/Logs/Trust/Pure.hs +++ b/Logs/Trust/Pure.hs @@ -1,6 +1,6 @@ {- git-annex trust log, pure operations - - - Copyright 2010-2013 Joey Hess + - Copyright 2010-2013 Joey Hess - - Licensed under the GNU GPL version 3 or higher. -} diff --git a/Logs/UUID.hs b/Logs/UUID.hs --- a/Logs/UUID.hs +++ b/Logs/UUID.hs @@ -8,7 +8,7 @@ - - uuid.log stores a list of known uuids, and their descriptions. - - - Copyright 2010-2012 Joey Hess + - Copyright 2010-2012 Joey Hess - - Licensed under the GNU GPL version 3 or higher. -} diff --git a/Logs/UUIDBased.hs b/Logs/UUIDBased.hs --- a/Logs/UUIDBased.hs +++ b/Logs/UUIDBased.hs @@ -9,7 +9,7 @@ - - New uuid based logs instead use the form: "timestamp UUID INFO" - - - Copyright 2011-2013 Joey Hess + - Copyright 2011-2013 Joey Hess - - Licensed under the GNU GPL version 3 or higher. -} diff --git a/Logs/Unused.hs b/Logs/Unused.hs --- a/Logs/Unused.hs +++ b/Logs/Unused.hs @@ -10,7 +10,7 @@ - The timestamp indicates when the key was first determined to be unused. - Older versions of the log omit the timestamp. - - - Copyright 2010-2014 Joey Hess + - Copyright 2010-2014 Joey Hess - - Licensed under the GNU GPL version 3 or higher. -} diff --git a/Logs/View.hs b/Logs/View.hs --- a/Logs/View.hs +++ b/Logs/View.hs @@ -4,7 +4,7 @@ - - This file is stored locally in .git/annex/, not in the git-annex branch. - - - Copyright 2014 Joey Hess + - Copyright 2014 Joey Hess - - Licensed under the GNU GPL version 3 or higher. -} diff --git a/Logs/Web.hs b/Logs/Web.hs --- a/Logs/Web.hs +++ b/Logs/Web.hs @@ -1,6 +1,6 @@ {- Web url logs. - - - Copyright 2011-2014 Joey Hess + - Copyright 2011-2014 Joey Hess - - Licensed under the GNU GPL version 3 or higher. -} @@ -37,7 +37,8 @@ {- Gets all urls that a key might be available from. -} getUrls :: Key -> Annex [URLString] getUrls key = do - l <- go $ urlLogFile key : oldurlLogs key + config <- Annex.getGitConfig + l <- go $ urlLogFile config key : oldurlLogs config key tmpl <- Annex.getState (maybeToList . M.lookup key . Annex.tempurls) return (tmpl ++ l) where @@ -54,13 +55,15 @@ setUrlPresent :: UUID -> Key -> URLString -> Annex () setUrlPresent uuid key url = do us <- getUrls key - unless (url `elem` us) $ - addLog (urlLogFile key) =<< logNow InfoPresent url + unless (url `elem` us) $ do + config <- Annex.getGitConfig + addLog (urlLogFile config key) =<< logNow InfoPresent url logChange key uuid InfoPresent setUrlMissing :: UUID -> Key -> URLString -> Annex () setUrlMissing uuid key url = do - addLog (urlLogFile key) =<< logNow InfoMissing url + config <- Annex.getGitConfig + addLog (urlLogFile config key) =<< logNow InfoMissing url whenM (null <$> getUrls key) $ logChange key uuid InfoMissing diff --git a/Messages.hs b/Messages.hs --- a/Messages.hs +++ b/Messages.hs @@ -1,6 +1,6 @@ {- git-annex output messages - - - Copyright 2010-2014 Joey Hess + - Copyright 2010-2014 Joey Hess - - Licensed under the GNU GPL version 3 or higher. -} diff --git a/Messages/JSON.hs b/Messages/JSON.hs --- a/Messages/JSON.hs +++ b/Messages/JSON.hs @@ -1,6 +1,6 @@ {- git-annex JSON output - - - Copyright 2011 Joey Hess + - Copyright 2011 Joey Hess - - Licensed under the GNU GPL version 3 or higher. -} diff --git a/Remote.hs b/Remote.hs --- a/Remote.hs +++ b/Remote.hs @@ -1,6 +1,6 @@ {- git-annex remotes - - - Copyright 2011 Joey Hess + - Copyright 2011 Joey Hess - - Licensed under the GNU GPL version 3 or higher. -} @@ -131,8 +131,8 @@ byNameOrGroup n = go =<< getConfigMaybe (ConfigKey ("remotes." ++ n)) where go (Just l) = concatMap maybeToList <$> - mapM (Remote.byName . Just) (split " " l) - go Nothing = maybeToList <$> Remote.byName (Just n) + mapM (byName . Just) (split " " l) + go Nothing = maybeToList <$> byName (Just n) {- Only matches remote name, not UUID -} byNameOnly :: RemoteName -> Annex (Maybe Remote) @@ -272,15 +272,17 @@ return (sortBy (comparing cost) validremotes, validtrusteduuids) {- Displays known locations of a key. -} -showLocations :: Key -> [UUID] -> String -> Annex () -showLocations key exclude nolocmsg = do +showLocations :: Bool -> Key -> [UUID] -> String -> Annex () +showLocations separateuntrusted key exclude nolocmsg = do u <- getUUID uuids <- keyLocations key - untrusteduuids <- trustGet UnTrusted + untrusteduuids <- if separateuntrusted + then trustGet UnTrusted + else pure [] let uuidswanted = filteruuids uuids (u:exclude++untrusteduuids) let uuidsskipped = filteruuids uuids (u:exclude++uuidswanted) - ppuuidswanted <- Remote.prettyPrintUUIDs "wanted" uuidswanted - ppuuidsskipped <- Remote.prettyPrintUUIDs "skipped" uuidsskipped + ppuuidswanted <- prettyPrintUUIDs "wanted" uuidswanted + ppuuidsskipped <- prettyPrintUUIDs "skipped" uuidsskipped showLongNote $ message ppuuidswanted ppuuidsskipped ignored <- filter (remoteAnnexIgnore . gitconfig) <$> remoteList unless (null ignored) $ diff --git a/Remote/BitTorrent.hs b/Remote/BitTorrent.hs --- a/Remote/BitTorrent.hs +++ b/Remote/BitTorrent.hs @@ -1,6 +1,6 @@ {- BitTorrent remote. - - - Copyright 2014 Joey Hess + - Copyright 2014 Joey Hess - - Licensed under the GNU GPL version 3 or higher. -} diff --git a/Remote/Bup.hs b/Remote/Bup.hs --- a/Remote/Bup.hs +++ b/Remote/Bup.hs @@ -1,6 +1,6 @@ {- Using bup as a remote. - - - Copyright 2011-2014 Joey Hess + - Copyright 2011-2014 Joey Hess - - Licensed under the GNU GPL version 3 or higher. -} diff --git a/Remote/Ddar.hs b/Remote/Ddar.hs --- a/Remote/Ddar.hs +++ b/Remote/Ddar.hs @@ -1,6 +1,6 @@ {- Using ddar as a remote. Based on bup and rsync remotes. - - - Copyright 2011 Joey Hess + - Copyright 2011 Joey Hess - Copyright 2014 Robie Basak - - Licensed under the GNU GPL version 3 or higher. @@ -12,7 +12,6 @@ import qualified Data.ByteString.Lazy as L import System.IO.Error -import Data.String.Utils import Common.Annex import Types.Remote import Types.Key @@ -164,7 +163,7 @@ ExitSuccess -> return $ Right True ExitFailure 1 -> return $ Right False ExitFailure code -> return $ Left $ "ssh call " ++ - show (Data.String.Utils.join " " $ toCommand params) ++ + show (unwords $ toCommand params) ++ " failed with status " ++ show code where (host, ddarrepo') = splitRemoteDdarRepo ddarrepo diff --git a/Remote/Directory.hs b/Remote/Directory.hs --- a/Remote/Directory.hs +++ b/Remote/Directory.hs @@ -1,6 +1,6 @@ {- A "remote" that is just a filesystem directory. - - - Copyright 2011-2014 Joey Hess + - Copyright 2011-2014 Joey Hess - - Licensed under the GNU GPL version 3 or higher. -} @@ -15,6 +15,7 @@ import qualified Data.ByteString.Lazy as L import qualified Data.Map as M +import Data.Default import Common.Annex import Types.Remote @@ -107,7 +108,7 @@ {- Directory where the file(s) for a key are stored. -} storeDir :: FilePath -> Key -> FilePath -storeDir d k = addTrailingPathSeparator $ d hashDirLower k keyFile k +storeDir d k = addTrailingPathSeparator $ d hashDirLower def k keyFile k {- Where we store temporary data for a key, in the directory, as it's being - written. -} diff --git a/Remote/Directory/LegacyChunked.hs b/Remote/Directory/LegacyChunked.hs --- a/Remote/Directory/LegacyChunked.hs +++ b/Remote/Directory/LegacyChunked.hs @@ -2,7 +2,7 @@ - - Can be removed eventually. - - - Copyright 2011-2012 Joey Hess + - Copyright 2011-2012 Joey Hess - - Licensed under the GNU GPL version 3 or higher. -} diff --git a/Remote/External.hs b/Remote/External.hs --- a/Remote/External.hs +++ b/Remote/External.hs @@ -1,6 +1,6 @@ {- External special remote interface. - - - Copyright 2013 Joey Hess + - Copyright 2013 Joey Hess - - Licensed under the GNU GPL version 3 or higher. -} @@ -184,7 +184,7 @@ handleRemoteRequest (PROGRESS bytesprocessed) = maybe noop (\a -> liftIO $ a bytesprocessed) mp handleRemoteRequest (DIRHASH k) = - send $ VALUE $ hashDirMixed k + send $ VALUE $ hashDirMixed def k handleRemoteRequest (SETCONFIG setting value) = liftIO $ atomically $ do let v = externalConfig external diff --git a/Remote/External/Types.hs b/Remote/External/Types.hs --- a/Remote/External/Types.hs +++ b/Remote/External/Types.hs @@ -1,6 +1,6 @@ {- External special remote data types. - - - Copyright 2013 Joey Hess + - Copyright 2013 Joey Hess - - Licensed under the GNU GPL version 3 or higher. -} diff --git a/Remote/GCrypt.hs b/Remote/GCrypt.hs --- a/Remote/GCrypt.hs +++ b/Remote/GCrypt.hs @@ -1,6 +1,6 @@ {- git remotes encrypted using git-remote-gcrypt - - - Copyright 2013 Joey Hess + - Copyright 2013 Joey Hess - - Licensed under the GNU GPL version 3 or higher. -} @@ -16,6 +16,7 @@ import qualified Data.Map as M import qualified Data.ByteString.Lazy as L import Control.Exception +import Data.Default import Common.Annex import Types.Remote @@ -121,7 +122,7 @@ , availability = availabilityCalc r , remotetype = remote , mkUnavailable = return Nothing - , getInfo = return $ gitRepoInfo r + , getInfo = gitRepoInfo this , claimUrl = Nothing , checkUrl = Nothing } @@ -361,7 +362,7 @@ {- Annexed objects are hashed using lower-case directories for max - portability. -} gCryptLocation :: Remote -> Key -> FilePath -gCryptLocation r key = Git.repoLocation (repo r) objectDir keyPath key hashDirLower +gCryptLocation r key = Git.repoLocation (repo r) objectDir keyPath key (hashDirLower def) data AccessMethod = AccessDirect | AccessShell diff --git a/Remote/Git.hs b/Remote/Git.hs --- a/Remote/Git.hs +++ b/Remote/Git.hs @@ -1,6 +1,6 @@ {- Standard git remotes. - - - Copyright 2011-2012 Joey Hess + - Copyright 2011-2012 Joey Hess - - Licensed under the GNU GPL version 3 or higher. -} @@ -159,7 +159,7 @@ , availability = availabilityCalc r , remotetype = remote , mkUnavailable = unavailable r u c gc - , getInfo = return $ gitRepoInfo r + , getInfo = gitRepoInfo new , claimUrl = Nothing , checkUrl = Nothing } @@ -327,13 +327,15 @@ -- If the remote is known to not be bare, try the hash locations -- used for non-bare repos first, as an optimisation. locs - | remoteAnnexBare (gitconfig r) == Just False = reverse (annexLocations key) - | otherwise = annexLocations key + | remoteAnnexBare remoteconfig == Just False = reverse (annexLocations cfg key) + | otherwise = annexLocations cfg key #ifndef mingw32_HOST_OS locs' = locs #else locs' = map (replace "\\" "/") locs #endif + remoteconfig = gitconfig r + cfg = fromJust $ remoteGitConfig remoteconfig dropKey :: Remote -> Key -> Annex Bool dropKey r key @@ -563,9 +565,7 @@ (const $ copyFileExternal CopyTimeStamps src dest) watchfilesize oldsz = do threadDelay 500000 -- 0.5 seconds - v <- catchMaybeIO $ - toBytesProcessed . fileSize - <$> getFileStatus dest + v <- catchMaybeIO $ toBytesProcessed <$> getFileSize dest case v of Just sz | sz /= oldsz -> do diff --git a/Remote/Glacier.hs b/Remote/Glacier.hs --- a/Remote/Glacier.hs +++ b/Remote/Glacier.hs @@ -1,6 +1,6 @@ {- Amazon Glacier remotes. - - - Copyright 2012 Joey Hess + - Copyright 2012 Joey Hess - - Licensed under the GNU GPL version 3 or higher. -} diff --git a/Remote/Helper/AWS.hs b/Remote/Helper/AWS.hs --- a/Remote/Helper/AWS.hs +++ b/Remote/Helper/AWS.hs @@ -1,6 +1,6 @@ {- Amazon Web Services common infrastructure. - - - Copyright 2011-2014 Joey Hess + - Copyright 2011-2014 Joey Hess - - Licensed under the GNU GPL version 3 or higher. -} diff --git a/Remote/Helper/Chunked.hs b/Remote/Helper/Chunked.hs --- a/Remote/Helper/Chunked.hs +++ b/Remote/Helper/Chunked.hs @@ -1,6 +1,6 @@ {- git-annex chunked remotes - - - Copyright 2014 Joey Hess + - Copyright 2014 Joey Hess - - Licensed under the GNU GPL version 3 or higher. -} @@ -244,8 +244,7 @@ | otherwise = go =<< chunkKeys u chunkconfig basek where go ls = do - currsize <- liftIO $ catchMaybeIO $ - toInteger . fileSize <$> getFileStatus dest + currsize <- liftIO $ catchMaybeIO $ getFileSize dest let ls' = maybe ls (setupResume ls) currsize if any null ls' then return True -- dest is already complete diff --git a/Remote/Helper/Chunked/Legacy.hs b/Remote/Helper/Chunked/Legacy.hs --- a/Remote/Helper/Chunked/Legacy.hs +++ b/Remote/Helper/Chunked/Legacy.hs @@ -1,6 +1,6 @@ {- legacy git-annex chunked remotes - - - Copyright 2012 Joey Hess + - Copyright 2012 Joey Hess - - Licensed under the GNU GPL version 3 or higher. -} diff --git a/Remote/Helper/Encryptable.hs b/Remote/Helper/Encryptable.hs --- a/Remote/Helper/Encryptable.hs +++ b/Remote/Helper/Encryptable.hs @@ -1,6 +1,6 @@ {- common functions for encryptable remotes - - - Copyright 2011 Joey Hess + - Copyright 2011 Joey Hess - - Licensed under the GNU GPL version 3 or higher. -} diff --git a/Remote/Helper/Git.hs b/Remote/Helper/Git.hs --- a/Remote/Helper/Git.hs +++ b/Remote/Helper/Git.hs @@ -1,6 +1,6 @@ {- Utilities for git remotes. - - - Copyright 2011-2014 Joey Hess + - Copyright 2011-2014 Joey Hess - - Licensed under the GNU GPL version 3 or higher. -} @@ -10,7 +10,10 @@ import Common.Annex import qualified Git import Types.Availability +import qualified Types.Remote as Remote +import Data.Time.Clock.POSIX + repoCheap :: Git.Repo -> Bool repoCheap = not . Git.repoIsUrl @@ -31,7 +34,15 @@ | Git.repoIsLocalUnknown r = fallback | otherwise = a -gitRepoInfo :: Git.Repo -> [(String, String)] -gitRepoInfo r = - [ ("repository location", Git.repoLocation r) - ] +gitRepoInfo :: Remote -> Annex [(String, String)] +gitRepoInfo r = do + d <- fromRepo Git.localGitDir + mtimes <- liftIO $ mapM (modificationTime <$$> getFileStatus) + =<< dirContentsRecursive (d "refs" "remotes" Remote.name r) + let lastsynctime = case mtimes of + [] -> "never" + _ -> show $ posixSecondsToUTCTime $ realToFrac $ maximum mtimes + return + [ ("repository location", Git.repoLocation (Remote.repo r)) + , ("last synced", lastsynctime) + ] diff --git a/Remote/Helper/Hooks.hs b/Remote/Helper/Hooks.hs --- a/Remote/Helper/Hooks.hs +++ b/Remote/Helper/Hooks.hs @@ -1,6 +1,6 @@ {- Adds hooks to remotes. - - - Copyright 2012 Joey Hess + - Copyright 2012 Joey Hess - - Licensed under the GNU GPL version 3 or higher. -} diff --git a/Remote/Helper/Http.hs b/Remote/Helper/Http.hs --- a/Remote/Helper/Http.hs +++ b/Remote/Helper/Http.hs @@ -1,6 +1,6 @@ {- helpers for remotes using http - - - Copyright 2014 Joey Hess + - Copyright 2014 Joey Hess - - Licensed under the GNU GPL version 3 or higher. -} @@ -32,7 +32,7 @@ -- the meter as it's sent. httpBodyStorer :: FilePath -> MeterUpdate -> IO RequestBody httpBodyStorer src m = do - size <- fromIntegral . fileSize <$> getFileStatus src :: IO Integer + size <- getFileSize src let streamer sink = withMeteredFile src m $ \b -> byteStringPopper b sink return $ RequestBodyStream (fromInteger size) streamer diff --git a/Remote/Helper/Messages.hs b/Remote/Helper/Messages.hs --- a/Remote/Helper/Messages.hs +++ b/Remote/Helper/Messages.hs @@ -1,6 +1,6 @@ {- git-annex remote messages - - - Copyright 2013 Joey Hess + - Copyright 2013 Joey Hess - - Licensed under the GNU GPL version 3 or higher. -} diff --git a/Remote/Helper/ReadOnly.hs b/Remote/Helper/ReadOnly.hs --- a/Remote/Helper/ReadOnly.hs +++ b/Remote/Helper/ReadOnly.hs @@ -1,6 +1,6 @@ {- Adds readonly support to remotes. - - - Copyright 2013 Joey Hess + - Copyright 2013 Joey Hess - - Licensed under the GNU GPL version 3 or higher. -} diff --git a/Remote/Helper/Special.hs b/Remote/Helper/Special.hs --- a/Remote/Helper/Special.hs +++ b/Remote/Helper/Special.hs @@ -1,6 +1,6 @@ {- helpers for special remotes - - - Copyright 2011-2014 Joey Hess + - Copyright 2011-2014 Joey Hess - - Licensed under the GNU GPL version 3 or higher. -} diff --git a/Remote/Helper/Ssh.hs b/Remote/Helper/Ssh.hs --- a/Remote/Helper/Ssh.hs +++ b/Remote/Helper/Ssh.hs @@ -1,6 +1,6 @@ {- git-annex remote access with ssh and git-annex-shell - - - Copyright 2011-2013 Joey Hess + - Copyright 2011-2013 Joey Hess - - Licensed under the GNU GPL version 3 or higher. -} diff --git a/Remote/Hook.hs b/Remote/Hook.hs --- a/Remote/Hook.hs +++ b/Remote/Hook.hs @@ -1,14 +1,12 @@ {- A remote that provides hooks to run shell commands. - - - Copyright 2011 Joey Hess + - Copyright 2011 Joey Hess - - Licensed under the GNU GPL version 3 or higher. -} module Remote.Hook (remote) where -import qualified Data.Map as M - import Common.Annex import Types.Remote import Types.Key @@ -20,6 +18,8 @@ import Remote.Helper.Special import Utility.Env +import qualified Data.Map as M + type Action = String type HookName = String @@ -90,7 +90,7 @@ ] fileenv Nothing = [] fileenv (Just file) = [envvar "FILE" file] - hashbits = map takeDirectory $ splitPath $ hashDirMixed k + hashbits = map takeDirectory $ splitPath $ hashDirMixed def k lookupHook :: HookName -> Action -> Annex (Maybe String) lookupHook hookname action = do diff --git a/Remote/List.hs b/Remote/List.hs --- a/Remote/List.hs +++ b/Remote/List.hs @@ -2,7 +2,7 @@ {- git-annex remote list - - - Copyright 2011,2012 Joey Hess + - Copyright 2011,2012 Joey Hess - - Licensed under the GNU GPL version 3 or higher. -} diff --git a/Remote/Rsync.hs b/Remote/Rsync.hs --- a/Remote/Rsync.hs +++ b/Remote/Rsync.hs @@ -1,6 +1,6 @@ {- A remote that is only accessible by rsync. - - - Copyright 2011 Joey Hess + - Copyright 2011 Joey Hess - - Licensed under the GNU GPL version 3 or higher. -} @@ -37,6 +37,7 @@ import Logs.Transfer import Types.Creds import Types.Key (isChunkKey) +import Annex.DirHashes import qualified Data.Map as M @@ -212,8 +213,8 @@ - content could be. Note that the parent directories have - to also be explicitly included, due to how rsync - traverses directories. -} - includes = concatMap use annexHashes - use h = let dir = h k in + includes = concatMap use dirHashes + use h = let dir = h def k in [ parentDir dir , dir -- match content directory and anything in it diff --git a/Remote/Rsync/RsyncUrl.hs b/Remote/Rsync/RsyncUrl.hs --- a/Remote/Rsync/RsyncUrl.hs +++ b/Remote/Rsync/RsyncUrl.hs @@ -1,6 +1,6 @@ {- Rsync urls. - - - Copyright 2014 Joey Hess + - Copyright 2014 Joey Hess - - Licensed under the GNU GPL version 3 or higher. -} @@ -14,10 +14,12 @@ import Utility.Rsync import Utility.SafeCommand +import Data.Default import System.FilePath.Posix #ifdef mingw32_HOST_OS import Data.String.Utils #endif +import Annex.DirHashes type RsyncUrl = String @@ -35,12 +37,12 @@ | otherwise = u rsyncUrls :: RsyncOpts -> Key -> [RsyncUrl] -rsyncUrls o k = map use annexHashes +rsyncUrls o k = map use dirHashes where use h = rsyncUrl o hash h rsyncEscape o (f f) f = keyFile k #ifndef mingw32_HOST_OS - hash h = h k + hash h = h def k #else - hash h = replace "\\" "/" (h k) + hash h = replace "\\" "/" (h def k) #endif diff --git a/Remote/S3.hs b/Remote/S3.hs --- a/Remote/S3.hs +++ b/Remote/S3.hs @@ -1,6 +1,6 @@ {- S3 remotes - - - Copyright 2011-2014 Joey Hess + - Copyright 2011-2014 Joey Hess - - Licensed under the GNU GPL version 3 or higher. -} @@ -159,7 +159,7 @@ store r h = fileStorer $ \k f p -> do case partSize (hinfo h) of Just partsz | partsz > 0 -> do - fsz <- fromIntegral . fileSize <$> liftIO (getFileStatus f) + fsz <- liftIO $ getFileSize f if fsz > partsz then multipartupload fsz partsz k f p else singlepartupload k f p diff --git a/Remote/Tahoe.hs b/Remote/Tahoe.hs --- a/Remote/Tahoe.hs +++ b/Remote/Tahoe.hs @@ -13,7 +13,7 @@ - - Tahoe has its own encryption, so git-annex's encryption is not used. - - - Copyright 2014 Joey Hess + - Copyright 2014 Joey Hess - - Licensed under the GNU GPL version 3 or higher. -} diff --git a/Remote/Web.hs b/Remote/Web.hs --- a/Remote/Web.hs +++ b/Remote/Web.hs @@ -1,6 +1,6 @@ {- Web remote. - - - Copyright 2011 Joey Hess + - Copyright 2011 Joey Hess - - Licensed under the GNU GPL version 3 or higher. -} diff --git a/Remote/WebDAV.hs b/Remote/WebDAV.hs --- a/Remote/WebDAV.hs +++ b/Remote/WebDAV.hs @@ -1,6 +1,6 @@ {- WebDAV remotes. - - - Copyright 2012-2014 Joey Hess + - Copyright 2012-2014 Joey Hess - - Licensed under the GNU GPL version 3 or higher. -} diff --git a/Remote/WebDAV/DavLocation.hs b/Remote/WebDAV/DavLocation.hs --- a/Remote/WebDAV/DavLocation.hs +++ b/Remote/WebDAV/DavLocation.hs @@ -1,6 +1,6 @@ {- WebDAV locations. - - - Copyright 2014 Joey Hess + - Copyright 2014 Joey Hess - - Licensed under the GNU GPL version 3 or higher. -} @@ -17,6 +17,7 @@ import System.FilePath.Posix -- for manipulating url paths import Network.Protocol.HTTP.DAV (inDAVLocation, DAVT) import Control.Monad.IO.Class (MonadIO) +import Data.Default #ifdef mingw32_HOST_OS import Data.String.Utils #endif @@ -33,9 +34,9 @@ keyDir k = addTrailingPathSeparator $ hashdir keyFile k where #ifndef mingw32_HOST_OS - hashdir = hashDirLower k + hashdir = hashDirLower def k #else - hashdir = replace "\\" "/" (hashDirLower k) + hashdir = replace "\\" "/" (hashDirLower def k) #endif keyLocation :: Key -> DavLocation diff --git a/RemoteDaemon/Common.hs b/RemoteDaemon/Common.hs --- a/RemoteDaemon/Common.hs +++ b/RemoteDaemon/Common.hs @@ -1,6 +1,6 @@ {- git-remote-daemon utilities - - - Copyright 2014 Joey Hess + - Copyright 2014 Joey Hess - - Licensed under the GNU GPL version 3 or higher. -} diff --git a/RemoteDaemon/Core.hs b/RemoteDaemon/Core.hs --- a/RemoteDaemon/Core.hs +++ b/RemoteDaemon/Core.hs @@ -1,6 +1,6 @@ {- git-remote-daemon core - - - Copyright 2014 Joey Hess + - Copyright 2014 Joey Hess - - Licensed under the GNU GPL version 3 or higher. -} @@ -20,24 +20,25 @@ import Config import Annex.Ssh -import Control.Concurrent.Async import Control.Concurrent +import Control.Concurrent.Async +import Control.Concurrent.STM import Network.URI import qualified Data.Map as M runForeground :: IO () runForeground = do (readh, writeh) <- ioHandles - ichan <- newChan :: IO (Chan Consumed) - ochan <- newChan :: IO (Chan Emitted) + ichan <- newTChanIO :: IO (TChan Consumed) + ochan <- newTChanIO :: IO (TChan Emitted) let reader = forever $ do l <- hGetLine readh case parseMessage l of Nothing -> error $ "protocol error: " ++ l - Just cmd -> writeChan ichan cmd + Just cmd -> atomically $ writeTChan ichan cmd let writer = forever $ do - msg <- readChan ochan + msg <- atomically $ readTChan ochan hPutStrLn writeh $ unwords $ formatMessage msg hFlush writeh let controller = runController ichan ochan @@ -46,11 +47,11 @@ void $ tryIO $ reader `concurrently` writer `concurrently` controller -type RemoteMap = M.Map Git.Repo (IO (), Chan Consumed) +type RemoteMap = M.Map Git.Repo (IO (), TChan Consumed) -- Runs the transports, dispatching messages to them, and handling -- the main control messages. -runController :: Chan Consumed -> Chan Emitted -> IO () +runController :: TChan Consumed -> TChan Emitted -> IO () runController ichan ochan = do h <- genTransportHandle m <- genRemoteMap h ochan @@ -58,7 +59,7 @@ go h False m where go h paused m = do - cmd <- readChan ichan + cmd <- atomically $ readTChan ichan case cmd of RELOAD -> do h' <- updateTransportHandle h @@ -88,22 +89,28 @@ -- All remaining messages are sent to -- all Transports. msg -> do - unless paused $ - forM_ chans (`writeChan` msg) + unless paused $ atomically $ + forM_ chans (`writeTChan` msg) go h paused m where chans = map snd (M.elems m) startrunning m = forM_ (M.elems m) startrunning' - startrunning' (transport, _) = void $ async transport + startrunning' (transport, c) = do + -- drain any old control messages from the channel + -- to avoid confusing the transport with them + atomically $ drain c + void $ async transport - broadcast msg m = forM_ (M.elems m) send + drain c = maybe noop (const $ drain c) =<< tryReadTChan c + + broadcast msg m = atomically $ forM_ (M.elems m) send where - send (_, c) = writeChan c msg + send (_, c) = writeTChan c msg -- Generates a map with a transport for each supported remote in the git repo, -- except those that have annex.sync = false -genRemoteMap :: TransportHandle -> Chan Emitted -> IO RemoteMap +genRemoteMap :: TransportHandle -> TChan Emitted -> IO RemoteMap genRemoteMap h@(TransportHandle g _) ochan = M.fromList . catMaybes <$> mapM gen (Git.remotes g) where @@ -111,7 +118,7 @@ Git.Url u -> case M.lookup (uriScheme u) remoteTransports of Just transport | remoteAnnexSync (extractRemoteGitConfig r (Git.repoDescribe r)) -> do - ichan <- newChan :: IO (Chan Consumed) + ichan <- newTChanIO :: IO (TChan Consumed) return $ Just ( r , (transport r (RemoteURI u) h ichan ochan, ichan) diff --git a/RemoteDaemon/Transport.hs b/RemoteDaemon/Transport.hs --- a/RemoteDaemon/Transport.hs +++ b/RemoteDaemon/Transport.hs @@ -1,6 +1,6 @@ {- git-remote-daemon transports - - - Copyright 2014 Joey Hess + - Copyright 2014 Joey Hess - - Licensed under the GNU GPL version 3 or higher. -} diff --git a/RemoteDaemon/Transport/Ssh.hs b/RemoteDaemon/Transport/Ssh.hs --- a/RemoteDaemon/Transport/Ssh.hs +++ b/RemoteDaemon/Transport/Ssh.hs @@ -1,6 +1,6 @@ {- git-remote-daemon, git-annex-shell over ssh transport - - - Copyright 2014 Joey Hess + - Copyright 2014 Joey Hess - - Licensed under the GNU GPL version 3 or higher. -} @@ -18,7 +18,7 @@ import Git.Command import Utility.ThreadScheduler -import Control.Concurrent.Chan +import Control.Concurrent.STM import Control.Concurrent.Async transport :: Transport @@ -58,7 +58,7 @@ return $ either (either id id) id status - send msg = writeChan ochan msg + send msg = atomically $ writeTChan ochan msg fetch = do send (SYNCING url) @@ -80,7 +80,7 @@ Nothing -> return Stopping handlecontrol = do - msg <- readChan ichan + msg <- atomically $ readTChan ichan case msg of STOP -> return Stopping LOSTNET -> return Stopping diff --git a/RemoteDaemon/Transport/Ssh/Types.hs b/RemoteDaemon/Transport/Ssh/Types.hs --- a/RemoteDaemon/Transport/Ssh/Types.hs +++ b/RemoteDaemon/Transport/Ssh/Types.hs @@ -1,6 +1,6 @@ {- git-remote-daemon, git-annex-shell notifychanges protocol types - - - Copyright 2014 Joey Hess + - Copyright 2014 Joey Hess - - Licensed under the GNU GPL version 3 or higher. -} diff --git a/RemoteDaemon/Types.hs b/RemoteDaemon/Types.hs --- a/RemoteDaemon/Types.hs +++ b/RemoteDaemon/Types.hs @@ -1,6 +1,6 @@ {- git-remote-daemon data types. - - - Copyright 2014 Joey Hess + - Copyright 2014 Joey Hess - - Licensed under the GNU GPL version 3 or higher. -} @@ -17,6 +17,7 @@ import Network.URI import Control.Concurrent +import Control.Concurrent.STM -- The URI of a remote is used to uniquely identify it (names change..) newtype RemoteURI = RemoteURI URI @@ -24,7 +25,7 @@ -- A Transport for a particular git remote consumes some messages -- from a Chan, and emits others to another Chan. -type Transport = RemoteRepo -> RemoteURI -> TransportHandle -> Chan Consumed -> Chan Emitted -> IO () +type Transport = RemoteRepo -> RemoteURI -> TransportHandle -> TChan Consumed -> TChan Emitted -> IO () type RemoteRepo = Git.Repo type LocalRepo = Git.Repo diff --git a/Test.hs b/Test.hs --- a/Test.hs +++ b/Test.hs @@ -1,6 +1,6 @@ {- git-annex test suite - - - Copyright 2010-2013 Joey Hess + - Copyright 2010-2013 Joey Hess - - Licensed under the GNU GPL version 3 or higher. -} @@ -38,7 +38,6 @@ import qualified Types.Backend import qualified Types.TrustLevel import qualified Types -import qualified Logs import qualified Logs.MapLog import qualified Logs.Trust import qualified Logs.Remote @@ -138,7 +137,6 @@ , testProperty "prop_idempotent_key_decode" Types.Key.prop_idempotent_key_decode , testProperty "prop_idempotent_shellEscape" Utility.SafeCommand.prop_idempotent_shellEscape , testProperty "prop_idempotent_shellEscape_multiword" Utility.SafeCommand.prop_idempotent_shellEscape_multiword - , testProperty "prop_logs_sane" Logs.prop_logs_sane , testProperty "prop_idempotent_configEscape" Logs.Remote.prop_idempotent_configEscape , testProperty "prop_parse_show_Config" Logs.Remote.prop_parse_show_Config , testProperty "prop_upFrom_basics" Utility.Path.prop_upFrom_basics diff --git a/Types.hs b/Types.hs --- a/Types.hs +++ b/Types.hs @@ -1,6 +1,6 @@ {- git-annex abstract data types - - - Copyright 2010 Joey Hess + - Copyright 2010 Joey Hess - - Licensed under the GNU GPL version 3 or higher. -} diff --git a/Types/Availability.hs b/Types/Availability.hs --- a/Types/Availability.hs +++ b/Types/Availability.hs @@ -1,6 +1,6 @@ {- git-annex remote availability - - - Copyright 2014 Joey Hess + - Copyright 2014 Joey Hess - - Licensed under the GNU GPL version 3 or higher. -} diff --git a/Types/Backend.hs b/Types/Backend.hs --- a/Types/Backend.hs +++ b/Types/Backend.hs @@ -2,7 +2,7 @@ - - Most things should not need this, using Types instead - - - Copyright 2010,2012 Joey Hess + - Copyright 2010,2012 Joey Hess - - Licensed under the GNU GPL version 3 or higher. -} diff --git a/Types/BranchState.hs b/Types/BranchState.hs --- a/Types/BranchState.hs +++ b/Types/BranchState.hs @@ -1,6 +1,6 @@ {- git-annex BranchState data type - - - Copyright 2011 Joey Hess + - Copyright 2011 Joey Hess - - Licensed under the GNU GPL version 3 or higher. -} diff --git a/Types/CleanupActions.hs b/Types/CleanupActions.hs --- a/Types/CleanupActions.hs +++ b/Types/CleanupActions.hs @@ -1,6 +1,6 @@ {- Enumeration of cleanup actions - - - Copyright 2014 Joey Hess + - Copyright 2014 Joey Hess - - Licensed under the GNU GPL version 3 or higher. -} diff --git a/Types/Command.hs b/Types/Command.hs --- a/Types/Command.hs +++ b/Types/Command.hs @@ -1,6 +1,6 @@ {- git-annex command data types - - - Copyright 2010-2011 Joey Hess + - Copyright 2010-2011 Joey Hess - - Licensed under the GNU GPL version 3 or higher. -} diff --git a/Types/Creds.hs b/Types/Creds.hs --- a/Types/Creds.hs +++ b/Types/Creds.hs @@ -1,6 +1,6 @@ {- credentials - - - Copyright 2014 Joey Hess + - Copyright 2014 Joey Hess - - Licensed under the GNU GPL version 3 or higher. -} diff --git a/Types/Crypto.hs b/Types/Crypto.hs --- a/Types/Crypto.hs +++ b/Types/Crypto.hs @@ -1,6 +1,6 @@ {- git-annex crypto types - - - Copyright 2011-2012 Joey Hess + - Copyright 2011-2012 Joey Hess - - Licensed under the GNU GPL version 3 or higher. -} diff --git a/Types/DesktopNotify.hs b/Types/DesktopNotify.hs --- a/Types/DesktopNotify.hs +++ b/Types/DesktopNotify.hs @@ -1,6 +1,6 @@ {- git-annex DesktopNotify type - - - Copyright 2014 Joey Hess + - Copyright 2014 Joey Hess - - Licensed under the GNU GPL version 3 or higher. -} diff --git a/Types/Difference.hs b/Types/Difference.hs new file mode 100644 --- /dev/null +++ b/Types/Difference.hs @@ -0,0 +1,89 @@ +{- git-annex repository differences + - + - Copyright 2015 Joey Hess + - + - Licensed under the GNU GPL version 3 or higher. + -} + +module Types.Difference ( + Difference(..), + Differences(..), + readDifferences, + getDifferences, + differenceConfigKey, + differenceConfigVal, + hasDifference, + listDifferences, +) where + +import Utility.PartialPrelude +import qualified Git +import qualified Git.Config + +import Data.Maybe +import Data.Monoid +import qualified Data.Set as S + +-- Describes differences from the v5 repository format. +-- +-- The serialization is stored in difference.log, so avoid changes that +-- would break compatability. +-- +-- Not breaking compatability is why a list of Differences is used, rather +-- than a sum type. With a sum type, adding a new field for some future +-- difference would serialize to a value that an older version could not +-- parse, even if that new field was not used. With the Differences list, +-- old versions can still parse it, unless the new Difference constructor +-- is used. +-- +-- The constructors intentionally do not have parameters; this is to +-- ensure that any Difference that can be expressed is supported. +-- So, a new repository version would be Version6, rather than Version Int. +data Difference + = ObjectHashLower + | OneLevelObjectHash + | OneLevelBranchHash + deriving (Show, Read, Ord, Eq, Enum, Bounded) + +data Differences + = Differences (S.Set Difference) + | UnknownDifferences + +instance Eq Differences where + Differences a == Differences b = a == b + _ == _ = False -- UnknownDifferences cannot be equal + +instance Monoid Differences where + mempty = Differences S.empty + mappend (Differences a) (Differences b) = Differences (S.union a b) + mappend _ _ = UnknownDifferences + +readDifferences :: String -> Differences +readDifferences = maybe UnknownDifferences Differences . readish + +getDifferences :: Git.Repo -> Differences +getDifferences r = Differences $ S.fromList $ catMaybes $ + map getmaybe [minBound .. maxBound] + where + getmaybe d = case Git.Config.isTrue =<< Git.Config.getMaybe (differenceConfigKey d) r of + Just True -> Just d + _ -> Nothing + +differenceConfigKey :: Difference -> String +differenceConfigKey ObjectHashLower = tunable "objecthashlower" +differenceConfigKey OneLevelObjectHash = tunable "objecthash1" +differenceConfigKey OneLevelBranchHash = tunable "branchhash1" + +differenceConfigVal :: Difference -> String +differenceConfigVal _ = Git.Config.boolConfig True + +tunable :: String -> String +tunable k = "annex.tune." ++ k + +hasDifference :: Difference -> Differences -> Bool +hasDifference d (Differences s) = S.member d s +hasDifference _ UnknownDifferences = False + +listDifferences :: Differences -> [Difference] +listDifferences (Differences s) = S.toList s +listDifferences UnknownDifferences = [] diff --git a/Types/Distribution.hs b/Types/Distribution.hs --- a/Types/Distribution.hs +++ b/Types/Distribution.hs @@ -1,6 +1,6 @@ {- Data type for a distribution of git-annex - - - Copyright 2013 Joey Hess + - Copyright 2013 Joey Hess - - Licensed under the GNU GPL version 3 or higher. -} diff --git a/Types/FileMatcher.hs b/Types/FileMatcher.hs --- a/Types/FileMatcher.hs +++ b/Types/FileMatcher.hs @@ -1,6 +1,6 @@ {- git-annex file matcher types - - - Copyright 2013 Joey Hess + - Copyright 2013 Joey Hess - - Licensed under the GNU GPL version 3 or higher. -} diff --git a/Types/GitConfig.hs b/Types/GitConfig.hs --- a/Types/GitConfig.hs +++ b/Types/GitConfig.hs @@ -1,6 +1,6 @@ {- git-annex configuration - - - Copyright 2012-2014 Joey Hess + - Copyright 2012-2014 Joey Hess - - Licensed under the GNU GPL version 3 or higher. -} @@ -20,6 +20,7 @@ import Types.Distribution import Types.Availability import Types.NumCopies +import Types.Difference import Utility.HumanTime {- Main git-annex settings. Each setting corresponds to a git-config key @@ -56,6 +57,7 @@ , annexHardLink :: Bool , coreSymlinks :: Bool , gcryptId :: Maybe String + , annexDifferences :: Differences } extractGitConfig :: Git.Repo -> GitConfig @@ -93,9 +95,10 @@ , annexHardLink = getbool (annex "hardlink") False , coreSymlinks = getbool "core.symlinks" True , gcryptId = getmaybe "core.gcrypt-id" + , annexDifferences = getDifferences r } where - getbool k def = fromMaybe def $ getmaybebool k + getbool k d = fromMaybe d $ getmaybebool k getmaybebool k = Git.Config.isTrue =<< getmaybe k getmayberead k = readish =<< getmaybe k getmaybe k = Git.Config.getMaybe k r @@ -175,7 +178,7 @@ , remoteGitConfig = Nothing } where - getbool k def = fromMaybe def $ getmaybebool k + getbool k d = fromMaybe d $ getmaybebool k getmaybebool k = Git.Config.isTrue =<< getmaybe k getmayberead k = readish =<< getmaybe k getmaybe k = mplus (Git.Config.getMaybe (key k) r) diff --git a/Types/Group.hs b/Types/Group.hs --- a/Types/Group.hs +++ b/Types/Group.hs @@ -1,6 +1,6 @@ {- git-annex repo groups - - - Copyright 2012 Joey Hess + - Copyright 2012 Joey Hess - - Licensed under the GNU GPL version 3 or higher. -} diff --git a/Types/Key.hs b/Types/Key.hs --- a/Types/Key.hs +++ b/Types/Key.hs @@ -2,7 +2,7 @@ - - Most things should not need this, using Types instead - - - Copyright 2011-2014 Joey Hess + - Copyright 2011-2014 Joey Hess - - Licensed under the GNU GPL version 3 or higher. -} diff --git a/Types/KeySource.hs b/Types/KeySource.hs --- a/Types/KeySource.hs +++ b/Types/KeySource.hs @@ -1,6 +1,6 @@ {- KeySource data type - - - Copyright 2012 Joey Hess + - Copyright 2012 Joey Hess - - Licensed under the GNU GPL version 3 or higher. -} diff --git a/Types/LockPool.hs b/Types/LockPool.hs --- a/Types/LockPool.hs +++ b/Types/LockPool.hs @@ -1,6 +1,6 @@ {- git-annex lock pool data types - - - Copyright 2014 Joey Hess + - Copyright 2014 Joey Hess - - Licensed under the GNU GPL version 3 or higher. -} diff --git a/Types/Messages.hs b/Types/Messages.hs --- a/Types/Messages.hs +++ b/Types/Messages.hs @@ -1,6 +1,6 @@ {- git-annex Messages data types - - - Copyright 2012 Joey Hess + - Copyright 2012 Joey Hess - - Licensed under the GNU GPL version 3 or higher. -} diff --git a/Types/MetaData.hs b/Types/MetaData.hs --- a/Types/MetaData.hs +++ b/Types/MetaData.hs @@ -1,6 +1,6 @@ {- git-annex general metadata - - - Copyright 2014 Joey Hess + - Copyright 2014 Joey Hess - - Licensed under the GNU GPL version 3 or higher. -} diff --git a/Types/NumCopies.hs b/Types/NumCopies.hs --- a/Types/NumCopies.hs +++ b/Types/NumCopies.hs @@ -1,6 +1,6 @@ {- git-annex numcopies type - - - Copyright 2014 Joey Hess + - Copyright 2014 Joey Hess - - Licensed under the GNU GPL version 3 or higher. -} diff --git a/Types/Option.hs b/Types/Option.hs --- a/Types/Option.hs +++ b/Types/Option.hs @@ -1,6 +1,6 @@ {- git-annex command options - - - Copyright 2011 Joey Hess + - Copyright 2011 Joey Hess - - Licensed under the GNU GPL version 3 or higher. -} diff --git a/Types/Remote.hs b/Types/Remote.hs --- a/Types/Remote.hs +++ b/Types/Remote.hs @@ -2,7 +2,7 @@ - - Most things should not need this, using Types instead - - - Copyright 2011-2014 Joey Hess + - Copyright 2011-2014 Joey Hess - - Licensed under the GNU GPL version 3 or higher. -} diff --git a/Types/ScheduledActivity.hs b/Types/ScheduledActivity.hs --- a/Types/ScheduledActivity.hs +++ b/Types/ScheduledActivity.hs @@ -1,6 +1,6 @@ {- git-annex scheduled activities - - - Copyright 2013 Joey Hess + - Copyright 2013 Joey Hess - - Licensed under the GNU GPL version 3 or higher. -} diff --git a/Types/StandardGroups.hs b/Types/StandardGroups.hs --- a/Types/StandardGroups.hs +++ b/Types/StandardGroups.hs @@ -1,6 +1,6 @@ {- git-annex standard repository groups - - - Copyright 2012 Joey Hess + - Copyright 2012 Joey Hess - - Licensed under the GNU GPL version 3 or higher. -} diff --git a/Types/StoreRetrieve.hs b/Types/StoreRetrieve.hs --- a/Types/StoreRetrieve.hs +++ b/Types/StoreRetrieve.hs @@ -1,6 +1,6 @@ {- Types for Storer and Retriever actions for remotes. - - - Copyright 2014 Joey Hess + - Copyright 2014 Joey Hess - - Licensed under the GNU GPL version 3 or higher. -} diff --git a/Types/TrustLevel.hs b/Types/TrustLevel.hs --- a/Types/TrustLevel.hs +++ b/Types/TrustLevel.hs @@ -1,6 +1,6 @@ {- git-annex trust levels - - - Copyright 2010 Joey Hess + - Copyright 2010 Joey Hess - - Licensed under the GNU GPL version 3 or higher. -} diff --git a/Types/UUID.hs b/Types/UUID.hs --- a/Types/UUID.hs +++ b/Types/UUID.hs @@ -1,6 +1,6 @@ {- git-annex UUID type - - - Copyright 2011 Joey Hess + - Copyright 2011 Joey Hess - - Licensed under the GNU GPL version 3 or higher. -} diff --git a/Types/UrlContents.hs b/Types/UrlContents.hs --- a/Types/UrlContents.hs +++ b/Types/UrlContents.hs @@ -1,6 +1,6 @@ {- git-annex URL contents - - - Copyright 2014 Joey Hess + - Copyright 2014 Joey Hess - - Licensed under the GNU GPL version 3 or higher. -} diff --git a/Types/View.hs b/Types/View.hs --- a/Types/View.hs +++ b/Types/View.hs @@ -1,6 +1,6 @@ {- types for metadata based branch views - - - Copyright 2014 Joey Hess + - Copyright 2014 Joey Hess - - Licensed under the GNU GPL version 3 or higher. -} diff --git a/Upgrade.hs b/Upgrade.hs --- a/Upgrade.hs +++ b/Upgrade.hs @@ -1,6 +1,6 @@ {- git-annex upgrade support - - - Copyright 2010, 2013 Joey Hess + - Copyright 2010, 2013 Joey Hess - - Licensed under the GNU GPL version 3 or higher. -} diff --git a/Upgrade/V0.hs b/Upgrade/V0.hs --- a/Upgrade/V0.hs +++ b/Upgrade/V0.hs @@ -1,6 +1,6 @@ {- git-annex v0 -> v1 upgrade support - - - Copyright 2010 Joey Hess + - Copyright 2010 Joey Hess - - Licensed under the GNU GPL version 3 or higher. -} diff --git a/Upgrade/V1.hs b/Upgrade/V1.hs --- a/Upgrade/V1.hs +++ b/Upgrade/V1.hs @@ -1,6 +1,6 @@ {- git-annex v1 -> v2 upgrade support - - - Copyright 2011 Joey Hess + - Copyright 2011 Joey Hess - - Licensed under the GNU GPL version 3 or higher. -} @@ -9,6 +9,7 @@ import System.Posix.Types import Data.Char +import Data.Default import Common.Annex import Types.Key @@ -92,7 +93,7 @@ case r of Nothing -> noop Just (k, _) -> do - link <- inRepo $ gitAnnexLink f k + link <- calcRepo $ gitAnnexLink f k liftIO $ removeFile f liftIO $ createSymbolicLink link f Annex.Queue.addCommand "add" [Param "--"] [f] @@ -228,7 +229,7 @@ logFile1 repo key = Upgrade.V2.gitStateDir repo ++ keyFile1 key ++ ".log" logFile2 :: Key -> Git.Repo -> String -logFile2 = logFile' hashDirLower +logFile2 = logFile' (hashDirLower def) logFile' :: (Key -> FilePath) -> Key -> Git.Repo -> String logFile' hasher key repo = diff --git a/Upgrade/V2.hs b/Upgrade/V2.hs --- a/Upgrade/V2.hs +++ b/Upgrade/V2.hs @@ -1,6 +1,6 @@ {- git-annex v2 -> v3 upgrade support - - - Copyright 2011 Joey Hess + - Copyright 2011 Joey Hess - - Licensed under the GNU GPL version 3 or higher. -} @@ -12,6 +12,7 @@ import qualified Git.Command import qualified Git.Ref import qualified Annex.Branch +import qualified Annex import Annex.Content import Utility.Tmp import Logs @@ -47,7 +48,8 @@ e <- liftIO $ doesDirectoryExist old when e $ do - mapM_ (\(k, f) -> inject f $ locationLogFile k) =<< locationLogs + config <- Annex.getGitConfig + mapM_ (\(k, f) -> inject f $ locationLogFile config k) =<< locationLogs mapM_ (\f -> inject f f) =<< logFiles old saveState False diff --git a/Upgrade/V3.hs b/Upgrade/V3.hs --- a/Upgrade/V3.hs +++ b/Upgrade/V3.hs @@ -2,7 +2,7 @@ - - There was no explicit v3 to v4 upgrade, so run v5 upgrade code. - - - Copyright 2013 Joey Hess + - Copyright 2013 Joey Hess - - Licensed under the GNU GPL version 3 or higher. -} diff --git a/Upgrade/V4.hs b/Upgrade/V4.hs --- a/Upgrade/V4.hs +++ b/Upgrade/V4.hs @@ -1,6 +1,6 @@ {- git-annex v4 -> v5 uppgrade support - - - Copyright 2013 Joey Hess + - Copyright 2013 Joey Hess - - Licensed under the GNU GPL version 3 or higher. -} diff --git a/Utility/Applicative.hs b/Utility/Applicative.hs --- a/Utility/Applicative.hs +++ b/Utility/Applicative.hs @@ -1,6 +1,6 @@ {- applicative stuff - - - Copyright 2012 Joey Hess + - Copyright 2012 Joey Hess - - License: BSD-2-clause -} diff --git a/Utility/Base64.hs b/Utility/Base64.hs --- a/Utility/Base64.hs +++ b/Utility/Base64.hs @@ -1,6 +1,6 @@ {- Simple Base64 access - - - Copyright 2011 Joey Hess + - Copyright 2011 Joey Hess - - License: BSD-2-clause -} diff --git a/Utility/Batch.hs b/Utility/Batch.hs --- a/Utility/Batch.hs +++ b/Utility/Batch.hs @@ -1,6 +1,6 @@ {- Running a long or expensive batch operation niced. - - - Copyright 2013 Joey Hess + - Copyright 2013 Joey Hess - - License: BSD-2-clause -} diff --git a/Utility/Bloom.hs b/Utility/Bloom.hs --- a/Utility/Bloom.hs +++ b/Utility/Bloom.hs @@ -1,6 +1,6 @@ {- bloomfilter compatability wrapper - - - Copyright 2014 Joey Hess + - Copyright 2014 Joey Hess - - License: BSD-2-clause -} diff --git a/Utility/CoProcess.hs b/Utility/CoProcess.hs --- a/Utility/CoProcess.hs +++ b/Utility/CoProcess.hs @@ -1,7 +1,7 @@ {- Interface for running a shell command as a coprocess, - sending it queries and getting back results. - - - Copyright 2012-2013 Joey Hess + - Copyright 2012-2013 Joey Hess - - License: BSD-2-clause -} diff --git a/Utility/CopyFile.hs b/Utility/CopyFile.hs --- a/Utility/CopyFile.hs +++ b/Utility/CopyFile.hs @@ -1,6 +1,6 @@ {- file copying - - - Copyright 2010-2014 Joey Hess + - Copyright 2010-2014 Joey Hess - - License: BSD-2-clause -} diff --git a/Utility/DBus.hs b/Utility/DBus.hs --- a/Utility/DBus.hs +++ b/Utility/DBus.hs @@ -1,6 +1,6 @@ {- DBus utilities - - - Copyright 2012 Joey Hess + - Copyright 2012 Joey Hess - - License: BSD-2-clause -} diff --git a/Utility/Daemon.hs b/Utility/Daemon.hs --- a/Utility/Daemon.hs +++ b/Utility/Daemon.hs @@ -1,6 +1,6 @@ {- daemon support - - - Copyright 2012-2014 Joey Hess + - Copyright 2012-2014 Joey Hess - - License: BSD-2-clause -} diff --git a/Utility/Data.hs b/Utility/Data.hs --- a/Utility/Data.hs +++ b/Utility/Data.hs @@ -1,6 +1,6 @@ {- utilities for simple data types - - - Copyright 2013 Joey Hess + - Copyright 2013 Joey Hess - - License: BSD-2-clause -} diff --git a/Utility/DataUnits.hs b/Utility/DataUnits.hs --- a/Utility/DataUnits.hs +++ b/Utility/DataUnits.hs @@ -1,6 +1,6 @@ {- data size display and parsing - - - Copyright 2011 Joey Hess + - Copyright 2011 Joey Hess - - License: BSD-2-clause - @@ -41,6 +41,7 @@ memoryUnits, bandwidthUnits, oldSchoolUnits, + Unit(..), roughSize, compareSizes, diff --git a/Utility/DirWatcher.hs b/Utility/DirWatcher.hs --- a/Utility/DirWatcher.hs +++ b/Utility/DirWatcher.hs @@ -4,7 +4,7 @@ - (and subdirectories) for changes, and runs hooks for different - sorts of events as they occur. - - - Copyright 2012-2013 Joey Hess + - Copyright 2012-2013 Joey Hess - - License: BSD-2-clause -} diff --git a/Utility/DirWatcher/FSEvents.hs b/Utility/DirWatcher/FSEvents.hs --- a/Utility/DirWatcher/FSEvents.hs +++ b/Utility/DirWatcher/FSEvents.hs @@ -1,6 +1,6 @@ {- FSEvents interface - - - Copyright 2012 Joey Hess + - Copyright 2012 Joey Hess - - License: BSD-2-clause -} diff --git a/Utility/DirWatcher/INotify.hs b/Utility/DirWatcher/INotify.hs --- a/Utility/DirWatcher/INotify.hs +++ b/Utility/DirWatcher/INotify.hs @@ -1,6 +1,6 @@ {- higher-level inotify interface - - - Copyright 2012 Joey Hess + - Copyright 2012 Joey Hess - - License: BSD-2-clause -} diff --git a/Utility/DirWatcher/Kqueue.hs b/Utility/DirWatcher/Kqueue.hs --- a/Utility/DirWatcher/Kqueue.hs +++ b/Utility/DirWatcher/Kqueue.hs @@ -1,6 +1,6 @@ {- BSD kqueue file modification notification interface - - - Copyright 2012 Joey Hess + - Copyright 2012 Joey Hess - - License: BSD-2-clause -} diff --git a/Utility/DirWatcher/Types.hs b/Utility/DirWatcher/Types.hs --- a/Utility/DirWatcher/Types.hs +++ b/Utility/DirWatcher/Types.hs @@ -1,6 +1,6 @@ {- generic directory watching types - - - Copyright 2012 Joey Hess + - Copyright 2012 Joey Hess - - License: BSD-2-clause -} diff --git a/Utility/DirWatcher/Win32Notify.hs b/Utility/DirWatcher/Win32Notify.hs --- a/Utility/DirWatcher/Win32Notify.hs +++ b/Utility/DirWatcher/Win32Notify.hs @@ -1,6 +1,6 @@ {- Win32-notify interface - - - Copyright 2013 Joey Hess + - Copyright 2013 Joey Hess - - License: BSD-2-clause -} diff --git a/Utility/Directory.hs b/Utility/Directory.hs --- a/Utility/Directory.hs +++ b/Utility/Directory.hs @@ -1,6 +1,6 @@ {- directory traversal and manipulation - - - Copyright 2011-2014 Joey Hess + - Copyright 2011-2014 Joey Hess - - License: BSD-2-clause -} diff --git a/Utility/DiskFree.hs b/Utility/DiskFree.hs --- a/Utility/DiskFree.hs +++ b/Utility/DiskFree.hs @@ -1,6 +1,6 @@ {- disk free space checking - - - Copyright 2012, 2014 Joey Hess + - Copyright 2012, 2014 Joey Hess - - License: BSD-2-clause -} diff --git a/Utility/Dot.hs b/Utility/Dot.hs --- a/Utility/Dot.hs +++ b/Utility/Dot.hs @@ -1,6 +1,6 @@ {- a simple graphviz / dot(1) digraph description generator library - - - Copyright 2010 Joey Hess + - Copyright 2010 Joey Hess - - License: BSD-2-clause -} diff --git a/Utility/DottedVersion.hs b/Utility/DottedVersion.hs --- a/Utility/DottedVersion.hs +++ b/Utility/DottedVersion.hs @@ -1,6 +1,6 @@ {- dotted versions, such as 1.0.1 - - - Copyright 2011-2014 Joey Hess + - Copyright 2011-2014 Joey Hess - - License: BSD-2-clause -} diff --git a/Utility/Env.hs b/Utility/Env.hs --- a/Utility/Env.hs +++ b/Utility/Env.hs @@ -1,6 +1,6 @@ {- portable environment variables - - - Copyright 2013 Joey Hess + - Copyright 2013 Joey Hess - - License: BSD-2-clause -} diff --git a/Utility/Exception.hs b/Utility/Exception.hs --- a/Utility/Exception.hs +++ b/Utility/Exception.hs @@ -1,6 +1,6 @@ {- Simple IO exception handling (and some more) - - - Copyright 2011-2014 Joey Hess + - Copyright 2011-2014 Joey Hess - - License: BSD-2-clause -} diff --git a/Utility/ExternalSHA.hs b/Utility/ExternalSHA.hs --- a/Utility/ExternalSHA.hs +++ b/Utility/ExternalSHA.hs @@ -3,7 +3,7 @@ - This is typically a bit faster than using Haskell libraries, - by around 1% to 10%. Worth it for really big files. - - - Copyright 2011-2013 Joey Hess + - Copyright 2011-2013 Joey Hess - - License: BSD-2-clause -} diff --git a/Utility/FileMode.hs b/Utility/FileMode.hs --- a/Utility/FileMode.hs +++ b/Utility/FileMode.hs @@ -1,6 +1,6 @@ {- File mode utilities. - - - Copyright 2010-2012 Joey Hess + - Copyright 2010-2012 Joey Hess - - License: BSD-2-clause -} diff --git a/Utility/FileSize.hs b/Utility/FileSize.hs new file mode 100644 --- /dev/null +++ b/Utility/FileSize.hs @@ -0,0 +1,35 @@ +{- File size. + - + - License: BSD-2-clause + -} + +{-# LANGUAGE CPP #-} + +module Utility.FileSize where + +import System.PosixCompat.Files +#ifdef mingw32_HOST_OS +import Control.Exception (bracket) +import System.IO +#endif + +{- Gets the size of a file. + - + - This is better than using fileSize, because on Windows that returns a + - FileOffset which maxes out at 2 gb. + - See https://github.com/jystic/unix-compat/issues/16 + -} +getFileSize :: FilePath -> IO Integer +#ifndef mingw32_HOST_OS +getFileSize f = fmap (fromIntegral . fileSize) (getFileStatus f) +#else +getFileSize f = bracket (openFile f ReadMode) hClose hFileSize +#endif + +{- Gets the size of the file, when its FileStatus is already known. -} +getFileSize' :: FilePath -> FileStatus -> IO Integer +#ifndef mingw32_HOST_OS +getFileSize' _ s = return $ fromIntegral $ fileSize s +#else +getFileSize' f _ = getFileSize f +#endif diff --git a/Utility/FileSystemEncoding.hs b/Utility/FileSystemEncoding.hs --- a/Utility/FileSystemEncoding.hs +++ b/Utility/FileSystemEncoding.hs @@ -1,6 +1,6 @@ {- GHC File system encoding handling. - - - Copyright 2012-2014 Joey Hess + - Copyright 2012-2014 Joey Hess - - License: BSD-2-clause -} diff --git a/Utility/Format.hs b/Utility/Format.hs --- a/Utility/Format.hs +++ b/Utility/Format.hs @@ -1,6 +1,6 @@ {- Formatted string handling. - - - Copyright 2010, 2011 Joey Hess + - Copyright 2010, 2011 Joey Hess - - License: BSD-2-clause -} diff --git a/Utility/FreeDesktop.hs b/Utility/FreeDesktop.hs --- a/Utility/FreeDesktop.hs +++ b/Utility/FreeDesktop.hs @@ -5,7 +5,7 @@ - http://standards.freedesktop.org/menu-spec/latest/ - http://standards.freedesktop.org/icon-theme-spec/latest/ - - - Copyright 2012 Joey Hess + - Copyright 2012 Joey Hess - - License: BSD-2-clause -} diff --git a/Utility/Glob.hs b/Utility/Glob.hs --- a/Utility/Glob.hs +++ b/Utility/Glob.hs @@ -3,7 +3,7 @@ - This uses TDFA when available, with a fallback to regex-compat. - TDFA is less buggy in its support for non-unicode characters. - - - Copyright 2014 Joey Hess + - Copyright 2014 Joey Hess - - License: BSD-2-clause -} diff --git a/Utility/Gpg.hs b/Utility/Gpg.hs --- a/Utility/Gpg.hs +++ b/Utility/Gpg.hs @@ -1,6 +1,6 @@ {- gpg interface - - - Copyright 2011 Joey Hess + - Copyright 2011 Joey Hess - - Licensed under the GNU GPL version 3 or higher. -} diff --git a/Utility/Hash.hs b/Utility/Hash.hs --- a/Utility/Hash.hs +++ b/Utility/Hash.hs @@ -1,8 +1,4 @@ -{- Convenience wrapper around cryptohash. - - Falls back to SHA if it's not available. - -} - -{-# LANGUAGE CPP #-} +{- Convenience wrapper around cryptohash. -} module Utility.Hash ( sha1, @@ -10,10 +6,9 @@ sha256, sha384, sha512, -#ifdef WITH_CRYPTOHASH skein256, skein512, -#endif + md5, prop_hashes_stable ) where @@ -21,9 +16,6 @@ import qualified Data.Text as T import qualified Data.Text.Encoding as T -#ifndef WITH_CRYPTOHASH -import Data.Digest.Pure.SHA -#else import Crypto.Hash sha1 :: L.ByteString -> Digest SHA1 @@ -51,7 +43,8 @@ skein512 :: L.ByteString -> Digest Skein512_512 skein512 = hashlazy -#endif +md5 :: L.ByteString -> Digest MD5 +md5 = hashlazy {- Check that all the hashes continue to hash the same. -} prop_hashes_stable :: Bool @@ -61,10 +54,9 @@ , (show . sha256, "2c26b46b68ffc68ff99b453c1d30413413422d706483bfa0f98a5e886266e7ae") , (show . sha384, "98c11ffdfdd540676b1a137cb1a22b2a70350c9a44171d6b1180c6be5cbb2ee3f79d532c8a1dd9ef2e8e08e752a3babb") , (show . sha512, "f7fbba6e0636f890e56fbbf3283e524c6fa3204ae298382d624741d0dc6638326e282c41be5e4254d8820772c5518a2c5a8c0c7f7eda19594a7eb539453e1ed7") -#ifdef WITH_CRYPTOHASH , (show . skein256, "a04efd9a0aeed6ede40fe5ce0d9361ae7b7d88b524aa19917b9315f1ecf00d33") , (show . skein512, "fd8956898113510180aa4658e6c0ac85bd74fb47f4a4ba264a6b705d7a8e8526756e75aecda12cff4f1aca1a4c2830fbf57f458012a66b2b15a3dd7d251690a7") -#endif + , (show . md5, "acbd18db4cc2f85cedef654fccc4a4d8") ] where foo = L.fromChunks [T.encodeUtf8 $ T.pack "foo"] diff --git a/Utility/HumanNumber.hs b/Utility/HumanNumber.hs --- a/Utility/HumanNumber.hs +++ b/Utility/HumanNumber.hs @@ -1,6 +1,6 @@ {- numbers for humans - - - Copyright 2012-2013 Joey Hess + - Copyright 2012-2013 Joey Hess - - License: BSD-2-clause -} diff --git a/Utility/HumanTime.hs b/Utility/HumanTime.hs --- a/Utility/HumanTime.hs +++ b/Utility/HumanTime.hs @@ -1,6 +1,6 @@ {- Time for humans. - - - Copyright 2012-2013 Joey Hess + - Copyright 2012-2013 Joey Hess - - License: BSD-2-clause -} diff --git a/Utility/InodeCache.hs b/Utility/InodeCache.hs --- a/Utility/InodeCache.hs +++ b/Utility/InodeCache.hs @@ -1,7 +1,7 @@ {- Caching a file's inode, size, and modification time - to see when it's changed. - - - Copyright 2013, 2014 Joey Hess + - Copyright 2013, 2014 Joey Hess - - License: BSD-2-clause -} @@ -45,7 +45,7 @@ import Data.Word (Word64) #endif -data InodeCachePrim = InodeCachePrim FileID FileOffset EpochTime +data InodeCachePrim = InodeCachePrim FileID Integer EpochTime deriving (Show, Eq, Ord) newtype InodeCache = InodeCache InodeCachePrim @@ -112,15 +112,16 @@ genInodeCache :: FilePath -> TSDelta -> IO (Maybe InodeCache) genInodeCache f delta = catchDefaultIO Nothing $ - toInodeCache delta =<< getFileStatus f + toInodeCache delta f =<< getFileStatus f -toInodeCache :: TSDelta -> FileStatus -> IO (Maybe InodeCache) -toInodeCache (TSDelta getdelta) s +toInodeCache :: TSDelta -> FilePath -> FileStatus -> IO (Maybe InodeCache) +toInodeCache (TSDelta getdelta) f s | isRegularFile s = do delta <- getdelta + sz <- getFileSize' f s return $ Just $ InodeCache $ InodeCachePrim (fileID s) - (fileSize s) + sz (modificationTime s + delta) | otherwise = pure Nothing diff --git a/Utility/JSONStream.hs b/Utility/JSONStream.hs --- a/Utility/JSONStream.hs +++ b/Utility/JSONStream.hs @@ -1,6 +1,6 @@ {- Streaming JSON output. - - - Copyright 2011 Joey Hess + - Copyright 2011 Joey Hess - - License: BSD-2-clause -} diff --git a/Utility/LinuxMkLibs.hs b/Utility/LinuxMkLibs.hs --- a/Utility/LinuxMkLibs.hs +++ b/Utility/LinuxMkLibs.hs @@ -1,6 +1,6 @@ {- Linux library copier and binary shimmer - - - Copyright 2013 Joey Hess + - Copyright 2013 Joey Hess - - License: BSD-2-clause -} diff --git a/Utility/LockFile.hs b/Utility/LockFile.hs --- a/Utility/LockFile.hs +++ b/Utility/LockFile.hs @@ -4,7 +4,7 @@ - This module does *not* attempt to be a portability shim, it just exposes - the native locking of the OS. - - - Copyright 2014 Joey Hess + - Copyright 2014 Joey Hess - - License: BSD-2-clause -} diff --git a/Utility/LockFile/Posix.hs b/Utility/LockFile/Posix.hs --- a/Utility/LockFile/Posix.hs +++ b/Utility/LockFile/Posix.hs @@ -1,6 +1,6 @@ {- Posix lock files - - - Copyright 2014 Joey Hess + - Copyright 2014 Joey Hess - - License: BSD-2-clause -} diff --git a/Utility/LockFile/Windows.hs b/Utility/LockFile/Windows.hs --- a/Utility/LockFile/Windows.hs +++ b/Utility/LockFile/Windows.hs @@ -1,6 +1,6 @@ {- Windows lock files - - - Copyright 2014 Joey Hess + - Copyright 2014 Joey Hess - - License: BSD-2-clause -} diff --git a/Utility/LogFile.hs b/Utility/LogFile.hs --- a/Utility/LogFile.hs +++ b/Utility/LogFile.hs @@ -1,6 +1,6 @@ {- log files - - - Copyright 2012 Joey Hess + - Copyright 2012 Joey Hess - - License: BSD-2-clause -} diff --git a/Utility/Lsof.hs b/Utility/Lsof.hs --- a/Utility/Lsof.hs +++ b/Utility/Lsof.hs @@ -1,6 +1,6 @@ {- lsof interface - - - Copyright 2012 Joey Hess + - Copyright 2012 Joey Hess - - License: BSD-2-clause -} diff --git a/Utility/Matcher.hs b/Utility/Matcher.hs --- a/Utility/Matcher.hs +++ b/Utility/Matcher.hs @@ -10,7 +10,7 @@ - Is forgiving about misplaced closing parens, so "foo and (bar or baz" - will be handled, as will "foo and ( bar or baz ) )" - - - Copyright 2011-2013 Joey Hess + - Copyright 2011-2013 Joey Hess - - License: BSD-2-clause -} diff --git a/Utility/Metered.hs b/Utility/Metered.hs --- a/Utility/Metered.hs +++ b/Utility/Metered.hs @@ -1,6 +1,6 @@ {- Metered IO - - - Copyright 2012, 2013 Joey Hess + - Copyright 2012, 2013 Joey Hess - - License: BSD-2-clause -} diff --git a/Utility/Misc.hs b/Utility/Misc.hs --- a/Utility/Misc.hs +++ b/Utility/Misc.hs @@ -1,6 +1,6 @@ {- misc utility functions - - - Copyright 2010-2011 Joey Hess + - Copyright 2010-2011 Joey Hess - - License: BSD-2-clause -} diff --git a/Utility/Monad.hs b/Utility/Monad.hs --- a/Utility/Monad.hs +++ b/Utility/Monad.hs @@ -1,6 +1,6 @@ {- monadic stuff - - - Copyright 2010-2012 Joey Hess + - Copyright 2010-2012 Joey Hess - - License: BSD-2-clause -} diff --git a/Utility/Mounts.hsc b/Utility/Mounts.hsc --- a/Utility/Mounts.hsc +++ b/Utility/Mounts.hsc @@ -4,7 +4,7 @@ - Volker Wysk - - Modified to support BSD, Mac OS X, and Android by - - Joey Hess + - Joey Hess - - Licensed under the GNU LGPL version 2.1 or higher. -} diff --git a/Utility/Network.hs b/Utility/Network.hs --- a/Utility/Network.hs +++ b/Utility/Network.hs @@ -1,6 +1,6 @@ {- network functions - - - Copyright 2012 Joey Hess + - Copyright 2012 Joey Hess - - License: BSD-2-clause -} diff --git a/Utility/NotificationBroadcaster.hs b/Utility/NotificationBroadcaster.hs --- a/Utility/NotificationBroadcaster.hs +++ b/Utility/NotificationBroadcaster.hs @@ -6,7 +6,7 @@ - - Multiple clients are supported. Each has a unique id. - - - Copyright 2012 Joey Hess + - Copyright 2012 Joey Hess - - License: BSD-2-clause -} diff --git a/Utility/OSX.hs b/Utility/OSX.hs --- a/Utility/OSX.hs +++ b/Utility/OSX.hs @@ -1,6 +1,6 @@ {- OSX stuff - - - Copyright 2012 Joey Hess + - Copyright 2012 Joey Hess - - License: BSD-2-clause -} diff --git a/Utility/PID.hs b/Utility/PID.hs --- a/Utility/PID.hs +++ b/Utility/PID.hs @@ -1,6 +1,6 @@ {- process ids - - - Copyright 2014 Joey Hess + - Copyright 2014 Joey Hess - - License: BSD-2-clause -} diff --git a/Utility/Parallel.hs b/Utility/Parallel.hs --- a/Utility/Parallel.hs +++ b/Utility/Parallel.hs @@ -1,6 +1,6 @@ {- parallel processing via threads - - - Copyright 2012 Joey Hess + - Copyright 2012 Joey Hess - - License: BSD-2-clause -} diff --git a/Utility/Path.hs b/Utility/Path.hs --- a/Utility/Path.hs +++ b/Utility/Path.hs @@ -1,6 +1,6 @@ {- path manipulation - - - Copyright 2010-2014 Joey Hess + - Copyright 2010-2014 Joey Hess - - License: BSD-2-clause -} @@ -85,7 +85,7 @@ - parent (ie for "/" or ".") -} upFrom :: FilePath -> Maybe FilePath upFrom dir - | null dirs = Nothing + | length dirs < 2 = Nothing | otherwise = Just $ joinDrive drive (join s $ init dirs) where -- on Unix, the drive will be "/" when the dir is absolute, otherwise "" diff --git a/Utility/Percentage.hs b/Utility/Percentage.hs --- a/Utility/Percentage.hs +++ b/Utility/Percentage.hs @@ -1,6 +1,6 @@ {- percentages - - - Copyright 2012 Joey Hess + - Copyright 2012 Joey Hess - - License: BSD-2-clause -} diff --git a/Utility/PosixFiles.hs b/Utility/PosixFiles.hs --- a/Utility/PosixFiles.hs +++ b/Utility/PosixFiles.hs @@ -2,7 +2,7 @@ - - This is like System.PosixCompat.Files, except with a fixed rename. - - - Copyright 2014 Joey Hess + - Copyright 2014 Joey Hess - - License: BSD-2-clause -} diff --git a/Utility/QuickCheck.hs b/Utility/QuickCheck.hs --- a/Utility/QuickCheck.hs +++ b/Utility/QuickCheck.hs @@ -1,6 +1,6 @@ {- QuickCheck with additional instances - - - Copyright 2012-2014 Joey Hess + - Copyright 2012-2014 Joey Hess - - License: BSD-2-clause -} diff --git a/Utility/Quvi.hs b/Utility/Quvi.hs --- a/Utility/Quvi.hs +++ b/Utility/Quvi.hs @@ -1,6 +1,6 @@ {- querying quvi (import qualified) - - - Copyright 2013 Joey Hess + - Copyright 2013 Joey Hess - - License: BSD-2-clause -} diff --git a/Utility/Rsync.hs b/Utility/Rsync.hs --- a/Utility/Rsync.hs +++ b/Utility/Rsync.hs @@ -1,6 +1,6 @@ {- various rsync stuff - - - Copyright 2010-2013 Joey Hess + - Copyright 2010-2013 Joey Hess - - License: BSD-2-clause -} diff --git a/Utility/SRV.hs b/Utility/SRV.hs --- a/Utility/SRV.hs +++ b/Utility/SRV.hs @@ -3,7 +3,7 @@ - Uses either the ADNS Haskell library, or the standalone Haskell DNS - package, or the host command. - - - Copyright 2012 Joey Hess + - Copyright 2012 Joey Hess - - License: BSD-2-clause -} diff --git a/Utility/SafeCommand.hs b/Utility/SafeCommand.hs --- a/Utility/SafeCommand.hs +++ b/Utility/SafeCommand.hs @@ -1,6 +1,6 @@ {- safely running shell commands - - - Copyright 2010-2013 Joey Hess + - Copyright 2010-2013 Joey Hess - - License: BSD-2-clause -} diff --git a/Utility/Scheduled.hs b/Utility/Scheduled.hs --- a/Utility/Scheduled.hs +++ b/Utility/Scheduled.hs @@ -1,6 +1,6 @@ {- scheduled activities - - - Copyright 2013-2014 Joey Hess + - Copyright 2013-2014 Joey Hess - - License: BSD-2-clause -} diff --git a/Utility/Shell.hs b/Utility/Shell.hs --- a/Utility/Shell.hs +++ b/Utility/Shell.hs @@ -1,6 +1,6 @@ {- /bin/sh handling - - - Copyright 2013 Joey Hess + - Copyright 2013 Joey Hess - - License: BSD-2-clause -} diff --git a/Utility/SimpleProtocol.hs b/Utility/SimpleProtocol.hs --- a/Utility/SimpleProtocol.hs +++ b/Utility/SimpleProtocol.hs @@ -1,6 +1,6 @@ {- Simple line-based protocols. - - - Copyright 2013-2014 Joey Hess + - Copyright 2013-2014 Joey Hess - - License: BSD-2-clause -} diff --git a/Utility/SshConfig.hs b/Utility/SshConfig.hs --- a/Utility/SshConfig.hs +++ b/Utility/SshConfig.hs @@ -1,6 +1,6 @@ {- ssh config file parsing and modification - - - Copyright 2013 Joey Hess + - Copyright 2013 Joey Hess - - License: BSD-2-clause -} diff --git a/Utility/TList.hs b/Utility/TList.hs --- a/Utility/TList.hs +++ b/Utility/TList.hs @@ -6,7 +6,7 @@ - Unlike a TQueue, the entire contents of a TList can be efficiently - read without modifying it. - - - Copyright 2013 Joey Hess + - Copyright 2013 Joey Hess -} {-# LANGUAGE BangPatterns #-} diff --git a/Utility/Tense.hs b/Utility/Tense.hs --- a/Utility/Tense.hs +++ b/Utility/Tense.hs @@ -1,6 +1,6 @@ {- Past and present tense text. - - - Copyright 2012 Joey Hess + - Copyright 2012 Joey Hess - - License: BSD-2-clause -} diff --git a/Utility/ThreadLock.hs b/Utility/ThreadLock.hs --- a/Utility/ThreadLock.hs +++ b/Utility/ThreadLock.hs @@ -1,6 +1,6 @@ {- locking between threads - - - Copyright 2012 Joey Hess + - Copyright 2012 Joey Hess - - License: BSD-2-clause -} diff --git a/Utility/ThreadScheduler.hs b/Utility/ThreadScheduler.hs --- a/Utility/ThreadScheduler.hs +++ b/Utility/ThreadScheduler.hs @@ -1,6 +1,6 @@ {- thread scheduling - - - Copyright 2012, 2013 Joey Hess + - Copyright 2012, 2013 Joey Hess - Copyright 2011 Bas van Dijk & Roel van Dijk - - License: BSD-2-clause diff --git a/Utility/Tmp.hs b/Utility/Tmp.hs --- a/Utility/Tmp.hs +++ b/Utility/Tmp.hs @@ -1,6 +1,6 @@ {- Temporary files and directories. - - - Copyright 2010-2013 Joey Hess + - Copyright 2010-2013 Joey Hess - - License: BSD-2-clause -} diff --git a/Utility/Touch.hsc b/Utility/Touch.hsc --- a/Utility/Touch.hsc +++ b/Utility/Touch.hsc @@ -1,6 +1,6 @@ {- More control over touching a file. - - - Copyright 2011 Joey Hess + - Copyright 2011 Joey Hess - - License: BSD-2-clause -} diff --git a/Utility/URI.hs b/Utility/URI.hs --- a/Utility/URI.hs +++ b/Utility/URI.hs @@ -1,6 +1,6 @@ {- Network.URI - - - Copyright 2014 Joey Hess + - Copyright 2014 Joey Hess - - License: BSD-2-clause -} diff --git a/Utility/Url.hs b/Utility/Url.hs --- a/Utility/Url.hs +++ b/Utility/Url.hs @@ -1,6 +1,6 @@ {- Url downloading. - - - Copyright 2011-2014 Joey Hess + - Copyright 2011-2014 Joey Hess - - License: BSD-2-clause -} @@ -17,6 +17,8 @@ check, checkBoth, exists, + UrlInfo(..), + getUrlInfo, download, downloadQuiet, parseURIRelaxed @@ -26,7 +28,6 @@ import Network.URI import Network.HTTP.Conduit import Network.HTTP.Types -import Data.Default import qualified Data.CaseInsensitive as CI import qualified Data.ByteString as B import qualified Data.ByteString.UTF8 as B8 @@ -84,38 +85,53 @@ v <- check url expected_size uo return (fst v && snd v) check :: URLString -> Maybe Integer -> UrlOptions -> IO (Bool, Bool) -check url expected_size = go <$$> exists url +check url expected_size = go <$$> getUrlInfo url where - go (False, _) = (False, False) - go (True, Nothing) = (True, True) - go (True, s) = case expected_size of + go (UrlInfo False _ _) = (False, False) + go (UrlInfo True Nothing _) = (True, True) + go (UrlInfo True s _) = case expected_size of Just _ -> (True, expected_size == s) Nothing -> (True, True) +exists :: URLString -> UrlOptions -> IO Bool +exists url uo = urlExists <$> getUrlInfo url uo + +data UrlInfo = UrlInfo + { urlExists :: Bool + , urlSize :: Maybe Integer + , urlSuggestedFile :: Maybe FilePath + } + {- Checks that an url exists and could be successfully downloaded, - - also returning its size if available. -} -exists :: URLString -> UrlOptions -> IO (Bool, Maybe Integer) -exists url uo = case parseURIRelaxed url of + - also returning its size and suggested filename if available. -} +getUrlInfo :: URLString -> UrlOptions -> IO UrlInfo +getUrlInfo url uo = case parseURIRelaxed url of Just u -> case parseUrl (show u) of Just req -> existsconduit req `catchNonAsync` const dne -- http-conduit does not support file:, ftp:, etc urls, -- so fall back to reading files and using curl. Nothing | uriScheme u == "file:" -> do - s <- catchMaybeIO $ getFileStatus (unEscapeString $ uriPath u) + let f = unEscapeString (uriPath u) + s <- catchMaybeIO $ getFileStatus f case s of - Just stat -> return (True, Just $ fromIntegral $ fileSize stat) + Just stat -> do + sz <- getFileSize' f stat + found (Just sz) Nothing Nothing -> dne | Build.SysConfig.curl -> do output <- catchDefaultIO "" $ readProcess "curl" $ toCommand curlparams case lastMaybe (lines output) of - Just ('2':_:_) -> return (True, extractlencurl output) + Just ('2':_:_) -> found + (extractlencurl output) + Nothing _ -> dne | otherwise -> dne Nothing -> dne where - dne = return (False, Nothing) + dne = return $ UrlInfo False Nothing Nothing + found sz f = return $ UrlInfo True sz f curlparams = addUserAgent uo $ [ Param "-s" @@ -130,23 +146,36 @@ _ -> Nothing _ -> Nothing - extractlen resp = readish . B8.toString =<< headMaybe lenheaders - where - lenheaders = map snd $ - filter (\(h, _) -> h == hContentLength) - (responseHeaders resp) - + extractlen = readish . B8.toString <=< firstheader hContentLength + + extractfilename = contentDispositionFilename . B8.toString + <=< firstheader hContentDisposition + + firstheader h = headMaybe . map snd . + filter (\p -> fst p == h) . responseHeaders + existsconduit req = withManager $ \mgr -> do - let req' = headRequest (applyRequest uo req) - resp <- http req' mgr - -- forces processing the response before the - -- manager is closed - ret <- if responseStatus resp == ok200 - then return (True, extractlen resp) - else liftIO dne - liftIO $ closeManager mgr - return ret + let req' = headRequest (applyRequest uo req) + resp <- http req' mgr + -- forces processing the response before the + -- manager is closed + ret <- liftIO $ if responseStatus resp == ok200 + then found + (extractlen resp) + (extractfilename resp) + else dne + liftIO $ closeManager mgr + return ret +-- Parse eg: attachment; filename="fname.ext" +-- per RFC 2616 +contentDispositionFilename :: String -> Maybe FilePath +contentDispositionFilename s + | "attachment; filename=\"" `isPrefixOf` s && "\"" `isSuffixOf` s = + Just $ reverse $ drop 1 $ reverse $ + drop 1 $ dropWhile (/= '"') s + | otherwise = Nothing + #if MIN_VERSION_http_conduit(2,0,0) headRequest :: Request -> Request #else @@ -225,6 +254,9 @@ hAcceptEncoding :: CI.CI B.ByteString hAcceptEncoding = "Accept-Encoding" + +hContentDisposition :: CI.CI B.ByteString +hContentDisposition = "Content-Disposition" #if ! MIN_VERSION_http_types(0,7,0) hContentLength :: CI.CI B.ByteString diff --git a/Utility/UserInfo.hs b/Utility/UserInfo.hs --- a/Utility/UserInfo.hs +++ b/Utility/UserInfo.hs @@ -1,6 +1,6 @@ {- user info - - - Copyright 2012 Joey Hess + - Copyright 2012 Joey Hess - - License: BSD-2-clause -} diff --git a/Utility/Verifiable.hs b/Utility/Verifiable.hs --- a/Utility/Verifiable.hs +++ b/Utility/Verifiable.hs @@ -1,6 +1,6 @@ {- values verified using a shared secret - - - Copyright 2012 Joey Hess + - Copyright 2012 Joey Hess - - License: BSD-2-clause -} diff --git a/Utility/WebApp.hs b/Utility/WebApp.hs --- a/Utility/WebApp.hs +++ b/Utility/WebApp.hs @@ -1,6 +1,6 @@ {- Yesod webapp - - - Copyright 2012-2014 Joey Hess + - Copyright 2012-2014 Joey Hess - - License: BSD-2-clause -} diff --git a/Utility/WinProcess.hs b/Utility/WinProcess.hs --- a/Utility/WinProcess.hs +++ b/Utility/WinProcess.hs @@ -1,6 +1,6 @@ {- Windows processes - - - Copyright 2014 Joey Hess + - Copyright 2014 Joey Hess - - License: BSD-2-clause -} diff --git a/Utility/Yesod.hs b/Utility/Yesod.hs --- a/Utility/Yesod.hs +++ b/Utility/Yesod.hs @@ -3,7 +3,7 @@ - Also a bit of a compatability layer to make it easier to support yesod - 1.1-1.4 in the same code base. - - - Copyright 2012-2014 Joey Hess + - Copyright 2012-2014 Joey Hess - - Licensed under the GNU GPL version 3 or higher. -} diff --git a/Utility/libdiskfree.c b/Utility/libdiskfree.c --- a/Utility/libdiskfree.c +++ b/Utility/libdiskfree.c @@ -1,6 +1,6 @@ /* disk free space checking, C mini-library * - * Copyright 2012, 2014 Joey Hess + * Copyright 2012, 2014 Joey Hess * * License: BSD-2-clause */ diff --git a/Utility/libkqueue.c b/Utility/libkqueue.c --- a/Utility/libkqueue.c +++ b/Utility/libkqueue.c @@ -1,6 +1,6 @@ /* kqueue interface, C mini-library * - * Copyright 2012 Joey Hess + * Copyright 2012 Joey Hess * * License: BSD-2-clause */ diff --git a/Utility/libmounts.c b/Utility/libmounts.c --- a/Utility/libmounts.c +++ b/Utility/libmounts.c @@ -5,7 +5,7 @@ * Copyright (c) 2001 * David Rufino * Copyright 2012 - * Joey Hess + * Joey Hess * * Redistribution and use in source and binary forms, with or without * modification, are permitted provided that the following conditions diff --git a/debian/changelog b/debian/changelog --- a/debian/changelog +++ b/debian/changelog @@ -1,3 +1,40 @@ +git-annex (5.20150205) unstable; urgency=medium + + * info: Can now display info about a given uuid. + * Added to remote/uuid info: Count of the number of keys present + on the remote, and their size. This is rather expensive to calculate, + so comes last and --fast will disable it. + * info remote: Include the date of the last sync with the remote. + * sync: Added --message/-m option like git commit. + * remotedaemon: Fix problem that could prevent ssh connections being + made after two LOSTNET messages were received in a row (perhaps due to + two different network interfaces being brought down). + * Fix build failure when wget is not installed. + * Fix wording of message displayed when unable to get a file that + is available in untrusted repositories. + * addurl: When a Content-Disposition header suggests a filename to use, + addurl will consider using it, if it's reasonable and doesn't conflict + with an existing file. (--file overrides this) + * Fix default repository description created by git annex init, + which got broken by the relative path changes in the last release. + * init: Repository tuning parameters can now be passed when initializing a + repository for the first time. For details, see + http://git-annex.branchable.com/tuning/ + * merge: Refuse to merge changes from a git-annex branch of a repo + that has been tuned in incompatible ways. + * Support annex.tune.objecthash1, annex.tune.objecthashlower, and + annex.tune.branchhash1. + * Remove support for building without cryptohash. + * Added MD5 and MD5E backends. + * assistant: Fix local pairing when ssh pubkey comment contains spaces. + * Avoid using fileSize which maxes out at just 2 gb on Windows. + Instead, use hFileSize, which doesn't have a bounded size. + Fixes support for files > 2 gb on Windows. + * Windows: Fix running of the pre-commit-annex hook. + * Windows: Fix S3 special remote; need to call withSocketsDo. Thanks, Trent. + + -- Joey Hess Thu, 05 Feb 2015 14:08:33 -0400 + git-annex (5.20150113) unstable; urgency=medium * unlock: Don't allow unlocking files that have never been committed to git diff --git a/debian/control b/debian/control --- a/debian/control +++ b/debian/control @@ -14,7 +14,7 @@ libghc-cryptohash-dev, libghc-dataenc-dev, libghc-utf8-string-dev, - libghc-aws-dev (>= 0.9.2), + libghc-aws-dev (>= 0.9.2-2~), libghc-conduit-dev, libghc-resourcet-dev, libghc-dav-dev (>= 1.0) [amd64 i386 kfreebsd-amd64 kfreebsd-i386 powerpc], diff --git a/debian/copyright b/debian/copyright --- a/debian/copyright +++ b/debian/copyright @@ -2,30 +2,30 @@ Source: native package Files: * -Copyright: © 2010-2014 Joey Hess +Copyright: © 2010-2015 Joey Hess License: GPL-3+ Files: Assistant/WebApp.hs Assistant/WebApp/* templates/* static/* -Copyright: © 2012-2014 Joey Hess +Copyright: © 2012-2014 Joey Hess © 2014 Sören Brunk License: AGPL-3+ Files: Remote/Ddar.hs -Copyright: © 2011 Joey Hess +Copyright: © 2011 Joey Hess © 2014 Robie Basak License: GPL-3+ Files: Utility/ThreadScheduler.hs Copyright: 2011 Bas van Dijk & Roel van Dijk - 2012, 2013 Joey Hess + 2012, 2013 Joey Hess License: BSD-2-clause Files: Utility/* -Copyright: 2012-2014 Joey Hess +Copyright: 2012-2015 Joey Hess License: BSD-2-clause Files: Utility/Gpg.hs Utility/DirWatcher* -Copyright: © 2010-2014 Joey Hess +Copyright: © 2010-2014 Joey Hess License: GPL-3+ Files: Assistant/WebApp/Bootstrap3.hs @@ -34,7 +34,7 @@ Files: doc/logo* */favicon.ico standalone/osx/git-annex.app/Contents/Resources/git-annex.icns standalone/android/icons/* Copyright: 2007 Henrik Nyh - 2010 Joey Hess + 2010 Joey Hess 2013 John Lawrence License: other Free to modify and redistribute with due credit, and obviously free to use. @@ -46,14 +46,14 @@ Files: Utility/libmounts.c Copyright: 1980, 1989, 1993, 1994 The Regents of the University of California 2001 David Rufino - 2012 Joey Hess + 2012 Joey Hess License: BSD-3-clause * Copyright (c) 1980, 1989, 1993, 1994 * The Regents of the University of California. All rights reserved. * Copyright (c) 2001 * David Rufino * Copyright 2012 - * Joey Hess + * Joey Hess * * Redistribution and use in source and binary forms, with or without * modification, are permitted provided that the following conditions diff --git a/doc/backends.mdwn b/doc/backends.mdwn --- a/doc/backends.mdwn +++ b/doc/backends.mdwn @@ -17,8 +17,8 @@ This is the least expensive backend, recommended for really large files or slow systems. * `SHA512`, `SHA512E` -- Best SHA-2 hash, for the very paranoid. -* `SHA1`, `SHA1E` -- Smaller hash than `SHA256` for those who want a checksum - but are not concerned about security. +* `SHA1`, `SHA1E`, `MD5`, `MD5E` -- Smaller hashes than `SHA256` + for those who want a checksum but are not concerned about security. * `SHA384`, `SHA384E`, `SHA224`, `SHA224E` -- Hashes for people who like unusual sizes. * `SKEIN512`, `SKEIN512E`, `SKEIN256`, `SKEIN256E` diff --git a/doc/backends/comment_11_f0f6316bbdc971a9ab157de9bbb9f74c._comment b/doc/backends/comment_11_f0f6316bbdc971a9ab157de9bbb9f74c._comment new file mode 100644 --- /dev/null +++ b/doc/backends/comment_11_f0f6316bbdc971a9ab157de9bbb9f74c._comment @@ -0,0 +1,14 @@ +[[!comment format=mdwn + username="https://www.google.com/accounts/o8/id?id=AItOawnx8kHW66N3BqmkVpgtXDlYMvr8TJ5VvfY" + nickname="Yaroslav" + subject="add MD5SUM (with E) backend?" + date="2015-01-29T22:07:40Z" + content=""" +probably in many cases MD5SUM might be sufficient to cover the space of the available load and + +- its size would be even smaller than SHA1 (thus smaller git-annex footprint) +- immediate matching to often distributed MD5SUMs +- matching to ETags (whenever wasn't a multipart upload) in S3 buckets + +or use of MD5SUM hash is really not recommended for non-encryption-critical cases too? +"""]] diff --git a/doc/backends/comment_12_da76dff5fe712318d7d4313f1d827883._comment b/doc/backends/comment_12_da76dff5fe712318d7d4313f1d827883._comment new file mode 100644 --- /dev/null +++ b/doc/backends/comment_12_da76dff5fe712318d7d4313f1d827883._comment @@ -0,0 +1,10 @@ +[[!comment format=mdwn + username="joey" + subject="""MD5""" + date="2015-02-04T17:25:45Z" + content=""" +I've added MD5 and MD5E. Of course, if you choose to use these, or the WORM +backend, you give up the cryptographic verification that the content +currently in your repository is the same content that was in it before. +Whether that matters in your application is up to you. +"""]] diff --git a/doc/bugs/Build_fails_when_no_wget_avalible.mdwn b/doc/bugs/Build_fails_when_no_wget_avalible.mdwn new file mode 100644 --- /dev/null +++ b/doc/bugs/Build_fails_when_no_wget_avalible.mdwn @@ -0,0 +1,46 @@ +### Please describe the problem. + +When trying to build git-annex 5.21050113 in a clean cabal sandbox on OSX and not having wget avalible, breaks the configure step of the build. See excerpt of build log below. + +I am not sure if it is a bug or not, from the debian dependencies it seems that wget is required, but from reading various pieces of the documentation it seems to only be recommended. Installing wget makes it build. + +### What steps will reproduce the problem? + + + +### What version of git-annex are you using? On what operating system? + +5.20150113 on OSX Yosemite. + +### Please provide any additional information below. + +[[!format sh """ + checking version...fatal: Not a git repository (or any of the parent directories): .git + 5.20150113 + checking UPGRADE_LOCATION... not available + checking git... yes + checking git version... 2.2.1 + checking cp -a... yes + checking cp -p... yes + checking cp --preserve=timestamps... no + checking cp --reflink=auto... no + checking xargs -0... yes + checking rsync... yes + checking curl... yes + checking wget... no + checking wget supports -q --show-progress...setup: wget: does not exist +cabal: Error: some packages failed to install: +git-annex-5.20150113 failed during the configure step. The exception was: +ExitFailure 1 + + +# End of transcript or log. +"""]] + +-- Carl + +> wget is not intended to be a hard build dependency. The Debian package +> should always be built with wget, so it's a build-dependency there. +> +> I've fixed the configure script to not crash in this situation. +> [[done]]. --[[Joey]] diff --git a/doc/bugs/Direct_mode_sync_fails_to_transfer_a_10GB_file.mdwn b/doc/bugs/Direct_mode_sync_fails_to_transfer_a_10GB_file.mdwn --- a/doc/bugs/Direct_mode_sync_fails_to_transfer_a_10GB_file.mdwn +++ b/doc/bugs/Direct_mode_sync_fails_to_transfer_a_10GB_file.mdwn @@ -56,3 +56,5 @@ # End of transcript or log. """]] + +> [[fixed|done]] --[[Joey]] diff --git a/doc/bugs/Forcing_https_for_Google_cloud_storage_remote__63__.mdwn b/doc/bugs/Forcing_https_for_Google_cloud_storage_remote__63__.mdwn new file mode 100644 --- /dev/null +++ b/doc/bugs/Forcing_https_for_Google_cloud_storage_remote__63__.mdwn @@ -0,0 +1,31 @@ +### Please describe the problem. + +A special remote for Google cloud storage would appear to send the developer keys in the clear. +Obviously the content itself can be secured with the encryption but sending the auth keys in +the clear permits anybody listening (i.e. at a public WiFi access point) to gain r/w access to +the user's GCS store. + +### What steps will reproduce the problem? + +Setup a new special remote: + + git annex initremote gcs type=S3 chunk=2MiB encryption=none host=storage.googleapis.com bucket=gitannex + ... + git move --to=gcs blah + +Capture packets. Watch the developer keys go by in the headers. And in this case, see the content too because there's no +encryption turned on. But I believe that I know how to fix this. + +I tried to persuade `git annex` to use a SSL connection but without encouraging results: + + git annex initremote gcs type=S3 chunk=2MiB port=443 host=storage.googleapis.com bucket=gitannex + initremote gcs (checking bucket...) git-annex: ErrorClosed + + +### What version of git-annex are you using? On what operating system? + +Debian wheezy, git-annex version: 5.20141024~bpo70+1 + +### Please provide any additional information below. + +> [[done]]; port=443 supported since 5.20141203. --[[Joey]] diff --git a/doc/bugs/How_to_use_a_DRA_bucket_in_Google_cloud_storage__63__.mdwn b/doc/bugs/How_to_use_a_DRA_bucket_in_Google_cloud_storage__63__.mdwn new file mode 100644 --- /dev/null +++ b/doc/bugs/How_to_use_a_DRA_bucket_in_Google_cloud_storage__63__.mdwn @@ -0,0 +1,23 @@ +### Please describe the problem. + +Git annex's special S3 remote doesn't seem to work with DRA buckets in Google cloud storage. + +### What steps will reproduce the problem? + +I created a DRA-style bucket in Google cloud storage: + + gsutil mb gs://gitannex-dra + +Then followed [this hint](https://gist.github.com/jterrace/4576324) to +set up use of GCS. Except that it didn't work: + + git annex initremote gcs type=S3 encryption=none host=storage.googleapis.com port=80 bucket=gitannex-dra + initremote gcs (checking bucket...) git-annex: Invalid argument. + +### What version of git-annex are you using? On what operating system? + +Wheezy, git-annex version: 5.20141024~bpo70+1 + +### Please provide any additional information below. + +There didn't seem to be any extra logs and `--debug` didn't seem to add anything useful. diff --git a/doc/bugs/No_such_file_with_certain_filenames_using_WORM_backend.mdwn b/doc/bugs/No_such_file_with_certain_filenames_using_WORM_backend.mdwn --- a/doc/bugs/No_such_file_with_certain_filenames_using_WORM_backend.mdwn +++ b/doc/bugs/No_such_file_with_certain_filenames_using_WORM_backend.mdwn @@ -59,3 +59,6 @@ # End of transcript or log. """]] + +> [[done]]; this is a duplicate of the bug referred to in my comment below. +> --[[Joey]] diff --git a/doc/bugs/Revert_to_old_file_version_in_direct_mode___40__VFAT__41__.mdwn b/doc/bugs/Revert_to_old_file_version_in_direct_mode___40__VFAT__41__.mdwn --- a/doc/bugs/Revert_to_old_file_version_in_direct_mode___40__VFAT__41__.mdwn +++ b/doc/bugs/Revert_to_old_file_version_in_direct_mode___40__VFAT__41__.mdwn @@ -24,4 +24,6 @@ > VFAT is a crippled file system. I am not going to reimplenent all of git > to support it. The suggested method won't work; git-annex would need -> to add a git-annex revert, etc, etc, etc ad infinitum. [[wontfix|done]] --[[Joey]] +> to add a git-annex revert, etc, etc, etc ad infinitum +> +> Instead, see the `git annex proxy` command. [[done]] --[[Joey]] diff --git a/doc/bugs/S3_Access_fails_on_windows.mdwn b/doc/bugs/S3_Access_fails_on_windows.mdwn new file mode 100644 --- /dev/null +++ b/doc/bugs/S3_Access_fails_on_windows.mdwn @@ -0,0 +1,42 @@ +### Please describe the problem. + +Attempting to do *anything* with an S3 reomote using git-annex on windows fails with error code 10093 (i.e. WSA_NOT_INITIALISED). + +### What steps will reproduce the problem? + +Assuming you have a disabled S3 remote called "the-cloud" (e.g. a fresh clone) +[[!format sh """ +C:\annex> git annex enableremote "the-cloud" +enableremote the-cloud gpg: WARNING: using insecure memory! +gpg: please see http://www.gnupg.org/documentation/faqs.html for more information +(checking bucket...) (creating bucket in ap-southeast-2...) git-annex-old: FailedConnectionException2 "my-bucket-name.s3-ap-southeast-2.amazonaws.com" 80 False getAddrInfo: does not exist (error 10093) +"""]] + +### What version of git-annex are you using? On what operating system? + +git-annex 5.20150113-gcf247cf on windows 8.1 + +### Please provide any additional information below. + +This error is caused by the Winsock library not being initialised before a socket operation is attempted. The patch below fixes the issue, and it should be a no-op on non-Windows platforms. + +[[!format patch """ +diff --git a/git-annex.hs b/git-annex.hs +index cdaa754..0eed9db 100644 +--- a/git-annex.hs ++++ b/git-annex.hs +@@ -21,8 +21,10 @@ import Utility.UserInfo + import Utility.Env + #endif + ++import Network.Socket (withSocketsDo) ++ + main :: IO () +-main = do ++main = withSocketsDo $ do + ps <- getArgs + run ps =<< getProgName + where +"""]] + +> Thanks very much for the patch! [[done]] --[[Joey]] diff --git a/doc/bugs/git-annex_assistant_not_working_with_nested_git_repos.mdwn b/doc/bugs/git-annex_assistant_not_working_with_nested_git_repos.mdwn new file mode 100644 --- /dev/null +++ b/doc/bugs/git-annex_assistant_not_working_with_nested_git_repos.mdwn @@ -0,0 +1,22 @@ +### Please describe the problem. +When using git-annex in indirect mode (or even in direct mode I think, although this is not to be very reliable in this context), git repos inside a git-annex are ignored. This is due to the fact that git is ignoring nested .git folders, and then, we can safely work with git-annex and nested git repos without conflicts. + +Using a tool such as my-repos, one can then sync its entire home directory, containing folders and git repos, syncing the normal folders thanks to git-annex, and storing the git repos metadata for easy cloning using my-repos. + +However, when using the git-annex assistant (or the daemon to have automatic background sync), this is no longer the case. + +After discussion on IRC, we thought this could be due to the fact that files are copied sequentially and that the .git folder is not yet present when it starts copying. However, disabling the daemon, copying the files and reenabling it then leads to the same behaviour. + +Thanks! + + +### What version of git-annex are you using? On what operating system? + +git-annex-bin on AUR. + +> Many people have reported this as a bug, see +> +> +> But git simply does not allow +> storing .git in .git. With good reason IMHO. So this is a duplicate +> bug report, and I can't fix it. [[done]]. --[[Joey]] diff --git a/doc/bugs/git-annex_died_of_signal_11_when_syncing_content.mdwn b/doc/bugs/git-annex_died_of_signal_11_when_syncing_content.mdwn new file mode 100644 --- /dev/null +++ b/doc/bugs/git-annex_died_of_signal_11_when_syncing_content.mdwn @@ -0,0 +1,30 @@ +### Please describe the problem. + +git-annex dies of signal 11 when syncing content with Box. + +I noticed that the assistant stopped syncing after a few files, so I tried to sync manually through the terminal and saw the error. + +### What steps will reproduce the problem? + + $ git annex sync box.com --content + commit ok + copy myfile1 (checking box.com...) (to box.com...) + ok + copy myfile2 (checking box.com...) (to box.com...) + ok + copy myfile3 (checking box.com...) (to box.com...) + ok + copy myfile4 (checking box.com...) (to box.com...) + ok + copy myfile5 (checking box.com...) error: git-annex died of signal 11 + +The number of files that are copied correctly is quite random, some times it syncs 200 files and other times only 2 or 3. + + +### What version of git-annex are you using? On what operating system? + +5.20141125 on Debian Sid (everything install from official packages) + +### Please provide any additional information below. + +I don't know how to get more details of the problem, I haven't manage to get a more precise error activating logs or verbose mode, if there's anything I can do to debug the problem I'll be more than willing. diff --git a/doc/bugs/git_annex_import_fails_on_filenames_with_newlines_in_them.mdwn b/doc/bugs/git_annex_import_fails_on_filenames_with_newlines_in_them.mdwn --- a/doc/bugs/git_annex_import_fails_on_filenames_with_newlines_in_them.mdwn +++ b/doc/bugs/git_annex_import_fails_on_filenames_with_newlines_in_them.mdwn @@ -44,3 +44,4 @@ Linux durian 3.14-1-amd64 #1 SMP Debian 3.14.9-1 (2014-06-30) x86_64 GNU/Linux [[!tag confirmed git-bug]] +[[!title git limitations prevent using git-annex on filenames containing newlines]] diff --git a/doc/bugs/git_annex_unused_fails_when_a_filename_contains_newline.mdwn b/doc/bugs/git_annex_unused_fails_when_a_filename_contains_newline.mdwn new file mode 100644 --- /dev/null +++ b/doc/bugs/git_annex_unused_fails_when_a_filename_contains_newline.mdwn @@ -0,0 +1,69 @@ +### Please describe the problem. + +After annexing files with newline (`\n`) characters in their name, then running `git annex unused` on the same git annex repository fails, instead of working correctly. The error is "git-annex: unknown response from git cat-file ". +This issue might happen with filenames with other special characters in the filename, too. + +### What steps will reproduce the problem? + +1. create git annex repository +2. create a file with a newline in its name +3. annex the file +4. run `git annex unused` + +Expected result: success + +Actual results: error: "git-annex: unknown response from git cat-file ". + + +### What version of git-annex are you using? On what operating system? + +git-annex package version 5.20140412ubuntu1, architecture i386. System is xubuntu 14.04. + +[[!format sh """ +zolee@zolee-Latitude-E6440:/media/zolee/Stuff/dell-zoli-git-annex$ git annex version +git-annex version: 5.20140412ubuntu1 +build flags: Assistant Webapp Webapp-secure Pairing Testsuite S3 WebDAV Inotify DBus DesktopNotify XMPP DNS Feeds Quvi TDFA CryptoHash +key/value backends: SHA256E SHA1E SHA512E SHA224E SHA384E SKEIN256E SKEIN512E SHA256 SHA1 SHA512 SHA224 SHA384 SKEIN256 SKEIN512 WORM URL +remote types: git gcrypt S3 bup directory rsync web webdav tahoe glacier hook external +local repository version: 5 +supported repository version: 5 +upgrade supported from repository versions: 0 1 2 4 +"""]] + + +### Please provide any additional information below. + +[[!format sh """ +# If you can, paste a complete transcript of the problem occurring here. +# If the problem is with the git-annex assistant, paste in .git/annex/daemon.log + +zolee@zolee-Latitude-E6440:/media/zolee/Stuff/dell-zoli-git-annex$ git annex unused +unused . (checking for unused data...) [2014-07-13 16:42:04 EEST] read: git ["--git-dir=/media/zolee/Stuff/dell-zoli-git-annex/.git","--work-tree=/media/zolee/Stuff/dell-zoli-git-annex","ls-files","--cached","--others","-z","--","/media/zolee/Stuff/dell-zoli-git-annex"] +[2014-07-13 16:42:31 EEST] read: git ["--git-dir=/media/zolee/Stuff/dell-zoli-git-annex/.git","--work-tree=/media/zolee/Stuff/dell-zoli-git-annex","symbolic-ref","HEAD"] +[2014-07-13 16:42:31 EEST] read: git ["--git-dir=/media/zolee/Stuff/dell-zoli-git-annex/.git","--work-tree=/media/zolee/Stuff/dell-zoli-git-annex","show-ref","--hash","refs/heads/dell-zoli-master"] +[2014-07-13 16:42:31 EEST] read: git ["--git-dir=/media/zolee/Stuff/dell-zoli-git-annex/.git","--work-tree=/media/zolee/Stuff/dell-zoli-git-annex","show-ref"] +(checking dell-zoli-master...) [2014-07-13 16:42:31 EEST] read: git ["--git-dir=/media/zolee/Stuff/dell-zoli-git-annex/.git","--work-tree=/media/zolee/Stuff/dell-zoli-git-annex","show-ref","--head"] +[2014-07-13 16:42:31 EEST] read: git ["--git-dir=/media/zolee/Stuff/dell-zoli-git-annex/.git","--work-tree=/media/zolee/Stuff/dell-zoli-git-annex","show-ref","--head"] +[2014-07-13 16:42:31 EEST] read: git ["--git-dir=/media/zolee/Stuff/dell-zoli-git-annex/.git","--work-tree=/media/zolee/Stuff/dell-zoli-git-annex","diff-index","-z","--raw","--no-renames","-l0","refs/heads/dell-zoli-master"] +(checking store-zoli/laptop-zoli-master...) [2014-07-13 16:42:32 EEST] read: git ["--git-dir=/media/zolee/Stuff/dell-zoli-git-annex/.git","--work-tree=/media/zolee/Stuff/dell-zoli-git-annex","show-ref","--head"] +[2014-07-13 16:42:32 EEST] read: git ["--git-dir=/media/zolee/Stuff/dell-zoli-git-annex/.git","--work-tree=/media/zolee/Stuff/dell-zoli-git-annex","show-ref","--head"] +[2014-07-13 16:42:32 EEST] read: git ["--git-dir=/media/zolee/Stuff/dell-zoli-git-annex/.git","--work-tree=/media/zolee/Stuff/dell-zoli-git-annex","diff-index","-z","--raw","--no-renames","-l0","refs/remotes/store-zoli/laptop-zoli-master"] +[2014-07-13 16:42:33 EEST] chat: git ["--git-dir=/media/zolee/Stuff/dell-zoli-git-annex/.git","--work-tree=/media/zolee/Stuff/dell-zoli-git-annex","cat-file","--batch"] +git-annex: unknown response from git cat-file ("Code Composer Studio missing","refs/remotes/store-zoli/laptop-zoli-master:egyetem/2009-2010-sem2/diploma/tex/titlu-lucrare.tex~") +zolee@zolee-Latitude-E6440:/media/zolee/Stuff/dell-zoli-git-annex$ + + +zolee@zolee-Latitude-E6440:/media/zolee/Stuff/dell-zoli-git-annex/egyetem/2009-2010-sem2/media-processors$ ls +51325409-1.pdf course2010 Noterestanta.pdf Proiecte_6xxx.pdf rg_rand.c TMS320C6000?Code Composer Studio? Tutorial?- spru301c.pdf +ccs_workspace.tar.gz netrol Proc_Media project site +zolee@zolee-Latitude-E6440:/media/zolee/Stuff/dell-zoli-git-annex/egyetem/2009-2010-sem2/media-processors$ ls -b +51325409-1.pdf course2010 Noterestanta.pdf Proiecte_6xxx.pdf rg_rand.c \ \ \ TMS320C6000\nCode\ Composer\ Studio\n\ \ \ \ \ \ Tutorial\n-\ spru301c.pdf +ccs_workspace.tar.gz netrol Proc_Media project site +zolee@zolee-Latitude-E6440:/media/zolee/Stuff/dell-zoli-git-annex/egyetem/2009-2010-sem2/media-processors$ + +# End of transcript or log. +"""]] + +> dup of +> [[git_annex_import_fails_on_filenames_with_newlines_in_them]]; closing as +> such. [[done]] --[[Joey]] diff --git a/doc/bugs/git_annex_wont_work_with_git-dir_and_work-tree.mdwn b/doc/bugs/git_annex_wont_work_with_git-dir_and_work-tree.mdwn new file mode 100644 --- /dev/null +++ b/doc/bugs/git_annex_wont_work_with_git-dir_and_work-tree.mdwn @@ -0,0 +1,27 @@ +### Please describe the problem. +If using git annex with external .git dir webapp report a tread crashed and ever trying to restart it crash again and webapp is not able to upload/download/sync (also the download of git-annex updates is affected) + +### What steps will reproduce the problem? + + +### What version of git-annex are you using? On what operating system? + +git-annex version: 5.20150113-gcf247cf +build flags: Assistant Webapp Webapp-secure Pairing Testsuite S3 WebDAV Inotify DBus DesktopNotify XMPP DNS Feeds Quvi TDFA CryptoHash +key/value backends: SHA256E SHA1E SHA512E SHA224E SHA384E SKEIN256E SKEIN512E SHA256 SHA1 SHA512 SHA224 SHA384 SKEIN256 SKEIN512 WORM URL +remote types: git gcrypt S3 bup directory rsync web bittorrent webdav tahoe glacier ddar hook external + +Precompiled tarball from official git-annex download site + +Gentoo linux + +### Please provide any additional information below. + +[[!format sh """ + +Launching web browser on file://../.git_annex_repos/pippo.git/annex/webapp.html <-- note wrong path! should be /home/gioacchino/.git_annex_repos/pippo.git/annex/webapp.html + +RemoteControl crashed: user error (nice ["ionice","-c3","/home/gioacchino/opt/git-annex.linux/git-annex","remotedaemon"] exited 1) + +WebApp crashed: : hPutStr: illegal operation (handle is closed +"""]] diff --git a/doc/bugs/glacier_fails_to_copy.mdwn b/doc/bugs/glacier_fails_to_copy.mdwn new file mode 100644 --- /dev/null +++ b/doc/bugs/glacier_fails_to_copy.mdwn @@ -0,0 +1,82 @@ +### Please describe the problem. +glacier copy shows the output of the glacier-cli help and a gpg error for each file and most of the files fail to copy. + +### What steps will reproduce the problem? +1. git annex init "Photos" +2. cp -R ../photodir/ . +3. git annex add . +4. git commit -a -m added +5. export AWS_ACCESS_KEY_ID="***" +6. export AWS_SECRET_ACCESS_KEY="***" +7. git annex initremote glacier type=glacier encryption=shared vault=photos +8. git annex copy --auto --to glacier + +### What version of git-annex are you using? On what operating system? +5.20150113-gcf247cf +Arch Linux (git-annex-bin package) + +### Please provide any additional information below. +I get the following messages over and over again: +[[!format sh """ +# If you can, paste a complete transcript of the problem occurring here. +# If the problem is with the git-annex assistant, paste in .git/annex/daemon.log +copy 2003/10/14/085.jpg (checking glacier...) (to glacier...) +8% 0.0 B/s 0s +glacier [args] + + Commands + vaults - Operations with vaults + jobs - Operations with jobs + upload - Upload files to a vault. If the vault doesn't exits, it is + created + + Common args: + --access_key - Your AWS Access Key ID. If not supplied, boto will + use the value of the environment variable + AWS_ACCESS_KEY_ID + --secret_key - Your AWS Secret Access Key. If not supplied, boto + will use the value of the environment variable + AWS_SECRET_ACCESS_KEY + --region - AWS region to use. Possible values: us-east-1, us-west-1, + us-west-2, ap-northeast-1, eu-west-1. + Default: us-east-1 + + Vaults operations: + + List vaults: + glacier vaults + + Jobs operations: + + List jobs: + glacier jobs + + Uploading files: + + glacier upload + + Examples : + glacier upload pics *.jpg + glacier upload pics a.jpg b.jpg + +gpg: [stdout]: write error: Broken pipe +gpg: DBG: deflate: iobuf_write failed +gpg: build_packet failed: Broken pipe +gpg: [stdout]: write error: Broken pipe +gpg: iobuf_flush failed on close: Broken pipe +gpg: [stdout]: write error: Broken pipe +gpg: iobuf_flush failed on close: Broken pipe +gpg: symmetric encryption of '[stdin]' failed: Broken pipe + + user error (gpg ["--batch","--no-tty","--use-agent","--quiet","--trust-model","always","--batch","--passphrase-fd","227","--symmetric","--force-mdc","--no-textmode"] exited 2) +failed +git-annex: fd:230: hPutBuf: resource vanished (Broken pipe) + +# lots more lines like this + +ok +(Recording state in git...) +git-annex: copy: 230 failed + +# End of transcript or log. +"""]] diff --git a/doc/bugs/windows_isExecutable_fail.mdwn b/doc/bugs/windows_isExecutable_fail.mdwn new file mode 100644 --- /dev/null +++ b/doc/bugs/windows_isExecutable_fail.mdwn @@ -0,0 +1,27 @@ +On Windows, isExecutable fails to detect a file that is indeed executable +as such. This prevents git-annex from running the pre-commit-hook +on Windows. + +getFileStatus yields a fileMode of 100666, which is +clearly a dummy mode. Not surprising, since unix-compat is partial stubs +on windows. + +Actually, isExecutable is ok (it needs to check unix modes because it is +used on file modes coming out of git). But, getFileStatus is the wrong +thing to be using on Windows to check if a hook exists and is executable. + +I don't see anything in Win32 or Win32-extras on hackage that can check +executablility. Looking at git's source, it uses `access(path, X_OK) < 0`; +haskell equivilant is System.Posix.Files.fileAccess, but the version +in unix-compat has the same problem as checking getFileStatus's fileMode. + +I think it's reasonable to assume that if a hook exists on windows, it's +intended to be executable, and try to run it. Actually, testing with +msysgit, it runs hooks whether or not they have the execute bit set! +So, done that now. + +However, now git-annex tries to run the hook but fails when it's a shell +script because #!/bin/sh is useless on windows. It looks to me like msysgit +runs "sh hook" to work around that, and it is in fact parsing the shebang +line and dispatching the interpreter. Ugh. (Also, pre-commit.bat doesn't +get run.) Ok, added this same hack to git-annex. [[done]] --[[Joey]] diff --git a/doc/chunking.mdwn b/doc/chunking.mdwn --- a/doc/chunking.mdwn +++ b/doc/chunking.mdwn @@ -1,4 +1,4 @@ -Some [[special_remotes]] have support for breaking large files up into +Most [[special_remotes]] have support for breaking large files up into chunks that are stored on the remote. This can be useful to work around limitations on the size of files diff --git a/doc/contact.mdwn b/doc/contact.mdwn --- a/doc/contact.mdwn +++ b/doc/contact.mdwn @@ -1,4 +1,4 @@ -Joey Hess is the author of git-annex. If you need to +Joey Hess is the author of git-annex. If you need to talk about something privately, email me. The [[forum]] is the best place to discuss git-annex. diff --git a/doc/design/assistant/polls/Android_default_directory.mdwn b/doc/design/assistant/polls/Android_default_directory.mdwn --- a/doc/design/assistant/polls/Android_default_directory.mdwn +++ b/doc/design/assistant/polls/Android_default_directory.mdwn @@ -4,4 +4,4 @@ want the first time they run it, but to save typing on android, anything that gets enough votes will be included in a list of choices as well. -[[!poll open=yes expandable=yes 71 "/sdcard/annex" 6 "Whole /sdcard" 7 "DCIM directory (photos and videos only)" 2 "Same as for regular git-annex. ~/annex/"]] +[[!poll open=yes expandable=yes 72 "/sdcard/annex" 6 "Whole /sdcard" 7 "DCIM directory (photos and videos only)" 2 "Same as for regular git-annex. ~/annex/"]] diff --git a/doc/design/assistant/polls/prioritizing_special_remotes.mdwn b/doc/design/assistant/polls/prioritizing_special_remotes.mdwn --- a/doc/design/assistant/polls/prioritizing_special_remotes.mdwn +++ b/doc/design/assistant/polls/prioritizing_special_remotes.mdwn @@ -6,7 +6,7 @@ Help me prioritize my work: What special remote would you most like to use with the git-annex assistant? -[[!poll open=yes 16 "Amazon S3 (done)" 12 "Amazon Glacier (done)" 10 "Box.com (done)" 74 "My phone (or MP3 player)" 25 "Tahoe-LAFS" 13 "OpenStack SWIFT" 35 "Google Drive"]] +[[!poll open=yes 18 "Amazon S3 (done)" 12 "Amazon Glacier (done)" 10 "Box.com (done)" 74 "My phone (or MP3 player)" 25 "Tahoe-LAFS" 13 "OpenStack SWIFT" 35 "Google Drive"]] This poll is ordered with the options I consider easiest to build listed first. Mostly because git-annex already supports them and they diff --git a/doc/design/git-remote-daemon.mdwn b/doc/design/git-remote-daemon.mdwn --- a/doc/design/git-remote-daemon.mdwn +++ b/doc/design/git-remote-daemon.mdwn @@ -162,7 +162,7 @@ No pushing is done for CHANGED, since git handles ssh natively. -TODO: test! +This is implemented and seems to work well. ## telehash diff --git a/doc/design/v6.mdwn b/doc/design/v6.mdwn new file mode 100644 --- /dev/null +++ b/doc/design/v6.mdwn @@ -0,0 +1,233 @@ +This page's purpose is to collect and explore plans for a future +annex.version 6. + +There are two major possible changes that could go in v6 or a later +version that would require a hard migration of git-annex repositories: + +1. Changing .git/annex/objects/ paths, as appear in the git-annex symlinks. + +2. Changing the layout of the git-annex branch in a substantial way. + +## object path changes + +Any change in this area requires the user make changes to their master +branch, any other active branches. Old un-converted tags and other +historical trees in git would also be broken. This is a pretty bad user +experience. (And it bloats history with a commit that rewrites everything +too. + +For this reason, any changes in this area have been avoided, going all the +way back to v2 (2011). + +> git-annex had approximately 3 users at the +> time of that migration, and as one of them, I can say it was a total PITA. +--[[Joey]] + +So, there would need to be significant payoffs to justify this change. + +Note that changing the hash directories might also change where objects are +stored in special remotes. Because repos can be offline or expensive to +migrate (or both -- Glacier!) any such changes need to keep looking in the +old locations for backwards compatability. + +Possible reasons to make changes: + +* It's annoyingly inconsistent that git-annex uses a different hash + directory layout for non-bare repository (on a non-crippled filesystem) + than is used for bare repositories and some special remotes. + + Users occasionally stumble over this difference when messing with + internals. The code is somewhat complicated by it. In some cases, + git-annex checks both locations (eg, a bare repo defaults to xxx/yyy + but really old ones might use xX/yY for some keys). + + The mixed case hash directories have caused trouble on case-insensative + filesystems, although that has mostly been papered over to avoid + problems. + +* The hash directories, and also the per-key directories + can slow down using a repository on a disk (both SSD and spinning). + + + + Initial benchmarks suggest that going from xX/yY/KEY/OBJ to xX/yY/OBJ + directories would improve speed 3x. + + Presumably, removing the yY would also speed it up, unless there are too + many objects and the filesystem gets slow w/o the hash directories. + +* Removing a directory level would also reduce disk usage, see [[forum/scalability_with_lots_of_files/]] for more info. + +## git-annex branch changes + +This might involve, eg, rethinking the xxx/yyy/ hash directories used +in the git-annex branch. + +Would this require a hard version transition? It might be possible to avoid +one, but then git-annex would have to look in both the old and the new +place. And if a un-transitioned repo was merged into a transitioned one, +git-annex would have to look in *both* places, and union merge the two sets +of data on the fly. This doubles the git-cat-file overhead of every +operation involving the git-annex branch. So a hard transition would +probably be best. + +Also, note that w/o a hard transition, there's the risk that a old +git-annex version gets ahold of a git-annex branch created by a new +git-annex version, and sees only half of the story (the un-transitioned +files). This could be a very confusing failure mode. It doesn't help that +the git-annex branch does not currently have any kind of +version number embedded in it, so the old version of git-annex doesn't even +have a way to check if it can handle the branch. + +Possible reasons to make changes: + +* There is a discussion of some possible changes to the hash directories here + with a + goal of reducing the overhead of the git-annex branch in the overall size + of the git-annex repository. + + Removing the second-level hash directories might improve performance. + It doesn't save much space when a repository is having incremental changes + made to it. However, if millions of annexed objects are being added + in a single commit, removing the second-level hash directories does save + space; it halves the number of tree + objects[1](https://github.com/datalad/datalad/issues/17#issuecomment-68759754). + + Also, + + suggests using xxx/yyy.log, where one log contains information for + multiple keys. This would probably improve performance too due to + caching, although in some cases git-annex would have to process extra + information to get to the info about the key it wants, which hurts + performance. The disk usage change of this method has not yet been + quantified. + +* Another reason to do it would be improving git-annex to use vector clocks, + instead of its current assumption that client's clocks are close enough to + accurate. This would presumably change the contents of the files. + +* While not a sufficient reason on its own, the best practices for file + formats in the git-annex branch has evolved over time, and there are some + files that have unusual formats for historical reasons. Other files have + modern formats, but their parsers have to cope with old versions that + have other formats. A hard transition would provide an opportunity to + clean up a lot of that. + +## living on the edge + +Rather than a hard transition, git-annex could add a v6 mode +that could be optionally enabled when initing a repo for the first time. + +Users who know they need that mode could then turn it one, and get the +benefits, while everyone else avoids a transition that doesn't benefit them +much. + +There could even be multiple modes, with different tradeoffs depending on +how the repo will be used, its size, etc. Of course that adds complexity. + +But the main problem with this idea is, how to avoid the foot shooting +result of merging repo A(v5) into repo B(v6)? This seems like it would be +all to easy for a user to do. + +As far as git-annex branch changes go, it might be possible for git-annex +to paper over the problem by handling both versions in the merged git-annex +branch, as discussed earlier. But for .git/annex/objects/ changes, there +does not seem to be a reasonable thing for git-annex to do. When it's +receiving an object into a mixed v5 and v6 repo, it can't know which +location that repo expects the object file to be located in. Different +files in the repo might point to the same object in different locations! +Total mess. Must avoid this. + +Currently, annex.version is a per-local-repo setting. git-annex can't tell +if two repos that it's merging have different annex.version's. + +It would be possible to add a git-annex:version file, which would work for +git-annex branch merging. Ie, `git-annex merge` could detect if different +git-annex branches have different versions, and refuse to merge them (or +upgrade the old one before merging it). + +Also, that file could be used by git-annex, to automatically set +annex.version when auto-initing a clone of a repo that was initted with +a newer than default version. + +But git-anex:version won't prevent merging B/master into A's master. +That merge can be done by git; nothing in git-annex can prevent it. + +What we could do is have a .annex-version flag file in the root of the +repo. Then git merge would at least have a merge conflict. Note that this +means inflicting the file on all git-annex repos, even ones used by people +with no intention of living on the edge. And, it would take quite a while +until all such repos get updated to contain such a file. + +Or, we could just document that if you initialize a repo with experimental +annex.version, you're living on the edge and you can screw up your repo +by merging with a repo from an old version. + +git-annex fsck could also fix up any broken links that do result from the +inevitable cases where users ignore the docs. + +## version numbers vs configuration + +A particular annex.version like 5 encompasses a number of somewhat distinct +things + +* git-annex branch layout +* .git/annex/objects/ layout +* other git stuff (like eg, the name of the HEAD branch in direct mode) + +If the user is specifying at `git annex init` time some nonstandard things +they want to make the default meet their use case better, that is more +a matter of configuration than of picking a version. + +For example, we could say that the user is opting out of the second-level +object hash directories. Or we could say the user is choosing to use v6, +which is like v5 except with different object hash directory structure. + + git annex init --config annex.objects.hashdirectories 1 + --config annex.objects.hashlower true + git annex init --version 6 + +The former would be more flexible. The latter is simpler. + +The former also lets the user chose *no* hash directories, or +choose 2 levels of hash directories while using the (v5 default) mixed +case hashing. + +## concrete design + +Make git-annex:difference.log be used by newer git-annex versions than v5, +and by nonstandard configurations. + +The file contents will be "timestamp uuid [value, ..]", where value is a +serialized data type that describes divergence from v5 (since v5 and older +don't have the git-annex:difference.log file). + +So, for example, "[Version 6]" could indicate that v6 is being used. Or, +"[ObjectHashLower True, ObjectHashDirectories 1, BranchHashDirectories 1]" +indicate a nonstandard configuration on top of v5 (this might turn out to +be identical to v6; just make the compare equal and no problem). + +git-annex merge would check if it's merging in a git-annex:difference.log from +another repo that doesn't match the git-annex:difference.log of the local repo, +and abort. git-annex sync (and the assistant) would check the same, but +before merging master branches either, to avoid a bad merge there. + +The git-annex:difference.log of a local repo could be changed by an upgrade +or some sort of transition. When this happens, the new value is written +for the uuid of the local repo. git-annex merge would then refuse to merge +with remote repos until they were also transitioned. + +(There's perhaps some overlap here with the existing +git-annex:transitions.log, however the current transitions involve +forgetting history/dead remotes and so can be done repeatedly on a +repository. Also, the current transitions can be performed on remote +branches before merging them in; that wouldn't work well for version +changes since those require other changes in the remote repo.) + +Not covered: + +* git-merge of other branches, such as master (can be fixed by `git annex + fix` or `fsck`) +* Old versions of git-annex will ignore the version file of course, + and so merging such repos using them can result in pain. + diff --git a/doc/design/v6/comment_1_b7b4819211910556838ec37bc2b6b37b._comment b/doc/design/v6/comment_1_b7b4819211910556838ec37bc2b6b37b._comment new file mode 100644 --- /dev/null +++ b/doc/design/v6/comment_1_b7b4819211910556838ec37bc2b6b37b._comment @@ -0,0 +1,14 @@ +[[!comment format=mdwn + username="https://www.google.com/accounts/o8/id?id=AItOawl9sYlePmv1xK-VvjBdN-5doOa_Xw-jH4U" + nickname="Richard" + subject="comment 1" + date="2015-01-22T01:05:56Z" + content=""" +My gut feeling for incompatible changes in v6 is to somehow make v5 and below error out on all merges with a v6 repo. + +Conversely, v6 git-annex running in v6 repos would transition all data while merging in v5 repos. + +As a migration path for existing repos, you could move `git-annex` and `master` to `git-annex_v5` and `master_v5`. Once you are certain all known repos within that repo group are transitioned, either kill the v5 branches automagically or print info on cli/web UI on what needs to be run to get rid of them. + +Having several plain git 1+ GiB repos (i.e. without any annex objects), I would love to transition after v6 and the migration paths have been hung a month or three to dry. +"""]] diff --git a/doc/design/v6/comment_2_8f35254d2cd5d0c273d5392ddd857c2d._comment b/doc/design/v6/comment_2_8f35254d2cd5d0c273d5392ddd857c2d._comment new file mode 100644 --- /dev/null +++ b/doc/design/v6/comment_2_8f35254d2cd5d0c273d5392ddd857c2d._comment @@ -0,0 +1,24 @@ +[[!comment format=mdwn + username="https://www.google.com/accounts/o8/id?id=AItOawnx8kHW66N3BqmkVpgtXDlYMvr8TJ5VvfY" + nickname="Yaroslav" + subject="comment 2" + date="2015-01-26T19:46:12Z" + content=""" +\"... merging repo A(v5) into repo B(v6)? This seems like it would be all to easy for a user to do.\" + +it would be easy if two separate repos are inited separately of different versions and then merged. But how frequent could such situation arise? I don't think that it is not that common actually in non git-annex assistant initialized repositories, especially if \"v6\" (or some other custom) layout would be non-default. + +This also somewhat reflects upon \"When it's receiving an object into a mixed v5 and v6 repo, it can't know which location that repo expects the object file to be located in.\" -- how plausible/frequent would be to see a mixed v5/6 repo? + +\".annex-version flag file\" -- I think it is a good idea. (may be even better an .annex/version directory/file to reserve for possibly future other branch-specific, thus not for git-annex branch additions). Indeed it would take time for repos to acquire it, but imho it is ok, if added automagically by new git-annex versions. Also it is a tiny price to pay for users who do not really care about \"living on the edge\". But it also might better be coupled with having git-annex:version (i.e. version file under git-annex branch) describing layout of the git-annex branch since those two are somewhat independent, right? + +Also a wild idea to mitigate inconvenience for users happen they migrate repositories from old to new formats: to provide 'git annex compat-layout [version]' command which, for files with content, would generate symlinks to files in new format to locations in old, with some command to clean them up later on (e.g. 'git annex compat-layout --cleanup'). Although inefficient per-se it could be a big convenience since would eliminate need to \"migrate/rewrite\" entire history, while still making it possible to get access to previous versions. With a handling in hooks could be automated to even hide that from users entirely. or is there a big culprit I don't see? + + +\"version numbers vs configuration\" + +having flexibility of configurations, possibly with versions simply providing enumerations to some of them, might be a great feature to have in the long run. Not sure though if it would not blow up complexity :-/ + +Overall -- if complete transition to improved/unified v6 is too big of undertaker, allowing for custom non-default configurations while sticking to v5 as the default one and forbidding merges between different versions, could be sufficient to scale up for atypical large uses. If everyone to migrate to v6 -- more optimal layout should be well thought through to be worthwhile undertaking. + +"""]] diff --git a/doc/devblog/day_246__old_todos.mdwn b/doc/devblog/day_246__old_todos.mdwn new file mode 100644 --- /dev/null +++ b/doc/devblog/day_246__old_todos.mdwn @@ -0,0 +1,9 @@ +Got a release out today. + +I'm feeling a little under the weather, so wanted something easy to do in +the rest of the day that would be nice and constructive. Ended up going +over the todo list. Old todos come in three groups; hard problems, already +solved, and easy changes that never got done. I left the first group alone, +closed many todos in the second group, and implemented a few easy changes. +Including `git annex sync -m` and adding some more info to `git annex info +remote`. diff --git a/doc/devblog/day_247__hooks_and_large_files_on_windows.mdwn b/doc/devblog/day_247__hooks_and_large_files_on_windows.mdwn new file mode 100644 --- /dev/null +++ b/doc/devblog/day_247__hooks_and_large_files_on_windows.mdwn @@ -0,0 +1,30 @@ +Today I got The pre-commit-annex hook working on Windows. It turns out that +msysgit runs hook scripts even when they're not executable, and it parses +the #! line itself. Now git-annex does too, on Windows. + +Also, added a new chapter to the walkthrough, +[[walkthrough/using_special_remotes]]. They clearly needed to be mentioned, +especially to show the workflow of running initremote in one repository, +then syncing another repository and running enableremote to enable the same +special remote there. + +Then more fun Windows porting! Turns out git-annex on Windows didn't handle +files > 2 gb correctly; the way it was getting file size +[uses a too small data type on Windows](https://github.com/jystic/unix-compat/issues/16). +Luckily git-annex itself treats all file sizes as unbounded Integers, +so I was easily able to swap in a `getFileSize` that returns correct +values for large files. + +While I haven't blogged since the 13th and have not been too active until +today, there are still a number of little improvements that have been done +here and there. + +Including a fix for an interesting bug where the assistant would tell +the remotedaemon that the network connection has been lost, twice in a row, +and this would make the remotedeamon fail to reconnect to the remote when +the network came up. I'm not sure what situation triggers this bug (Maybe +machines with 2 interfaces? Or maybe a double disconnection event for 1 +interface?), but I was able to reproduce it by sending messages to the +remotedaemon, and so fixed it. + +Backlog is down to 118 messages. diff --git a/doc/devblog/day_248__workload_tuning.mdwn b/doc/devblog/day_248__workload_tuning.mdwn new file mode 100644 --- /dev/null +++ b/doc/devblog/day_248__workload_tuning.mdwn @@ -0,0 +1,54 @@ +Today I put together a lot of things I've been thinking about: + +* There's some evidence that git-annex needs tuning to handle some unusual + repositories. In particular very big repositories might benefit from + different object hashing. +* It's really hard to handle [[upgrades]] that change the fundamentals of + how git-annex repositories work. Such an upgrade would need every + git-annex user to upgrade their repository, and would be very painful. + It's hard to imagine a change that is worth that amount of pain. +* There are other changes some would like to see (like lower-case object + hash directory names) that are certianly not enough to warrant a flag + day repo format upgrade. +* It would be nice to let people who want to have some flexability to play + around with changes, in their own repos, as long as they don't a) + make git-annex a lot more complicated, or b) negatively impact others. + (Without having to fork git-annex.) + +This is discussed in more depth in [[design/v6]]. + +The solution, which I've built today, is support for +[[tuning]] settings, when a new repository is first created. The resulting +repository will be different in some significant way from a default +git-annex repository, but git-annex will support it just fine. + +The main limitations are: + +* You can't change the tuning of an existing repository + (unless a tool gets written to transition it). +* You absolutely don't want to merge repo B, which has been tuned in + nonstandard ways, into repo A which has not. Or A into B. (Unless you like + watching slow motion car crashes.) + +I built all the infrastructure for this today. Basically, the git-annex +branch gets a record of all tunings that have been applied, and they're +automatically propigated to new clones of a repository. + +And I implemented the first tunable setting: + + git -c annex.tune.objecthashlower=true annex init + +This is definitely an experimental feature for now. +`git-annex merge` and similar commands will detect attempts to merge +between incompatably tuned repositories, and error out. But, there are a +lot of ways to shoot yourself in the foot if you use this feature: + +* Nothing stops `git merge` from merging two incompatable repositories. +* Nothing stops any version of git-annex older from today from merging + either. + +Now that the groundwork is laid, I can pretty easily, and inexpensively, +add more tunable settings. The next two I plan to add are already +documented, `annex.tune.objecthashdirectories` and +`annex.tune.branchhashdirectories`. Most new tunables should take about 4 +lines of code to add to git-annex. diff --git a/doc/encryption.mdwn b/doc/encryption.mdwn --- a/doc/encryption.mdwn +++ b/doc/encryption.mdwn @@ -34,7 +34,7 @@ Here the KEYID(s) are passed to `gpg` to find encryption keys. Typically, you will say "keyid=2512E3C7" to use a specific gpg key. -Or, you might say "keyid=joey@kitenet.net" to search for matching keys. +Or, you might say "keyid=id@joeyh.name" to search for matching keys. To add a new key and allow it to access all the content that is stored in the encrypted special remote, just run `git annex diff --git a/doc/forum/Add_annex_files_outside_git_root_directory.mdwn b/doc/forum/Add_annex_files_outside_git_root_directory.mdwn new file mode 100644 --- /dev/null +++ b/doc/forum/Add_annex_files_outside_git_root_directory.mdwn @@ -0,0 +1,24 @@ +Hi, + +I love the idea of git-annex, and I'm trying to do my first steps with it. I'm stuck on the following issue: + +When creating a git repository and annexing a file in the root directory, everything works as expected: + + git init + git annex init "mytest" + echo 1 > annexfile + git annex add annexfile + # add annexfile ok + # (Recording state in git...) + +However, when I try to add a file in a subdirectory of the repository, the adding command fails without any error message: + + mkdir mydir + echo 1 > mydir/myfile + git annex add mydir/myfile + # no message, no status change, nothing + # note that I can add the file in the root dir and then move it to `mydir` + +Am I doing something wrong here? + +Thank you! diff --git a/doc/forum/Alternative_to_XMPP_on_Windows__63__.mdwn b/doc/forum/Alternative_to_XMPP_on_Windows__63__.mdwn new file mode 100644 --- /dev/null +++ b/doc/forum/Alternative_to_XMPP_on_Windows__63__.mdwn @@ -0,0 +1,1 @@ +Is there an alternative to XMPP to sync Windows machines? diff --git a/doc/forum/Is_there_any_delta_handling_for_file_modifications__63__.mdwn b/doc/forum/Is_there_any_delta_handling_for_file_modifications__63__.mdwn new file mode 100644 --- /dev/null +++ b/doc/forum/Is_there_any_delta_handling_for_file_modifications__63__.mdwn @@ -0,0 +1,20 @@ +Hi! + +I have few large files, which will be slightly modified from time to time. Consider the following example: + + $ git init + $ git annex init "somerepo" + $ dd if=/dev/urandom of=foo bs=50M count=1 + $ git annex add foo + $ git commit -m "foo added" + $ git annex unlock foo + $ echo "modification" >> foo + $ git annex add foo + $ git -m commit "modification 1 of foo" + $ echo "another modification" >> foo + $ git annex add foo + $ git -m commit "modification 2 of foo" + +I would have expected ending up with a full copy of foo, and a delta storage for the first version and the first modification. Instead, three full-sized copies are created within the .git/annex/objects directory, even though the modifications only added a few characters. + +Is there any way to not always store a full copy of each file for each modification, but only a delta? diff --git a/doc/forum/Ubuntu_PPA/comment_8_feecd478a4d44cb5ffc7020c646174ba._comment b/doc/forum/Ubuntu_PPA/comment_8_feecd478a4d44cb5ffc7020c646174ba._comment new file mode 100644 --- /dev/null +++ b/doc/forum/Ubuntu_PPA/comment_8_feecd478a4d44cb5ffc7020c646174ba._comment @@ -0,0 +1,8 @@ +[[!comment format=mdwn + username="https://www.google.com/accounts/o8/id?id=AItOawntodrSgODU27WUCyN2PV7TC14YMkyaoxQ" + nickname="Dennis" + subject="Ubuntu Trusty 14.04" + date="2015-01-24T03:19:41Z" + content=""" +I am running into the same issue with Ubuntu Trusty 14.04. The version shipped is 5.20140412ubuntu1, but I would like to try a more recent version to see if an issue I experience still persists. Is there any up-to-date PPA available for Trusty? +"""]] diff --git a/doc/forum/adding_remote_bup_repo_using_ssh.mdwn b/doc/forum/adding_remote_bup_repo_using_ssh.mdwn new file mode 100644 --- /dev/null +++ b/doc/forum/adding_remote_bup_repo_using_ssh.mdwn @@ -0,0 +1,42 @@ +I have two machines connected to my home network. machine A. Machine A has a git-annex repo which stores the data using a remote bup repo. The bup repo resides on Machine A itself. Now, I want to set up the same kind of environment in Machine B ( git annex repo backed down by bup remote). The only condition is that I need to re-use the bup repo in the machine A. So I went up like this: + + git clone ssh://192.168.1.33/path/to/git-annex-repo-on-machine-a + +This succeeded. The next step was to add a reference to the bup repo on machine A to this new git-annex repo in machine B. I went about like this: + + git annex initremote mybup type=bup encryption=none buprepo=192.168.1.33:/path/to/bup-repo-on-machine-a + +This seems to work OK, except the fact that the following shows up: + + Reinitialized existing Git repository in /Users/XXX/.bup/ + Reinitialized existing Git repository in /Users/path/to/bup-repo-on-machine-a + +*Q1*: Why does git-annex create bup repos on the local folder while initializaing a remote bup repo? + +After that, I tried to get the file from the git repo using + + git annex get --from mybup + +..And nothing happened. This is the debug output from the last command : + + read: git ["--git-dir=/private/tmp/annexed-setups/.git","--work-tree=/private/tmp/annexed-setups","show-ref","git-annex"] + read: git ["--git-dir=/private/tmp/annexed-setups/.git","--work-tree=/private/tmp/annexed-setups","show-ref","--hash","refs/heads/git-annex"] + read: git ["--git-dir=/private/tmp/annexed-setups/.git","--work-tree=/private/tmp/annexed-setups","log","refs/heads/git- annex..c9af31cb3e563657e83b8b8e1f9a8de1ff690e4f","-n1","--pretty=%H"] + read: git ["--git-dir=/private/tmp/annexed-setups/.git","--work-tree=/private/tmp/annexed-setups","log","refs/heads/git-annex..b7b2af7f94af4770d5b4da7231bc3e41c0a6129d","-n1","--pretty=%H"] + read: git ["--git-dir=/private/tmp/annexed-setups/.git","--work-tree=/private/tmp/annexed-setups","log","refs/heads/git-annex..7b1017c5e68ec5a2b298b899bf723d0093fa0c7c","-n1","--pretty=%H"] + chat: git ["--git-dir=/private/tmp/annexed-setups/.git","--work-tree=/private/tmp/annexed-setups","cat-file","--batch"] + read: git ["--git-dir=/private/tmp/annexed-setups/.git","--work-tree=/private/tmp/annexed-setups","ls-files","--cached","-z","--","file.iso"] + +The file was not obtained from the remote. However, when I did + + git annex fsck --from mybup + +This resolved all the files properly and then when I did a + + git annex list. + +it showed all files to be reachable from the mybup repo. + +*Q2* Is this the correct workflow? +*Q3* Do I need to do a [costly] fsck for bup remote to properly work over ssh? + diff --git a/doc/forum/example_of_massively_disconnected_operation.mdwn b/doc/forum/example_of_massively_disconnected_operation.mdwn --- a/doc/forum/example_of_massively_disconnected_operation.mdwn +++ b/doc/forum/example_of_massively_disconnected_operation.mdwn @@ -4,7 +4,7 @@ 
 commit 4151f4595fe6205d4aed653617ab23eb3335130a
-Author: Joey Hess 
+Author: Joey Hess 
 Date:   Tue Oct 26 02:18:03 2010 -0400
 
 joey> git pull
diff --git a/doc/forum/git_annex_assistant_repository_history__63__.mdwn b/doc/forum/git_annex_assistant_repository_history__63__.mdwn
new file mode 100644
--- /dev/null
+++ b/doc/forum/git_annex_assistant_repository_history__63__.mdwn
@@ -0,0 +1,7 @@
+Hi,
+
+Even after googling for a while, I'm still having a hard time finding an answer for this:
+
+How can I access the revision history information for an annex-assistant repository?  For example, to recover a file on one computer that another computer deleted.  Or, to view how another computer modified a file.
+
+Thanks!
diff --git a/doc/forum/scalability_with_lots_of_files.mdwn b/doc/forum/scalability_with_lots_of_files.mdwn
new file mode 100644
--- /dev/null
+++ b/doc/forum/scalability_with_lots_of_files.mdwn
@@ -0,0 +1,43 @@
+What is git-annex's [[scalability]] with large (10k+) number of files and a few (~10) repositories?
+
+I have had difficult times maintaining a music archive of around 20k files, spread around 17 repositories.
+
+`ncdu` tells me, of the actual files in the direct repository:
+
+
+$ ncdu --exclude .git
+ Total disk usage: 109,3GiB  Apparent size: 109,3GiB  Items: 23771
+

+
+Now looking at the git-annex metadata:
+
+
+$ time git clone -b git-annex /srv/mp3
+Cloning into 'mp3'...
+done.
+Checking out files: 100% (31207/31207), done.
+0.69user 1.72system 0:04.65elapsed 51%CPU (0avgtext+0avgdata 47732maxresident)k
+40inputs+489552outputs (1major+2906minor)pagefaults 0swaps
+$ git branch
+  annex/direct/master
+* git-annex
+  master
+$ wc -l uuid.log
+7 uuid.log
+$ find -type f | wc
+  31429   62214 3013920
+$ du -sh .
+361M    .
+$ du -sch *  | tail -1
+243M    total
+

+
+So basically, it looks like the git-annex location tracking takes up around 243M, 361M if we include git's history of it (I assume). This means around 8KiB of storage per file, and 4KiB/file for history (git is doing a pretty good job here). (8KiB kind of makes sense here: one file for the tracking log (4KiB) and another directory to hold it (another 4KiB)...)
+
+Is that about right? Are there ways to compress that somehow? Could I at least drop the *history* of that from git without too much harm - that would already save 120MiB...
+
+That repository is around 18 months old.
+
+(It's interesting to notice the limitation of the "one file per record" storage format here: since git-annex has so many little files, and all of those take at least $blocksize (it seems like it's 4KB here), it takes up space pretty quickly. Another good point for git here: packing files together saves a *lot* of space! Could files be packed *before* being stored in the git-annex branch? or is that totally stupid. :)
+
+Thanks! --[[anarcat]]
diff --git a/doc/git-annex-shell.mdwn b/doc/git-annex-shell.mdwn
--- a/doc/git-annex-shell.mdwn
+++ b/doc/git-annex-shell.mdwn
@@ -126,7 +126,7 @@
 
 # AUTHOR
 
-Joey Hess 
+Joey Hess 
 
 
 
diff --git a/doc/git-annex.mdwn b/doc/git-annex.mdwn
--- a/doc/git-annex.mdwn
+++ b/doc/git-annex.mdwn
@@ -174,6 +174,8 @@
   This behavior can be overridden by configuring the preferred content of
   a repository. See see PREFERRED CONTENT below.
 
+  The `--message` or `-m` option can be used to specify a commit message.
+
 * `merge`
 
   This performs the same merging (and merge conflict resolution)
@@ -216,8 +218,10 @@
   is there at a future point, specify `--relaxed`. (Implies `--fast`.)
 
   Normally the filename is based on the full url, so will look like
-  "www.example.com_dir_subdir_bigfile". For a shorter filename, specify
-  `--pathdepth=N`. For example, `--pathdepth=1` will use "dir/subdir/bigfile",
+  "www.example.com_dir_subdir_bigfile". In some cases, addurl is able to
+  come up with a better filename based on other information. Or, for a
+  shorter filename, specify `--pathdepth=N`. For example,
+  `--pathdepth=1` will use "dir/subdir/bigfile",
   while `--pathdepth=3` will use "bigfile". It can also be negative;
   `--pathdepth=-2` will use the last two parts of the url.
 
@@ -696,10 +700,12 @@
   To generate output suitable for the gource visualization program,
   specify `--gource`.
 
-* `info [directory|file|remote ...]`
+* `info [directory|file|remote|uuid ...]`
 
   Displays statistics and other information for the specified item,
-  which can be a directory, or a file, or a remote.
+  which can be a directory, or a file, or a remote, or the uuid of a
+  repository. 
+
   When no item is specified, displays statistics and information
   for the repository as a whole.
 
@@ -1833,6 +1839,12 @@
   Used by hook special remotes and external special remotes to record
   the type of the remote.
 
+* `annex.tune.objecthash1`, `annex.tune.objecthashlower`, `annex.tune.branchhash1`
+
+  These can be passed to `git annex init` to tune the repository.
+  They cannot be safely changed in a running repository.
+  For details, see .
+
 # CONFIGURATION VIA .gitattributes
 
 The key-value backend used when adding a new file to the annex can be
@@ -1892,7 +1904,7 @@
 
 # AUTHOR
 
-Joey Hess 
+Joey Hess 
 
 
 
diff --git a/doc/git-union-merge.mdwn b/doc/git-union-merge.mdwn
--- a/doc/git-union-merge.mdwn
+++ b/doc/git-union-merge.mdwn
@@ -31,7 +31,7 @@
 
 # AUTHOR
 
-Joey Hess 
+Joey Hess 
 
 
 
diff --git a/doc/install/Ubuntu/comment_13_7964374bb2332940677eea570bdb0b69._comment b/doc/install/Ubuntu/comment_13_7964374bb2332940677eea570bdb0b69._comment
new file mode 100644
--- /dev/null
+++ b/doc/install/Ubuntu/comment_13_7964374bb2332940677eea570bdb0b69._comment
@@ -0,0 +1,8 @@
+[[!comment format=mdwn
+ username="https://www.google.com/accounts/o8/id?id=AItOawntodrSgODU27WUCyN2PV7TC14YMkyaoxQ"
+ nickname="Dennis"
+ subject="Ubuntu Trusty 14.04"
+ date="2015-01-24T03:20:48Z"
+ content="""
+I am searching for current packages for Ubuntu Trusty 14.04. The version shipped is 5.20140412ubuntu1, but I would like to try a more recent version to see if an issue I experience still persists. Is there any up-to-date PPA available for Trusty?
+"""]]
diff --git a/doc/install/Ubuntu/comment_14_b511063001af2e2170bef657cf016ff2._comment b/doc/install/Ubuntu/comment_14_b511063001af2e2170bef657cf016ff2._comment
new file mode 100644
--- /dev/null
+++ b/doc/install/Ubuntu/comment_14_b511063001af2e2170bef657cf016ff2._comment
@@ -0,0 +1,12 @@
+[[!comment format=mdwn
+ username="https://www.google.com/accounts/o8/id?id=AItOawltxdgYMUK4CMJh3jC8AlegwyoiHA9Ka7o"
+ nickname="Justin"
+ subject="Trusty PPA"
+ date="2015-01-27T18:24:50Z"
+ content="""
+@Dennis, I just got a backport of the latest release (5.20150113) running under trusty.  This was my first attempt at backporting software and it ended up being a fairly big project.  I had to pull in a lot of haskell dependencies from vivid in order to get this to build.
+
+I'll attempt to keep this PPA up-to-date as long as I don't have to do too much more build dep wrangling.
+
+
+"""]]
diff --git a/doc/internals.mdwn b/doc/internals.mdwn
--- a/doc/internals.mdwn
+++ b/doc/internals.mdwn
@@ -257,3 +257,12 @@
 
 	ForgetGitHistory 1387325539.685136s
 	ForgetDeadRemotes 1387325539.685136s
+
+## `difference.log`
+
+Used when a repository has fundamental differences from other repositories,
+that should prevent merging.
+
+Example:
+
+	e605dca6-446a-11e0-8b2a-002170d25c55 [ObjectHashLower] timestamp=1422387398.30395s
diff --git a/doc/internals/hashing/comment_3_19b7d20ca392078f14f9f10992f288ec._comment b/doc/internals/hashing/comment_3_19b7d20ca392078f14f9f10992f288ec._comment
new file mode 100644
--- /dev/null
+++ b/doc/internals/hashing/comment_3_19b7d20ca392078f14f9f10992f288ec._comment
@@ -0,0 +1,7 @@
+[[!comment format=mdwn
+ username="josch"
+ subject="any particular reason for the chosen characters for base32 encoding"
+ date="2015-01-31T17:13:57Z"
+ content="""
+are the characters \"0123456789zqjxkmvwgpfZQJXKMVWGPF\" chosen randomly for the base32 encoding or was there a reason to choose exactly these?
+"""]]
diff --git a/doc/internals/hashing/comment_4_7642d6ce5fd4d37d464b05d0b4f869c6._comment b/doc/internals/hashing/comment_4_7642d6ce5fd4d37d464b05d0b4f869c6._comment
new file mode 100644
--- /dev/null
+++ b/doc/internals/hashing/comment_4_7642d6ce5fd4d37d464b05d0b4f869c6._comment
@@ -0,0 +1,8 @@
+[[!comment format=mdwn
+ username="joey"
+ subject="""comment 4"""
+ date="2015-02-04T17:14:24Z"
+ content="""
+The only reason for the letter choice is that it avoids making random
+words with possibly unintentional meanings..
+"""]]
diff --git a/doc/news/version_5.20141125.mdwn b/doc/news/version_5.20141125.mdwn
deleted file mode 100644
--- a/doc/news/version_5.20141125.mdwn
+++ /dev/null
@@ -1,8 +0,0 @@
-git-annex 5.20141125 released with [[!toggle text="these changes"]]
-[[!toggleable text="""
-   * 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
-     pointed at the working tree of a git-annex repository,
-     possibly resulting in data loss. Closes: #[768093](http://bugs.debian.org/768093)
-   * Windows: Fix crash when user.name is not set in git config."""]]
diff --git a/doc/news/version_5.20141203.mdwn b/doc/news/version_5.20141203.mdwn
deleted file mode 100644
--- a/doc/news/version_5.20141203.mdwn
+++ /dev/null
@@ -1,28 +0,0 @@
-git-annex 5.20141203 released with [[!toggle text="these changes"]]
-[[!toggleable text="""
-   * proxy: New command for direct mode repositories, allows bypassing
-     the direct mode guard in a safe way to do all sorts of things
-     including git revert, git mv, git checkout ...
-   * undo: New command to undo the most recent change to a file
-     or to the contents of a directory.
-   * Add undo action to nautilus and konqueror integration.
-   * diffdriver: New git-annex command, to make git external diff drivers
-     work with annexed files.
-   * pre-commit: Block partial commit of unlocked annexed file, since
-     that left a typechange staged in index due to some infelicity of git's
-     handling of partial commits.
-   * Work around behavior change in lsof 4.88's -F output format.
-   * S3: Switched to using the haskell aws library.
-   * S3: No longer buffers entire files in memory when uploading without
-     chunking.
-   * S3: When built with a new enough version of the haskell aws library,
-     supports doing multipart uploads, in order to store extremely large
-     files in S3 when not using chunking.
-   * Don't show "(gpg)" when decrypting the remote encryption cipher,
-     since this could be taken to read that's the only time git-annex
-     runs gpg, which is not the case.
-   * Debian package is now maintained by Gergely Nagy.
-   * Windows: Remove Alt+A keyboard shortcut, which turns out to have scope
-     outside the menus.
-   * Windows: Install ssh and other bundled programs to Git/cmd,
-     instead of Git/bin, since the latter is not in the default msysgit PATH."""]]
diff --git a/doc/news/version_5.20150205.mdwn b/doc/news/version_5.20150205.mdwn
new file mode 100644
--- /dev/null
+++ b/doc/news/version_5.20150205.mdwn
@@ -0,0 +1,34 @@
+git-annex 5.20150205 released with [[!toggle text="these changes"]]
+[[!toggleable text="""
+   * info: Can now display info about a given uuid.
+   * Added to remote/uuid info: Count of the number of keys present
+     on the remote, and their size. This is rather expensive to calculate,
+     so comes last and --fast will disable it.
+   * info remote: Include the date of the last sync with the remote.
+   * sync: Added --message/-m option like git commit.
+   * remotedaemon: Fix problem that could prevent ssh connections being
+     made after two LOSTNET messages were received in a row (perhaps due to
+     two different network interfaces being brought down).
+   * Fix build failure when wget is not installed.
+   * Fix wording of message displayed when unable to get a file that
+     is available in untrusted repositories.
+   * addurl: When a Content-Disposition header suggests a filename to use,
+     addurl will consider using it, if it's reasonable and doesn't conflict
+     with an existing file. (--file overrides this)
+   * Fix default repository description created by git annex init,
+     which got broken by the relative path changes in the last release.
+   * init: Repository tuning parameters can now be passed when initializing a
+     repository for the first time. For details, see
+     http://git-annex.branchable.com/tuning/
+   * merge: Refuse to merge changes from a git-annex branch of a repo
+     that has been tuned in incompatible ways.
+   * Support annex.tune.objecthash1, annex.tune.objecthashlower, and
+     annex.tune.branchhash1.
+   * Remove support for building without cryptohash.
+   * Added MD5 and MD5E backends.
+   * assistant: Fix local pairing when ssh pubkey comment contains spaces.
+   * Avoid using fileSize which maxes out at just 2 gb on Windows.
+     Instead, use hFileSize, which doesn't have a bounded size.
+     Fixes support for files > 2 gb on Windows.
+   * Windows: Fix running of the pre-commit-annex hook.
+   * Windows: Fix S3 special remote; need to call withSocketsDo. Thanks, Trent."""]]
diff --git a/doc/news/version_5/comment_1_ae8c464ccb7b7b218efd9151c5bbd1a5._comment b/doc/news/version_5/comment_1_ae8c464ccb7b7b218efd9151c5bbd1a5._comment
deleted file mode 100644
--- a/doc/news/version_5/comment_1_ae8c464ccb7b7b218efd9151c5bbd1a5._comment
+++ /dev/null
@@ -1,7 +0,0 @@
-[[!comment format=mdwn
- username="joey"
- subject="""comment 1"""
- date="2014-11-06T19:39:10Z"
- content="""
-Yeah, typoed. Should not cause any big problem though.
-"""]]
diff --git a/doc/preferred_content.mdwn b/doc/preferred_content.mdwn
--- a/doc/preferred_content.mdwn
+++ b/doc/preferred_content.mdwn
@@ -154,6 +154,29 @@
 
 	metadata=tag=done
 
+### difference: unused
+
+The --unused option makes git-annex operate on every key that `git annex
+unused` has determined to be unused. The corresponding `unused` keyword
+in a preferred content expression also matches those keys. 
+
+However, the latter doesn't make git-annex consider those keys. So
+when git-annex is only checking preferred content expressions against files
+in the repository (which are obviously used), `unused` in a preferred
+content expression won't match anything.
+
+So when is `unused` useful in a preferred content expression?
+
+Using `git annex sync --content --all` will ensure that all keys, including
+unused ones, are examined and the preferred content expressions followed.
+Similarly, `git annex sync --content --unused` will only look at the unused
+keys.
+
+The git-annex assistant periodically scans for unused files, and
+moves them to some repository whose preferred content expression
+matches "unused". (Or, if annex.expireunused is set, it may just delete
+them.)
+
 ## upgrades
 
 It's important that all clones of a repository can understand one-another's
diff --git a/doc/scalability/comment_1_a6656ae397277719d67d0953a28fe1d8._comment b/doc/scalability/comment_1_a6656ae397277719d67d0953a28fe1d8._comment
new file mode 100644
--- /dev/null
+++ b/doc/scalability/comment_1_a6656ae397277719d67d0953a28fe1d8._comment
@@ -0,0 +1,12 @@
+[[!comment format=mdwn
+ username="https://www.google.com/accounts/o8/id?id=AItOawmiPEySoakXDQ4OUAmC9neEOZW17W1KvlU"
+ nickname="Francesco Saverio"
+ subject="Default value of annex.queuesize"
+ date="2015-01-14T15:45:46Z"
+ content="""
+What is the default value of :
+
+    annex.queuesize 
+
+Without knowing the default value it is impossible to increase it :) thank you
+"""]]
diff --git a/doc/scalability/comment_2_71c7c3aa97284602d0f64c11a98d1782._comment b/doc/scalability/comment_2_71c7c3aa97284602d0f64c11a98d1782._comment
new file mode 100644
--- /dev/null
+++ b/doc/scalability/comment_2_71c7c3aa97284602d0f64c11a98d1782._comment
@@ -0,0 +1,8 @@
+[[!comment format=mdwn
+ username="joey"
+ subject="""comment 2"""
+ date="2015-01-15T18:56:42Z"
+ content="""
+annex.queuesize default is documented on the man page. Currently 10240
+commands.
+"""]]
diff --git a/doc/special_remotes/S3.mdwn b/doc/special_remotes/S3.mdwn
--- a/doc/special_remotes/S3.mdwn
+++ b/doc/special_remotes/S3.mdwn
@@ -1,8 +1,9 @@
 This special remote type stores file contents in a bucket in Amazon S3
 or a similar service.
 
-See [[tips/using_Amazon_S3]] and
-[[tips/Internet_Archive_via_S3]] for usage examples.
+See [[tips/using_Amazon_S3]], 
+[[tips/Internet_Archive_via_S3]], and [[tips/using_Google_Cloud_Storage]]
+for usage examples.
 
 ## configuration
 
diff --git a/doc/special_remotes/rsync.mdwn b/doc/special_remotes/rsync.mdwn
--- a/doc/special_remotes/rsync.mdwn
+++ b/doc/special_remotes/rsync.mdwn
@@ -2,12 +2,12 @@
 
 Setup example:
 
-	# git annex initremote myrsync type=rsync rsyncurl=rsync://rsync.example.com/myrsync keyid=joey@kitenet.net encryption=shared
+	# git annex initremote myrsync type=rsync rsyncurl=rsync://rsync.example.com/myrsync keyid=id@joeyh.name encryption=shared
 	# git annex describe myrsync "rsync server"
 
 Or for using rsync over SSH
 
-	# git annex initremote myrsync type=rsync rsyncurl=ssh.example.com:/myrsync keyid=joey@kitenet.net encryption=shared
+	# git annex initremote myrsync type=rsync rsyncurl=ssh.example.com:/myrsync keyid=id@joeyh.name encryption=shared
 	# git annex describe myrsync "rsync server"
 
 ## configuration
diff --git a/doc/special_remotes/webdav.mdwn b/doc/special_remotes/webdav.mdwn
--- a/doc/special_remotes/webdav.mdwn
+++ b/doc/special_remotes/webdav.mdwn
@@ -37,4 +37,4 @@
 
 Setup example:
 
-	# WEBDAV_USERNAME=joey@kitenet.net WEBDAV_PASSWORD=xxxxxxx git annex initremote box.com type=webdav url=https://dav.box.com/dav/git-annex chunk=10mb keyid=joey@kitenet.net
+	# WEBDAV_USERNAME=id@joeyh.name WEBDAV_PASSWORD=xxxxxxx git annex initremote box.com type=webdav url=https://dav.box.com/dav/git-annex chunk=10mb keyid=id@joeyh.name
diff --git a/doc/sync/comment_17_44a4ae4685c4bf2b4e7c61897eb3ff80._comment b/doc/sync/comment_17_44a4ae4685c4bf2b4e7c61897eb3ff80._comment
new file mode 100644
--- /dev/null
+++ b/doc/sync/comment_17_44a4ae4685c4bf2b4e7c61897eb3ff80._comment
@@ -0,0 +1,14 @@
+[[!comment format=mdwn
+ username="https://www.google.com/accounts/o8/id?id=AItOawm_YXzEdPHzbSGVwtmTR7g1BqDtTnIBB5s"
+ nickname="Matthias"
+ subject="comment 17"
+ date="2015-01-22T22:04:09Z"
+ content="""
+git sync … >> fetches from each remote
+
+Well, I have two git annex-ed repositories where \"git remote -v\" properly lists the other repo, and \"git annex sync foo\" manages to pull from foo, but \"git annex sync\" without a remote name simply does a local sync. Also, neither command pushes anything anywhere.
+
+So, where does \"git annex\" get its list of remotes from? What could prevent it from accessing them?
+
+
+"""]]
diff --git a/doc/sync/comment_18_838fb249cd5be83962770d5cc394389a._comment b/doc/sync/comment_18_838fb249cd5be83962770d5cc394389a._comment
new file mode 100644
--- /dev/null
+++ b/doc/sync/comment_18_838fb249cd5be83962770d5cc394389a._comment
@@ -0,0 +1,9 @@
+[[!comment format=mdwn
+ username="joey"
+ subject="""comment 18"""
+ date="2015-02-04T19:12:23Z"
+ content="""
+If a remote has "remote..annex-sync" set to false in the git
+config, `git-annex sync` will skip that remote unless you specify the name.
+That's probably what's going on in your case.
+"""]]
diff --git a/doc/thanks.mdwn b/doc/thanks.mdwn
--- a/doc/thanks.mdwn
+++ b/doc/thanks.mdwn
@@ -4,7 +4,7 @@
 do. You have my most sincere thanks. --[[Joey]]
 
 (If I got your name wrong, or you don't want it publically posted here,
-email .)
+email .)
 
 ## 2014-2015
 
diff --git a/doc/tips/using_Amazon_S3.mdwn b/doc/tips/using_Amazon_S3.mdwn
--- a/doc/tips/using_Amazon_S3.mdwn
+++ b/doc/tips/using_Amazon_S3.mdwn
@@ -24,8 +24,8 @@
 
 	# cd /media/usb/annex
 	# git pull laptop
-	# git annex initremote cloud
-	initremote cloud (gpg) (checking bucket) ok
+	# git annex enableremote cloud
+	enableremote cloud (gpg) (checking bucket) ok
 
 Now the remote can be used like any other remote.
 
diff --git a/doc/tips/using_box.com_as_a_special_remote.mdwn b/doc/tips/using_box.com_as_a_special_remote.mdwn
--- a/doc/tips/using_box.com_as_a_special_remote.mdwn
+++ b/doc/tips/using_box.com_as_a_special_remote.mdwn
@@ -42,7 +42,7 @@
 * Create `~/.davfs2/secrets`. This file contains your Box.com login and password.
   Your login is probably the email address you signed up with.
 
-        echo "/media/box.com joey@kitenet.net mypassword" > ~/.davfs2/secrets
+        echo "/media/box.com id@joeyh.name mypassword" > ~/.davfs2/secrets
         chmod 600 ~/.davfs2/secrets
 
 * Now you should be able to mount Box, as a non-root user:
diff --git a/doc/todo/Chunks_support_in_all_special_remotes.mdwn b/doc/todo/Chunks_support_in_all_special_remotes.mdwn
--- a/doc/todo/Chunks_support_in_all_special_remotes.mdwn
+++ b/doc/todo/Chunks_support_in_all_special_remotes.mdwn
@@ -3,3 +3,8 @@
 Support for chunks is useful, for example, to be able to upload large files over slow, unreliable connections or to minimize the amount of data to be sent when only part of a big file has been changed.
 
 Couldn't the code used to split, checksum and reconstruct the files in the `directory` remote be used also in all the other special remotes?
+
+> [[done]]; nearly all special remotes support chunking now, and the ones
+> that don't omit it for their own reasons, for example bup is not sped up
+> by using chunks, and glacier needs some additional work to support them.
+> --[[Joey]]
diff --git a/doc/todo/Configuring_metadata_view_filenames.mdwn b/doc/todo/Configuring_metadata_view_filenames.mdwn
new file mode 100644
--- /dev/null
+++ b/doc/todo/Configuring_metadata_view_filenames.mdwn
@@ -0,0 +1,1 @@
+Currently, in a git annex view, filenames take the form basename%path%.ext. I understand that this is a carefully drafted mapping to allow changes to be merged back into metadata. However, maybe it would be possible to make the separator ('%') and the order (e.g. path%basename.ext instead) configurable?
diff --git a/doc/todo/Recursive_addurl_simlar_to_wget_--recursive.mdwn b/doc/todo/Recursive_addurl_simlar_to_wget_--recursive.mdwn
--- a/doc/todo/Recursive_addurl_simlar_to_wget_--recursive.mdwn
+++ b/doc/todo/Recursive_addurl_simlar_to_wget_--recursive.mdwn
@@ -5,3 +5,5 @@
 git-annex addurl --recursive http://somehost.tld/somedir/
 
 For sanity, mimicking wget closely with default depth of 5, but customizable with the --level switch.
+
+> [[done]] --[[Joey]]
diff --git a/doc/todo/__91__FR__93___No_consistency_check_while_on_battery-only.mdwn b/doc/todo/__91__FR__93___No_consistency_check_while_on_battery-only.mdwn
new file mode 100644
--- /dev/null
+++ b/doc/todo/__91__FR__93___No_consistency_check_while_on_battery-only.mdwn
@@ -0,0 +1,14 @@
+I hope this has not been mentioned before.  I only found in mentioned in a comment of a devblog post.
+
+### Please describe the problem.
+With `git annex assistant` running, consistency checks is sometimes triggered while the computer is battery-powered (as opposed to plugged into AC).
+
+### What steps will reproduce the problem?
+Configure `git annex assistant` to make consistency check daily (or whatever the default is), unplug from power and wait.
+
+### What version of git-annex are you using? On what operating system?
+`5.20141231` on Archlinux 64 bit.  (From the changelog I guess it's also present in the newest version).
+
+### Please provide any additional information below.
+
+It would be nice if one could toggle whether consistency check may run while not plugged into AC.
diff --git a/doc/todo/notifications.mdwn b/doc/todo/notifications.mdwn
--- a/doc/todo/notifications.mdwn
+++ b/doc/todo/notifications.mdwn
@@ -1,3 +1,6 @@
 Just started today with git-annex and it looks great replacement for proprietary syncing solutions (well in allot of aspects it's much better than proprietary solutions) but I do believe desktop and email notifications are must have features.
 
 I think these services would be nice to have: growl, libnotify, email, twitter (publicly sharing with a group or repository stored on public server for users to download).  
+
+> git-annex has desktop notifications. I think that if you want something
+> beyond that, you should script it. So, [[done]] --[[Joey]]
diff --git a/doc/todo/openwrt_package/comment_4_132e67b34f9c616217e037e4ecac70a4._comment b/doc/todo/openwrt_package/comment_4_132e67b34f9c616217e037e4ecac70a4._comment
new file mode 100644
--- /dev/null
+++ b/doc/todo/openwrt_package/comment_4_132e67b34f9c616217e037e4ecac70a4._comment
@@ -0,0 +1,8 @@
+[[!comment format=mdwn
+ username="joey"
+ subject="""comment 4"""
+ date="2015-01-13T20:39:53Z"
+ content="""
+I checked, and the current status is that mips and mipsel in Debian have
+up-to-date builds of ghc and git-annex.
+"""]]
diff --git a/doc/todo/resuming_encrypted_uploads.mdwn b/doc/todo/resuming_encrypted_uploads.mdwn
--- a/doc/todo/resuming_encrypted_uploads.mdwn
+++ b/doc/todo/resuming_encrypted_uploads.mdwn
@@ -20,3 +20,10 @@
 The question, then, is whether resuming uploads is useful enough to add
 this overhead and user-visible complexity.
 --[[Joey]] 
+
+> The new-style chunking code chunks and then encrypts. This means that
+> each individual chunk is a stand-alone file that can be decrypted later,
+> and so resumes of uploads to encrypted, chunked remotes works now.
+>
+> I think that's better than the ideas discussed above, so [[done]]
+> --[[Joey]]
diff --git a/doc/todo/view_git_annex_log_in_webapp.mdwn b/doc/todo/view_git_annex_log_in_webapp.mdwn
--- a/doc/todo/view_git_annex_log_in_webapp.mdwn
+++ b/doc/todo/view_git_annex_log_in_webapp.mdwn
@@ -3,3 +3,5 @@
 A must have feature for me is to be able to view git annex log in the web app as "git annex log" doesn't got BIDI support (RTL scripts like Arabic, Farsi, Hebrew).
 Adding Bi-directional text support would be too much to ask from a developer that don't know these languages thus the solution is to use the already the web browser to handle that.
 
+> Closing as it's not clear what the submitter wanted done here. [[done]]
+> --[[Joey]]
diff --git a/doc/tuning.mdwn b/doc/tuning.mdwn
new file mode 100644
--- /dev/null
+++ b/doc/tuning.mdwn
@@ -0,0 +1,46 @@
+git-annex now has experimental support for tuning a repository for
+different work loads. 
+
+For example, a repository with a very large number of files in it may work
+better if git-annex uses some nonstandard hash format, for either the
+`.git/annex/objects/` directory, or for the log files in the git-annex
+branch.
+
+A repository can currently only be tuned when it is first created; this is
+done by passing `-c name=value` parameters to `git annex init`.
+
+For example, this will make git-annex use only 1 level for hash directories
+in `.git/annex/objects`:
+
+	git -c annex.tune.objecthash1=true annex init
+
+It's very important to keep in mind that this makes a nonstandard format
+git-annex repository. In general, this cannot safely be used with
+git-annex older than version 5.20150128. Older version of git-annex will
+not understand and will get confused and perhaps do bad things.
+
+Also, it's not safe to merge two separate git repositories that have been
+tuned differently (or one tuned and the other one not). git-annex will
+prevent merging their git-annex branches together, but it cannot prevent
+`git merge remote/master` merging two branches, and the result will be ugly
+at best (`git annex fix` can fix up the mess somewhat).
+
+Again, tuned repositories are an experimental feature; use with caution!
+
+The following tuning parameters are available:
+
+* `annex.tune.objecthash1=true`  
+  Use just one level of hash directories in `.git/annex/objects/`,
+  instead of the default two levels.
+
+* `annex.tune.objecthashlower=true`  
+  Make the hash directories in `.git/annex/objects/` use
+  all lower-case, instead of the default mixed-case.
+
+* `annex.tune.branchhash1=true`  
+  Use just one level of hash directories in the git-annex branch,
+  instead of the default two levels.
+
+Note that git-annex will automatically propigate these setting to
+`.git/config` for tuned repositories. You should never directly change
+these settings in `.git/config`
diff --git a/doc/tuning/comment_1_f8af8e9b696d32d238ebd56a3b8058c4._comment b/doc/tuning/comment_1_f8af8e9b696d32d238ebd56a3b8058c4._comment
new file mode 100644
--- /dev/null
+++ b/doc/tuning/comment_1_f8af8e9b696d32d238ebd56a3b8058c4._comment
@@ -0,0 +1,17 @@
+[[!comment format=mdwn
+ username="https://www.google.com/accounts/o8/id?id=AItOawnx8kHW66N3BqmkVpgtXDlYMvr8TJ5VvfY"
+ nickname="Yaroslav"
+ subject="annex.tune.objecthashlower=true is not just "lower" letters used but a different strategy altogether"
+ date="2015-02-01T02:58:26Z"
+ content="""
+it starts to use 2 levels (even if annex.tune.objecthash1=true) of hash directories having 3 characters in the filename at each level.  So it is not just \"taken existing hash directories (1 or 2 levels) and use their lower-case version.  It is a different way to create the hash directories:
+
+e.g.  one with objecthas1=true
+
+1 -> .git/annex/objects/qj/SHA256E-s6--ecdc5536f73bdae8816f0ea40726ef5e9b810d914493075903bb90623d97b1d8/SHA256E-s6--ecdc5536f73bdae8816f0ea40726ef5e9b810d914493075903bb90623d97b1d8
+
+and if I provide all three options at once:
+
+1 -> .git/annex/objects/ccf/a40/SHA256E-s6--ecdc5536f73bdae8816f0ea40726ef5e9b810d914493075903bb90623d97b1d8/SHA256E-s6--ecdc5536f73bdae8816f0ea40726ef5e9b810d914493075903bb90623d97b1d8
+
+"""]]
diff --git a/doc/tuning/comment_2_a0091dbb39b79dfe101d05f9a5db216f._comment b/doc/tuning/comment_2_a0091dbb39b79dfe101d05f9a5db216f._comment
new file mode 100644
--- /dev/null
+++ b/doc/tuning/comment_2_a0091dbb39b79dfe101d05f9a5db216f._comment
@@ -0,0 +1,12 @@
+[[!comment format=mdwn
+ username="joey"
+ subject="""comment 2"""
+ date="2015-02-04T17:09:41Z"
+ content="""
+Right, it's not simply lower-casing but a different hash strategy
+as described in [[internals/hashing]].
+
+Combining annex.tune.objecthashlower and annex.tune.objecthash1 will
+result in one level of hash directories. If you get two levels then
+you probabaly typoed "objecthas1" ...
+"""]]
diff --git a/doc/use_case/Bob.mdwn b/doc/use_case/Bob.mdwn
--- a/doc/use_case/Bob.mdwn
+++ b/doc/use_case/Bob.mdwn
@@ -19,7 +19,7 @@
 [[more about future-proofing|future_proofing]]
 
 Run in a cron job, git-annex adds new files to archival drives at night. It
-also helps Bob keep track of intentional, and unintentional copies of
+also helps Bob keep track of intentional and unintentional copies of
 files, and logs information he can use to decide when it's time to duplicate
 the content of old drives.  
 [[more about backup copies|copies]]
diff --git a/doc/users/joey.mdwn b/doc/users/joey.mdwn
--- a/doc/users/joey.mdwn
+++ b/doc/users/joey.mdwn
@@ -1,2 +1,2 @@
-Joey Hess   
-
+Joey Hess   
+
diff --git a/doc/walkthrough.mdwn b/doc/walkthrough.mdwn
--- a/doc/walkthrough.mdwn
+++ b/doc/walkthrough.mdwn
@@ -14,6 +14,7 @@
 	walkthrough/removing_files:_When_things_go_wrong
 	walkthrough/modifying_annexed_files
 	walkthrough/using_ssh_remotes
+	walkthrough/using_special_remotes
 	walkthrough/moving_file_content_between_repositories
 	walkthrough/quiet_please:_When_git-annex_seems_to_skip_files
 	walkthrough/using_tags_and_branches
diff --git a/doc/walkthrough/renaming_files.mdwn b/doc/walkthrough/renaming_files.mdwn
--- a/doc/walkthrough/renaming_files.mdwn
+++ b/doc/walkthrough/renaming_files.mdwn
@@ -14,5 +14,4 @@
 
 (Note that if a repository is in direct mode, you can't run normal git
 commands in it. Instead, just move the files using non-git commands, and
-`git annex add` and `git annex sync`. This walkthrough does not make a
-direct mode repository.)
+`git annex add` and `git annex sync`.)
diff --git a/doc/walkthrough/using_special_remotes.mdwn b/doc/walkthrough/using_special_remotes.mdwn
new file mode 100644
--- /dev/null
+++ b/doc/walkthrough/using_special_remotes.mdwn
@@ -0,0 +1,53 @@
+We've seen above that git-annex can be used to store files in
+regular git remotes, accessed either via ssh, or on a removable drive. But
+git-annex can also store files in Amazon S3, Glacier, on a rsync server, in
+WebDAV, or even pull files down from the web and bittorrent.
+This and much more is made possible by [[special_remotes]].
+
+These are not normal git repositories; indeed the git repository is not
+stored on a special remote. But git-annex can store the contents of files
+in special remotes, and operate on them much as it would on any other
+remote. Bonus: Files stored on special remotes can easily be
+[[encrypted|encryption]]!
+
+All you need to get started using a special remote is to initialize it.
+This is done using the `git annex initremote` command, which needs to be
+passed different parameters depending on the type of special remote.
+
+Some special remotes also need things like passwords to be set in
+environment variables. Don't worry -- it will prompt if you leave anything off.
+So feel free to make any kind of special remote instead of the S3 remote
+used in this example.
+
+	# export AWS_ACCESS_KEY_ID="somethingotherthanthis"
+	# export AWS_SECRET_ACCESS_KEY="s3kr1t"
+	# git annex initremote mys3 type=S3 chunk=1MiB encryption=shared
+	initremote mys3 (shared encryption) (checking bucket) (creating bucket in US) ok
+
+Now you can store files on the newly initialized special remote.
+
+	# git annex copy my_cool_big_file --to mys3
+	copy my_cool_big_file (to mys3...) ok
+
+Once you've initialized a special remote in one repository, you can enable
+use of the same special remote in other clones of the repository.
+If the mys3 remote above was initialized on your laptop, you'll also want
+to enable it on your desktop.
+
+To do so, first get git-annex in sync (so it knows about
+the special remote that was added in the other repository), and then
+use `git annex enableremote`.
+
+	desktop# git annex sync
+	desktop# export AWS_ACCESS_KEY_ID="somethingotherthanthis"
+	desktop# export AWS_SECRET_ACCESS_KEY="s3kr1t"
+	desktop# git annex enableremote mys3
+	enableremote mys3 (checking bucket) ok
+
+And now you can download files from the special remote:
+
+	desktop# git annex get my_cool_big_file --from mys3
+	get my_cool_big_file (from mys3...) ok
+
+This has only scratched the surface of what can be done with
+[[special_remotes]].
diff --git a/doc/walkthrough/using_ssh_remotes.mdwn b/doc/walkthrough/using_ssh_remotes.mdwn
--- a/doc/walkthrough/using_ssh_remotes.mdwn
+++ b/doc/walkthrough/using_ssh_remotes.mdwn
@@ -5,13 +5,13 @@
 Say you have a desktop on the same network as your laptop and want
 to clone the laptop's annex to it:
 
-	# git clone ssh://mylaptop/home/me/annex ~/annex
-	# cd ~/annex
-	# git annex init "my desktop"
+	desktop# git clone ssh://mylaptop/home/me/annex ~/annex
+	desktop# cd ~/annex
+	desktop# git annex init "my desktop"
 
 Now you can get files and they will be transferred (using `rsync` via `ssh`):
 
-	# git annex get my_cool_big_file
+	desktop# git annex get my_cool_big_file
 	get my_cool_big_file (getting UUID for origin...) (from origin...)
 	SHA256-s86050597--6ae2688bc533437766a48aa19f2c06be14d1bab9c70b468af445d4f07b65f41e  100% 2159     2.1KB/s   00:00
 	ok
@@ -19,7 +19,7 @@
 When you drop files, git-annex will ssh over to the remote and make
 sure the file's content is still there before removing it locally:
 
-	# git annex drop my_cool_big_file
+	desktop# git annex drop my_cool_big_file
 	drop my_cool_big_file (checking origin..) ok
 
 Note that normally git-annex prefers to use non-ssh remotes, like
diff --git a/git-annex-shell.1 b/git-annex-shell.1
--- a/git-annex-shell.1
+++ b/git-annex-shell.1
@@ -105,7 +105,7 @@
 git\-shell(1)
 .PP
 .SH AUTHOR
-Joey Hess 
+Joey Hess 
 .PP
 
 .PP
diff --git a/git-annex.1 b/git-annex.1
--- a/git-annex.1
+++ b/git-annex.1
@@ -160,6 +160,8 @@
 This behavior can be overridden by configuring the preferred content of
 a repository. See see PREFERRED CONTENT below.
 .IP
+The \fB\-\-message\fP or \fB\-m\fP option can be used to specify a commit message.
+.IP
 .IP "\fBmerge\fP"
 This performs the same merging (and merge conflict resolution)
 that is done by the sync command, but without pushing or pulling any data.
@@ -199,8 +201,10 @@
 is there at a future point, specify \fB\-\-relaxed\fP. (Implies \fB\-\-fast\fP.)
 .IP
 Normally the filename is based on the full url, so will look like
-"www.example.com_dir_subdir_bigfile". For a shorter filename, specify
-\fB\-\-pathdepth=N\fP. For example, \fB\-\-pathdepth=1\fP will use "dir/subdir/bigfile",
+"www.example.com_dir_subdir_bigfile". In some cases, addurl is able to
+come up with a better filename based on other information. Or, for a
+shorter filename, specify \fB\-\-pathdepth=N\fP. For example,
+\fB\-\-pathdepth=1\fP will use "dir/subdir/bigfile",
 while \fB\-\-pathdepth=3\fP will use "bigfile". It can also be negative;
 \fB\-\-pathdepth=\-2\fP will use the last two parts of the url.
 .IP
@@ -644,9 +648,11 @@
 To generate output suitable for the gource visualization program,
 specify \fB\-\-gource\fP.
 .IP
-.IP "\fBinfo [directory|file|remote ...]\fP"
+.IP "\fBinfo [directory|file|remote|uuid ...]\fP"
 Displays statistics and other information for the specified item,
-which can be a directory, or a file, or a remote.
+which can be a directory, or a file, or a remote, or the uuid of a
+repository. 
+.IP
 When no item is specified, displays statistics and information
 for the repository as a whole.
 .IP
@@ -1641,6 +1647,11 @@
 Used by hook special remotes and external special remotes to record
 the type of the remote.
 .IP
+.IP "\fBannex.tune.objecthash1\fP, \fBannex.tune.objecthashlower\fP, \fBannex.tune.branchhash1\fP"
+These can be passed to \fBgit annex init\fP to tune the repository.
+They cannot be safely changed in a running repository.
+For details, see .
+.IP
 .SH CONFIGURATION VIA .gitattributes
 The key\-value backend used when adding a new file to the annex can be
 configured on a per\-file\-type basis via \fB.gitattributes\fP files. In the file,
@@ -1696,7 +1707,7 @@
 should be included, in, for example, \fB/usr/share/doc/git\-annex/\fP.
 .PP
 .SH AUTHOR
-Joey Hess 
+Joey Hess 
 .PP
 
 .PP
diff --git a/git-annex.cabal b/git-annex.cabal
--- a/git-annex.cabal
+++ b/git-annex.cabal
@@ -1,8 +1,8 @@
 Name: git-annex
-Version: 5.20150113
+Version: 5.20150205
 Cabal-Version: >= 1.8
 License: GPL-3
-Maintainer: Joey Hess 
+Maintainer: Joey Hess 
 Author: Joey Hess
 Stability: Stable
 Copyright: 2010-2014 Joey Hess
@@ -87,9 +87,6 @@
 Flag Tahoe
   Description: Enable the tahoe special remote
 
-Flag CryptoHash
-  Description: Enable use of cryptohash for checksumming
-
 Flag DesktopNotify
   Description: Enable desktop environment notifications
 
@@ -112,7 +109,8 @@
    base (>= 4.5 && < 4.9), monad-control, exceptions (>= 0.6), transformers,
    IfElse, text, QuickCheck >= 2.1, bloomfilter, edit-distance,
    SafeSemaphore, uuid, random, dlist, unix-compat, async, stm (>= 2.3),
-   data-default, case-insensitive, http-conduit, http-types
+   data-default, case-insensitive, http-conduit, http-types,
+   cryptohash (>= 0.10.0)
   CC-Options: -Wall
   GHC-Options: -Wall
   Extensions: PackageImports
@@ -148,10 +146,6 @@
     CPP-Options: -DWITH_TDFA
   else
     Build-Depends: regex-compat
-  
-  if flag(CryptoHash)
-    Build-Depends: cryptohash (>= 0.10.0)
-    CPP-Options: -DWITH_CRYPTOHASH
 
   if flag(S3)
     Build-Depends: conduit, resourcet, conduit-extra, aws (>= 0.9.2), http-client
diff --git a/git-annex.hs b/git-annex.hs
--- a/git-annex.hs
+++ b/git-annex.hs
@@ -1,6 +1,6 @@
 {- git-annex main program dispatch
  -
- - Copyright 2010-2014 Joey Hess 
+ - Copyright 2010-2014 Joey Hess 
  -
  - Licensed under the GNU GPL version 3 or higher.
  -}
@@ -9,6 +9,7 @@
 
 import System.Environment (getArgs, getProgName)
 import System.FilePath
+import Network.Socket (withSocketsDo)
 
 import qualified CmdLine.GitAnnex
 import qualified CmdLine.GitAnnexShell
@@ -22,7 +23,7 @@
 #endif
 
 main :: IO ()
-main = do
+main = withSocketsDo $ do
 	ps <- getArgs
 	run ps =<< getProgName
   where
diff --git a/git-union-merge.hs b/git-union-merge.hs
--- a/git-union-merge.hs
+++ b/git-union-merge.hs
@@ -1,6 +1,6 @@
 {- git-union-merge program
  -
- - Copyright 2011 Joey Hess 
+ - Copyright 2011 Joey Hess 
  -
  - Licensed under the GNU GPL version 3 or higher.
  -}