diff options
60 files changed, 657 insertions, 78 deletions
diff --git a/Annex/AutoMerge.hs b/Annex/AutoMerge.hs index f0f183dfb..5ffa7b073 100644 --- a/Annex/AutoMerge.hs +++ b/Annex/AutoMerge.hs @@ -37,7 +37,7 @@ import qualified Data.Set as S - Callers should use Git.Branch.changed first, to make sure that - there are changed from the current branch to the branch being merged in. -} -autoMergeFrom :: Git.Ref -> (Maybe Git.Ref) -> Git.Branch.CommitMode -> Annex Bool +autoMergeFrom :: Git.Ref -> Maybe Git.Ref -> Git.Branch.CommitMode -> Annex Bool autoMergeFrom branch currbranch commitmode = do showOutput case currbranch of diff --git a/Annex/Content.hs b/Annex/Content.hs index 17050224d..9d70ccee3 100644 --- a/Annex/Content.hs +++ b/Annex/Content.hs @@ -538,7 +538,7 @@ getKeysPresent keyloc = do -} getstate direct = do when direct $ - void $ inodesChanged + void inodesChanged Annex.getState id {- Things to do to record changes to content when shutting down. diff --git a/Annex/Content/Direct.hs b/Annex/Content/Direct.hs index e6a9b5eda..86e053d7f 100644 --- a/Annex/Content/Direct.hs +++ b/Annex/Content/Direct.hs @@ -257,7 +257,7 @@ annexSentinalFile :: Annex SentinalFile annexSentinalFile = do sentinalfile <- fromRepo gitAnnexInodeSentinal sentinalcachefile <- fromRepo gitAnnexInodeSentinalCache - return $ SentinalFile + return SentinalFile { sentinalFile = sentinalfile , sentinalCacheFile = sentinalcachefile } diff --git a/Annex/Difference.hs b/Annex/Difference.hs index 66dc03a32..e0dc17da7 100644 --- a/Annex/Difference.hs +++ b/Annex/Difference.hs @@ -38,10 +38,10 @@ setDifferences = do ( do oldds <- recordedDifferencesFor u when (ds /= oldds) $ - warning $ "Cannot change tunable parameters in already initialized repository." + warning "Cannot change tunable parameters in already initialized repository." return oldds , if otherds == mempty - then ifM (not . null . filter (/= u) . M.keys <$> uuidMap) + then ifM (any (/= u) . M.keys <$> uuidMap) ( do warning "Cannot change tunable parameters in a clone of an existing repository." return mempty diff --git a/Annex/DirHashes.hs b/Annex/DirHashes.hs index 03769350d..91c3e7817 100644 --- a/Annex/DirHashes.hs +++ b/Annex/DirHashes.hs @@ -46,7 +46,7 @@ configHashLevels d config | otherwise = def branchHashDir :: GitConfig -> Key -> String -branchHashDir config key = hashDirLower (branchHashLevels config) key +branchHashDir = hashDirLower . branchHashLevels {- Two different directory hashes may be used. The mixed case hash - came first, and is fine, except for the problem of case-strict diff --git a/Annex/FileMatcher.hs b/Annex/FileMatcher.hs index 0de4d83d1..9677e65dd 100644 --- a/Annex/FileMatcher.hs +++ b/Annex/FileMatcher.hs @@ -24,10 +24,10 @@ import Types.Remote (RemoteConfig) import Data.Either import qualified Data.Set as S -checkFileMatcher :: (FileMatcher Annex) -> FilePath -> Annex Bool +checkFileMatcher :: FileMatcher Annex -> FilePath -> Annex Bool checkFileMatcher matcher file = checkMatcher matcher Nothing (Just file) S.empty True -checkMatcher :: (FileMatcher Annex) -> Maybe Key -> AssociatedFile -> AssumeNotPresent -> Bool -> Annex Bool +checkMatcher :: FileMatcher Annex -> Maybe Key -> AssociatedFile -> AssumeNotPresent -> Bool -> Annex Bool checkMatcher matcher mkey afile notpresent d | isEmpty matcher = return d | otherwise = case (mkey, afile) of diff --git a/Annex/MetaData.hs b/Annex/MetaData.hs index 3b776a6d7..0751bbb49 100644 --- a/Annex/MetaData.hs +++ b/Annex/MetaData.hs @@ -36,7 +36,7 @@ import Data.Time.Clock.POSIX -} genMetaData :: Key -> FilePath -> FileStatus -> Annex () genMetaData key file status = do - maybe noop (flip copyMetaData key) =<< catKeyFileHEAD file + maybe noop (`copyMetaData` key) =<< catKeyFileHEAD file whenM (annexGenMetaData <$> Annex.getGitConfig) $ do curr <- getCurrentMetaData key addMetaData key (dateMetaData mtime curr) @@ -52,4 +52,4 @@ dateMetaData mtime old = MetaData $ M.fromList $ filter isnew ] where isnew (f, _) = S.null (currentMetaDataValues f old) - (y, m, _d) = toGregorian $ utctDay $ mtime + (y, m, _d) = toGregorian $ utctDay mtime diff --git a/Annex/Notification.hs b/Annex/Notification.hs index 25f1ee678..a7b757e50 100644 --- a/Annex/Notification.hs +++ b/Annex/Notification.hs @@ -43,7 +43,7 @@ notifyTransfer direction (Just f) a = do return ok else a NotifyWitness #else -notifyTransfer _ (Just _) a = do a NotifyWitness +notifyTransfer _ (Just _) a = a NotifyWitness #endif notifyDrop :: Maybe FilePath -> Bool -> Annex () diff --git a/Annex/View.hs b/Annex/View.hs index 315cc7df2..2b8a80e5f 100644 --- a/Annex/View.hs +++ b/Annex/View.hs @@ -314,7 +314,7 @@ getViewedFileMetaData = getDirMetaData . dirFromViewedFile . takeFileName - branch for the view. -} applyView :: View -> Annex Git.Branch -applyView view = applyView' viewedFileFromReference getWorkTreeMetaData view +applyView = applyView' viewedFileFromReference getWorkTreeMetaData {- Generates a new branch for a View, which must be a more narrow - version of the View originally used to generate the currently diff --git a/Build/Configure.hs b/Build/Configure.hs index 4498838a1..c90231b29 100644 --- a/Build/Configure.hs +++ b/Build/Configure.hs @@ -94,12 +94,15 @@ getUpgradeLocation = do return $ Config "upgradelocation" $ MaybeStringConfig e getGitVersion :: Test -getGitVersion = do - v <- Git.Version.installed - let oldestallowed = Git.Version.normalize "1.7.1.0" - when (v < oldestallowed) $ - error $ "installed git version " ++ show v ++ " is too old! (Need " ++ show oldestallowed ++ " or newer)" - return $ Config "gitversion" $ StringConfig $ show v +getGitVersion = go =<< getEnv "FORCE_GIT_VERSION" + where + go (Just s) = return $ Config "gitversion" $ StringConfig s + go Nothing = do + v <- Git.Version.installed + let oldestallowed = Git.Version.normalize "1.7.1.0" + when (v < oldestallowed) $ + error $ "installed git version " ++ show v ++ " is too old! (Need " ++ show oldestallowed ++ " or newer)" + return $ Config "gitversion" $ StringConfig $ show v checkWgetQuietProgress :: Test checkWgetQuietProgress = Config "wgetquietprogress" . BoolConfig diff --git a/Build/NullSoftInstaller.hs b/Build/NullSoftInstaller.hs index 846c8d621..42260bd3f 100644 --- a/Build/NullSoftInstaller.hs +++ b/Build/NullSoftInstaller.hs @@ -85,8 +85,14 @@ uninstaller = "git-annex-uninstall.exe" gitInstallDir :: Exp FilePath
gitInstallDir = fromString "$PROGRAMFILES\\Git"
+-- This intentionall has a different name than git-annex or
+-- git-annex-webapp, since it is itself treated as an executable file.
+-- Also, on XP, the filename is displayed, not the description.
startMenuItem :: Exp FilePath
-startMenuItem = "$SMPROGRAMS/git-annex.lnk"
+startMenuItem = "$SMPROGRAMS/Git Annex (Webapp).lnk"
+
+oldStartMenuItem :: Exp FilePath
+oldStartMenuItem = "$SMPROGRAMS/git-annex.lnk"
autoStartItem :: Exp FilePath
autoStartItem = "$SMSTARTUP/git-annex-autostart.lnk"
@@ -125,8 +131,9 @@ makeInstaller gitannex license htmlhelp extrabins launchers = nsis $ do , StartOptions "SW_SHOWNORMAL"
, IconFile "$INSTDIR/cmd/git-annex.exe"
, IconIndex 2
- , Description "git-annex webapp"
+ , Description "Git Annex (Webapp)"
]
+ delete [RebootOK] $ oldStartMenuItem
createShortcut autoStartItem
[ Target "wscript.exe"
, Parameters "\"$INSTDIR/git-annex-autostart.vbs\""
diff --git a/Command/Info.hs b/Command/Info.hs index db5953050..b7cb3232f 100644 --- a/Command/Info.hs +++ b/Command/Info.hs @@ -10,7 +10,7 @@ module Command.Info where import "mtl" Control.Monad.State.Strict -import qualified Data.Map as M +import qualified Data.Map.Strict as M import Text.JSON import Data.Tuple import Data.Ord @@ -66,7 +66,7 @@ instance Show Variance where data StatInfo = StatInfo { presentData :: Maybe KeyData , referencedData :: Maybe KeyData - , remoteData :: M.Map UUID KeyData + , repoData :: M.Map UUID KeyData , numCopiesStats :: Maybe NumCopiesStats } @@ -77,7 +77,7 @@ emptyStatInfo = StatInfo Nothing Nothing M.empty Nothing type StatState = StateT StatInfo Annex cmd :: [Command] -cmd = [noCommit $ dontCheck repoExists $ withOptions (jsonOption : annexedMatchingOptions) $ +cmd = [noCommit $ dontCheck repoExists $ withOptions (jsonOption : bytesOption : annexedMatchingOptions) $ command "info" (paramOptional $ paramRepeating paramItem) seek SectionQuery "shows information about the specified item or the repository as a whole"] @@ -156,9 +156,9 @@ selStats fast_stats slow_stats = do global_fast_stats :: [Stat] global_fast_stats = [ repository_mode - , remote_list Trusted - , remote_list SemiTrusted - , remote_list UnTrusted + , repo_list Trusted + , repo_list SemiTrusted + , repo_list UnTrusted , transfer_list , disk_size ] @@ -184,6 +184,7 @@ dir_fast_stats = dir_slow_stats :: [FilePath -> Stat] dir_slow_stats = [ const numcopies_stats + , const reposizes_stats ] file_stats :: FilePath -> Key -> [Stat] @@ -245,8 +246,8 @@ repository_mode = simpleStat "repository mode" $ lift $ ) ) -remote_list :: TrustLevel -> Stat -remote_list level = stat n $ nojson $ lift $ do +repo_list :: TrustLevel -> Stat +repo_list level = stat n $ nojson $ lift $ do us <- filter (/= NoUUID) . M.keys <$> (M.union <$> uuidMap <*> remoteMap Remote.name) rs <- fst <$> trustPartition level us @@ -290,7 +291,7 @@ local_annex_keys = stat "local annex keys" $ json show $ local_annex_size :: Stat local_annex_size = simpleStat "local annex size" $ - showSizeKeys <$> cachedPresentData + lift . showSizeKeys =<< cachedPresentData remote_annex_keys :: UUID -> Stat remote_annex_keys u = stat "remote annex keys" $ json show $ @@ -298,7 +299,7 @@ remote_annex_keys u = stat "remote annex keys" $ json show $ remote_annex_size :: UUID -> Stat remote_annex_size u = simpleStat "remote annex size" $ - showSizeKeys <$> cachedRemoteData u + lift . showSizeKeys =<< cachedRemoteData u known_annex_files :: Stat known_annex_files = stat "annexed files in working tree" $ json show $ @@ -306,7 +307,7 @@ known_annex_files = stat "annexed files in working tree" $ json show $ known_annex_size :: Stat known_annex_size = simpleStat "size of annexed files in working tree" $ - showSizeKeys <$> cachedReferencedData + lift . showSizeKeys =<< cachedReferencedData tmp_size :: Stat tmp_size = staleSize "temporary object directory size" gitAnnexTmpObjectDir @@ -315,7 +316,7 @@ bad_data_size :: Stat bad_data_size = staleSize "bad keys size" gitAnnexBadDir key_size :: Key -> Stat -key_size k = simpleStat "size" $ pure $ showSizeKeys $ foldKeys [k] +key_size k = simpleStat "size" $ lift $ showSizeKeys $ foldKeys [k] key_name :: Key -> Stat key_name k = simpleStat "key" $ pure $ key2file k @@ -331,7 +332,8 @@ bloom_info = simpleStat "bloom filter size" $ do -- Two bloom filters are used at the same time, so double the size -- of one. - size <- roughSize memoryUnits False . (* 2) . fromIntegral . fst <$> + sizer <- lift mkSizer + size <- sizer memoryUnits False . (* 2) . fromIntegral . fst <$> lift Command.Unused.bloomBitsHashes return $ size ++ note @@ -358,13 +360,14 @@ disk_size = simpleStat "available local disk space" $ lift $ calcfree <$> (annexDiskReserve <$> Annex.getGitConfig) <*> inRepo (getDiskFree . gitAnnexDir) + <*> mkSizer where - calcfree reserve (Just have) = unwords - [ roughSize storageUnits False $ nonneg $ have - reserve - , "(+" ++ roughSize storageUnits False reserve + calcfree reserve (Just have) sizer = unwords + [ sizer storageUnits False $ nonneg $ have - reserve + , "(+" ++ sizer storageUnits False reserve , "reserved)" ] - calcfree _ _ = "unknown" + calcfree _ _ _ = "unknown" nonneg x | x >= 0 = x @@ -389,6 +392,26 @@ numcopies_stats = stat "numcopies stats" $ nojson $ . map (\(variance, count) -> show variance ++ ": " ++ show count) . sortBy (flip (comparing snd)) . M.toList +reposizes_stats :: Stat +reposizes_stats = stat "repositories containing these files" $ nojson $ + calc + <$> lift uuidDescriptions + <*> lift mkSizer + <*> cachedRepoData + where + calc descm sizer = multiLine + . format + . map (\(u, d) -> line descm sizer u d) + . sortBy (flip (comparing (sizeKeys . snd))) . M.toList + line descm sizer u d = (sz, fromUUID u ++ " -- " ++ desc) + where + sz = sizer storageUnits True (sizeKeys d) + desc = fromMaybe "" (M.lookup u descm) + format l = map (\(c1, c2) -> lpad maxc1 c1 ++ ": " ++ c2 ) l + where + maxc1 = maximum (map (length . fst) l) + lpad n s = (replicate (n - length s) ' ') ++ s + cachedPresentData :: StatState KeyData cachedPresentData = do s <- get @@ -402,11 +425,11 @@ cachedPresentData = do cachedRemoteData :: UUID -> StatState KeyData cachedRemoteData u = do s <- get - case M.lookup u (remoteData s) of + case M.lookup u (repoData s) of Just v -> return v Nothing -> do v <- foldKeys <$> lift (loggedKeysFor u) - put s { remoteData = M.insert u v (remoteData s) } + put s { repoData = M.insert u v (repoData s) } return v cachedReferencedData :: StatState KeyData @@ -424,17 +447,21 @@ cachedReferencedData = do cachedNumCopiesStats :: StatState (Maybe NumCopiesStats) cachedNumCopiesStats = numCopiesStats <$> get +-- currently only available for directory info +cachedRepoData :: StatState (M.Map UUID KeyData) +cachedRepoData = repoData <$> get + getDirStatInfo :: FilePath -> Annex StatInfo getDirStatInfo dir = do fast <- Annex.getState Annex.fast matcher <- Limit.getMatcher - (presentdata, referenceddata, numcopiesstats) <- + (presentdata, referenceddata, numcopiesstats, repodata) <- Command.Unused.withKeysFilesReferencedIn dir initial (update matcher fast) - return $ StatInfo (Just presentdata) (Just referenceddata) M.empty (Just numcopiesstats) + return $ StatInfo (Just presentdata) (Just referenceddata) repodata (Just numcopiesstats) where - initial = (emptyKeyData, emptyKeyData, emptyNumCopiesStats) - update matcher fast key file vs@(presentdata, referenceddata, numcopiesstats) = + initial = (emptyKeyData, emptyKeyData, emptyNumCopiesStats, M.empty) + update matcher fast key file vs@(presentdata, referenceddata, numcopiesstats, repodata) = ifM (matcher $ MatchingFile $ FileInfo file file) ( do !presentdata' <- ifM (inAnnex key) @@ -442,10 +469,13 @@ getDirStatInfo dir = do , return presentdata ) let !referenceddata' = addKey key referenceddata - !numcopiesstats' <- if fast - then return numcopiesstats - else updateNumCopiesStats key file numcopiesstats - return $! (presentdata', referenceddata', numcopiesstats') + (!numcopiesstats', !repodata') <- if fast + then return (numcopiesstats, repodata) + else do + locs <- Remote.keyLocations key + nc <- updateNumCopiesStats file numcopiesstats locs + return (nc, updateRepoData key locs repodata) + return $! (presentdata', referenceddata', numcopiesstats', repodata') , return vs ) @@ -465,22 +495,32 @@ addKey key (KeyData count size unknownsize backends) = {- All calculations strict to avoid thunks when repeatedly - applied to many keys. -} !count' = count + 1 - !backends' = M.insertWith' (+) (keyBackendName key) 1 backends + !backends' = M.insertWith (+) (keyBackendName key) 1 backends !size' = maybe size (+ size) ks !unknownsize' = maybe (unknownsize + 1) (const unknownsize) ks ks = keySize key -updateNumCopiesStats :: Key -> FilePath -> NumCopiesStats -> Annex NumCopiesStats -updateNumCopiesStats key file (NumCopiesStats m) = do - !variance <- Variance <$> numCopiesCheck file key (-) - let !m' = M.insertWith' (+) variance 1 m +updateRepoData :: Key -> [UUID] -> M.Map UUID KeyData -> M.Map UUID KeyData +updateRepoData key locs m = m' + where + !m' = M.unionWith (\_old new -> new) m $ + M.fromList $ zip locs (map update locs) + update loc = addKey key (fromMaybe emptyKeyData $ M.lookup loc m) + +updateNumCopiesStats :: FilePath -> NumCopiesStats -> [UUID] -> Annex NumCopiesStats +updateNumCopiesStats file (NumCopiesStats m) locs = do + have <- trustExclude UnTrusted locs + !variance <- Variance <$> numCopiesCheck' file (-) have + let !m' = M.insertWith (+) variance 1 m let !ret = NumCopiesStats m' return ret -showSizeKeys :: KeyData -> String -showSizeKeys d = total ++ missingnote +showSizeKeys :: KeyData -> Annex String +showSizeKeys d = do + sizer <- mkSizer + return $ total sizer ++ missingnote where - total = roughSize storageUnits False $ sizeKeys d + total sizer = sizer storageUnits False $ sizeKeys d missingnote | unknownSizeKeys d == 0 = "" | otherwise = aside $ @@ -494,8 +534,9 @@ staleSize label dirspec = go =<< lift (dirKeys dirspec) go keys = onsize =<< sum <$> keysizes keys onsize 0 = nostat onsize size = stat label $ - json (++ aside "clean up with git-annex unused") $ - return $ roughSize storageUnits False size + json (++ aside "clean up with git-annex unused") $ do + sizer <- lift mkSizer + return $ sizer storageUnits False size keysizes keys = do dir <- lift $ fromRepo dirspec liftIO $ forM keys $ \k -> catchDefaultIO 0 $ @@ -506,3 +547,12 @@ aside s = " (" ++ s ++ ")" multiLine :: [String] -> String multiLine = concatMap (\l -> "\n\t" ++ l) + +mkSizer :: Annex ([Unit] -> Bool -> ByteSize -> String) +mkSizer = ifM (getOptionFlag bytesOption) + ( return (const $ const show) + , return roughSize + ) + +bytesOption :: Option +bytesOption = flagOption [] "bytes" "display file sizes in bytes" diff --git a/Config/NumCopies.hs b/Config/NumCopies.hs index b25e0818d..50dcdf684 100644 --- a/Config/NumCopies.hs +++ b/Config/NumCopies.hs @@ -11,9 +11,10 @@ module Config.NumCopies ( getFileNumCopies, getGlobalFileNumCopies, getNumCopies, - numCopiesCheck, deprecatedNumCopies, - defaultNumCopies + defaultNumCopies, + numCopiesCheck, + numCopiesCheck', ) where import Common.Annex @@ -75,6 +76,10 @@ getFileNumCopies' file = maybe getGlobalNumCopies (return . Just) =<< getattr - belived to exist, and the configured value. -} numCopiesCheck :: FilePath -> Key -> (Int -> Int -> v) -> Annex v numCopiesCheck file key vs = do - NumCopies needed <- getFileNumCopies file have <- trustExclude UnTrusted =<< Remote.keyLocations key + numCopiesCheck' file vs have + +numCopiesCheck' :: FilePath -> (Int -> Int -> v) -> [UUID] -> Annex v +numCopiesCheck' file vs have = do + NumCopies needed <- getFileNumCopies file return $ length have `vs` needed @@ -179,13 +179,13 @@ includeCredsInfo c storage info = do Just _ -> do let (uenv, penv) = credPairEnvironment storage ret $ "from environment variables (" ++ unwords [uenv, penv] ++ ")" - Nothing -> case (\ck -> M.lookup ck c) =<< credPairRemoteKey storage of + Nothing -> case (`M.lookup` c) =<< credPairRemoteKey storage of Nothing -> ifM (existsCacheCredPair storage) ( ret "stored locally" , ret "not available" ) Just _ -> case extractCipher c of - Just (EncryptedCipher _ _ _) -> ret "embedded in git repository (gpg encrypted)" + Just (EncryptedCipher {}) -> ret "embedded in git repository (gpg encrypted)" _ -> ret "embedded in git repository (not encrypted)" where ret s = return $ ("creds", s) : info diff --git a/Locations.hs b/Locations.hs index 7602a27e4..8b0b819e6 100644 --- a/Locations.hs +++ b/Locations.hs @@ -165,7 +165,7 @@ gitAnnexLink file key r config = do {- This special case is for git submodules on filesystems not - supporting symlinks; generate link target that will - work portably. -} - | coreSymlinks config == False && needsSubmoduleFixup r = + | not (coreSymlinks config) && needsSubmoduleFixup r = fromMaybe whoops $ absNormPathUnix currdir $ Git.repoPath r </> ".git" | otherwise = Git.localGitDir r @@ -83,7 +83,7 @@ remoteMap' mkv mkk = M.fromList . mapMaybe mk <$> remoteList Nothing -> Nothing Just k -> Just (k, mkv r) -{- Map of UUIDs of remotes and their descriptions. +{- Map of UUIDs of repositories and their descriptions. - The names of Remotes are added to suppliment any description that has - been set for a repository. -} uuidDescriptions :: Annex (M.Map UUID String) @@ -130,8 +130,7 @@ byName' n = go . filter matching <$> remoteList byNameOrGroup :: RemoteName -> Annex [Remote] byNameOrGroup n = go =<< getConfigMaybe (ConfigKey ("remotes." ++ n)) where - go (Just l) = concatMap maybeToList <$> - mapM (byName . Just) (split " " l) + go (Just l) = catMaybes <$> mapM (byName . Just) (split " " l) go Nothing = maybeToList <$> byName (Just n) {- Only matches remote name, not UUID -} @@ -343,4 +342,4 @@ claimingUrl url = do let web = Prelude.head $ filter (\r -> uuid r == webUUID) rs fromMaybe web <$> firstM checkclaim rs where - checkclaim = maybe (pure False) (flip id url) . claimUrl + checkclaim = maybe (pure False) (`id` url) . claimUrl diff --git a/Remote/BitTorrent.hs b/Remote/BitTorrent.hs index 2770f30ae..baba2e23e 100644 --- a/Remote/BitTorrent.hs +++ b/Remote/BitTorrent.hs @@ -212,7 +212,7 @@ downloadTorrentFile u = do downloadMagnetLink :: URLString -> FilePath -> FilePath -> Annex Bool downloadMagnetLink u metadir dest = ifM download ( liftIO $ do - ts <- filter (".torrent" `isPrefixOf`) + ts <- filter (".torrent" `isSuffixOf`) <$> dirContents metadir case ts of (t:[]) -> do diff --git a/Types/Difference.hs b/Types/Difference.hs index 74bac0aca..064703bf7 100644 --- a/Types/Difference.hs +++ b/Types/Difference.hs @@ -62,8 +62,8 @@ readDifferences :: String -> Differences readDifferences = maybe UnknownDifferences Differences . readish getDifferences :: Git.Repo -> Differences -getDifferences r = Differences $ S.fromList $ catMaybes $ - map getmaybe [minBound .. maxBound] +getDifferences r = Differences $ S.fromList $ + mapMaybe getmaybe [minBound .. maxBound] where getmaybe d = case Git.Config.isTrue =<< Git.Config.getMaybe (differenceConfigKey d) r of Just True -> Just d diff --git a/Types/Distribution.hs b/Types/Distribution.hs index 2a44a1575..d4de7a79b 100644 --- a/Types/Distribution.hs +++ b/Types/Distribution.hs @@ -25,7 +25,7 @@ type GitAnnexVersion = String data AutoUpgrade = AskUpgrade | AutoUpgrade | NoAutoUpgrade deriving (Eq) -toAutoUpgrade :: (Maybe String) -> AutoUpgrade +toAutoUpgrade :: Maybe String -> AutoUpgrade toAutoUpgrade Nothing = AskUpgrade toAutoUpgrade (Just s) | s == "ask" = AskUpgrade diff --git a/Utility/DataUnits.hs b/Utility/DataUnits.hs index 2ece14305..6e40932ef 100644 --- a/Utility/DataUnits.hs +++ b/Utility/DataUnits.hs @@ -42,6 +42,7 @@ module Utility.DataUnits ( bandwidthUnits, oldSchoolUnits, Unit(..), + ByteSize, roughSize, compareSizes, diff --git a/Utility/Path.hs b/Utility/Path.hs index 2675aa0f9..9f0737fe8 100644 --- a/Utility/Path.hs +++ b/Utility/Path.hs @@ -138,9 +138,15 @@ relPathDirToFile from to = relPathDirToFileAbs <$> absPath from <*> absPath to {- This requires the first path to be absolute, and the - second path cannot contain ../ or ./ + - + - On Windows, if the paths are on different drives, + - a relative path is not possible and the path is simply + - returned as-is. -} relPathDirToFileAbs :: FilePath -> FilePath -> FilePath -relPathDirToFileAbs from to = join s $ dotdots ++ uncommon +relPathDirToFileAbs from to + | takeDrive from /= takeDrive to = to + | otherwise = join s $ dotdots ++ uncommon where s = [pathSeparator] pfrom = split s from @@ -153,6 +159,7 @@ relPathDirToFileAbs from to = join s $ dotdots ++ uncommon prop_relPathDirToFile_basics :: FilePath -> FilePath -> Bool prop_relPathDirToFile_basics from to + | null from || null to = True | from == to = null r | otherwise = not (null r) where diff --git a/debian/changelog b/debian/changelog index 19dade5de..c29058ca6 100644 --- a/debian/changelog +++ b/debian/changelog @@ -1,11 +1,19 @@ git-annex (5.20150410) UNRELEASED; urgency=medium + * get, move, copy, mirror: Concurrent downloads and uploads are + now supported! For example: git-annex get -J10 * Fix activity log parsing, which caused the log to not retain activity from other uuids. * Union merge could fall over if there was a file in the repository with the same name as a git ref. Now fixed. - * get, move, copy, mirror: Concurrent downloads and uploads are - now supported! For example: git-annex get -J10 + * info dir: Added information about repositories that + contain files in the specified directory. + * info: Added --bytes option. + * Windows: Renamed start menu file to avoid loop in some versions + of Windows where the menu file is treated as a git-annex program. + * bittorrent: Fix handling of magnet links. + * Windows: Fixed support of remotes on other drives. + (A reversion introduced in version 5.20150113.) -- Joey Hess <id@joeyh.name> Thu, 09 Apr 2015 20:59:43 -0400 diff --git a/doc/bugs/Windows:_Annex_can_not_get_files.mdwn b/doc/bugs/Windows:_Annex_can_not_get_files.mdwn index 8f636138d..f23624032 100644 --- a/doc/bugs/Windows:_Annex_can_not_get_files.mdwn +++ b/doc/bugs/Windows:_Annex_can_not_get_files.mdwn @@ -158,3 +158,5 @@ ok C:\annex1>cd \annex2 """]] + +> [[fixed|done]]; a simple path calculation bug. --[[Joey]] diff --git a/doc/bugs/Windows:_Annex_can_not_get_files/comment_3_5039702d7676b4712bb2bf586a83e591._comment b/doc/bugs/Windows:_Annex_can_not_get_files/comment_3_5039702d7676b4712bb2bf586a83e591._comment new file mode 100644 index 000000000..f5878a2ed --- /dev/null +++ b/doc/bugs/Windows:_Annex_can_not_get_files/comment_3_5039702d7676b4712bb2bf586a83e591._comment @@ -0,0 +1,13 @@ +[[!comment format=mdwn + username="joey" + subject="""comment 3""" + date="2015-04-14T17:28:11Z" + content=""" +There is quite a lot of unrelated noise in this bug report. For example, +when you run "git annex init dir1", you're telling git-annex to refer to +that repository as "dir1". It should thus be unsuprising when it does in +whereis etc messages about that repository. + +This is a duplicate of +<http://git-annex.branchable.com/bugs/Windows:_repo_located_on_different_drive_letter_unavailable/> +"""]] diff --git a/doc/bugs/Windows:_repo_located_on_different_drive_letter_unavailable.mdwn b/doc/bugs/Windows:_repo_located_on_different_drive_letter_unavailable.mdwn index 311675126..070191a63 100644 --- a/doc/bugs/Windows:_repo_located_on_different_drive_letter_unavailable.mdwn +++ b/doc/bugs/Windows:_repo_located_on_different_drive_letter_unavailable.mdwn @@ -160,3 +160,5 @@ Latest sync command should inject annex-uuid to .config file, but it does not. F [remote "c"] url = C:\\Annex fetch = +refs/heads/*:refs/remotes/c/* + +> [[fixed|done]]; a simple path calculation bug. --[[Joey]] diff --git a/doc/bugs/Windows:_repo_located_on_different_drive_letter_unavailable/comment_3_418a94a7257c2c5eaa7e0febe93c33ab._comment b/doc/bugs/Windows:_repo_located_on_different_drive_letter_unavailable/comment_3_418a94a7257c2c5eaa7e0febe93c33ab._comment new file mode 100644 index 000000000..6641bb75d --- /dev/null +++ b/doc/bugs/Windows:_repo_located_on_different_drive_letter_unavailable/comment_3_418a94a7257c2c5eaa7e0febe93c33ab._comment @@ -0,0 +1,8 @@ +[[!comment format=mdwn + username="joey" + subject="""comment 3""" + date="2015-04-14T17:32:29Z" + content=""" +This is partly a bug in uuid discovery; however even after I manually fill +in the remote's annex-uuid, it cannot get the file. +"""]] diff --git a/doc/bugs/addurl_magnet_could_not_download_torrent_file.mdwn b/doc/bugs/addurl_magnet_could_not_download_torrent_file.mdwn new file mode 100644 index 000000000..f00a63a7a --- /dev/null +++ b/doc/bugs/addurl_magnet_could_not_download_torrent_file.mdwn @@ -0,0 +1,49 @@ +### Please describe the problem. + +Every time I try to `addurl` with `magnet:` I get this error message: + + could not download torrent file + +### What steps will reproduce the problem? + + git-annex addurl "magnet:?xt=urn:btih:b548b3b8efce813d71c9355832b4382680b8abf9" + +### What version of git-annex are you using? On what operating system? + +* git-annex 5.20150409 +* ubuntu 14.04 x64 + +### Please provide any additional information below. + +[[!format sh """ + +git-annex addurl magnet:?xt=urn:btih:b548b3b8efce813d71c9355832b4382680b8abf9 +(downloading torrent file...) + +04/13 17:16:15 [NOTICE] IPv4 DHT: listening on UDP port 6930 + +04/13 17:16:15 [NOTICE] IPv4 BitTorrent: listening on TCP port 6890 + +04/13 17:16:15 [NOTICE] IPv6 BitTorrent: listening on TCP port 6890 +[#3e3bb9 74KiB/74KiB(100%) CN:13 SD:1] +04/13 17:16:33 [NOTICE] Download complete: [METADATA]b548b3b8efce813d71c9355832b4382680b8abf9 + +04/13 17:16:33 [NOTICE] Saved metadata as ../.git/annex/misctmp/URL--magnet&c,63xt,61urn&cbtih&cb548b3b8efce813d71c9355832b4382680b8abf9/meta/b548b3b8efce813d71c9355832b4382680b8abf9.torrent. + +Download Results: +gid |stat|avg speed |path/URI +======+====+===========+======================================================= +3e3bb9|OK | 0B/s|[MEMORY][METADATA]b548b3b8efce813d71c9355832b4382680b8abf9 + +Status Legend: +(OK):download completed. +addurl magnet:?xt=urn:btih:b548b3b8efce813d71c9355832b4382680b8abf9 + could not download torrent file +failed +git-annex: addurl: 1 failed + +"""]] + +> Looking at the code, it was looking for a file prefixed by ".torrent", +> but of course that should be suffixed instead. So, [[fixed|done]] +> --[[Joey]] diff --git a/doc/bugs/commitBuffer:_invalid_argument___40__invalid_character__41__/comment_1_b56c847c5eda432a4330b4d853a25519._comment b/doc/bugs/commitBuffer:_invalid_argument___40__invalid_character__41__2/comment_1_b56c847c5eda432a4330b4d853a25519._comment index 43e6a390b..43e6a390b 100644 --- a/doc/bugs/commitBuffer:_invalid_argument___40__invalid_character__41__/comment_1_b56c847c5eda432a4330b4d853a25519._comment +++ b/doc/bugs/commitBuffer:_invalid_argument___40__invalid_character__41__2/comment_1_b56c847c5eda432a4330b4d853a25519._comment diff --git a/doc/bugs/encryption__61__none_doesn__39__t_work_with_enableremote.mdwn b/doc/bugs/encryption__61__none_doesn__39__t_work_with_enableremote.mdwn index 9eecdf5f5..991d05493 100644 --- a/doc/bugs/encryption__61__none_doesn__39__t_work_with_enableremote.mdwn +++ b/doc/bugs/encryption__61__none_doesn__39__t_work_with_enableremote.mdwn @@ -40,3 +40,5 @@ upgrade supported from repository versions: 0 1 2 4 # End of transcript or log. """]] + +[[!tag moreinfo]] diff --git a/doc/bugs/false_positives_from_fsck_in_bare_repo.mdwn b/doc/bugs/false_positives_from_fsck_in_bare_repo.mdwn index cb1163996..215db1178 100644 --- a/doc/bugs/false_positives_from_fsck_in_bare_repo.mdwn +++ b/doc/bugs/false_positives_from_fsck_in_bare_repo.mdwn @@ -43,3 +43,5 @@ $ # End of transcript or log. """]] + +[[!tag moreinfo]] diff --git a/doc/bugs/fsck_reports_unsolvable_problem.mdwn b/doc/bugs/fsck_reports_unsolvable_problem.mdwn new file mode 100644 index 000000000..d0164f8bc --- /dev/null +++ b/doc/bugs/fsck_reports_unsolvable_problem.mdwn @@ -0,0 +1,20 @@ +### Please describe the problem. + +On my bare git-annex repo, `git annex fsck -q` reports: + + ** No known copies exist of SHA256E-s1212237--d2edd369f6a9005e23f022c7d797b166c66b90defc561329dbafab9a0fc0c7fc.jpg + +`git log -SSA256E...` returns nothing. `git annex repair` and `git annex forget` do not fix the problem. + +This means that running `fsck` from cron or a script will now always fail. There should be a way to recover from this situation. + +### What steps will reproduce the problem? + +According to IRC this "can happen if you annexed a file and then deleted it without ever committing to git". + + +### What version of git-annex are you using? On what operating system? + +5.20140717 from Ubuntu utopic + +[[!tag confirmed]] diff --git a/doc/bugs/fsck_reports_unsolvable_problem/comment_1_2beb21b685cea7402ffbf84d247c30b2._comment b/doc/bugs/fsck_reports_unsolvable_problem/comment_1_2beb21b685cea7402ffbf84d247c30b2._comment new file mode 100644 index 000000000..e43ed96f5 --- /dev/null +++ b/doc/bugs/fsck_reports_unsolvable_problem/comment_1_2beb21b685cea7402ffbf84d247c30b2._comment @@ -0,0 +1,51 @@ +[[!comment format=mdwn + username="joey" + subject="""comment 1""" + date="2015-04-14T16:57:15Z" + content=""" +case 1 + +1. git annex add file +2. git annex drop --force file +3. git rm file +4. git commit -m nochange + +case 2 + +1. git annex add file +2. git commit -m added +3. git annex drop --force file +4. git rm file +5. git commit -m removed + +fsck --all, or fsck in a bare repo, will repport the same problem in either +case; the only difference being that in the latter case you can see that +the master branch's history (or some user branch) did once include the lost +file. In the former case, only the git-annex branch ever had a commit made +about the lost file. + +The only way to remove this message would be either remove the log file +from the git-annex branch, or teach fsck to ignore it. + +Due to union merge it's not as simple as deleting the log file. A `git +annex forget` type transition is needed to avoid merging the log file back in +from elsewhere. It's certianly doable using the transition infrastructure. + +Or, fsck could have its own blacklist of known problems to not warn about. +in some ways that's more complex; in others it's perhaps simpler since it +avoids the complexity needed to handle transitions. (forced pushing, branch +rewriting on merge, etc) + +Either way, I think the question is what UI to use to identify these keys. +Seems like the user would have to examine their repos's history and +understand whether they've hit case 1, or case 2, vs when a file they +really wanted to have available in the history has actually been lost. +Fsck could give some guidance, but not a whole lot. Note that if the user +goofs up, they coud end up in a situation that's rather more a mess than +this one! + +(I've seen maybe half a dozen people reporting this problem before. I think +most or all of them were using fsck in a bare repository. It might be that, +if fsck in a bare repository didn't behave as fsck --all, nobody would +care.) +"""]] diff --git a/doc/bugs/git-annex-shell_doesn__39__t_work_as_expected.mdwn b/doc/bugs/git-annex-shell_doesn__39__t_work_as_expected.mdwn index 93d890d81..f77f33a32 100644 --- a/doc/bugs/git-annex-shell_doesn__39__t_work_as_expected.mdwn +++ b/doc/bugs/git-annex-shell_doesn__39__t_work_as_expected.mdwn @@ -117,3 +117,5 @@ git-annex: unknown command anarc.at </pre> Turning off `sshcaching` seems to work around the issue. Note that this happens even if the git repo is moved to a non-NFS filesystem, so I have the feeling it's not directly related to [this bugfix](http://source.git-annex.branchable.com/?p=source.git;a=commit;h=bd110516c09d318b298804efc4ee888270f3d601). + +> [[done]] diff --git a/doc/bugs/git-annex_unused_--from_s3_doesn__39__t.mdwn b/doc/bugs/git-annex_unused_--from_s3_doesn__39__t.mdwn index 07ae44e89..db41d0701 100644 --- a/doc/bugs/git-annex_unused_--from_s3_doesn__39__t.mdwn +++ b/doc/bugs/git-annex_unused_--from_s3_doesn__39__t.mdwn @@ -27,3 +27,5 @@ arch linux x86_64 ### Please provide any additional information below. The S3 remote is encrypted with the default "hybrid" method + +[[!tag moreinfo]] diff --git a/doc/bugs/--list-tests_runs_tests.mdwn b/doc/bugs/list-tests_runs_tests.mdwn index cea58db84..cea58db84 100644 --- a/doc/bugs/--list-tests_runs_tests.mdwn +++ b/doc/bugs/list-tests_runs_tests.mdwn diff --git a/doc/bugs/windows_start_menu_shortcuts_are_missing___34__Start_in__34___parameter.mdwn b/doc/bugs/windows_start_menu_shortcuts_are_missing___34__Start_in__34___parameter.mdwn index 72f0794a5..9c8f1b5ba 100644 --- a/doc/bugs/windows_start_menu_shortcuts_are_missing___34__Start_in__34___parameter.mdwn +++ b/doc/bugs/windows_start_menu_shortcuts_are_missing___34__Start_in__34___parameter.mdwn @@ -10,3 +10,6 @@ git version 1.9.5.msysgit.1. git-annex version: 5.20150317-g237d5b0. Windows 7 P ### Please provide any additional information below. This seems to be fixed by editing the shortcuts and setting the "Start in" parameter to the git installation directory. For me this is "C:\Program Files (x86)\Git". + +> I've renamed it. The old git-annex.lnk will be +> deleted by the installer if it exists. [[done]] --[[Joey]] diff --git a/doc/bugs/windows_start_menu_shortcuts_are_missing___34__Start_in__34___parameter/comment_4_7bec797548ff4ea270b96f9c0aada62c._comment b/doc/bugs/windows_start_menu_shortcuts_are_missing___34__Start_in__34___parameter/comment_4_7bec797548ff4ea270b96f9c0aada62c._comment new file mode 100644 index 000000000..1b9a4dcf3 --- /dev/null +++ b/doc/bugs/windows_start_menu_shortcuts_are_missing___34__Start_in__34___parameter/comment_4_7bec797548ff4ea270b96f9c0aada62c._comment @@ -0,0 +1,10 @@ +[[!comment format=mdwn + username="https://launchpad.net/~eliasson" + nickname="eliasson" + subject="comment 4" + date="2015-04-10T15:35:30Z" + content=""" +Perhaps both? Changing the VBscript for existing users, and renaming the link as a more long term solution for new installations. + +I would argue that testing with newer Windows versions than XP is somewhat important. If you need money for a Windows license you could always launch another crowdfunding campaign... +"""]] diff --git a/doc/devblog/day_274__concurrent_annex_state/comment_1_7414fc0dde7a1d1ee456f8eba0b0c2a9._comment b/doc/devblog/day_274__concurrent_annex_state/comment_1_7414fc0dde7a1d1ee456f8eba0b0c2a9._comment new file mode 100644 index 000000000..b4e2eeef8 --- /dev/null +++ b/doc/devblog/day_274__concurrent_annex_state/comment_1_7414fc0dde7a1d1ee456f8eba0b0c2a9._comment @@ -0,0 +1,11 @@ +[[!comment format=mdwn + username="https://id.koumbit.net/anarcat" + subject="comment 1" + date="2015-04-10T21:33:02Z" + content=""" +great news! + +one thing i've been wondering after fooling around with the git-annex branch outside of git-annex is why git-annex talks with the commandline git client at all? libgit, for example, seem to access the .git objects directly without a dependency on the git commandline... there doesn't seem to be any haskell shims for libgit, but it seems to me it would reduce the overhead of a bunch of stuff in git-annex... + +as an aside, any thoughts of making the [git-annex-specific git library](http://source.git-annex.branchable.com/?p=source.git;a=tree;f=Git;hb=HEAD) portable and standalone? maybe in collaboration with the existing [hs-libgit](https://hackage.haskell.org/package/libgit)? +"""]] diff --git a/doc/devblog/day_274__concurrent_annex_state/comment_2_4ca498ee4b4aaac8ee6dbc2c769dbad7._comment b/doc/devblog/day_274__concurrent_annex_state/comment_2_4ca498ee4b4aaac8ee6dbc2c769dbad7._comment new file mode 100644 index 000000000..e8629e532 --- /dev/null +++ b/doc/devblog/day_274__concurrent_annex_state/comment_2_4ca498ee4b4aaac8ee6dbc2c769dbad7._comment @@ -0,0 +1,21 @@ +[[!comment format=mdwn + username="joey" + subject="""comment 2""" + date="2015-04-11T14:41:47Z" + content=""" +Josh Tripplet has some haskell bindings for libgit2 somewhere. +My reasons for not using it so far include: + +* ABI stability; at least it used to have none. soname is 21 already.. +* Josh told me parts of it are much less optimised than git. + (This was several years ago, but I still imagine the git code base + has much more work on speed.) +* It's not even been in a stable release of Debian yet. +* Adding a C library dependency will make git-annex much harder for + users to get started building. +* The couple of things that I could really use a git library for, like + index file access and catting object contents, could be implemented + just as well (and likely as fast) in pure haskell + code, and would not be particularly hard to do either. There may even + be suitable pure haskell libraries for them; haven't checked. +"""]] diff --git a/doc/devblog/day_275-276__mostly_Windows.mdwn b/doc/devblog/day_275-276__mostly_Windows.mdwn new file mode 100644 index 000000000..4b5a066e2 --- /dev/null +++ b/doc/devblog/day_275-276__mostly_Windows.mdwn @@ -0,0 +1,17 @@ +Mostly working on Windows recently. Fixed handling of git +repos on different drive letters. Fixed crazy start menu loop. Worked around +stange msysgit version problem. + +Added one nice new feature yesterday: `git annex info $dir` now includes a +table of repositories that are storing files in the directory, with their +sizes. + + repositories containing these files: + 288.98 MB: ca9c5d52-f03a-11df-ac14-6b772ffe59f9 -- archive-5 + 288.98 MB: f1c0ce8d-d848-4d21-988c-dd78eed172e8 -- archive-8 + 10.48 MB: 587b9ccf-4548-4d6f-9765-27faecc4105f -- darkstar + 15.18 kB: 42d47daa-45fd-11e0-9827-9f142c1630b3 -- origin + +Nice thing about this feature is it's done for free, with no extra work other +than a little bit of addition. All the heavy location lookup work was already +being done to get the numcopies stats. diff --git a/doc/forum/Adding_a_mounted_network/comment_3_559cfec9210f8c86de6ee13de0ec2175._comment b/doc/forum/Adding_a_mounted_network/comment_3_559cfec9210f8c86de6ee13de0ec2175._comment new file mode 100644 index 000000000..b45f74176 --- /dev/null +++ b/doc/forum/Adding_a_mounted_network/comment_3_559cfec9210f8c86de6ee13de0ec2175._comment @@ -0,0 +1,7 @@ +[[!comment format=mdwn + username="http://lhealy.livejournal.com/" + subject="comment 3" + date="2015-04-10T15:35:16Z" + content=""" +Thanks for both these answers. For the first, one does the repository have to be made first? I.e., do a `git init --bare` first? I discovered the second approach before reading the comment and it worked, but it did not make a bare repository as happens with the \"removable drive\" option in the assistant. +"""]] diff --git a/doc/forum/Cant_see_git-annex-shell_via_SSH_in_OSX.mdwn b/doc/forum/Cant_see_git-annex-shell_via_SSH_in_OSX.mdwn new file mode 100644 index 000000000..76b1d5a8f --- /dev/null +++ b/doc/forum/Cant_see_git-annex-shell_via_SSH_in_OSX.mdwn @@ -0,0 +1,119 @@ +### Sync Problems using SSH remote in OSX + +- Im trying to work out SSH remotes by trying to sync up repos on my home network, following the walkthrough. +- I have two machines (mini and mbp ) running OSX Mavericks, with RLogin enabled for all users to enable ssh. +- I can SSH into the remote machine and see *git-annex-shell*, which seems to have ok permissions + +``` + + johns-mbp:annex johnmccallum$ ssh john@johns-mini-5.home + + Last login: Sun Apr 12 07:31:07 2015 from johns-mbp.home + + johns-mini-5:~ john$ which git-annex-shell + + /usr/local/bin/git-annex-shell + + johns-mini-5:~ john$ ls -l /usr/local/bin/git-annex-shell + + -rwxr-xr-x@ 1 john admin 668 12 Apr 07:03 /usr/local/bin/git-annex-shell + +``` + +- Previously on mini I created and populated a repo + +``` + + 494 mkdir annex + + 495 cd annex + + 496 git init + + 497 git annex init + + 498 cp ~/Pictures/*.png . + + 499 git annex add . + + 500 git commit -a -m 'added png' + +``` + +- I can git clone this repo to MBP by SSH + + +``` + johns-mbp:~ johnmccallum$ git clone ssh://john@johns-mini-5.home/Users/john/annex ~/annex + + Cloning into '/Users/johnmccallum/annex'... + + remote: Counting objects: 24, done. + + remote: Compressing objects: 100% (19/19), done. + + remote: Total 24 (delta 3), reused 0 (delta 0) + + Receiving objects: 100% (24/24), done. + + Resolving deltas: 100% (3/3), done. + + Checking connectivity... done + + johns-mbp:~ johnmccallum$ cd annex + + johns-mbp:annex johnmccallum$ git annex init 'MBP' + + init MBP (merging origin/git-annex into git-annex...) + + (recording state in git...) + + ok + + (recording state in git...) + + johns-mbp:annex johnmccallum$ ls -l + + total 16 + + lrwxr-xr-x 1 johnmccallum staff 196 12 Apr 08:20 CoGe-Snapshot at 2013-03-22 - 11-27-20.png -> .git/annex/objects/gf/Xp/SHA256E-s367697-- fce3f47f218805cd9855ec3fd4203b52e83587148b34c8e706df512783eb7557.png/SHA256E-s367697--fce3f47f218805cd9855ec3fd4203b52e83587148b34c8e706df512783eb7557.png + + lrwxr-xr-x 1 johnmccallum staff 196 12 Apr 08:20 delicious.png -> .git/annex/objects/ZJ/vX/SHA256E-s112714--057d0faa464f8d588c053dae460838d68ea7803d7eaf7330798679e63f92cecb.png/SHA256E-s112714--057d0faa464f8d588c053dae460838d68ea7803d7eaf7330798679e63f92cecb.png + + +``` + + **HOWEVER** _git annex get_ fails as follows: + +``` + + johns-mbp:annex johnmccallum$ git annex get delicious.png + + get delicious.png bash: git-annex-shell: command not found + + Remote origin does not have git-annex installed; setting annex-ignore + + This could be a problem with the git-annex installation on the remote. Please make sure that git-annex-shell is available in PATH when you ssh into the remote. Once you have fixed the git-annex installation, run: git config remote.origin.annex-ignore false + (not available) + Try making some of these repositories available: + 129620b2-91b1-4541-b7b1-9e5a9d31d5d3 -- john@johns-mini-5.home:~/annex + failed + git-annex: get: 1 failed + +``` + +This is not the case on the remote host when I SSH in as the same user + +``` + + johns-mini-5:~ john$ which git-annex-shell + + + /usr/local/bin/git-annex-shell + +``` + + + The only thread on this seems to be https://git-annex.branchable.com/forum/not_finding_git-annex-shell_on_remote/ and Im at a loss to understand it. + +Any suggestions would be welcome diff --git a/doc/forum/Slow_transfer_speeds_on_copy_in_Windows/comment_2_9ebd40fe286f6c13f1021bf360e9c48e._comment b/doc/forum/Slow_transfer_speeds_on_copy_in_Windows/comment_2_9ebd40fe286f6c13f1021bf360e9c48e._comment new file mode 100644 index 000000000..9ad9acb7d --- /dev/null +++ b/doc/forum/Slow_transfer_speeds_on_copy_in_Windows/comment_2_9ebd40fe286f6c13f1021bf360e9c48e._comment @@ -0,0 +1,8 @@ +[[!comment format=mdwn + username="https://www.google.com/accounts/o8/id?id=AItOawlh1G1u_AMJEyADqlfuzV2cePniocDyK6A" + nickname="Adam" + subject="comment 2" + date="2015-04-13T14:21:12Z" + content=""" +rsync is indeed slow... The version bundled with msysgit is being used, and I read it has performance issues. Will try a different version of rsync, perhaps in cygwin. +"""]] diff --git a/doc/forum/Slow_transfer_speeds_on_copy_in_Windows/comment_3_c169ad6205c998f3d44f9c0859071b2d._comment b/doc/forum/Slow_transfer_speeds_on_copy_in_Windows/comment_3_c169ad6205c998f3d44f9c0859071b2d._comment new file mode 100644 index 000000000..13a854188 --- /dev/null +++ b/doc/forum/Slow_transfer_speeds_on_copy_in_Windows/comment_3_c169ad6205c998f3d44f9c0859071b2d._comment @@ -0,0 +1,8 @@ +[[!comment format=mdwn + username="https://www.google.com/accounts/o8/id?id=AItOawlh1G1u_AMJEyADqlfuzV2cePniocDyK6A" + nickname="Adam" + subject="comment 3" + date="2015-04-13T17:23:15Z" + content=""" +Verified to be rsync 3.0.9 that is bundled with git annex which is causing the slowdown. Updated to cwRsync 3.1.1 and it was fast again. +"""]] diff --git a/doc/forum/__34__git_annex_sync__34___synced_after_8_hours.mdwn b/doc/forum/__34__git_annex_sync__34___synced_after_8_hours.mdwn new file mode 100644 index 000000000..2804828f5 --- /dev/null +++ b/doc/forum/__34__git_annex_sync__34___synced_after_8_hours.mdwn @@ -0,0 +1,40 @@ +Hi, + +The git annex seem has problem with many files. + +For synchronize, the operation lasts 8 hours. Here the sample for synchronizing to my local remote server (sbackup) + +start at **20:12** / end at **04:13** / total time = ~ **8 hours** + + git annex sync sbackup + + [2015-04-13 20:12:26 CEST] call: git ["--git-dir=.git","--work-tree=.","push","sbackup","+git-annex:synced/git-annex","master:synced/master"] + Counting objects: 792155, done. + Delta compression using up to 4 threads. + Compressing objects: 100% (789727/789727), done. + Writing objects: 100% (792155/792155), 75.73 MiB | 2.35 MiB/s, done. + Total 792155 (delta 449604), reused 1 (delta 0) + To partage@192.168.253.53:/data/samba/git-annex/docshare + ae182f0..fad3aca git-annex -> synced/git-annex + e0e67fe..5226a6f master -> synced/master + [2015-04-14 04:13:05 CEST] read: git ["--git-dir=.git","--work-tree=.","push","sbackup","git-annex","master"] + ok + +Another problem, I do not know exactly how many files I own (i use **find . | wc -l** ) + +.git = 1250633 + +documents = 61124 + +medias = 199504 + +it seem i own ~250000 files, but in the .git **1.2 millions files**. + +The following command also very slow + + git annex info + + +What the best pratices for use git annex with many files > 500 000 or maintenance & reduction/cleaning method + +Thanks diff --git a/doc/forum/__34__git_annex_sync__34___synced_after_8_hours/comment_1_e815ac48a17cc4296473d61e712d95e0._comment b/doc/forum/__34__git_annex_sync__34___synced_after_8_hours/comment_1_e815ac48a17cc4296473d61e712d95e0._comment new file mode 100644 index 000000000..4cc665e04 --- /dev/null +++ b/doc/forum/__34__git_annex_sync__34___synced_after_8_hours/comment_1_e815ac48a17cc4296473d61e712d95e0._comment @@ -0,0 +1,13 @@ +[[!comment format=mdwn + username="CandyAngel" + subject="comment 1" + date="2015-04-14T08:40:33Z" + content=""" +If you want a file count: + + git annex find | wc -l + +is probably the best measure. + +I have an annex with about several million files in it and it is slow, but not as slow as you are describing. Have you done a repack/gc cycle? +"""]] diff --git a/doc/forum/ga-ncdu/comment_3_c5ce3b663de76b50754de70b3fb23bf0._comment b/doc/forum/ga-ncdu/comment_3_c5ce3b663de76b50754de70b3fb23bf0._comment new file mode 100644 index 000000000..318441e7b --- /dev/null +++ b/doc/forum/ga-ncdu/comment_3_c5ce3b663de76b50754de70b3fb23bf0._comment @@ -0,0 +1,15 @@ +[[!comment format=mdwn + username="CandyAngel" + subject="comment 3" + date="2015-04-12T22:12:53Z" + content=""" +Whelp, didn't realise it had been over two weeks! Got caught up in other stuff (VR). + +[Here's the bitbucket repository!](https://bitbucket.org/CandyAngel/ga-ncdu) + +I've coded my own JSON output so it doesn't depend on any non-core Perl modules. + +Please let me know of any bugs, feature requests etc. Feedback would be appreciated, even just letting me know you are using it would be great! + + ga-ncdu.pl ~/mah_annex | ncdu -f- +"""]] diff --git a/doc/git-annex-expire.mdwn b/doc/git-annex-expire.mdwn index ce07d7976..8629036c0 100644 --- a/doc/git-annex-expire.mdwn +++ b/doc/git-annex-expire.mdwn @@ -32,7 +32,7 @@ expired. * `--no-act` - Print out what would be done, but not not actually expite or unexpire + Print out what would be done, but not not actually expire or unexpire any repositories. * `--activity=Name` diff --git a/doc/git-annex-fromkey.mdwn b/doc/git-annex-fromkey.mdwn index 9569c4211..1126e823e 100644 --- a/doc/git-annex-fromkey.mdwn +++ b/doc/git-annex-fromkey.mdwn @@ -13,7 +13,7 @@ in the git repository to link to a specified key. If the key and file are not specified on the command line, they are instead read from stdin. Any number of lines can be provided in this -mode, each containing a key and filename, sepearated by a single space. +mode, each containing a key and filename, separated by a single space. # OPTIONS diff --git a/doc/git-annex-info.mdwn b/doc/git-annex-info.mdwn index 52b145c51..31c422703 100644 --- a/doc/git-annex-info.mdwn +++ b/doc/git-annex-info.mdwn @@ -26,6 +26,10 @@ for the repository as a whole. Enable JSON output. This is intended to be parsed by programs that use git-annex. Each line of output is a JSON object. +* `--bytes` + + Show file sizes in bytes, disabling the default nicer units. + * file matching options When a directory is specified, the [[git-annex-matching-options]](1) diff --git a/doc/todo/addurl___8211__force-torrent_option.mdwn b/doc/todo/addurl___8211__force-torrent_option.mdwn new file mode 100644 index 000000000..acbb953c0 --- /dev/null +++ b/doc/todo/addurl___8211__force-torrent_option.mdwn @@ -0,0 +1 @@ +There are sites that don't provide direct links to `.torrent` files. Currently there is no way to download contents of such torrents with `git annex`, it simply uses web remote instead of bittorrent. Something like `--force-torrent` option could help here. diff --git a/doc/todo/addurl___8211__force-torrent_option/comment_1_15be1914c8d05cd1ad8220bcfea9d0bf._comment b/doc/todo/addurl___8211__force-torrent_option/comment_1_15be1914c8d05cd1ad8220bcfea9d0bf._comment new file mode 100644 index 000000000..456fb1ab4 --- /dev/null +++ b/doc/todo/addurl___8211__force-torrent_option/comment_1_15be1914c8d05cd1ad8220bcfea9d0bf._comment @@ -0,0 +1,8 @@ +[[!comment format=mdwn + username="joey" + subject="""comment 1""" + date="2015-04-14T19:11:28Z" + content=""" +I'd prefer torrent:url; this is consistent with quvi:url for forcing quvi +be used. +"""]] diff --git a/doc/todo/git-annex-standalone_Debian_package.mdwn b/doc/todo/git-annex-standalone_Debian_package.mdwn new file mode 100644 index 000000000..0172e1e72 --- /dev/null +++ b/doc/todo/git-annex-standalone_Debian_package.mdwn @@ -0,0 +1 @@ +As proposed with a sketch in https://github.com/joeyh/git-annex/pull/39, for DataLad we would need to get recent annex on older Debian/Ubuntu releases to get our testing farm and perspective users equipped with bleeding edge annex diff --git a/doc/todo/git-annex-standalone_Debian_package/comment_1_ef36b0265127611ffeea3a5ed8c29515._comment b/doc/todo/git-annex-standalone_Debian_package/comment_1_ef36b0265127611ffeea3a5ed8c29515._comment new file mode 100644 index 000000000..ad3f8b9e5 --- /dev/null +++ b/doc/todo/git-annex-standalone_Debian_package/comment_1_ef36b0265127611ffeea3a5ed8c29515._comment @@ -0,0 +1,20 @@ +[[!comment format=mdwn + username="joey" + subject="""comment 1""" + date="2015-04-11T13:52:28Z" + content=""" +I think this will work. I don't see a way to do it other than as a patch +to debian/ though.. Unless perhaps you could pass flags to stuff to make +a different directory be used. If you could do that, it could be included +in git-annex's master. + +The package needs to depend on git (any version) so that the user can run +"git annex". + +The rest of the depends are not necessary though. The standalone tarball +includes its own wget, rsync, gpg, curl, and ssh, so git-annex will be able +to use those. + +If removing eg, the depends on wget though, you will want to add a +recommends on ca-certificates.. +"""]] diff --git a/doc/todo/git-annex-standalone_Debian_package/comment_2_456413718e9faf3561a11000ee611611._comment b/doc/todo/git-annex-standalone_Debian_package/comment_2_456413718e9faf3561a11000ee611611._comment new file mode 100644 index 000000000..50a2bf516 --- /dev/null +++ b/doc/todo/git-annex-standalone_Debian_package/comment_2_456413718e9faf3561a11000ee611611._comment @@ -0,0 +1,10 @@ +[[!comment format=mdwn + username="https://www.google.com/accounts/o8/id?id=AItOawnx8kHW66N3BqmkVpgtXDlYMvr8TJ5VvfY" + nickname="Yaroslav" + subject="now available" + date="2015-04-12T13:49:04Z" + content=""" +from stock NeuroDebian repository across all debian/ubuntu releases. Packaging is within debian-standalone branch of http://github.com/yarikoptic/git-annex + +So far -- built manually (well -- debian/build-standalone) on my laptop. Later will be automated on the buildbot. +"""]] diff --git a/doc/todo/git-annex-standalone_Debian_package/comment_3_22539df11d1a514987b9c257fd8b1998._comment b/doc/todo/git-annex-standalone_Debian_package/comment_3_22539df11d1a514987b9c257fd8b1998._comment new file mode 100644 index 000000000..7f0d1d51a --- /dev/null +++ b/doc/todo/git-annex-standalone_Debian_package/comment_3_22539df11d1a514987b9c257fd8b1998._comment @@ -0,0 +1,8 @@ +[[!comment format=mdwn + username="https://www.google.com/accounts/o8/id?id=AItOawnx8kHW66N3BqmkVpgtXDlYMvr8TJ5VvfY" + nickname="Yaroslav" + subject="missed the comment" + date="2015-04-12T13:55:50Z" + content=""" +blind me managed to miss your comment, for which I am thankful. A branch sounded like the best way to go so I don't need to mess with patching BUT now thinking about it, I might just indeed move it into a new debian/patch/series-standalone which would be the quilt series to use to patch things for building standalone. Then it could be shipped in the main repo and applied only when necessary. Sounds good? +"""]] diff --git a/doc/todo/git-annex-standalone_Debian_package/comment_4_0aecbfdc9048df2131d99ad316f5d6f7._comment b/doc/todo/git-annex-standalone_Debian_package/comment_4_0aecbfdc9048df2131d99ad316f5d6f7._comment new file mode 100644 index 000000000..0f2393fc1 --- /dev/null +++ b/doc/todo/git-annex-standalone_Debian_package/comment_4_0aecbfdc9048df2131d99ad316f5d6f7._comment @@ -0,0 +1,8 @@ +[[!comment format=mdwn + username="joey" + subject="""comment 4""" + date="2015-04-14T19:14:16Z" + content=""" +The quilt series sounds reasonable if there's tooling to support building +that way. +"""]] diff --git a/doc/todo/wishlist:_rsync_efficiency.mdwn b/doc/todo/wishlist:_rsync_efficiency.mdwn new file mode 100644 index 000000000..fe1848f1b --- /dev/null +++ b/doc/todo/wishlist:_rsync_efficiency.mdwn @@ -0,0 +1,8 @@ +If you look at the transfer rates during a copy job to remotes, you see it going down to zero for a short time between files. + +While that's understandable from rsync's PoV, it's not as efficient as git-annex could be. + +Would parallelization be an option? Are there alternate improvements? + + +-- Richard diff --git a/git-annex.cabal b/git-annex.cabal index e0643e815..3c1af0df2 100644 --- a/git-annex.cabal +++ b/git-annex.cabal @@ -104,7 +104,7 @@ Flag network-uri Executable git-annex Main-Is: git-annex.hs Build-Depends: MissingH, hslogger, directory, filepath, - containers, utf8-string, mtl (>= 2), + containers (>= 0.5.0.0), utf8-string, mtl (>= 2), bytestring, old-locale, time, dataenc, SHA, process, json, base (>= 4.5 && < 4.9), monad-control, exceptions (>= 0.6), transformers, IfElse, text, QuickCheck >= 2.1, bloomfilter, edit-distance, diff --git a/standalone/windows/build.sh b/standalone/windows/build.sh index 09161c569..56323d8a3 100755 --- a/standalone/windows/build.sh +++ b/standalone/windows/build.sh @@ -9,7 +9,7 @@ set -e # Path to the Haskell Platform. #HP="/c/haskell/2014.2.0.0" # now in the default PATH -PATH="/c/Program Files (x86)/NSIS:/c/msysgit/cmd:$PATH" +PATH="/c/Program Files (x86)/NSIS:/c/msysgit/cmd:/c/msysgit/bin:$PATH" # Run a command with the cygwin environment available. # However, programs not from cygwin are preferred. @@ -22,6 +22,12 @@ withcygpreferred () { # This tells git-annex where to upgrade itself from. UPGRADE_LOCATION=http://downloads.kitenet.net/git-annex/windows/current/git-annex-installer.exe +export UPGRADE_LOCATION + +# This can be used to force git-annex to build supporting a particular +# version of git, instead of the version installed at build time. +FORCE_GIT_VERSION=1.9.5 +export FORCE_GIT_VERSION # Uncomment to get rid of cabal installed libraries. #rm -rf /c/Users/jenkins/AppData/Roaming/cabal /c/Users/jenkins/AppData/Roaming/ghc |