git-annex 4.20131106 → 5.20131118
raw patch · 169 files changed
+3350/−1478 lines, 169 filesdep +Win32-notifydep +ekgdep +tastydep −HUnitbinary-added
Dependencies added: Win32-notify, ekg, tasty, tasty-hunit, tasty-quickcheck
Dependencies removed: HUnit
Files
- Annex.hs +21/−4
- Annex/CatFile.hs +3/−5
- Annex/Content.hs +9/−19
- Annex/Content/Direct.hs +17/−9
- Annex/Direct.hs +89/−16
- Annex/Hook.hs +42/−0
- Annex/Perms.hs +12/−0
- Annex/Version.hs +6/−12
- Assistant.hs +48/−32
- Assistant/MakeRemote.hs +1/−0
- Assistant/Ssh.hs +3/−6
- Assistant/Threads/SanityChecker.hs +17/−0
- Assistant/Threads/Watcher.hs +5/−2
- Assistant/Threads/WebApp.hs +3/−1
- Assistant/TransferSlots.hs +12/−3
- Assistant/TransferrerPool.hs +13/−0
- Assistant/Types/DaemonStatus.hs +3/−0
- Assistant/WebApp/Common.hs +1/−0
- Assistant/WebApp/Configurators/AWS.hs +1/−1
- Assistant/WebApp/Configurators/Edit.hs +29/−7
- Assistant/WebApp/Configurators/Local.hs +3/−2
- Assistant/WebApp/Configurators/Ssh.hs +1/−1
- Assistant/WebApp/Configurators/WebDAV.hs +1/−1
- Assistant/WebApp/Control.hs +5/−1
- Assistant/WebApp/Form.hs +1/−2
- Assistant/WebApp/Gpg.hs +2/−1
- Assistant/WebApp/MakeRemote.hs +1/−1
- Assistant/WebApp/Page.hs +13/−10
- Assistant/WebApp/RepoId.hs +40/−0
- Assistant/WebApp/RepoList.hs +44/−70
- Assistant/WebApp/Types.hs +6/−0
- Assistant/WebApp/routes +4/−5
- Assistant/XMPP.hs +1/−1
- Build/BundledPrograms.hs +1/−0
- BuildFlags.hs +3/−0
- CHANGELOG +45/−0
- Command/Add.hs +21/−11
- Command/Fix.hs +6/−0
- Command/Fsck.hs +3/−2
- Command/Indirect.hs +5/−8
- Command/Info.hs +384/−0
- Command/List.hs +1/−1
- Command/Status.hs +62/−357
- Command/Sync.hs +10/−3
- Command/Upgrade.hs +6/−2
- Command/Watch.hs +1/−1
- Command/WebApp.hs +10/−4
- Config.hs +0/−5
- Git/Branch.hs +29/−3
- Git/Command.hs +2/−1
- Git/Config.hs +4/−1
- Git/Construct.hs +1/−0
- Git/GCrypt.hs +0/−1
- Git/Hook.hs +54/−0
- Git/LsFiles.hs +7/−0
- Git/Ref.hs +27/−2
- Git/Remote.hs +5/−2
- Git/Repair.hs +32/−5
- Git/Types.hs +6/−1
- GitAnnex.hs +11/−2
- GitAnnex/Options.hs +5/−2
- Init.hs +36/−62
- Logs/UUID.hs +1/−1
- Logs/UUIDBased.hs +5/−0
- Makefile +13/−10
- Remote.hs +21/−8
- Test.hs +404/−362
- Types/Key.hs +4/−4
- Types/Remote.hs +1/−1
- Upgrade.hs +21/−2
- Upgrade/V4.hs +23/−0
- Utility/Base64.hs +1/−1
- Utility/Batch.hs +2/−0
- Utility/DirWatcher.hs +22/−10
- Utility/Process.hs +41/−9
- Utility/Win32Notify.hs +65/−0
- debian/changelog +45/−0
- debian/control +2/−2
- doc/bare_repositories.mdwn +1/−1
- doc/bugs/Discrepancy_between_git_annex_add_and_git_annex_watch.mdwn +33/−0
- doc/bugs/Incorrect_merge__44___direct_repos___40__2__41__.mdwn +44/−0
- doc/bugs/Incorrect_merge___40__a_special_case__41__.mdwn +48/−0
- doc/bugs/Mac_OS_10.9_GPG_erro_when_creating_USB_repo___40__solved__41__.mdwn +23/−0
- doc/bugs/Mac_OS_10.9_GPG_error_adding_S3_repo___40__solved__41__.mdwn +28/−0
- doc/bugs/OSX_.dmg_unnecessarily_large_and_not_inherently_compressed.mdwn +68/−0
- doc/bugs/get_from_bup-remote_with_pubkey_failing.mdwn +93/−0
- doc/bugs/git-annex_broken_on_Android_4.3.mdwn +4/−0
- doc/bugs/git_annex_describe_can_break_uuid.log.mdwn +46/−0
- doc/bugs/git_annex_doesn__39__t_work_in_Max_OS_X_10.9.mdwn +2/−0
- doc/bugs/git_version_in_prebuilt_linux_tarball_is_outdated.mdwn +3/−0
- doc/bugs/gitignore_for_DCIM_on_Android_misses_some_files.mdwn +17/−0
- doc/bugs/ssh-keygen_failed_when_adding_remote_server_repo.mdwn +2/−0
- doc/bugs/typo_on_the_Mac_OS_10.7.5_Lion_build.mdwn +11/−0
- doc/bugs/unfinished_repository_when_using_annex-ignore_true_.mdwn +2/−0
- doc/bugs/web_app_loops_over_a_non-addable_file.mdwn +2/−0
- doc/bugs/webapp_usability:_fails_mysteriously_on_newer_repo_layouts.mdwn +34/−0
- doc/design/assistant/encrypted_git_remotes.mdwn +1/−1
- doc/design/assistant/polls/2013_user_survey.mdwn +1/−0
- doc/design/roadmap.mdwn +2/−2
- doc/devblog/day_50__.mdwn +0/−16
- doc/devblog/day_50__grab_bag.mdwn +34/−0
- doc/devblog/day_51__direct_mode_guard_finished.mdwn +6/−0
- doc/devblog/day_52__slowly_but_surely.mdwn +5/−0
- doc/devblog/day_54__android_bisection_minions.mdwn +9/−0
- doc/devblog/day_55__fireside_porting.mdwn +22/−0
- doc/devblog/day_56__git-annex_user_survey.mdwn +20/−0
- doc/devblog/day_57__mavericks.mdwn +14/−0
- doc/devblog/day_58__urgle.mdwn +16/−0
- doc/direct_mode.mdwn +28/−20
- doc/direct_mode/comment_10_94284a476604e9c812b7ee475ca22959._comment +0/−12
- doc/direct_mode/comment_1_93fc31e8dc0ad16248a2593a1482d375._comment +0/−8
- doc/direct_mode/comment_2_7f7086b34ed136851963f145868a1d23._comment +0/−12
- doc/direct_mode/comment_4_97c26bd82f623a3b2d56bab4afff0126._comment +0/−1
- doc/direct_mode/comment_9_cff56dbcdfec60375c30d5b1b1c60614._comment +0/−12
- doc/ekg.mdwn +14/−0
- doc/ekg/ekg.png binary
- doc/forum/Effectively_replicating_backup_files.mdwn +25/−0
- doc/forum/Help_on_my_usecase.mdwn +22/−0
- doc/forum/_preferred_content:_lastpresent.mdwn +1/−0
- doc/forum/git-annex_assistant_with_2_dedicated_servers.mdwn +11/−0
- doc/forum/git_annex_test_on_windows.mdwn +5/−0
- doc/forum/rsyncing_.git__47__annex__47__objects.mdwn +24/−0
- doc/git-annex.mdwn +38/−15
- doc/install/Android.mdwn +8/−3
- doc/install/Android/comment_13_f077a27c04131da89db1d7abcab3e68f._comment +0/−20
- doc/install/Android/comment_5_40cb6cb72c4ad4aa19a4a40f41a6a757._comment +0/−13
- doc/install/Android/comment_6_b0f723538e7328d5070c563f070858bd._comment +0/−8
- doc/install/Android/comment_7_c6dc23d0e6f4138c4bf8e3452755676f._comment +0/−8
- doc/install/OSX.mdwn +8/−10
- doc/install/Ubuntu.mdwn +11/−1
- doc/install/cabal.mdwn +6/−0
- doc/internals/comment_1_4b8ed353dca4f484b3b6eb463fa02fd8._comment +8/−0
- doc/internals/comment_2_c19232d5cc4976c2e5b014aef6e8d9ec._comment +8/−0
- doc/news/version_4.20130909.mdwn +0/−36
- doc/news/version_5.20131118.mdwn +42/−0
- doc/polls.mdwn +2/−0
- doc/polls/2013.mdwn +5/−0
- doc/shortcuts.mdwn +12/−0
- doc/testimonials/comment_1_2bf439f7a3bc3d6fab91849017946182._comment +8/−0
- doc/tips/Decentralized_repository_behind_a_Firewall.mdwn +1/−1
- doc/tips/The_perfect_preferred_content_settings_for_my_android_phone.mdwn +32/−0
- doc/tips/migrating_two_seperate_disconnected_directories_to_git_annex.mdwn +1/−1
- doc/tips/recovering_from_a_corrupt_git_repository.mdwn +17/−0
- doc/todo/Check_if_an_upgrade_is_available_in_the_webapp.mdwn +3/−0
- doc/todo/direct_mode_guard.mdwn +23/−0
- doc/todo/smudge/comment_3_4e7c25fe24a1e71f58a8354fa64f41c2._comment +10/−0
- doc/todo/windows_support.mdwn +9/−1
- doc/todo/wishlist:_detection_of_merge_conflicts.mdwn +13/−0
- doc/todo/wishlist:_disable_automatic_commits.mdwn +1/−1
- doc/upgrades.mdwn +10/−2
- doc/users/clacke.mdwn +3/−0
- git-annex.1 +37/−15
- git-annex.cabal +27/−14
- standalone/android/Makefile +9/−4
- standalone/android/abiversion +1/−0
- standalone/android/buildchroot +1/−0
- standalone/android/buildchroot-inchroot-asuser +1/−2
- standalone/android/clean-haskell-packages +2/−2
- standalone/android/haskell-patches/crypto-numbers_build-fix.patch +235/−0
- standalone/android/haskell-patches/socks_0.4.2_0001-remove-IPv6-stuff.patch +11/−11
- standalone/android/haskell-patches/yesod-form_spliced-TH.patch +24/−27
- standalone/android/install-haskell-packages +5/−2
- standalone/android/start binary
- templates/configurators/checkunfinished.hamlet +0/−16
- templates/configurators/edit/nonannexremote.hamlet +18/−0
- templates/configurators/edit/repository.hamlet +37/−0
- templates/configurators/editrepository.hamlet +0/−37
- templates/dashboard/transfers.hamlet +1/−1
- templates/repolist.hamlet +36/−44
Annex.hs view
@@ -12,7 +12,6 @@ AnnexState(..), PreferredContentMap, new,- newState, run, eval, getState,@@ -41,10 +40,12 @@ import Common import qualified Git import qualified Git.Config+import Git.Types hiding (remotes) import Git.CatFile import Git.CheckAttr import Git.CheckIgnore import Git.SharedRepository+import Git.Config import qualified Git.Queue import Types.Backend import Types.GitConfig@@ -112,9 +113,9 @@ } newState :: Git.Repo -> AnnexState-newState gitrepo = AnnexState- { repo = gitrepo- , gitconfig = extractGitConfig gitrepo+newState r = AnnexState+ { repo = if annexDirect c then fixupDirect r else r+ , gitconfig = c , backends = [] , remotes = [] , output = defaultMessageState@@ -144,6 +145,8 @@ , inodeschanged = Nothing , useragent = Nothing }+ where+ c = extractGitConfig r {- Makes an Annex state object for the specified git repo. - Ensures the config is read, if it was not already. -}@@ -247,3 +250,17 @@ withCurrentState a = do s <- getState id return $ eval s a++{- Direct mode repos have core.bare=true, but are not really bare.+ - Fix up the Repo to be a non-bare repo, and arrange for git commands+ - run by git-annex to be passed parameters that override this setting. -}+fixupDirect :: Git.Repo -> Git.Repo+fixupDirect r@(Repo { location = Local { gitdir = d, worktree = Nothing } }) =+ r+ { location = Local { gitdir = d </> ".git", worktree = Just d }+ , gitGlobalOpts = gitGlobalOpts r +++ [ Param "-c"+ , Param $ coreBare ++ "=" ++ boolConfig False+ ]+ }+fixupDirect r = r
Annex/CatFile.hs view
@@ -27,6 +27,7 @@ import Git.Types import Git.FilePath import Git.FileMode+import qualified Git.Ref catFile :: Git.Branch -> FilePath -> Annex L.ByteString catFile branch file = do@@ -109,9 +110,6 @@ {- From a file in the repository back to the key. -- - Prefixing the file with ./ makes this work even if in a subdirectory- - of a repo.- - - Ideally, this should reflect the key that's staged in the index, - not the key that's committed to HEAD. Unfortunately, git cat-file - does not refresh the index file after it's started up, so things@@ -134,8 +132,8 @@ catKeyFile :: FilePath -> Annex (Maybe Key) catKeyFile f = ifM (Annex.getState Annex.daemon) ( catKeyFileHEAD f- , catKeyChecked True (Ref $ ":./" ++ f)+ , catKeyChecked True $ Git.Ref.fileRef f ) catKeyFileHEAD :: FilePath -> Annex (Maybe Key)-catKeyFileHEAD f = catKeyChecked False (Ref $ "HEAD:./" ++ f)+catKeyFileHEAD f = catKeyChecked False $ Git.Ref.fileFromRef Git.Ref.headRef f
Annex/Content.hs view
@@ -29,7 +29,6 @@ preseedTmp, freezeContent, thawContent,- cleanObjectLoc, dirKeys, ) where @@ -255,11 +254,9 @@ where storeobject dest = ifM (liftIO $ doesFileExist dest) ( alreadyhave- , do- createContentDir dest+ , modifyContent dest $ do liftIO $ moveFile src dest freezeContent dest- freezeContentDir dest ) storeindirect = storeobject =<< calcRepo (gitAnnexLocation key) @@ -273,7 +270,6 @@ storedirect = storedirect' storeindirect storedirect' fallback [] = fallback storedirect' fallback (f:fs) = do- thawContentDir =<< calcRepo (gitAnnexLocation key) thawContent src v <- isAnnexLink f if Just key == v@@ -349,11 +345,11 @@ where goindirect = indirect =<< calcRepo (gitAnnexLocation key) -cleanObjectLoc :: Key -> Annex ()-cleanObjectLoc key = do+cleanObjectLoc :: Key -> Annex () -> Annex ()+cleanObjectLoc key cleaner = do file <- calcRepo $ gitAnnexLocation key- unlessM crippledFileSystem $- void $ liftIO $ catchMaybeIO $ allowWrite $ parentDir file+ void $ tryAnnexIO $ thawContentDir file+ cleaner liftIO $ removeparents file (3 :: Int) where removeparents _ 0 = noop@@ -369,13 +365,10 @@ removeAnnex :: Key -> Annex () removeAnnex key = withObjectLoc key remove removedirect where- remove file = do- thawContentDir file+ remove file = cleanObjectLoc key $ do liftIO $ nukeFile file removeInodeCache key- cleanObjectLoc key removedirect fs = do- thawContentDir =<< calcRepo (gitAnnexLocation key) cache <- recordedInodeCache key removeInodeCache key mapM_ (resetfile cache) fs@@ -389,12 +382,10 @@ {- Moves a key's file out of .git/annex/objects/ -} fromAnnex :: Key -> FilePath -> Annex ()-fromAnnex key dest = do+fromAnnex key dest = cleanObjectLoc key $ do file <- calcRepo $ gitAnnexLocation key- thawContentDir file thawContent file liftIO $ moveFile file dest- cleanObjectLoc key {- Moves a key out of .git/annex/objects/ into .git/annex/bad, and - returns the file it was moved to. -}@@ -404,9 +395,8 @@ bad <- fromRepo gitAnnexBadDir let dest = bad </> takeFileName src createAnnexDirectory (parentDir dest)- thawContentDir src- liftIO $ moveFile src dest- cleanObjectLoc key+ cleanObjectLoc key $+ liftIO $ moveFile src dest logStatus key InfoMissing return dest
Annex/Content/Direct.hs view
@@ -10,6 +10,7 @@ associatedFilesRelative, removeAssociatedFile, removeAssociatedFileUnchecked,+ removeAssociatedFiles, addAssociatedFile, goodContent, recordedInodeCache,@@ -64,8 +65,8 @@ files <- associatedFilesRelative key let files' = transform files when (files /= files') $ do- createContentDir mapping- liftIO $ viaTmp write mapping $ unlines files'+ modifyContent mapping $+ liftIO $ viaTmp write mapping $ unlines files' top <- fromRepo Git.repoPath return $ map (top </>) files' where@@ -75,6 +76,13 @@ hPutStr h content hClose h +{- Removes the list of associated files. -}+removeAssociatedFiles :: Key -> Annex ()+removeAssociatedFiles key = do+ mapping <- calcRepo $ gitAnnexMapping key+ modifyContent mapping $+ liftIO $ nukeFile mapping+ {- Removes an associated file. Returns new associatedFiles value. - Checks if this was the last copy of the object, and updates location - log. -}@@ -142,16 +150,16 @@ {- Writes inode cache for a key. -} writeInodeCache :: Key -> [InodeCache] -> Annex ()-writeInodeCache key caches = withInodeCacheFile key $ \f -> do- createContentDir f- liftIO $ writeFile f $- unlines $ map showInodeCache caches+writeInodeCache key caches = withInodeCacheFile key $ \f -> + modifyContent f $+ liftIO $ writeFile f $+ unlines $ map showInodeCache caches {- Removes an inode cache. -} removeInodeCache :: Key -> Annex ()-removeInodeCache key = withInodeCacheFile key $ \f -> do- createContentDir f -- also thaws directory- liftIO $ nukeFile f+removeInodeCache key = withInodeCacheFile key $ \f ->+ modifyContent f $+ liftIO $ nukeFile f withInodeCacheFile :: Key -> (FilePath -> Annex a) -> Annex a withInodeCacheFile key a = a =<< calcRepo (gitAnnexInodeCache key)
Annex/Direct.hs view
@@ -8,13 +8,18 @@ module Annex.Direct where import Common.Annex+import qualified Annex import qualified Git import qualified Git.LsFiles import qualified Git.Merge import qualified Git.DiffTree as DiffTree+import qualified Git.Config+import qualified Git.Ref+import qualified Git.Branch import Git.Sha import Git.FilePath import Git.Types+import Config import Annex.CatFile import qualified Annex.Queue import Logs.Location@@ -133,28 +138,33 @@ - and the commit sha passed in, along with the old sha of the tree - before the merge. Uses git diff-tree to find files that changed between - the two shas, and applies those changes to the work tree.+ -+ - There are really only two types of changes: An old item can be deleted,+ - or a new item added. Two passes are made, first deleting and then+ - adding. This is to handle cases where eg, a file is deleted and a+ - directory is added. The diff-tree output may list these in the opposite+ - order, but we cannot really add the directory until the file with the+ - same name is remvoed. -} mergeDirectCleanup :: FilePath -> Git.Ref -> Git.Ref -> Annex () mergeDirectCleanup d oldsha newsha = do (items, cleanup) <- inRepo $ DiffTree.diffTreeRecursive oldsha newsha makeabs <- flip fromTopFilePath <$> gitRepo- forM_ items (updated makeabs)+ let fsitems = zip (map (makeabs . DiffTree.file) items) items+ forM_ fsitems $+ go DiffTree.srcsha DiffTree.srcmode moveout moveout_raw+ forM_ fsitems $+ go DiffTree.dstsha DiffTree.dstmode movein movein_raw void $ liftIO cleanup liftIO $ removeDirectoryRecursive d where- updated makeabs item = do- let f = makeabs (DiffTree.file item)- void $ tryAnnex $- go f DiffTree.srcsha DiffTree.srcmode moveout moveout_raw- void $ tryAnnex $ - go f DiffTree.dstsha DiffTree.dstmode movein movein_raw- where- go f getsha getmode a araw- | getsha item == nullSha = noop- | otherwise = maybe (araw f) (\k -> void $ a k f)- =<< catKey (getsha item) (getmode item)+ go getsha getmode a araw (f, item)+ | getsha item == nullSha = noop+ | otherwise = void $+ tryAnnex . maybe (araw f) (\k -> void $ a k f)+ =<< catKey (getsha item) (getmode item) - moveout = removeDirect+ moveout k f = removeDirect k f {- Files deleted by the merge are removed from the work tree. - Empty work tree directories are removed, per git behavior. -}@@ -200,11 +210,11 @@ where fromindirect loc = do {- Move content from annex to direct file. -}- thawContentDir loc updateInodeCache k loc void $ addAssociatedFile k f- thawContent loc- replaceFile f $ liftIO . moveFile loc+ modifyContent loc $ do+ thawContent loc+ replaceFile f $ liftIO . moveFile loc fromdirect loc = do replaceFile f $ liftIO . void . copyFileExternal loc@@ -231,3 +241,66 @@ locs <- removeAssociatedFile oldk f whenM (pure (null locs) <&&> not <$> inAnnex oldk) $ logStatus oldk InfoMissing++{- Enable/disable direct mode. -}+setDirect :: Bool -> Annex ()+setDirect wantdirect = do+ if wantdirect+ then do+ switchHEAD+ setbare+ else do+ setbare+ switchHEADBack+ setConfig (annexConfig "direct") val+ Annex.changeGitConfig $ \c -> c { annexDirect = wantdirect }+ where+ val = Git.Config.boolConfig wantdirect+ setbare = setConfig (ConfigKey Git.Config.coreBare) val++{- Since direct mode sets core.bare=true, incoming pushes could change+ - the currently checked out branch. To avoid this problem, HEAD+ - is changed to a internal ref that nothing is going to push to.+ -+ - For refs/heads/master, use refs/heads/annex/direct/master;+ - this way things that show HEAD (eg shell prompts) will+ - hopefully show just "master". -}+directBranch :: Ref -> Ref+directBranch orighead = case split "/" $ show orighead of+ ("refs":"heads":"annex":"direct":_) -> orighead+ ("refs":"heads":rest) ->+ Ref $ "refs/heads/annex/direct/" ++ intercalate "/" rest+ _ -> Ref $ "refs/heads/" ++ show (Git.Ref.base orighead)++{- Converts a directBranch back to the original branch.+ -+ - Any other ref is left unchanged.+ -}+fromDirectBranch :: Ref -> Ref+fromDirectBranch directhead = case split "/" $ show directhead of+ ("refs":"heads":"annex":"direct":rest) -> + Ref $ "refs/heads/" ++ intercalate "/" rest+ _ -> directhead++switchHEAD :: Annex ()+switchHEAD = maybe noop switch =<< inRepo Git.Branch.currentUnsafe+ where+ switch orighead = do+ let newhead = directBranch orighead+ maybe noop (inRepo . Git.Branch.update newhead)+ =<< inRepo (Git.Ref.sha orighead)+ inRepo $ Git.Branch.checkout newhead++switchHEADBack :: Annex ()+switchHEADBack = maybe noop switch =<< inRepo Git.Branch.currentUnsafe+ where+ switch currhead = do+ let orighead = fromDirectBranch currhead+ v <- inRepo $ Git.Ref.sha currhead+ case v of+ Just headsha+ | orighead /= currhead -> do+ inRepo $ Git.Branch.update orighead headsha+ inRepo $ Git.Branch.checkout orighead+ inRepo $ Git.Branch.delete currhead+ _ -> inRepo $ Git.Branch.checkout orighead
+ Annex/Hook.hs view
@@ -0,0 +1,42 @@+{- git-annex git hooks+ -+ - Note that it's important that the scripts not change, otherwise+ - removing old hooks using an old version of the script would fail.+ -+ - Copyright 2013 Joey Hess <joey@kitenet.net>+ -+ - Licensed under the GNU GPL version 3 or higher.+ -}++module Annex.Hook where++import Common.Annex+import qualified Git.Hook as Git+import Utility.Shell+import Config++preCommitHook :: Git.Hook+preCommitHook = Git.Hook "pre-commit" (mkHookScript "git annex pre-commit .")++mkHookScript :: String -> String+mkHookScript s = unlines+ [ shebang_local+ , "# automatically configured by git-annex"+ , s+ ]++hookWrite :: Git.Hook -> Annex ()+hookWrite h = + -- cannot have git hooks in a crippled filesystem (no execute bit)+ unlessM crippledFileSystem $+ unlessM (inRepo $ Git.hookWrite h) $+ hookWarning h "already exists, not configuring"++hookUnWrite :: Git.Hook -> Annex ()+hookUnWrite h = unlessM (inRepo $ Git.hookUnWrite h) $+ hookWarning h "contents modified; not deleting. Edit it to remove call to git annex."++hookWarning :: Git.Hook -> String -> Annex ()+hookWarning h msg = do+ r <- gitRepo+ warning $ Git.hookName h ++ " hook (" ++ Git.hookFile h r ++ ") " ++ msg
Annex/Perms.hs view
@@ -13,12 +13,14 @@ createContentDir, freezeContentDir, thawContentDir,+ modifyContent, ) where import Common.Annex import Utility.FileMode import Git.SharedRepository import qualified Annex+import Annex.Exception import Config import System.Posix.Types@@ -103,3 +105,13 @@ liftIO $ allowWrite dir where dir = parentDir dest++{- Creates the content directory for a file if it doesn't already exist,+ - or thaws it if it does, then runs an action to modify the file, and+ - finally, freezes the content directory. -}+modifyContent :: FilePath -> Annex a -> Annex a+modifyContent f a = do+ createContentDir f -- also thaws it+ v <- tryAnnex a+ freezeContentDir f+ either throwAnnex return v
Annex/Version.hs view
@@ -19,18 +19,21 @@ defaultVersion = "3" directModeVersion :: Version-directModeVersion = "4"+directModeVersion = "5" supportedVersions :: [Version] supportedVersions = [defaultVersion, directModeVersion] upgradableVersions :: [Version] #ifndef mingw32_HOST_OS-upgradableVersions = ["0", "1", "2"]+upgradableVersions = ["0", "1", "2", "4"] #else-upgradableVersions = ["2"]+upgradableVersions = ["2", "4"] #endif +autoUpgradeableVersions :: [Version]+autoUpgradeableVersions = ["4"]+ versionField :: ConfigKey versionField = annexConfig "version" @@ -42,12 +45,3 @@ removeVersion :: Annex () removeVersion = unsetConfig versionField--checkVersion :: Version -> Annex ()-checkVersion v- | v `elem` supportedVersions = noop- | v `elem` upgradableVersions = err "Upgrade this repository: git-annex upgrade"- | otherwise = err "Upgrade git-annex."- where- err msg = error $ "Repository version " ++ v ++- " is not supported. " ++ msg
Assistant.hs view
@@ -50,6 +50,7 @@ import Utility.LogFile import Utility.ThreadScheduler import Utility.HumanTime+import Annex.Perms import qualified Build.SysConfig as SysConfig import System.Log.Logger@@ -63,11 +64,13 @@ - - startbrowser is passed the url and html shim file, as well as the original - stdout and stderr descriptors. -}-startDaemon :: Bool -> Bool -> Maybe Duration -> Maybe HostName -> Maybe (Maybe Handle -> Maybe Handle -> String -> FilePath -> IO ()) -> Annex ()-startDaemon assistant foreground startdelay listenhost startbrowser = do+startDaemon :: Bool -> Bool -> Maybe Duration -> Maybe String -> Maybe HostName -> Maybe (Maybe Handle -> Maybe Handle -> String -> FilePath -> IO ()) -> Annex ()+startDaemon assistant foreground startdelay cannotrun listenhost startbrowser = do Annex.changeState $ \s -> s { Annex.daemon = True } pidfile <- fromRepo gitAnnexPidFile logfile <- fromRepo gitAnnexLogFile+#ifndef mingw32_HOST_OS+ createAnnexDirectory (parentDir logfile) logfd <- liftIO $ openLog logfile if foreground then do@@ -86,6 +89,13 @@ Just a -> Just $ a origout origerr else start (Utility.Daemon.daemonize logfd (Just pidfile) False) Nothing+#else+ -- Windows is always foreground, and has no log file.+ start id $+ case startbrowser of+ Nothing -> Nothing+ Just a -> Just $ a Nothing Nothing+#endif where desc | assistant = "assistant"@@ -99,7 +109,6 @@ flip runAssistant (go webappwaiter) =<< newAssistantData st dstatus - #ifdef WITH_WEBAPP go webappwaiter = do d <- getAssistant id@@ -108,44 +117,51 @@ #endif notice ["starting", desc, "version", SysConfig.packageversion] urlrenderer <- liftIO newUrlRenderer- mapM_ (startthread urlrenderer)- [ watch $ commitThread #ifdef WITH_WEBAPP- , assist $ webAppThread d urlrenderer False listenhost Nothing webappwaiter+ let webappthread = [ assist $ webAppThread d urlrenderer False cannotrun listenhost Nothing webappwaiter ]+#else+ let webappthread = []+#endif+ let threads = if isJust cannotrun+ then webappthread+ else webappthread +++ [ watch $ commitThread+#ifdef WITH_WEBAPP #ifdef WITH_PAIRING- , assist $ pairListenerThread urlrenderer+ , assist $ pairListenerThread urlrenderer #endif #ifdef WITH_XMPP- , assist $ xmppClientThread urlrenderer- , assist $ xmppSendPackThread urlrenderer- , assist $ xmppReceivePackThread urlrenderer+ , assist $ xmppClientThread urlrenderer+ , assist $ xmppSendPackThread urlrenderer+ , assist $ xmppReceivePackThread urlrenderer #endif #endif- , assist $ pushThread- , assist $ pushRetryThread- , assist $ mergeThread- , assist $ transferWatcherThread- , assist $ transferPollerThread- , assist $ transfererThread- , assist $ daemonStatusThread- , assist $ sanityCheckerDailyThread- , assist $ sanityCheckerHourlyThread- , assist $ problemFixerThread urlrenderer+ , assist $ pushThread+ , assist $ pushRetryThread+ , assist $ mergeThread+ , assist $ transferWatcherThread+ , assist $ transferPollerThread+ , assist $ transfererThread+ , assist $ daemonStatusThread+ , assist $ sanityCheckerDailyThread+ , assist $ sanityCheckerHourlyThread+ , assist $ problemFixerThread urlrenderer #ifdef WITH_CLIBS- , assist $ mountWatcherThread urlrenderer+ , assist $ mountWatcherThread urlrenderer #endif- , assist $ netWatcherThread- , assist $ netWatcherFallbackThread- , assist $ transferScannerThread urlrenderer- , assist $ cronnerThread urlrenderer- , assist $ configMonitorThread- , assist $ glacierThread- , watch $ watchThread- -- must come last so that all threads that wait- -- on it have already started waiting- , watch $ sanityCheckerStartupThread startdelay- ]+ , assist $ netWatcherThread+ , assist $ netWatcherFallbackThread+ , assist $ transferScannerThread urlrenderer+ , assist $ cronnerThread urlrenderer+ , assist $ configMonitorThread+ , assist $ glacierThread+ , watch $ watchThread+ -- must come last so that all threads that wait+ -- on it have already started waiting+ , watch $ sanityCheckerStartupThread startdelay+ ] + mapM_ (startthread urlrenderer) threads liftIO waitForTermination watch a = (True, a)
Assistant/MakeRemote.hs view
@@ -20,6 +20,7 @@ import Logs.UUID import Logs.Remote import Git.Remote+import Git.Types (RemoteName) import Creds import Assistant.Gpg import Utility.Gpg (KeyId)
Assistant/Ssh.hs view
@@ -12,6 +12,7 @@ import Utility.UserInfo import Utility.Shell import Utility.Rsync+import Utility.FileMode import Git.Remote import Data.Text (Text)@@ -233,12 +234,8 @@ sshdir <- sshDir createDirectoryIfMissing True $ parentDir $ sshdir </> sshprivkeyfile - unlessM (doesFileExist $ sshdir </> sshprivkeyfile) $ do- h <- fdToHandle =<<- createFile (sshdir </> sshprivkeyfile)- (unionFileModes ownerWriteMode ownerReadMode)- hPutStr h (sshPrivKey sshkeypair)- hClose h+ unlessM (doesFileExist $ sshdir </> sshprivkeyfile) $+ writeFileProtected (sshdir </> sshprivkeyfile) (sshPrivKey sshkeypair) unlessM (doesFileExist $ sshdir </> sshpubkeyfile) $ writeFile (sshdir </> sshpubkeyfile) (sshPubKey sshkeypair)
Assistant/Threads/SanityChecker.hs view
@@ -25,8 +25,10 @@ import Utility.NotificationBroadcaster import Config import Utility.HumanTime+import Git.Repair import Data.Time.Clock.POSIX+import qualified Data.Set as S {- This thread runs once at startup, and most other threads wait for it - to finish. (However, the webapp thread does not, to prevent the UI@@ -35,6 +37,21 @@ sanityCheckerStartupThread startupdelay = namedThreadUnchecked "SanityCheckerStartup" $ do {- Stale git locks can prevent commits from happening, etc. -} void $ repairStaleGitLocks =<< liftAnnex gitRepo++ {- A corrupt index file can prevent the assistant from working at+ - all, so detect and repair. -}+ ifM (not <$> liftAnnex (inRepo (checkIndex S.empty)))+ ( do+ notice ["corrupt index file found at startup; removing and restaging"]+ liftAnnex $ inRepo nukeIndex+ {- Normally the startup scan avoids re-staging files,+ - but with the index deleted, everything needs to be+ - restaged. -}+ modifyDaemonStatus_ $ \s -> s { forceRestage = True }+ , whenM (liftAnnex $ inRepo missingIndex) $ do+ debug ["no index file; restaging"]+ modifyDaemonStatus_ $ \s -> s { forceRestage = True }+ ) {- If there's a startup delay, it's done here. -} liftIO $ maybe noop (threadDelaySeconds . Seconds . fromIntegral . durationSeconds) startupdelay
Assistant/Threads/Watcher.hs view
@@ -200,6 +200,9 @@ add matcher file | otherwise = noChange +shouldRestage :: DaemonStatus -> Bool+shouldRestage ds = scanComplete ds || forceRestage ds+ {- In direct mode, add events are received for both new files, and - modified existing files. -}@@ -214,7 +217,7 @@ - really modified, but it might have - just been deleted and been put back, - so it symlink is restaged to make sure. -}- ( ifM (scanComplete <$> getDaemonStatus)+ ( ifM (shouldRestage <$> getDaemonStatus) ( do link <- liftAnnex $ inRepo $ gitAnnexLink file key addLink file link (Just key)@@ -286,7 +289,7 @@ - links too.) -} ensurestaged (Just link) daemonstatus- | scanComplete daemonstatus = addLink file link mk+ | shouldRestage daemonstatus = addLink file link mk | otherwise = case filestatus of Just s | not (afterLastDaemonRun (statusChangeTime s) daemonstatus) -> noChange
Assistant/Threads/WebApp.hs view
@@ -52,11 +52,12 @@ :: AssistantData -> UrlRenderer -> Bool+ -> Maybe String -> Maybe HostName -> Maybe (IO Url) -> Maybe (Url -> FilePath -> IO ()) -> NamedThread-webAppThread assistantdata urlrenderer noannex listenhost postfirstrun onstartup = thread $ liftIO $ do+webAppThread assistantdata urlrenderer noannex cannotrun listenhost postfirstrun onstartup = thread $ liftIO $ do #ifdef __ANDROID__ when (isJust listenhost) $ -- See Utility.WebApp@@ -68,6 +69,7 @@ <*> getreldir <*> pure staticRoutes <*> pure postfirstrun+ <*> pure cannotrun <*> pure noannex <*> pure listenhost setUrlRenderer urlrenderer $ yesodRender webapp (pack "")
Assistant/TransferSlots.hs view
@@ -5,6 +5,8 @@ - Licensed under the GNU GPL version 3 or higher. -} +{-# LANGUAGE CPP #-}+ module Assistant.TransferSlots where import Assistant.Common@@ -32,8 +34,10 @@ import qualified Control.Exception as E import Control.Concurrent import qualified Control.Concurrent.MSemN as MSemN-import System.Posix.Signals (signalProcessGroup, sigTERM, sigKILL)+#ifndef mingw32_HOST_OS import System.Posix.Process (getProcessGroupIDOf)+import System.Posix.Signals (signalProcessGroup, sigTERM, sigKILL)+#endif type TransferGenerator = Assistant (Maybe (Transfer, TransferInfo, Transferrer -> Assistant ())) @@ -247,13 +251,18 @@ signalthread tid | pause = throwTo tid PauseTransfer | otherwise = killThread tid- {- In order to stop helper processes like rsync,- - kill the whole process group of the process running the transfer. -} killproc pid = void $ tryIO $ do+#ifndef mingw32_HOST_OS+ {- In order to stop helper processes like rsync,+ - kill the whole process group of the process+ - running the transfer. -} g <- getProcessGroupIDOf pid void $ tryIO $ signalProcessGroup sigTERM g threadDelay 50000 -- 0.05 second grace period void $ tryIO $ signalProcessGroup sigKILL g+#else+ error "TODO: cancelTransfer not implemented on Windows"+#endif {- Start or resume a transfer. -} startTransfer :: Transfer -> Assistant ()
Assistant/TransferrerPool.hs view
@@ -5,12 +5,17 @@ - Licensed under the GNU GPL version 3 or higher. -} +{-# LANGUAGE CPP #-}+ module Assistant.TransferrerPool where import Assistant.Common import Assistant.Types.TransferrerPool import Logs.Transfer++#ifndef mingw32_HOST_OS import qualified Command.TransferKeys as T+#endif import Control.Concurrent.STM import System.Process (create_group)@@ -38,13 +43,18 @@ - finish. -} performTransfer :: Transferrer -> Transfer -> AssociatedFile -> IO Bool performTransfer transferrer t f = catchBoolIO $ do+#ifndef mingw32_HOST_OS T.sendRequest t f (transferrerWrite transferrer) T.readResponse (transferrerRead transferrer)+#else+ error "TODO performTransfer not implemented on Windows"+#endif {- Starts a new git-annex transferkeys process, setting up a pipe - that will be used to communicate with it. -} mkTransferrer :: FilePath -> IO Transferrer mkTransferrer program = do+#ifndef mingw32_HOST_OS (myread, twrite) <- createPipe (tread, mywrite) <- createPipe mapM_ (\fd -> setFdOption fd CloseOnExec True) [myread, mywrite]@@ -68,6 +78,9 @@ , transferrerWrite = mywriteh , transferrerHandle = pid }+#else+ error "TODO mkTransferrer not implemented on Windows"+#endif {- Checks if a Transferrer is still running. If not, makes a new one. -} checkTransferrer :: FilePath -> Transferrer -> IO Transferrer
Assistant/Types/DaemonStatus.hs view
@@ -28,6 +28,8 @@ { startedThreads :: M.Map ThreadName (Async (), IO ()) -- False when the daemon is performing its startup scan , scanComplete :: Bool+ -- True when all files should be restaged.+ , forceRestage :: Bool -- Time when a previous process of the daemon was running ok , lastRunning :: Maybe POSIXTime -- True when the daily sanity checker is running@@ -80,6 +82,7 @@ newDaemonStatus :: IO DaemonStatus newDaemonStatus = DaemonStatus <$> pure M.empty+ <*> pure False <*> pure False <*> pure Nothing <*> pure False
Assistant/WebApp/Common.hs view
@@ -12,6 +12,7 @@ import Assistant.WebApp.Page as X import Assistant.WebApp.Form as X import Assistant.WebApp.Types as X+import Assistant.WebApp.RepoId as X import Utility.Yesod as X hiding (textField, passwordField, insertBy, replace, joinPath, deleteBy, delete, insert, Key, Option) import Data.Text as X (Text)
Assistant/WebApp/Configurators/AWS.hs view
@@ -23,7 +23,7 @@ import Types.StandardGroups import Creds import Assistant.Gpg-import Git.Remote+import Git.Types (RemoteName) import qualified Data.Text as T import qualified Data.Map as M
Assistant/WebApp/Configurators/Edit.hs view
@@ -38,6 +38,8 @@ import Types.Crypto import Utility.Gpg import Annex.UUID+import Assistant.Ssh+import Config import qualified Data.Text as T import qualified Data.Map as M@@ -158,26 +160,26 @@ Nothing -> aopt hiddenField "" Nothing Just d -> aopt textField "Associated directory" (Just $ Just d) -getEditRepositoryR :: UUID -> Handler Html+getEditRepositoryR :: RepoId -> Handler Html getEditRepositoryR = postEditRepositoryR -postEditRepositoryR :: UUID -> Handler Html+postEditRepositoryR :: RepoId -> Handler Html postEditRepositoryR = editForm False getEditNewRepositoryR :: UUID -> Handler Html getEditNewRepositoryR = postEditNewRepositoryR postEditNewRepositoryR :: UUID -> Handler Html-postEditNewRepositoryR = editForm True+postEditNewRepositoryR = editForm True . RepoUUID getEditNewCloudRepositoryR :: UUID -> Handler Html getEditNewCloudRepositoryR = postEditNewCloudRepositoryR postEditNewCloudRepositoryR :: UUID -> Handler Html-postEditNewCloudRepositoryR uuid = xmppNeeded >> editForm True uuid+postEditNewCloudRepositoryR uuid = xmppNeeded >> editForm True (RepoUUID uuid) -editForm :: Bool -> UUID -> Handler Html-editForm new uuid = page "Edit repository" (Just Configuration) $ do+editForm :: Bool -> RepoId -> Handler Html+editForm new (RepoUUID uuid) = page "Edit repository" (Just Configuration) $ do mremote <- liftAnnex $ Remote.remoteFromUUID uuid when (mremote == Nothing) $ whenM ((/=) uuid <$> liftAnnex getUUID) $@@ -196,7 +198,13 @@ config <- liftAnnex $ M.lookup uuid <$> readRemoteLog let repoInfo = getRepoInfo mremote config let repoEncryption = getRepoEncryption mremote config- $(widgetFile "configurators/editrepository")+ $(widgetFile "configurators/edit/repository")+editForm new r@(RepoName _) = page "Edit repository" (Just Configuration) $ do+ mr <- liftAnnex (repoIdRemote r)+ let repoInfo = getRepoInfo mr Nothing+ g <- liftAnnex gitRepo+ let sshrepo = maybe False (remoteLocationIsSshUrl . flip parseRemoteLocation g . Git.repoLocation . Remote.repo) mr+ $(widgetFile "configurators/edit/nonannexremote") {- Makes any directory associated with the repository. -} checkAssociatedDirectory :: RepoConfig -> Maybe Remote -> Annex ()@@ -245,3 +253,17 @@ ^{gpgKeyDisplay k (M.lookup k knownkeys)} |] getRepoEncryption _ _ = return () -- local repo++getUpgradeRepositoryR :: RepoId -> Handler ()+getUpgradeRepositoryR (RepoUUID _) = redirect DashboardR+getUpgradeRepositoryR r = go =<< liftAnnex (repoIdRemote r)+ where+ go Nothing = redirect DashboardR+ go (Just rmt) = do+ liftIO fixSshKeyPair+ liftAnnex $ setConfig + (remoteConfig (Remote.repo rmt) "ignore")+ (Git.Config.boolConfig False)+ liftAssistant $ syncRemote rmt+ liftAnnex $ void Remote.remoteListRefresh+ redirect DashboardR
Assistant/WebApp/Configurators/Local.hs view
@@ -30,6 +30,7 @@ import Utility.Network import Remote (prettyUUID) import Annex.UUID+import Annex.Direct import Types.StandardGroups import Logs.PreferredContent import Logs.UUID@@ -167,7 +168,7 @@ where addignore = do liftIO $ unlessM (doesFileExist ".gitignore") $- writeFile ".gitignore" ".thumbnails/*"+ writeFile ".gitignore" ".thumbnails" void $ inRepo $ Git.Command.runBool [Param "add", File ".gitignore"] @@ -199,7 +200,7 @@ getCombineRepositoryR newrepopath newrepouuid = do r <- combineRepos newrepopath remotename liftAssistant $ syncRemote r- redirect $ EditRepositoryR newrepouuid+ redirect $ EditRepositoryR $ RepoUUID newrepouuid where remotename = takeFileName newrepopath
Assistant/WebApp/Configurators/Ssh.hs view
@@ -20,7 +20,7 @@ import Utility.UserInfo import Utility.Gpg import Types.Remote (RemoteConfig)-import Git.Remote+import Git.Types (RemoteName) import qualified Remote.GCrypt as GCrypt import Annex.UUID import Logs.UUID
Assistant/WebApp/Configurators/WebDAV.hs view
@@ -18,7 +18,7 @@ import Types.Remote (RemoteConfig) import Types.StandardGroups import Logs.Remote-import Git.Remote+import Git.Types (RemoteName) import qualified Data.Map as M #endif
Assistant/WebApp/Control.hs view
@@ -67,5 +67,9 @@ getLogR = page "Logs" Nothing $ do logfile <- liftAnnex $ fromRepo gitAnnexLogFile logs <- liftIO $ listLogs logfile- logcontent <- liftIO $ concat <$> mapM readFile logs+ logcontent <- liftIO $ concat <$> mapM readlog logs $(widgetFile "control/log")+ where+ readlog f = withFile f ReadMode $ \h -> do+ fileEncoding h -- log may contain invalid utf-8+ hClose h `after` hGetContentsStrict h
Assistant/WebApp/Form.hs view
@@ -67,8 +67,7 @@ withExpandableNote :: Field sub master v -> (String, GWidget sub master ()) -> Field sub master v #endif withExpandableNote field (toggle, note) = withNote field $ [whamlet|-<a .btn data-toggle="collapse" data-target="##{ident}">- #{toggle}+<a .btn data-toggle="collapse" data-target="##{ident}">#{toggle}</a> <div ##{ident} .collapse> ^{note} |]
Assistant/WebApp/Gpg.hs view
@@ -18,6 +18,7 @@ import qualified Annex.Branch import qualified Git.GCrypt import qualified Remote.GCrypt as GCrypt+import Git.Types (RemoteName) import Assistant.WebApp.MakeRemote import Logs.Remote @@ -63,7 +64,7 @@ - branch from the gcrypt remote and merges it in, and then looks up - the name. -}-getGCryptRemoteName :: UUID -> String -> Annex Git.Remote.RemoteName+getGCryptRemoteName :: UUID -> String -> Annex RemoteName getGCryptRemoteName u repoloc = do tmpremote <- uniqueRemoteName "tmpgcryptremote" 0 <$> gitRepo void $ inRepo $ Git.Command.runBool
Assistant/WebApp/MakeRemote.hs view
@@ -17,7 +17,7 @@ import qualified Config import Config.Cost import Types.StandardGroups-import Git.Remote+import Git.Types (RemoteName) import Logs.PreferredContent import Assistant.MakeRemote
Assistant/WebApp/Page.hs view
@@ -52,16 +52,19 @@ customPage :: Maybe NavBarItem -> Widget -> Handler Html customPage navbaritem content = do webapp <- getYesod- navbar <- map navdetails <$> selectNavBar- pageinfo <- widgetToPageContent $ do- addStylesheet $ StaticR css_bootstrap_css- addStylesheet $ StaticR css_bootstrap_responsive_css- addScript $ StaticR jquery_full_js- addScript $ StaticR js_bootstrap_dropdown_js- addScript $ StaticR js_bootstrap_modal_js- addScript $ StaticR js_bootstrap_collapse_js- $(widgetFile "page")- giveUrlRenderer $(Hamlet.hamletFile $ hamletTemplate "bootstrap")+ case cannotRun webapp of+ Nothing -> do+ navbar <- map navdetails <$> selectNavBar+ pageinfo <- widgetToPageContent $ do+ addStylesheet $ StaticR css_bootstrap_css+ addStylesheet $ StaticR css_bootstrap_responsive_css+ addScript $ StaticR jquery_full_js+ addScript $ StaticR js_bootstrap_dropdown_js+ addScript $ StaticR js_bootstrap_modal_js+ addScript $ StaticR js_bootstrap_collapse_js+ $(widgetFile "page")+ giveUrlRenderer $(Hamlet.hamletFile $ hamletTemplate "bootstrap")+ Just msg -> error msg where navdetails i = (navBarName i, navBarRoute i, Just i == navbaritem)
+ Assistant/WebApp/RepoId.hs view
@@ -0,0 +1,40 @@+{- git-annex assistant webapp RepoId type+ -+ - Copyright 2012,2013 Joey Hess <joey@kitenet.net>+ -+ - Licensed under the GNU AGPL version 3 or higher.+ -}++module Assistant.WebApp.RepoId where++import Common.Annex+import Git.Types (RemoteName)+import qualified Remote++{- Parts of the webapp need to be able to act on repositories that may or+ - may not have a UUID. -}+data RepoId+ = RepoUUID UUID+ | RepoName RemoteName+ deriving (Eq, Ord, Show, Read)++mkRepoId :: Remote -> RepoId+mkRepoId r = case Remote.uuid r of+ NoUUID -> RepoName (Remote.name r)+ u -> RepoUUID u+++describeRepoId :: RepoId -> Annex String+describeRepoId (RepoUUID u) = Remote.prettyUUID u+describeRepoId (RepoName n) = return n++repoIdRemote :: RepoId -> Annex (Maybe Remote)+repoIdRemote (RepoUUID u) = Remote.remoteFromUUID u+repoIdRemote (RepoName n) = Remote.byNameOnly n++lacksUUID :: RepoId -> Bool+lacksUUID r = asUUID r == NoUUID++asUUID :: RepoId -> UUID+asUUID (RepoUUID u) = u+asUUID _ = NoUUID
Assistant/WebApp/RepoList.hs view
@@ -12,7 +12,6 @@ import Assistant.WebApp.Common import Assistant.DaemonStatus import Assistant.WebApp.Notifications-import Assistant.Ssh import qualified Annex import qualified Remote import qualified Types.Remote as Remote@@ -22,20 +21,22 @@ import Logs.Trust import Logs.Group import Config-import Git.Config import Git.Remote import Assistant.Sync import Config.Cost import Utility.NotificationBroadcaster import qualified Git-#ifdef WITH_XMPP-#endif import qualified Data.Map as M import qualified Data.Set as S import qualified Data.Text as T import Data.Function +type RepoList = [(RepoDesc, RepoId, Actions)]++type RepoDesc = String++{- Actions that can be performed on a repo in the list. -} data Actions = DisabledRepoActions { setupRepoLink :: Route WebApp }@@ -50,21 +51,21 @@ | UnwantedRepoActions { setupRepoLink :: Route WebApp } -mkSyncingRepoActions :: UUID -> Actions-mkSyncingRepoActions u = SyncingRepoActions- { setupRepoLink = EditRepositoryR u- , syncToggleLink = DisableSyncR u+mkSyncingRepoActions :: RepoId -> Actions+mkSyncingRepoActions repoid = SyncingRepoActions+ { setupRepoLink = EditRepositoryR repoid+ , syncToggleLink = DisableSyncR repoid } -mkNotSyncingRepoActions :: UUID -> Actions-mkNotSyncingRepoActions u = NotSyncingRepoActions- { setupRepoLink = EditRepositoryR u- , syncToggleLink = EnableSyncR u+mkNotSyncingRepoActions :: RepoId -> Actions+mkNotSyncingRepoActions repoid = NotSyncingRepoActions+ { setupRepoLink = EditRepositoryR repoid+ , syncToggleLink = EnableSyncR repoid } -mkUnwantedRepoActions :: UUID -> Actions-mkUnwantedRepoActions u = UnwantedRepoActions- { setupRepoLink = EditRepositoryR u+mkUnwantedRepoActions :: RepoId -> Actions+mkUnwantedRepoActions repoid = UnwantedRepoActions+ { setupRepoLink = EditRepositoryR repoid } needsEnabled :: Actions -> Bool@@ -122,10 +123,7 @@ $(widgetFile "repolist") where ident = "repolist"- unfinished uuid = uuid == NoUUID -type RepoList = [(String, UUID, Actions)]- {- A list of known repositories, with actions that can be taken on them. -} repoList :: RepoSelector -> Handler RepoList repoList reposelector@@ -133,27 +131,27 @@ | otherwise = list =<< (++) <$> configured <*> unconfigured where configured = do- syncing <- S.fromList . map Remote.uuid . syncRemotes- <$> liftAssistant getDaemonStatus+ syncremotes <- syncRemotes <$> liftAssistant getDaemonStatus+ let syncing = S.fromList $ map mkRepoId syncremotes liftAnnex $ do unwanted <- S.fromList- <$> filterM inUnwantedGroup (S.toList syncing)+ <$> filterM inUnwantedGroup (map Remote.uuid syncremotes) rs <- filter selectedrepo . concat . Remote.byCost <$> Remote.remoteList- let us = map Remote.uuid rs- let maker u- | u `S.member` unwanted = mkUnwantedRepoActions u- | u `S.member` syncing = mkSyncingRepoActions u- | otherwise = mkNotSyncingRepoActions u- let l = zip us $ map (maker . Remote.uuid) rs+ let l = flip map (map mkRepoId rs) $ \r -> case r of+ (RepoUUID u)+ | u `S.member` unwanted -> (r, mkUnwantedRepoActions r)+ _+ | r `S.member` syncing -> (r, mkSyncingRepoActions r)+ | otherwise -> (r, mkNotSyncingRepoActions r) if includeHere reposelector then do- u <- getUUID+ r <- RepoUUID <$> getUUID autocommit <- annexAutoCommit <$> Annex.getGitConfig let hereactions = if autocommit- then mkSyncingRepoActions u- else mkNotSyncingRepoActions u- let here = (u, hereactions)+ then mkSyncingRepoActions r+ else mkNotSyncingRepoActions r+ let here = (r, hereactions) return $ here : l else return l unconfigured = liftAnnex $ do@@ -164,7 +162,9 @@ <$> trustExclude DeadTrusted (M.keys m) selectedrepo r | Remote.readonly r = False- | onlyCloud reposelector = Git.repoIsUrl (Remote.repo r) && not (isXMPPRemote r)+ | onlyCloud reposelector = Git.repoIsUrl (Remote.repo r)+ && Remote.uuid r /= NoUUID + && not (isXMPPRemote r) | otherwise = True selectedremote Nothing = False selectedremote (Just (iscloud, _))@@ -190,23 +190,23 @@ _ -> Nothing where getconfig k = M.lookup k =<< M.lookup u m- val iscloud r = Just (iscloud, (u, DisabledRepoActions $ r u))- list l = liftAnnex $ do- let l' = nubBy ((==) `on` fst) l- l'' <- zip- <$> Remote.prettyListUUIDs (map fst l')- <*> pure l'- return $ map (\(name, (uuid, actions)) -> (name, uuid, actions)) l''+ val iscloud r = Just (iscloud, (RepoUUID u, DisabledRepoActions $ r u))+ list l = liftAnnex $+ forM (nubBy ((==) `on` fst) l) $ \(repoid, actions) ->+ (,,)+ <$> describeRepoId repoid+ <*> pure repoid+ <*> pure actions -getEnableSyncR :: UUID -> Handler ()+getEnableSyncR :: RepoId -> Handler () getEnableSyncR = flipSync True -getDisableSyncR :: UUID -> Handler ()+getDisableSyncR :: RepoId -> Handler () getDisableSyncR = flipSync False -flipSync :: Bool -> UUID -> Handler ()-flipSync enable uuid = do- mremote <- liftAnnex $ Remote.remoteFromUUID uuid+flipSync :: Bool -> RepoId -> Handler ()+flipSync enable repoid = do+ mremote <- liftAnnex $ repoIdRemote repoid liftAssistant $ changeSyncable mremote enable redirectBack @@ -238,29 +238,3 @@ costs = map Remote.cost rs' rs'' = (\(x, y) -> x ++ [remote] ++ y) $ splitAt (i + 1) rs' -{- Checks to see if any repositories with NoUUID have annex-ignore set.- - That could happen if there's a problem contacting a ssh remote- - soon after it was added. -}-getCheckUnfinishedRepositoriesR :: Handler Html-getCheckUnfinishedRepositoriesR = page "Unfinished repositories" (Just Configuration) $ do- stalled <- liftAnnex findStalled- $(widgetFile "configurators/checkunfinished")--findStalled :: Annex [Remote]-findStalled = filter isstalled <$> remoteListRefresh- where- isstalled r = Remote.uuid r == NoUUID- && remoteAnnexIgnore (Remote.gitconfig r)--getRetryUnfinishedRepositoriesR :: Handler ()-getRetryUnfinishedRepositoriesR = do- liftAssistant $ mapM_ unstall =<< liftAnnex findStalled- redirect DashboardR- where- unstall r = do- liftIO fixSshKeyPair- liftAnnex $ setConfig - (remoteConfig (Remote.repo r) "ignore")- (boolConfig False)- syncRemote r- liftAnnex $ void remoteListRefresh
Assistant/WebApp/Types.hs view
@@ -24,6 +24,7 @@ import Utility.Gpg (KeyId) import Build.SysConfig (packageversion) import Types.ScheduledActivity+import Assistant.WebApp.RepoId import Yesod.Static import Text.Hamlet@@ -43,6 +44,7 @@ , relDir :: Maybe FilePath , getStatic :: Static , postFirstRun :: Maybe (IO String)+ , cannotRun :: Maybe String , noAnnex :: Bool , listenHost ::Maybe HostName }@@ -214,5 +216,9 @@ fromPathPiece = readish . unpack instance PathPiece ScheduledActivity where+ toPathPiece = pack . show+ fromPathPiece = readish . unpack++instance PathPiece RepoId where toPathPiece = pack . show fromPathPiece = readish . unpack
Assistant/WebApp/routes view
@@ -29,13 +29,12 @@ /config/repository/switcher RepositorySwitcherR GET /config/repository/switchto/#FilePath SwitchToRepositoryR GET /config/repository/combine/#FilePath/#UUID CombineRepositoryR GET-/config/repository/edit/#UUID EditRepositoryR GET POST+/config/repository/edit/#RepoId EditRepositoryR GET POST /config/repository/edit/new/#UUID EditNewRepositoryR GET POST /config/repository/edit/new/cloud/#UUID EditNewCloudRepositoryR GET POST-/config/repository/sync/disable/#UUID DisableSyncR GET-/config/repository/sync/enable/#UUID EnableSyncR GET-/config/repository/unfinished/check CheckUnfinishedRepositoriesR GET-/config/repository/unfinished/retry RetryUnfinishedRepositoriesR GET+/config/repository/sync/disable/#RepoId DisableSyncR GET+/config/repository/sync/enable/#RepoId EnableSyncR GET+/config/repository/upgrade/#RepoId UpgradeRepositoryR GET /config/repository/add/drive AddDriveR GET POST /config/repository/add/drive/confirm/#RemovableDrive ConfirmAddDriveR GET
Assistant/XMPP.hs view
@@ -21,7 +21,7 @@ import Data.ByteString (ByteString) import qualified Data.ByteString as B import Data.XML.Types-import qualified Codec.Binary.Base64 as B64+import qualified "dataenc" Codec.Binary.Base64 as B64 {- Name of the git-annex tag, in our own XML namespace. - (Not using a namespace URL to avoid unnecessary bloat.) -}
Build/BundledPrograms.hs view
@@ -30,6 +30,7 @@ #endif , Just "rsync" , Just "ssh"+ , Just "ssh-keygen" #ifndef mingw32_HOST_OS , Just "sh" #endif
BuildFlags.hs view
@@ -60,4 +60,7 @@ #ifdef WITH_CRYPTOHASH , "CryptoHash" #endif+#ifdef WITH_EKG+ , "EKG"+#endif ]
CHANGELOG view
@@ -1,3 +1,48 @@+git-annex (5.20131118) unstable; urgency=low++ * Direct mode repositories now have core.bare=true set, to prevent+ accidentally running git commands that try to operate on the work tree,+ and so do the wrong thing in direct mode.+ * annex.version is now set to 5 for direct mode repositories.+ This upgrade is handled fully automatically, no need to run+ git annex upgrade+ * The "status" command has been renamed to "info", to allow+ "git annex status" to be used in direct mode repositories, now that+ "git status" won't work in them.+ * The -c option now not only modifies the git configuration seen by+ git-annex, but it is passed along to every git command git-annex runs.+ * watcher: Avoid loop when adding a file owned by someone else fails+ in indirect mode because its permissions cannot be modified.+ * webapp: Avoid encoding problems when displaying the daemon log file.+ * webapp: Improve UI around remote that have no annex.uuid set,+ either because setup of them is incomplete, or because the remote+ git repository is not a git-annex repository.+ * Include ssh-keygen in standalone bundle.+ * Allow optionally configuring git-annex with -fEKG to enable awesome+ remote monitoring interfaceat http://localhost:4242/+ * Fix bug that caused bad information to be written to the git-annex branch+ when running describe or other commands with a remote that has no uuid.+ * Work around Android linker problem that had prevented git-annex from+ running on Android 4.3 and 4.4.+ * repair: Handle case where index file is corrupt, but all objects are ok.+ * assistant: Notice on startup when the index file is corrupt, and+ auto-repair.+ * Fix direct mode merge bug when a direct mode file was deleted and replaced+ with a directory. An ordering problem caused the directory to not get+ created in this case.+ Thanks to Tim for the test case.+ * Direct mode .git/annex/objects directories are no longer left writable,+ because that allowed writing to symlinks of files that are not present,+ which followed the link and put bad content in an object location.+ Thanks to Tim for the test case.+ * fsck: Fix up .git/annex/object directory permissions.+ * Switched to the tasty test framework.+ * Android: Adjust default .gitignore to ignore .thumbnails at any location+ in the tree, not just at its top.+ * webapp: Check annex.version.++ -- Joey Hess <joeyh@debian.org> Mon, 18 Nov 2013 10:45:43 -0400+ git-annex (4.20131106) unstable; urgency=low * Improve local pairing behavior when two computers both try to start
Command/Add.hs view
@@ -23,10 +23,11 @@ import Annex.Link import qualified Annex import qualified Annex.Queue+#ifdef WITH_CLIBS #ifndef __ANDROID__ import Utility.Touch #endif-import Utility.FileMode+#endif import Config import Utility.InodeCache import Annex.FileMatcher@@ -86,11 +87,6 @@ - So a KeySource is returned. Its inodeCache can be used to detect any - changes that might be made to the file after it was locked down. -- - In indirect mode, the write bit is removed from the file as part of lock- - down to guard against further writes, and because objects in the annex- - have their write bit disabled anyway. This is not done in direct mode,- - because files there need to remain writable at all times.- - - When possible, the file is hard linked to a temp directory. This guards - against some changes, like deletion or overwrite of the file, and - allows lsof checks to be done more efficiently when adding a lot of files.@@ -103,16 +99,28 @@ , do tmp <- fromRepo gitAnnexTmpDir createAnnexDirectory tmp- unlessM isDirect $ - void $ liftIO $ tryIO $ preventWrite file- liftIO $ catchMaybeIO $ do+ eitherToMaybe <$> tryAnnexIO (go tmp)+ )+ where+ {- In indirect mode, the write bit is removed from the file as part+ - of lock down to guard against further writes, and because objects+ - in the annex have their write bit disabled anyway.+ -+ - Freezing the content early also lets us fail early when+ - someone else owns the file.+ -+ - This is not done in direct mode, because files there need to+ - remain writable at all times.+ -}+ go tmp = do+ unlessM isDirect $+ freezeContent file+ liftIO $ do (tmpfile, h) <- openTempFile tmp $ relatedTemplate $ takeFileName file hClose h nukeFile tmpfile withhardlink tmpfile `catchIO` const nohardlink- )- where nohardlink = do cache <- genInodeCache file return KeySource@@ -205,12 +213,14 @@ l <- inRepo $ gitAnnexLink file key replaceFile file $ makeAnnexLink l +#ifdef WITH_CLIBS #ifndef __ANDROID__ -- touch symlink to have same time as the original file, -- as provided in the InodeCache case mcache of Just c -> liftIO $ touch file (TimeSpec $ inodeCacheToMtime c) False Nothing -> noop+#endif #endif return l
Command/Fix.hs view
@@ -14,9 +14,11 @@ import Common.Annex import Command import qualified Annex.Queue+#ifdef WITH_CLIBS #ifndef __ANDROID__ import Utility.Touch #endif+#endif def :: [Command] def = [notDirect $ noCommit $ command "fix" paramPaths seek@@ -36,16 +38,20 @@ perform :: FilePath -> FilePath -> CommandPerform perform file link = do liftIO $ do+#ifdef WITH_CLIBS #ifndef __ANDROID__ -- preserve mtime of symlink mtime <- catchMaybeIO $ TimeSpec . modificationTime <$> getSymbolicLinkStatus file #endif+#endif createDirectoryIfMissing True (parentDir file) removeFile file createSymbolicLink link file+#ifdef WITH_CLIBS #ifndef __ANDROID__ maybe noop (\t -> touch file t False) mtime+#endif #endif next $ cleanup file
Command/Fsck.hs view
@@ -218,9 +218,10 @@ {- Since we're checking that a key's file is present, throw - in a permission fixup here too. -}- when (present && not direct) $ do- file <- calcRepo $ gitAnnexLocation key+ file <- calcRepo $ gitAnnexLocation key+ when (present && not direct) $ freezeContent file+ whenM (liftIO $ doesDirectoryExist $ parentDir file) $ freezeContentDir file {- In direct mode, modified files will show up as not present,
Command/Indirect.hs view
@@ -20,9 +20,9 @@ import qualified Annex import Annex.Direct import Annex.Content+import Annex.Content.Direct import Annex.CatFile import Annex.Version-import Annex.Perms import Annex.Exception import Init import qualified Command.Add@@ -77,7 +77,8 @@ Just s | isSymbolicLink s -> void $ flip whenAnnexed f $ \_ (k, _) -> do- cleandirect k+ removeInodeCache k+ removeAssociatedFiles k return Nothing | otherwise -> maybe noop (fromdirect f)@@ -87,8 +88,8 @@ fromdirect f k = do showStart "indirect" f- thawContentDir =<< calcRepo (gitAnnexLocation k)- cleandirect k -- clean before content directory gets frozen+ removeInodeCache k+ removeAssociatedFiles k whenM (liftIO $ not . isSymbolicLink <$> getSymbolicLinkStatus f) $ do v <-tryAnnexIO (moveAnnex k f) case v of@@ -103,10 +104,6 @@ warnlocked e = do warning $ show e warning "leaving this file as-is; correct this problem and run git annex add on it"-- cleandirect k = do- liftIO . nukeFile =<< calcRepo (gitAnnexInodeCache k)- liftIO . nukeFile =<< calcRepo (gitAnnexMapping k) cleanup :: CommandCleanup cleanup = do
+ Command/Info.hs view
@@ -0,0 +1,384 @@+{- git-annex command+ -+ - Copyright 2011 Joey Hess <joey@kitenet.net>+ -+ - Licensed under the GNU GPL version 3 or higher.+ -}++{-# LANGUAGE BangPatterns #-}++module Command.Info where++import "mtl" Control.Monad.State.Strict+import qualified Data.Map as M+import Text.JSON+import Data.Tuple+import Data.Ord+import System.PosixCompat.Files++import Common.Annex+import qualified Remote+import qualified Command.Unused+import qualified Git+import qualified Annex+import Command+import Utility.DataUnits+import Utility.DiskFree+import Annex.Content+import Types.Key+import Logs.UUID+import Logs.Trust+import Remote+import Config+import Utility.Percentage+import Logs.Transfer+import Types.TrustLevel+import Types.FileMatcher+import qualified Limit++-- a named computation that produces a statistic+type Stat = StatState (Maybe (String, StatState String))++-- data about a set of keys+data KeyData = KeyData+ { countKeys :: Integer+ , sizeKeys :: Integer+ , unknownSizeKeys :: Integer+ , backendsKeys :: M.Map String Integer+ }++data NumCopiesStats = NumCopiesStats+ { numCopiesVarianceMap :: M.Map Variance Integer+ }++newtype Variance = Variance Int+ deriving (Eq, Ord)++instance Show Variance where+ show (Variance n)+ | n >= 0 = "numcopies +" ++ show n+ | otherwise = "numcopies " ++ show n++-- cached info that multiple Stats use+data StatInfo = StatInfo+ { presentData :: Maybe KeyData+ , referencedData :: Maybe KeyData+ , numCopiesStats :: Maybe NumCopiesStats+ }++-- a state monad for running Stats in+type StatState = StateT StatInfo Annex++def :: [Command]+def = [noCommit $ command "info" paramPaths seek+ SectionQuery "shows general information about the annex"]++seek :: [CommandSeek]+seek = [withWords start]++start :: [FilePath] -> CommandStart+start [] = do+ globalInfo+ stop+start ps = do+ mapM_ localInfo =<< filterM isdir ps+ stop+ where+ isdir = liftIO . catchBoolIO . (isDirectory <$$> getFileStatus)++globalInfo :: Annex ()+globalInfo = do+ stats <- selStats global_fast_stats global_slow_stats+ showCustom "info" $ do+ evalStateT (mapM_ showStat stats) (StatInfo Nothing Nothing Nothing)+ return True++localInfo :: FilePath -> Annex ()+localInfo dir = showCustom (unwords ["info", dir]) $ do+ stats <- selStats (tostats local_fast_stats) (tostats local_slow_stats)+ evalStateT (mapM_ showStat stats) =<< getLocalStatInfo dir+ return True+ where+ tostats = map (\s -> s dir)++selStats :: [Stat] -> [Stat] -> Annex [Stat]+selStats fast_stats slow_stats = do+ fast <- Annex.getState Annex.fast+ return $ if fast+ then fast_stats+ else fast_stats ++ slow_stats++{- Order is significant. Less expensive operations, and operations+ - that share data go together.+ -}+global_fast_stats :: [Stat]+global_fast_stats = + [ repository_mode+ , remote_list Trusted+ , remote_list SemiTrusted+ , remote_list UnTrusted+ , transfer_list+ , disk_size+ ]+global_slow_stats :: [Stat]+global_slow_stats = + [ tmp_size+ , bad_data_size+ , local_annex_keys+ , local_annex_size+ , known_annex_files+ , known_annex_size+ , bloom_info+ , backend_usage+ ]+local_fast_stats :: [FilePath -> Stat]+local_fast_stats =+ [ local_dir+ , const local_annex_keys+ , const local_annex_size+ , const known_annex_files+ , const known_annex_size+ ]+local_slow_stats :: [FilePath -> Stat]+local_slow_stats =+ [ const numcopies_stats+ ]++stat :: String -> (String -> StatState String) -> Stat+stat desc a = return $ Just (desc, a desc)++nostat :: Stat+nostat = return Nothing++json :: JSON j => (j -> String) -> StatState j -> String -> StatState String+json serialize a desc = do+ j <- a+ lift $ maybeShowJSON [(desc, j)]+ return $ serialize j++nojson :: StatState String -> String -> StatState String+nojson a _ = a++showStat :: Stat -> StatState ()+showStat s = maybe noop calc =<< s+ where+ calc (desc, a) = do+ (lift . showHeader) desc+ lift . showRaw =<< a++repository_mode :: Stat+repository_mode = stat "repository mode" $ json id $ lift $+ ifM isDirect + ( return "direct", return "indirect" )++remote_list :: TrustLevel -> Stat+remote_list level = stat n $ nojson $ lift $ do+ us <- M.keys <$> (M.union <$> uuidMap <*> remoteMap Remote.name)+ rs <- fst <$> trustPartition level us+ s <- prettyPrintUUIDs n rs+ return $ if null s then "0" else show (length rs) ++ "\n" ++ beginning s+ where+ n = showTrustLevel level ++ " repositories"+ +local_dir :: FilePath -> Stat+local_dir dir = stat "directory" $ json id $ return dir++local_annex_keys :: Stat+local_annex_keys = stat "local annex keys" $ json show $+ countKeys <$> cachedPresentData++local_annex_size :: Stat+local_annex_size = stat "local annex size" $ json id $+ showSizeKeys <$> cachedPresentData++known_annex_files :: Stat+known_annex_files = stat "annexed files in working tree" $ json show $+ countKeys <$> cachedReferencedData++known_annex_size :: Stat+known_annex_size = stat "size of annexed files in working tree" $ json id $+ showSizeKeys <$> cachedReferencedData++tmp_size :: Stat+tmp_size = staleSize "temporary directory size" gitAnnexTmpDir++bad_data_size :: Stat+bad_data_size = staleSize "bad keys size" gitAnnexBadDir++bloom_info :: Stat+bloom_info = stat "bloom filter size" $ json id $ do+ localkeys <- countKeys <$> cachedPresentData+ capacity <- fromIntegral <$> lift Command.Unused.bloomCapacity+ let note = aside $+ if localkeys >= capacity+ then "appears too small for this repository; adjust annex.bloomcapacity"+ else showPercentage 1 (percentage capacity localkeys) ++ " full"++ -- Two bloom filters are used at the same time, so double the size+ -- of one.+ size <- roughSize memoryUnits False . (* 2) . fromIntegral . fst <$>+ lift Command.Unused.bloomBitsHashes++ return $ size ++ note++transfer_list :: Stat+transfer_list = stat "transfers in progress" $ nojson $ lift $ do+ uuidmap <- Remote.remoteMap id+ ts <- getTransfers+ return $ if null ts+ then "none"+ else multiLine $+ map (uncurry $ line uuidmap) $ sort ts+ where+ line uuidmap t i = unwords+ [ showLcDirection (transferDirection t) ++ "ing"+ , fromMaybe (key2file $ transferKey t) (associatedFile i)+ , if transferDirection t == Upload then "to" else "from"+ , maybe (fromUUID $ transferUUID t) Remote.name $+ M.lookup (transferUUID t) uuidmap+ ]++disk_size :: Stat+disk_size = stat "available local disk space" $ json id $ lift $+ calcfree+ <$> (annexDiskReserve <$> Annex.getGitConfig)+ <*> inRepo (getDiskFree . gitAnnexDir)+ where+ calcfree reserve (Just have) = unwords+ [ roughSize storageUnits False $ nonneg $ have - reserve+ , "(+" ++ roughSize storageUnits False reserve+ , "reserved)"+ ] + calcfree _ _ = "unknown"++ nonneg x+ | x >= 0 = x+ | otherwise = 0++backend_usage :: Stat+backend_usage = stat "backend usage" $ nojson $+ calc+ <$> (backendsKeys <$> cachedReferencedData)+ <*> (backendsKeys <$> cachedPresentData)+ where+ calc x y = multiLine $+ map (\(n, b) -> b ++ ": " ++ show n) $+ reverse $ sort $ map swap $ M.toList $+ M.unionWith (+) x y++numcopies_stats :: Stat+numcopies_stats = stat "numcopies stats" $ nojson $+ calc <$> (maybe M.empty numCopiesVarianceMap <$> cachedNumCopiesStats)+ where+ calc = multiLine+ . map (\(variance, count) -> show variance ++ ": " ++ show count)+ . reverse . sortBy (comparing snd) . M.toList++cachedPresentData :: StatState KeyData+cachedPresentData = do+ s <- get+ case presentData s of+ Just v -> return v+ Nothing -> do+ v <- foldKeys <$> lift getKeysPresent+ put s { presentData = Just v }+ return v++cachedReferencedData :: StatState KeyData+cachedReferencedData = do+ s <- get+ case referencedData s of+ Just v -> return v+ Nothing -> do+ !v <- lift $ Command.Unused.withKeysReferenced+ emptyKeyData addKey+ put s { referencedData = Just v }+ return v++-- currently only available for local info+cachedNumCopiesStats :: StatState (Maybe NumCopiesStats)+cachedNumCopiesStats = numCopiesStats <$> get++getLocalStatInfo :: FilePath -> Annex StatInfo+getLocalStatInfo dir = do+ fast <- Annex.getState Annex.fast+ matcher <- Limit.getMatcher+ (presentdata, referenceddata, numcopiesstats) <-+ Command.Unused.withKeysFilesReferencedIn dir initial+ (update matcher fast)+ return $ StatInfo (Just presentdata) (Just referenceddata) (Just numcopiesstats)+ where+ initial = (emptyKeyData, emptyKeyData, emptyNumCopiesStats)+ update matcher fast key file vs@(presentdata, referenceddata, numcopiesstats) =+ ifM (matcher $ FileInfo file file)+ ( do+ !presentdata' <- ifM (inAnnex key)+ ( return $ addKey key presentdata+ , return presentdata+ )+ let !referenceddata' = addKey key referenceddata+ !numcopiesstats' <- if fast+ then return numcopiesstats+ else updateNumCopiesStats key file numcopiesstats+ return $! (presentdata', referenceddata', numcopiesstats')+ , return vs+ )++emptyKeyData :: KeyData+emptyKeyData = KeyData 0 0 0 M.empty++emptyNumCopiesStats :: NumCopiesStats+emptyNumCopiesStats = NumCopiesStats M.empty++foldKeys :: [Key] -> KeyData+foldKeys = foldl' (flip addKey) emptyKeyData++addKey :: Key -> KeyData -> KeyData+addKey key (KeyData count size unknownsize backends) =+ KeyData count' size' unknownsize' backends'+ where+ {- All calculations strict to avoid thunks when repeatedly+ - applied to many keys. -}+ !count' = count + 1+ !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+ let !ret = NumCopiesStats m'+ return ret++showSizeKeys :: KeyData -> String+showSizeKeys d = total ++ missingnote+ where+ total = roughSize storageUnits False $ sizeKeys d+ missingnote+ | unknownSizeKeys d == 0 = ""+ | otherwise = aside $+ "+ " ++ show (unknownSizeKeys d) +++ " unknown size"++staleSize :: String -> (Git.Repo -> FilePath) -> Stat+staleSize label dirspec = go =<< lift (dirKeys dirspec)+ where+ go [] = nostat+ 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+ keysizes keys = do+ dir <- lift $ fromRepo dirspec+ liftIO $ forM keys $ \k -> catchDefaultIO 0 $+ fromIntegral . fileSize + <$> getFileStatus (dir </> keyFile k)++aside :: String -> String+aside s = " (" ++ s ++ ")"++multiLine :: [String] -> String+multiLine = concatMap (\l -> "\n\t" ++ l)
Command/List.hs view
@@ -22,7 +22,7 @@ import Annex.UUID import qualified Option import qualified Annex-import Git.Remote+import Git.Types (RemoteName) def :: [Command] def = [noCommit $ withOptions [allrepos] $ command "list" paramPaths seek
Command/Status.hs view
@@ -1,384 +1,89 @@ {- git-annex command -- - Copyright 2011 Joey Hess <joey@kitenet.net>+ - Copyright 2013 Joey Hess <joey@kitenet.net> - - Licensed under the GNU GPL version 3 or higher. -} -{-# LANGUAGE BangPatterns #-}- module Command.Status where -import "mtl" Control.Monad.State.Strict-import qualified Data.Map as M-import Text.JSON-import Data.Tuple-import Data.Ord-import System.PosixCompat.Files- import Common.Annex-import qualified Remote-import qualified Command.Unused-import qualified Git-import qualified Annex import Command-import Utility.DataUnits-import Utility.DiskFree-import Annex.Content-import Types.Key-import Logs.UUID-import Logs.Trust-import Remote+import Annex.CatFile+import Annex.Content.Direct import Config-import Utility.Percentage-import Logs.Transfer-import Types.TrustLevel-import Types.FileMatcher-import qualified Limit---- a named computation that produces a statistic-type Stat = StatState (Maybe (String, StatState String))---- data about a set of keys-data KeyData = KeyData- { countKeys :: Integer- , sizeKeys :: Integer- , unknownSizeKeys :: Integer- , backendsKeys :: M.Map String Integer- }--data NumCopiesStats = NumCopiesStats- { numCopiesVarianceMap :: M.Map Variance Integer- }--newtype Variance = Variance Int- deriving (Eq, Ord)--instance Show Variance where- show (Variance n)- | n >= 0 = "numcopies +" ++ show n- | otherwise = "numcopies " ++ show n---- cached info that multiple Stats use-data StatInfo = StatInfo- { presentData :: Maybe KeyData- , referencedData :: Maybe KeyData- , numCopiesStats :: Maybe NumCopiesStats- }---- a state monad for running Stats in-type StatState = StateT StatInfo Annex+import qualified Git.LsFiles as LsFiles+import qualified Git.Ref+import qualified Git def :: [Command]-def = [noCommit $ command "status" paramPaths seek- SectionQuery "shows status information about the annex"]+def = [notBareRepo $ noCommit $ noMessages $+ command "status" paramPaths seek SectionCommon+ "show the working tree status"] seek :: [CommandSeek]-seek = [withWords start]+seek = + [ withWords start+ ] start :: [FilePath] -> CommandStart start [] = do- globalStatus- stop-start ps = do- mapM_ localStatus =<< filterM isdir ps- stop- where- isdir = liftIO . catchBoolIO . (isDirectory <$$> getFileStatus)--globalStatus :: Annex ()-globalStatus = do- stats <- selStats global_fast_stats global_slow_stats- showCustom "status" $ do- evalStateT (mapM_ showStat stats) (StatInfo Nothing Nothing Nothing)- return True--localStatus :: FilePath -> Annex ()-localStatus dir = showCustom (unwords ["status", dir]) $ do- stats <- selStats (tostats local_fast_stats) (tostats local_slow_stats)- evalStateT (mapM_ showStat stats) =<< getLocalStatInfo dir- return True- where- tostats = map (\s -> s dir)--selStats :: [Stat] -> [Stat] -> Annex [Stat]-selStats fast_stats slow_stats = do- fast <- Annex.getState Annex.fast- return $ if fast- then fast_stats- else fast_stats ++ slow_stats--{- Order is significant. Less expensive operations, and operations- - that share data go together.- -}-global_fast_stats :: [Stat]-global_fast_stats = - [ repository_mode- , remote_list Trusted- , remote_list SemiTrusted- , remote_list UnTrusted- , transfer_list- , disk_size- ]-global_slow_stats :: [Stat]-global_slow_stats = - [ tmp_size- , bad_data_size- , local_annex_keys- , local_annex_size- , known_annex_files- , known_annex_size- , bloom_info- , backend_usage- ]-local_fast_stats :: [FilePath -> Stat]-local_fast_stats =- [ local_dir- , const local_annex_keys- , const local_annex_size- , const known_annex_files- , const known_annex_size- ]-local_slow_stats :: [FilePath -> Stat]-local_slow_stats =- [ const numcopies_stats- ]--stat :: String -> (String -> StatState String) -> Stat-stat desc a = return $ Just (desc, a desc)--nostat :: Stat-nostat = return Nothing--json :: JSON j => (j -> String) -> StatState j -> String -> StatState String-json serialize a desc = do- j <- a- lift $ maybeShowJSON [(desc, j)]- return $ serialize j+ -- Like git status, when run without a directory, behave as if+ -- given the path to the top of the repository.+ cwd <- liftIO getCurrentDirectory+ top <- fromRepo Git.repoPath+ next $ perform [relPathDirToFile cwd top]+start locs = next $ perform locs+ +perform :: [FilePath] -> CommandPerform+perform locs = do+ (l, cleanup) <- inRepo $ LsFiles.modifiedOthers locs+ getstatus <- ifM isDirect+ ( return statusDirect+ , return $ Just <$$> statusIndirect+ )+ forM_ l $ \f -> maybe noop (showFileStatus f) =<< getstatus f+ void $ liftIO cleanup+ next $ return True -nojson :: StatState String -> String -> StatState String-nojson a _ = a+data Status + = NewFile+ | DeletedFile+ | ModifiedFile -showStat :: Stat -> StatState ()-showStat s = maybe noop calc =<< s- where- calc (desc, a) = do- (lift . showHeader) desc- lift . showRaw =<< a+showStatus :: Status -> String+showStatus NewFile = "?"+showStatus DeletedFile = "D"+showStatus ModifiedFile = "M" -repository_mode :: Stat-repository_mode = stat "repository mode" $ json id $ lift $- ifM isDirect - ( return "direct", return "indirect" )+showFileStatus :: FilePath -> Status -> Annex ()+showFileStatus f s = liftIO $ putStrLn $ showStatus s ++ " " ++ f -remote_list :: TrustLevel -> Stat-remote_list level = stat n $ nojson $ lift $ do- us <- M.keys <$> (M.union <$> uuidMap <*> remoteMap Remote.name)- rs <- fst <$> trustPartition level us- s <- prettyPrintUUIDs n rs- return $ if null s then "0" else show (length rs) ++ "\n" ++ beginning s+statusDirect :: FilePath -> Annex (Maybe Status)+statusDirect f = checkstatus =<< liftIO (catchMaybeIO $ getFileStatus f) where- n = showTrustLevel level ++ " repositories"+ checkstatus Nothing = return $ Just DeletedFile+ checkstatus (Just s)+ -- Git thinks that present direct mode files modifed,+ -- so have to check.+ | not (isSymbolicLink s) = checkkey s =<< catKeyFile f+ | otherwise = Just <$> checkNew f -local_dir :: FilePath -> Stat-local_dir dir = stat "directory" $ json id $ return dir--local_annex_keys :: Stat-local_annex_keys = stat "local annex keys" $ json show $- countKeys <$> cachedPresentData--local_annex_size :: Stat-local_annex_size = stat "local annex size" $ json id $- showSizeKeys <$> cachedPresentData--known_annex_files :: Stat-known_annex_files = stat "annexed files in working tree" $ json show $- countKeys <$> cachedReferencedData--known_annex_size :: Stat-known_annex_size = stat "size of annexed files in working tree" $ json id $- showSizeKeys <$> cachedReferencedData--tmp_size :: Stat-tmp_size = staleSize "temporary directory size" gitAnnexTmpDir--bad_data_size :: Stat-bad_data_size = staleSize "bad keys size" gitAnnexBadDir--bloom_info :: Stat-bloom_info = stat "bloom filter size" $ json id $ do- localkeys <- countKeys <$> cachedPresentData- capacity <- fromIntegral <$> lift Command.Unused.bloomCapacity- let note = aside $- if localkeys >= capacity- then "appears too small for this repository; adjust annex.bloomcapacity"- else showPercentage 1 (percentage capacity localkeys) ++ " full"-- -- Two bloom filters are used at the same time, so double the size- -- of one.- size <- roughSize memoryUnits False . (* 2) . fromIntegral . fst <$>- lift Command.Unused.bloomBitsHashes-- return $ size ++ note+ checkkey s (Just k) = ifM (sameFileStatus k s)+ ( return Nothing+ , return $ Just ModifiedFile+ )+ checkkey _ Nothing = Just <$> checkNew f -transfer_list :: Stat-transfer_list = stat "transfers in progress" $ nojson $ lift $ do- uuidmap <- Remote.remoteMap id- ts <- getTransfers- return $ if null ts- then "none"- else multiLine $- map (uncurry $ line uuidmap) $ sort ts+statusIndirect :: FilePath -> Annex Status+statusIndirect f = ifM (liftIO $ isJust <$> catchMaybeIO (getFileStatus f))+ ( checkNew f+ , return DeletedFile+ ) where- line uuidmap t i = unwords- [ showLcDirection (transferDirection t) ++ "ing"- , fromMaybe (key2file $ transferKey t) (associatedFile i)- , if transferDirection t == Upload then "to" else "from"- , maybe (fromUUID $ transferUUID t) Remote.name $- M.lookup (transferUUID t) uuidmap- ] -disk_size :: Stat-disk_size = stat "available local disk space" $ json id $ lift $- calcfree- <$> (annexDiskReserve <$> Annex.getGitConfig)- <*> inRepo (getDiskFree . gitAnnexDir)- where- calcfree reserve (Just have) = unwords- [ roughSize storageUnits False $ nonneg $ have - reserve- , "(+" ++ roughSize storageUnits False reserve- , "reserved)"- ] - calcfree _ _ = "unknown"-- nonneg x- | x >= 0 = x- | otherwise = 0--backend_usage :: Stat-backend_usage = stat "backend usage" $ nojson $- calc- <$> (backendsKeys <$> cachedReferencedData)- <*> (backendsKeys <$> cachedPresentData)- where- calc x y = multiLine $- map (\(n, b) -> b ++ ": " ++ show n) $- reverse $ sort $ map swap $ M.toList $- M.unionWith (+) x y--numcopies_stats :: Stat-numcopies_stats = stat "numcopies stats" $ nojson $- calc <$> (maybe M.empty numCopiesVarianceMap <$> cachedNumCopiesStats)- where- calc = multiLine- . map (\(variance, count) -> show variance ++ ": " ++ show count)- . reverse . sortBy (comparing snd) . M.toList--cachedPresentData :: StatState KeyData-cachedPresentData = do- s <- get- case presentData s of- Just v -> return v- Nothing -> do- v <- foldKeys <$> lift getKeysPresent- put s { presentData = Just v }- return v--cachedReferencedData :: StatState KeyData-cachedReferencedData = do- s <- get- case referencedData s of- Just v -> return v- Nothing -> do- !v <- lift $ Command.Unused.withKeysReferenced- emptyKeyData addKey- put s { referencedData = Just v }- return v---- currently only available for local status-cachedNumCopiesStats :: StatState (Maybe NumCopiesStats)-cachedNumCopiesStats = numCopiesStats <$> get--getLocalStatInfo :: FilePath -> Annex StatInfo-getLocalStatInfo dir = do- fast <- Annex.getState Annex.fast- matcher <- Limit.getMatcher- (presentdata, referenceddata, numcopiesstats) <-- Command.Unused.withKeysFilesReferencedIn dir initial- (update matcher fast)- return $ StatInfo (Just presentdata) (Just referenceddata) (Just numcopiesstats)- where- initial = (emptyKeyData, emptyKeyData, emptyNumCopiesStats)- update matcher fast key file vs@(presentdata, referenceddata, numcopiesstats) =- ifM (matcher $ FileInfo file file)- ( do- !presentdata' <- ifM (inAnnex key)- ( return $ addKey key presentdata- , return presentdata- )- let !referenceddata' = addKey key referenceddata- !numcopiesstats' <- if fast- then return numcopiesstats- else updateNumCopiesStats key file numcopiesstats- return $! (presentdata', referenceddata', numcopiesstats')- , return vs- )--emptyKeyData :: KeyData-emptyKeyData = KeyData 0 0 0 M.empty--emptyNumCopiesStats :: NumCopiesStats-emptyNumCopiesStats = NumCopiesStats M.empty--foldKeys :: [Key] -> KeyData-foldKeys = foldl' (flip addKey) emptyKeyData--addKey :: Key -> KeyData -> KeyData-addKey key (KeyData count size unknownsize backends) =- KeyData count' size' unknownsize' backends'- where- {- All calculations strict to avoid thunks when repeatedly- - applied to many keys. -}- !count' = count + 1- !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- let !ret = NumCopiesStats m'- return ret--showSizeKeys :: KeyData -> String-showSizeKeys d = total ++ missingnote- where- total = roughSize storageUnits False $ sizeKeys d- missingnote- | unknownSizeKeys d == 0 = ""- | otherwise = aside $- "+ " ++ show (unknownSizeKeys d) ++- " unknown size"--staleSize :: String -> (Git.Repo -> FilePath) -> Stat-staleSize label dirspec = go =<< lift (dirKeys dirspec)- where- go [] = nostat- 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- keysizes keys = do- dir <- lift $ fromRepo dirspec- liftIO $ forM keys $ \k -> catchDefaultIO 0 $- fromIntegral . fileSize - <$> getFileStatus (dir </> keyFile k)--aside :: String -> String-aside s = " (" ++ s ++ ")"--multiLine :: [String] -> String-multiLine = concatMap (\l -> "\n\t" ++ l)+checkNew :: FilePath -> Annex Status+checkNew f = ifM (isJust <$> catObjectDetails (Git.Ref.fileRef f))+ ( return ModifiedFile+ , return NewFile+ )
Command/Sync.hs view
@@ -75,10 +75,10 @@ prepMerge = liftIO . setCurrentDirectory =<< fromRepo Git.repoPath syncBranch :: Git.Ref -> Git.Ref-syncBranch = Git.Ref.under "refs/heads/synced/"+syncBranch = Git.Ref.under "refs/heads/synced" . fromDirectBranch remoteBranch :: Remote -> Git.Ref -> Git.Ref-remoteBranch remote = Git.Ref.under $ "refs/remotes/" ++ Remote.name remote+remoteBranch remote = Git.Ref.underBase $ "refs/remotes/" ++ Remote.name remote syncRemotes :: [String] -> Annex [Remote] syncRemotes rs = ifM (Annex.getState Annex.fast) ( nub <$> pickfast , wanted )@@ -138,7 +138,13 @@ pushLocal :: Maybe Git.Ref -> CommandStart pushLocal Nothing = stop pushLocal (Just branch) = do+ -- Update the sync branch to match the new state of the branch inRepo $ updateBranch $ syncBranch branch+ -- In direct mode, we're operating on some special direct mode+ -- branch, rather than the intended branch, so update the indended+ -- branch.+ whenM isDirect $+ inRepo $ updateBranch $ fromDirectBranch branch stop updateBranch :: Git.Ref -> Git.Repo -> IO ()@@ -232,7 +238,7 @@ , refspec branch ] directpush = Git.Command.runQuiet $ pushparams- [show $ Git.Ref.base branch]+ [show $ Git.Ref.base $ fromDirectBranch branch] pushparams branches = [ Param "push" , Param $ Remote.name remote@@ -315,6 +321,7 @@ , Param "-m" , Param "git-annex automatic merge conflict fix" ]+ showLongNote "Merge conflict was automatically resolved; you may want to examine the result." return merged resolveMerge' :: LsFiles.Unmerged -> Annex (Maybe FilePath)
Command/Upgrade.hs view
@@ -11,6 +11,7 @@ import Command import Upgrade import Annex.Version+import Config def :: [Command] def = [dontCheck repoExists $ -- because an old version may not seem to exist@@ -23,6 +24,9 @@ start :: CommandStart start = do showStart "upgrade" "."- r <- upgrade- setVersion defaultVersion+ r <- upgrade False+ ifM isDirect+ ( setVersion directModeVersion+ , setVersion defaultVersion+ ) next $ next $ return r
Command/Watch.hs view
@@ -32,5 +32,5 @@ start assistant foreground stopdaemon startdelay = do if stopdaemon then stopDaemon- else startDaemon assistant foreground startdelay Nothing Nothing -- does not return+ else startDaemon assistant foreground startdelay Nothing Nothing Nothing -- does not return stop
Command/WebApp.hs view
@@ -30,6 +30,8 @@ import qualified Annex import Config.Files import qualified Option+import Upgrade+import Annex.Version import Control.Concurrent import Control.Concurrent.STM@@ -56,10 +58,14 @@ start' :: Bool -> Maybe HostName -> CommandStart start' allowauto listenhost = do liftIO ensureInstalled- ifM isInitialized ( go , auto )+ ifM isInitialized + ( go+ , auto+ ) stop where go = do+ cannotrun <- needsUpgrade . fromMaybe (error "no version") =<< getVersion browser <- fromRepo webBrowser f <- liftIO . absPath =<< fromRepo gitAnnexHtmlShim ifM (checkpid <&&> checkshim f)@@ -69,7 +75,7 @@ url <- liftIO . readFile =<< fromRepo gitAnnexUrlFile liftIO $ openBrowser browser f url Nothing Nothing- , startDaemon True True Nothing listenhost $ Just $ + , startDaemon True True Nothing cannotrun listenhost $ Just $ \origout origerr url htmlshim -> if isJust listenhost then maybe noop (`hPutStrLn` url) origout@@ -133,7 +139,7 @@ let callback a = Just $ a v runAssistant d $ do startNamedThread urlrenderer $- webAppThread d urlrenderer True listenhost+ webAppThread d urlrenderer True Nothing listenhost (callback signaler) (callback mainthread) waitNamedThreads@@ -155,7 +161,7 @@ _wait <- takeMVar v state <- Annex.new =<< Git.CurrentRepo.get Annex.eval state $- startDaemon True True Nothing listenhost $ Just $+ startDaemon True True Nothing Nothing listenhost $ Just $ sendurlback v sendurlback v _origout _origerr url _htmlshim = do recordUrl url
Config.hs view
@@ -71,11 +71,6 @@ isDirect :: Annex Bool isDirect = annexDirect <$> Annex.getGitConfig -setDirect :: Bool -> Annex ()-setDirect b = do- setConfig (annexConfig "direct") (Git.Config.boolConfig b)- Annex.changeGitConfig $ \c -> c { annexDirect = b }- crippledFileSystem :: Annex Bool crippledFileSystem = annexCrippledFileSystem <$> Annex.getGitConfig
Git/Branch.hs view
@@ -13,7 +13,7 @@ import Git import Git.Sha import Git.Command-import Git.Ref (headRef)+import qualified Git.Ref {- The currently checked out branch. -@@ -36,7 +36,7 @@ {- The current branch, which may not really exist yet. -} currentUnsafe :: Repo -> IO (Maybe Git.Ref) currentUnsafe r = parse . firstLine- <$> pipeReadStrict [Param "symbolic-ref", Param $ show headRef] r+ <$> pipeReadStrict [Param "symbolic-ref", Param $ show Git.Ref.headRef] r where parse l | null l = Nothing@@ -97,7 +97,7 @@ sha <- getSha "commit-tree" $ pipeWriteRead (map Param $ ["commit-tree", show tree] ++ ps) (Just $ flip hPutStr message) repo- run [Param "update-ref", Param $ show branch, Param $ show sha] repo+ update branch sha repo return sha where ps = concatMap (\r -> ["-p", show r]) parentrefs@@ -105,3 +105,29 @@ {- A leading + makes git-push force pushing a branch. -} forcePush :: String -> String forcePush b = "+" ++ b++{- Updates a branch (or other ref) to a new Sha. -}+update :: Branch -> Sha -> Repo -> IO ()+update branch sha = run + [ Param "update-ref"+ , Param $ show branch+ , Param $ show sha+ ]++{- Checks out a branch, creating it if necessary. -}+checkout :: Branch -> Repo -> IO ()+checkout branch = run+ [ Param "checkout"+ , Param "-q"+ , Param "-B"+ , Param $ show $ Git.Ref.base branch+ ]++{- Removes a branch. -}+delete :: Branch -> Repo -> IO ()+delete branch = run+ [ Param "branch"+ , Param "-q"+ , Param "-D"+ , Param $ show $ Git.Ref.base branch+ ]
Git/Command.hs view
@@ -21,7 +21,8 @@ {- Constructs a git command line operating on the specified repo. -} gitCommandLine :: [CommandParam] -> Repo -> [CommandParam]-gitCommandLine params Repo { location = l@(Local _ _ ) } = setdir : settree ++ params+gitCommandLine params r@(Repo { location = l@(Local _ _ ) }) =+ setdir : settree ++ gitGlobalOpts r ++ params where setdir = Param $ "--git-dir=" ++ gitpath (gitdir l) settree = case worktree l of
Git/Config.hs view
@@ -153,7 +153,10 @@ boolConfig False = "false" isBare :: Repo -> Bool-isBare r = fromMaybe False $ isTrue =<< getMaybe "core.bare" r+isBare r = fromMaybe False $ isTrue =<< getMaybe coreBare r++coreBare :: String+coreBare = "core.bare" {- Runs a command to get the configuration of a repo, - and returns a repo populated with the configuration, as well as the raw
Git/Construct.hs view
@@ -230,6 +230,7 @@ , remotes = [] , remoteName = Nothing , gitEnv = Nothing+ , gitGlobalOpts = [] }
Git/GCrypt.hs view
@@ -15,7 +15,6 @@ import qualified Git.Config as Config import qualified Git.Command as Command import Utility.Gpg-import Git.Remote urlPrefix :: String urlPrefix = "gcrypt::"
+ Git/Hook.hs view
@@ -0,0 +1,54 @@+{- git hooks+ -+ - Copyright 2013 Joey Hess <joey@kitenet.net>+ -+ - Licensed under the GNU GPL version 3 or higher.+ -}++module Git.Hook where++import Common+import Git+import Utility.Tmp++data Hook = Hook+ { hookName :: FilePath+ , hookScript :: String+ }++hookFile :: Hook -> Repo -> FilePath+hookFile h r = localGitDir r </> "hooks" </> hookName h++{- Writes a hook. Returns False if the hook already exists with a different+ - content. -}+hookWrite :: Hook -> Repo -> IO Bool+hookWrite h r = do+ let f = hookFile h r+ ifM (doesFileExist f)+ ( expectedContent h r+ , do+ viaTmp writeFile f (hookScript h)+ p <- getPermissions f+ setPermissions f $ p {executable = True}+ return True+ )++{- Removes a hook. Returns False if the hook contained something else, and+ - could not be removed. -}+hookUnWrite :: Hook -> Repo -> IO Bool+hookUnWrite h r = do+ let f = hookFile h r+ ifM (doesFileExist f)+ ( ifM (expectedContent h r)+ ( do+ removeFile f+ return True+ , return False+ )+ , return True+ )++expectedContent :: Hook -> Repo -> IO Bool+expectedContent h r = do+ content <- readFile $ hookFile h r+ return $ content == hookScript h
Git/LsFiles.hs view
@@ -11,6 +11,7 @@ allFiles, deleted, modified,+ modifiedOthers, staged, stagedNotDeleted, stagedOthersDetails,@@ -64,6 +65,12 @@ modified l repo = pipeNullSplit params repo where params = [Params "ls-files --modified -z --"] ++ map File l++{- Files that have been modified or are not checked into git. -}+modifiedOthers :: [FilePath] -> Repo -> IO ([FilePath], IO Bool)+modifiedOthers l repo = pipeNullSplit params repo+ where+ params = [Params "ls-files --modified --others -z --"] ++ map File l {- Returns a list of all files that are staged for commit. -} staged :: [FilePath] -> Repo -> IO ([FilePath], IO Bool)
Git/Ref.hs view
@@ -29,16 +29,41 @@ | prefix `isPrefixOf` s = drop (length prefix) s | otherwise = s +{- Given a directory and any ref, takes the basename of the ref and puts+ - it under the directory. -}+under :: String -> Ref -> Ref+under dir r = Ref $ dir ++ "/" +++ (reverse $ takeWhile (/= '/') $ reverse $ show r)+ {- Given a directory such as "refs/remotes/origin", and a ref such as - refs/heads/master, yields a version of that ref under the directory, - such as refs/remotes/origin/master. -}-under :: String -> Ref -> Ref-under dir r = Ref $ dir </> show (base r)+underBase :: String -> Ref -> Ref+underBase dir r = Ref $ dir ++ "/" ++ show (base r) +{- A Ref that can be used to refer to a file in the repository, as staged+ - in the index.+ -+ - Prefixing the file with ./ makes this work even if in a subdirectory+ - of a repo.+ -}+fileRef :: FilePath -> Ref+fileRef f = Ref $ ":./" ++ f++{- A Ref that can be used to refer to a file in the repository as it+ - appears in a given Ref. -}+fileFromRef :: Ref -> FilePath -> Ref+fileFromRef (Ref r) f = let (Ref fr) = fileRef f in Ref (r ++ fr)+ {- Checks if a ref exists. -} exists :: Ref -> Repo -> IO Bool exists ref = runBool [Param "show-ref", Param "--verify", Param "-q", Param $ show ref]++{- The file used to record a ref. (Git also stores some refs in a+ - packed-refs file.) -}+file :: Ref -> Repo -> FilePath+file ref repo = localGitDir repo </> show ref {- Checks if HEAD exists. It generally will, except for in a repository - that was just created. -}
Git/Remote.hs view
@@ -11,6 +11,7 @@ import Common import Git+import Git.Types import qualified Git.Command import qualified Git.BuildVersion @@ -21,8 +22,6 @@ import Git.FilePath #endif -type RemoteName = String- {- Construct a legal git remote name out of an arbitrary input string. - - There seems to be no formal definition of this in the git source,@@ -61,6 +60,10 @@ remoteLocationIsUrl :: RemoteLocation -> Bool remoteLocationIsUrl (RemoteUrl _) = True remoteLocationIsUrl _ = False++remoteLocationIsSshUrl :: RemoteLocation -> Bool+remoteLocationIsSshUrl (RemoteUrl u) = "ssh://" `isPrefixOf` u+remoteLocationIsSshUrl _ = False {- Determines if a given remote location is an url, or a local - path. Takes the repository's insteadOf configuration into account. -}
Git/Repair.hs view
@@ -12,8 +12,9 @@ retrieveMissingObjects, resetLocalBranches, removeTrackingBranches,- rewriteIndex, checkIndex,+ missingIndex,+ nukeIndex, emptyGoodCommits, ) where @@ -368,7 +369,9 @@ -- as long as ls-tree succeeded, we're good else cleanup -{- Checks that the index file only refers to objects that are not missing. -}+{- Checks that the index file only refers to objects that are not missing,+ - and is not itself corrupt. Note that a missing index file is not+ - considered a problem (repo may be new). -} checkIndex :: MissingObjects -> Repo -> IO Bool checkIndex missing r = do (bad, _good, cleanup) <- partitionIndex missing r@@ -378,6 +381,9 @@ void cleanup return False +missingIndex :: Repo -> IO Bool+missingIndex r = not <$> doesFileExist (localGitDir r </> "index")+ partitionIndex :: MissingObjects -> Repo -> IO ([LsFiles.StagedDetails], [LsFiles.StagedDetails], IO Bool) partitionIndex missing r = do (indexcontents, cleanup) <- LsFiles.stagedDetails [repoPath r] r@@ -396,7 +402,7 @@ | otherwise = do (bad, good, cleanup) <- partitionIndex missing r unless (null bad) $ do- nukeFile (localGitDir r </> "index")+ nukeIndex r UpdateIndex.streamUpdateIndex r =<< (catMaybes <$> mapM reinject good) void cleanup@@ -408,6 +414,9 @@ UpdateIndex.stageFile sha blobtype file r reinject _ = return Nothing +nukeIndex :: Repo -> IO ()+nukeIndex r = nukeFile (localGitDir r </> "index")+ newtype GoodCommits = GoodCommits (S.Set Sha) emptyGoodCommits :: GoodCommits@@ -448,7 +457,16 @@ missing <- cleanCorruptObjects fsckresult g stillmissing <- retrieveMissingObjects missing referencerepo g if S.null stillmissing- then successfulfinish stillmissing []+ then if repoIsLocalBare g+ then successfulfinish stillmissing []+ else ifM (checkIndex stillmissing g)+ ( successfulfinish stillmissing []+ , do+ putStrLn "No missing objects found, but the index file is corrupt!"+ if forced+ then corruptedindex+ else needforce stillmissing+ ) else do putStrLn $ unwords [ show (S.size stillmissing)@@ -491,6 +509,12 @@ putStrLn "Successfully recovered repository!" putStrLn "Please carefully check that the changes mentioned above are ok.." return (True, stillmissing, modifiedbranches)+ + corruptedindex = do+ nukeIndex g+ putStrLn "Removed the corrupted index file. You should look at what files are present in your working tree and git add them back to the index when appropriate."+ return (True, S.empty, [])+ successfulfinish stillmissing modifiedbranches = do mapM_ putStrLn [ "Successfully recovered repository!"@@ -503,5 +527,8 @@ then do putStrLn "If you have a clone of this bare repository, you should add it as a remote of this repository, and re-run git-recover-repository." putStrLn "If there are no clones of this repository, you can instead run git-recover-repository with the --force parameter to force recovery to a possibly usable state."- else putStrLn "To force a recovery to a usable state, run this command again with the --force parameter."+ return (False, stillmissing, [])+ else needforce stillmissing+ needforce stillmissing = do+ putStrLn "To force a recovery to a usable state, run this command again with the --force parameter." return (False, stillmissing, [])
Git/Types.hs view
@@ -10,6 +10,7 @@ import Network.URI import qualified Data.Map as M import System.Posix.Types+import Utility.SafeCommand {- Support repositories on local disk, and repositories accessed via an URL. -@@ -35,10 +36,14 @@ , fullconfig :: M.Map String [String] , remotes :: [Repo] -- remoteName holds the name used for this repo in remotes- , remoteName :: Maybe String+ , remoteName :: Maybe RemoteName -- alternate environment to use when running git commands , gitEnv :: Maybe [(String, String)]+ -- global options to pass to git when running git commands+ , gitGlobalOpts :: [CommandParam] } deriving (Show, Eq)++type RemoteName = String {- A git ref. Can be a sha1, or a branch or tag name. -} newtype Ref = Ref String
GitAnnex.hs view
@@ -5,7 +5,7 @@ - Licensed under the GNU GPL version 3 or higher. -} -{-# LANGUAGE CPP #-}+{-# LANGUAGE CPP, OverloadedStrings #-} module GitAnnex where @@ -46,6 +46,7 @@ import qualified Command.List import qualified Command.Log import qualified Command.Merge+import qualified Command.Info import qualified Command.Status import qualified Command.Migrate import qualified Command.Uninit@@ -87,6 +88,9 @@ import qualified Command.Test import qualified Command.FuzzTest #endif+#ifdef WITH_EKG+import System.Remote.Monitoring+#endif cmds :: [Command] cmds = concat@@ -140,6 +144,7 @@ , Command.List.def , Command.Log.def , Command.Merge.def+ , Command.Info.def , Command.Status.def , Command.Migrate.def , Command.Map.def@@ -169,4 +174,8 @@ header = "git-annex command [option ...]" run :: [String] -> IO ()-run args = dispatch True args cmds options [] header Git.CurrentRepo.get+run args = do+#ifdef WITH_EKG+ _ <- forkServer "localhost" 4242+#endif+ dispatch True args cmds options [] header Git.CurrentRepo.get
GitAnnex/Options.hs view
@@ -11,6 +11,7 @@ import Common.Annex import qualified Git.Config+import Git.Types import Command import Types.TrustLevel import qualified Annex@@ -59,12 +60,14 @@ "Trust Amazon Glacier inventory" ] ++ Option.matcher where+ trustArg t = ReqArg (Remote.forceTrust t) paramRemote setnumcopies v = maybe noop (\n -> Annex.changeState $ \s -> s { Annex.forcenumcopies = Just n }) (readish v) setuseragent v = Annex.changeState $ \s -> s { Annex.useragent = Just v }- setgitconfig v = Annex.changeGitRepo =<< inRepo (Git.Config.store v)- trustArg t = ReqArg (Remote.forceTrust t) paramRemote+ setgitconfig v = inRepo (Git.Config.store v)+ >>= pure . (\r -> r { gitGlobalOpts = gitGlobalOpts r ++ [Param "-c", Param v] })+ >>= Annex.changeGitRepo keyOptions :: [Option] keyOptions =
Init.hs view
@@ -12,11 +12,10 @@ isInitialized, initialize, uninitialize,- probeCrippledFileSystem+ probeCrippledFileSystem, ) where import Common.Annex-import Utility.Tmp import Utility.Network import qualified Annex import qualified Git@@ -26,7 +25,6 @@ import Logs.UUID import Annex.Version import Annex.UUID-import Utility.Shell import Config import Annex.Direct import Annex.Content.Direct@@ -36,6 +34,8 @@ import Utility.UserInfo import Utility.FileMode #endif+import Annex.Hook+import Upgrade genDescription :: Maybe String -> Annex String genDescription (Just d) = return d@@ -53,10 +53,19 @@ initialize :: Maybe String -> Annex () initialize mdescription = do prepUUID- setVersion defaultVersion- checkCrippledFileSystem checkFifoSupport- gitPreCommitHookWrite+ checkCrippledFileSystem+ unlessM isBare $+ hookWrite preCommitHook+ ifM (crippledFileSystem <&&> not <$> isBare)+ ( do+ enableDirectMode+ setDirect True+ setVersion directModeVersion+ , do+ setVersion defaultVersion+ setDirect False+ ) createInodeSentinalFile u <- getUUID {- This will make the first commit to git, so ensure git is set up@@ -67,16 +76,19 @@ uninitialize :: Annex () uninitialize = do- gitPreCommitHookUnWrite+ hookUnWrite preCommitHook removeRepoUUID removeVersion {- Will automatically initialize if there is already a git-annex - branch from somewhere. Otherwise, require a manual init - to avoid git-annex accidentially being run in git- - repos that did not intend to use it. -}+ - repos that did not intend to use it.+ -+ - Checks repository version and handles upgrades too.+ -} ensureInitialized :: Annex ()-ensureInitialized = getVersion >>= maybe needsinit checkVersion+ensureInitialized = getVersion >>= maybe needsinit checkUpgrade where needsinit = ifM Annex.Branch.hasSibling ( initialize Nothing@@ -87,45 +99,8 @@ isInitialized :: Annex Bool isInitialized = maybe Annex.Branch.hasSibling (const $ return True) =<< getVersion -{- set up a git pre-commit hook, if one is not already present -}-gitPreCommitHookWrite :: Annex ()-gitPreCommitHookWrite = unlessBare $ do- hook <- preCommitHook- ifM (liftIO $ doesFileExist hook)- ( do- content <- liftIO $ readFile hook- when (content /= preCommitScript) $- warning $ "pre-commit hook (" ++ hook ++ ") already exists, not configuring"- , unlessM crippledFileSystem $- liftIO $ do- viaTmp writeFile hook preCommitScript- p <- getPermissions hook- setPermissions hook $ p {executable = True}- )--gitPreCommitHookUnWrite :: Annex ()-gitPreCommitHookUnWrite = unlessBare $ do- hook <- preCommitHook- whenM (liftIO $ doesFileExist hook) $- ifM (liftIO $ (==) preCommitScript <$> readFile hook)- ( liftIO $ removeFile hook- , warning $ "pre-commit hook (" ++ hook ++ - ") contents modified; not deleting." ++- " Edit it to remove call to git annex."- )--unlessBare :: Annex () -> Annex ()-unlessBare = unlessM $ fromRepo Git.repoIsLocalBare--preCommitHook :: Annex FilePath-preCommitHook = (</>) <$> fromRepo Git.localGitDir <*> pure "hooks/pre-commit"--preCommitScript :: String-preCommitScript = unlines- [ shebang_local- , "# automatically configured by git-annex"- , "git annex pre-commit ."- ]+isBare :: Annex Bool+isBare = fromRepo Git.repoIsLocalBare {- A crippled filesystem is one that does not allow making symlinks, - or removing write access from files. -}@@ -158,25 +133,15 @@ warning "Detected a crippled filesystem." setCrippledFileSystem True - {- Normally git disables core.symlinks itself when the filesystem does- - not support them, but in Cygwin, git does support symlinks, while- - git-annex, not linking with Cygwin, does not. -}+ {- Normally git disables core.symlinks itself when the+ - filesystem does not support them, but in Cygwin, git+ - does support symlinks, while git-annex, not linking+ - with Cygwin, does not. -} whenM (coreSymlinks <$> Annex.getGitConfig) $ do warning "Disabling core.symlinks." setConfig (ConfigKey "core.symlinks") (Git.Config.boolConfig False) - unlessBare $ do- unlessM isDirect $ do- warning "Enabling direct mode."- top <- fromRepo Git.repoPath- (l, clean) <- inRepo $ Git.LsFiles.inRepo [top]- forM_ l $ \f ->- maybe noop (`toDirect` f) =<< isAnnexLink f- void $ liftIO clean- setDirect True- setVersion directModeVersion- probeFifoSupport :: Annex Bool probeFifoSupport = do #ifdef mingw32_HOST_OS@@ -199,3 +164,12 @@ warning "Detected a filesystem without fifo support." warning "Disabling ssh connection caching." setConfig (annexConfig "sshcaching") (Git.Config.boolConfig False)++enableDirectMode :: Annex ()+enableDirectMode = unlessM isDirect $ do+ warning "Enabling direct mode."+ top <- fromRepo Git.repoPath+ (l, clean) <- inRepo $ Git.LsFiles.inRepo [top]+ forM_ l $ \f ->+ maybe noop (`toDirect` f) =<< isAnnexLink f+ void $ liftIO clean
Logs/UUID.hs view
@@ -56,7 +56,7 @@ | otherwise = (k, v) where kuuid = fromUUID k- isbad = not (isuuid kuuid) && isuuid lastword+ isbad = not (isuuid kuuid) && not (null ws) && isuuid lastword ws = words $ value v lastword = Prelude.last ws fixeduuid = toUUID lastword
Logs/UUIDBased.hs view
@@ -63,6 +63,11 @@ parseLogWithUUID parser = M.fromListWith best . mapMaybe parse . lines where parse line+ -- This is a workaround for a bug that caused+ -- NoUUID items to be stored in the log.+ -- It can be removed at any time; is just here to clean+ -- up logs where that happened temporarily.+ | " " `isPrefixOf` line = Nothing | null ws = Nothing | otherwise = parser u (unwords info) >>= makepair where
Makefile view
@@ -83,8 +83,8 @@ Setup Build/InstallDesktopFile Build/EvilSplicer \ Build/Standalone Build/OSXMkLibs \ git-union-merge git-recover-repository- find -name \*.o -exec rm {} \;- find -name \*.hi -exec rm {} \;+ find . -name \*.o -exec rm {} \;+ find . -name \*.hi -exec rm {} \; Build/InstallDesktopFile: Build/InstallDesktopFile.hs $(GHC) --make $@@@ -162,10 +162,11 @@ ./Build/OSXMkLibs $(OSXAPP_BASE) rm -f tmp/git-annex.dmg- hdiutil create -size 640m -format UDRW -srcfolder tmp/build-dmg \+ hdiutil create -format UDBZ -srcfolder tmp/build-dmg \ -volname git-annex -o tmp/git-annex.dmg+ # temporarily still create compressed image too rm -f tmp/git-annex.dmg.bz2- bzip2 --fast tmp/git-annex.dmg+ bzip2 --fast < tmp/git-annex.dmg > tmp/git-annex.dmg.bz2 ANDROID_FLAGS?=-f-XMPP # Cross compile for Android.@@ -189,14 +190,16 @@ sed -i 's/GHC-Options: \(.*\)-Wall/GHC-Options: \1-Wall -fno-warn-unused-imports /i' tmp/androidtree/git-annex.cabal # Cabal cannot cross compile with custom build type, so workaround. sed -i 's/Build-type: Custom/Build-type: Simple/' tmp/androidtree/git-annex.cabal+# Build just once, but link twice, for 2 different versions of Android.+ mkdir -p tmp/androidtree/dist/build/git-annex/4.0 tmp/androidtree/dist/build/git-annex/4.3 if [ ! -e tmp/androidtree/dist/setup/setup ]; then \- cd tmp/androidtree && $$HOME/.ghc/android-14/arm-linux-androideabi-4.7/arm-linux-androideabi/bin/cabal configure -fAndroid $(ANDROID_FLAGS); \+ cd tmp/androidtree && $$HOME/.ghc/$(shell cat standalone/android/abiversion)/arm-linux-androideabi/bin/cabal configure -fAndroid $(ANDROID_FLAGS); \ fi- cd tmp/androidtree && $$HOME/.ghc/android-14/arm-linux-androideabi-4.7/arm-linux-androideabi/bin/cabal build--adb:- ANDROID_FLAGS="-Production" $(MAKE) android- adb push tmp/androidtree/dist/build/git-annex/git-annex /data/data/ga.androidterm/bin/git-annex+ cd tmp/androidtree && $$HOME/.ghc/$(shell cat standalone/android/abiversion)/arm-linux-androideabi/bin/cabal build \+ && mv dist/build/git-annex/git-annex dist/build/git-annex/4.0/git-annex+ cd tmp/androidtree && $$HOME/.ghc/$(shell cat standalone/android/abiversion)/arm-linux-androideabi/bin/cabal build \+ --ghc-options=-optl-z --ghc-options=-optlnocopyreloc \+ && mv dist/build/git-annex/git-annex dist/build/git-annex/4.3/git-annex androidapp: $(MAKE) android
Remote.hs view
@@ -24,6 +24,7 @@ remoteMap, uuidDescriptions, byName,+ byNameOnly, byNameWithUUID, byCost, prettyPrintUUIDs,@@ -58,7 +59,7 @@ import Logs.Location hiding (logStatus) import Remote.List import Config-import Git.Remote+import Git.Types (RemoteName) {- Map from UUIDs of Remotes to a calculated value. -} remoteMap :: (Remote -> a) -> Annex (M.Map UUID a)@@ -89,11 +90,12 @@ where checkuuid Nothing = return Nothing checkuuid (Just r)- | uuid r == NoUUID = do- let e = "cannot determine uuid for " ++ name r+ | uuid r == NoUUID = if remoteAnnexIgnore (gitconfig r)- then error $ e ++ " (" ++ show (remoteConfig (repo r) "ignore") ++ " is set)"- else error e+ then error $ noRemoteUUIDMsg r +++ " (" ++ show (remoteConfig (repo r) "ignore") +++ " is set)"+ else error $ noRemoteUUIDMsg r | otherwise = return $ Just r byName' :: RemoteName -> Annex (Either String Remote)@@ -104,16 +106,27 @@ handle (match:_) = Right match matching r = n == name r || toUUID n == uuid r +{- Only matches remote name, not UUID -}+byNameOnly :: RemoteName -> Annex (Maybe Remote)+byNameOnly n = headMaybe . filter matching <$> remoteList+ where+ matching r = n == name r++noRemoteUUIDMsg :: Remote -> String+noRemoteUUIDMsg r = "cannot determine uuid for " ++ name r+ {- Looks up a remote by name (or by UUID, or even by description),- - and returns its UUID. Finds even remotes that are not configured in- - .git/config. -}+ - and returns its UUID. Finds even repositories that are not+ - configured in .git/config. -} nameToUUID :: RemoteName -> Annex UUID nameToUUID "." = getUUID -- special case for current repo nameToUUID "here" = getUUID nameToUUID "" = error "no remote specified" nameToUUID n = byName' n >>= go where- go (Right r) = return $ uuid r+ go (Right r) = case uuid r of+ NoUUID -> error $ noRemoteUUIDMsg r+ u -> return u go (Left e) = fromMaybe (error e) <$> bydescription bydescription = do m <- uuidMap
Test.hs view
@@ -9,12 +9,14 @@ module Test where -import Test.HUnit-import Test.QuickCheck-import Test.QuickCheck.Test+import Test.Tasty+import Test.Tasty.Runners+import Test.Tasty.HUnit+import Test.Tasty.QuickCheck import System.PosixCompat.Files import Control.Exception.Extensible+import Data.Monoid import qualified Data.Map as M import System.IO.HVFS (SystemFS(..)) import qualified Text.JSON@@ -72,111 +74,101 @@ main :: IO () main = do- divider- putStrLn "First, some automated quick checks of properties ..."- divider- qcok <- all isSuccess <$> sequence quickcheck- divider- putStrLn "Now, some broader checks ..."- putStrLn " (Do not be alarmed by odd output here; it's normal."- putStrLn " wait for the last line to see how it went.)"- rs <- runhunit =<< prepare False #ifndef mingw32_HOST_OS- directrs <- runhunit =<< prepare True+ indirectenv <- prepare False+ directenv <- prepare True+ let tests = testGroup "Tests"+ [ localOption (QuickCheckTests 1000) properties+ , unitTests indirectenv "(indirect)"+ , unitTests directenv "(direct)"+ ] #else -- Windows is only going to use direct mode, so don't test twice.- let directrs = []+ env <- prepare False+ let tests = testGroup "Tests"+ [properties, unitTests env ""] #endif- divider- propigate (rs++directrs) qcok- where- divider = putStrLn $ replicate 70 '-'- runhunit env = do- r <- forM hunit $ \t -> do- divider- t env- cleanup tmpdir- return r--propigate :: [Counts] -> Bool -> IO ()-propigate cs qcok- | countsok && qcok = putStrLn "All tests ok."- | otherwise = do- unless qcok $- putStrLn "Quick check tests failed! This is a bug in git-annex."- unless countsok $ do- putStrLn "Some tests failed!"+ let runner = tryIngredients [consoleTestReporter] mempty tests+ ifM (maybe (error "tasty failed to return a runner!") id runner)+ ( exitSuccess+ , do putStrLn " (This could be due to a bug in git-annex, or an incompatability" putStrLn " with utilities, such as git, installed on this system.)"- exitFailure- where- noerrors (Counts { errors = e , failures = f }) = e + f == 0- countsok = all noerrors cs+ exitFailure+ ) -quickcheck :: [IO Result]-quickcheck =- [ check "prop_idempotent_deencode_git" Git.Filename.prop_idempotent_deencode- , check "prop_idempotent_deencode" Utility.Format.prop_idempotent_deencode- , check "prop_idempotent_fileKey" Locations.prop_idempotent_fileKey- , check "prop_idempotent_key_encode" Types.Key.prop_idempotent_key_encode- , check "prop_idempotent_key_decode" Types.Key.prop_idempotent_key_decode- , check "prop_idempotent_shellEscape" Utility.SafeCommand.prop_idempotent_shellEscape- , check "prop_idempotent_shellEscape_multiword" Utility.SafeCommand.prop_idempotent_shellEscape_multiword- , check "prop_logs_sane" Logs.prop_logs_sane- , check "prop_idempotent_configEscape" Logs.Remote.prop_idempotent_configEscape- , check "prop_parse_show_Config" Logs.Remote.prop_parse_show_Config- , check "prop_parentDir_basics" Utility.Path.prop_parentDir_basics- , check "prop_relPathDirToFile_basics" Utility.Path.prop_relPathDirToFile_basics- , check "prop_relPathDirToFile_regressionTest" Utility.Path.prop_relPathDirToFile_regressionTest- , check "prop_cost_sane" Config.Cost.prop_cost_sane- , check "prop_matcher_sane" Utility.Matcher.prop_matcher_sane- , check "prop_HmacSha1WithCipher_sane" Crypto.prop_HmacSha1WithCipher_sane- , check "prop_TimeStamp_sane" Logs.UUIDBased.prop_TimeStamp_sane- , check "prop_addLog_sane" Logs.UUIDBased.prop_addLog_sane- , check "prop_verifiable_sane" Utility.Verifiable.prop_verifiable_sane- , check "prop_segment_regressionTest" Utility.Misc.prop_segment_regressionTest- , check "prop_read_write_transferinfo" Logs.Transfer.prop_read_write_transferinfo- , check "prop_read_show_inodecache" Utility.InodeCache.prop_read_show_inodecache- , check "prop_parse_show_log" Logs.Presence.prop_parse_show_log- , check "prop_read_show_TrustLevel" Types.TrustLevel.prop_read_show_TrustLevel- , check "prop_parse_show_TrustLog" Logs.Trust.prop_parse_show_TrustLog- , check "prop_hashes_stable" Utility.Hash.prop_hashes_stable- , check "prop_schedule_roundtrips" Utility.Scheduled.prop_schedule_roundtrips- , check "prop_duration_roundtrips" Utility.HumanTime.prop_duration_roundtrips+properties :: TestTree+properties = testGroup "QuickCheck"+ [ testProperty "prop_idempotent_deencode_git" Git.Filename.prop_idempotent_deencode+ , testProperty "prop_idempotent_deencode" Utility.Format.prop_idempotent_deencode+ , testProperty "prop_idempotent_fileKey" Locations.prop_idempotent_fileKey+ , testProperty "prop_idempotent_key_encode" Types.Key.prop_idempotent_key_encode+ , 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_parentDir_basics" Utility.Path.prop_parentDir_basics+ , testProperty "prop_relPathDirToFile_basics" Utility.Path.prop_relPathDirToFile_basics+ , testProperty "prop_relPathDirToFile_regressionTest" Utility.Path.prop_relPathDirToFile_regressionTest+ , testProperty "prop_cost_sane" Config.Cost.prop_cost_sane+ , testProperty "prop_matcher_sane" Utility.Matcher.prop_matcher_sane+ , testProperty "prop_HmacSha1WithCipher_sane" Crypto.prop_HmacSha1WithCipher_sane+ , testProperty "prop_TimeStamp_sane" Logs.UUIDBased.prop_TimeStamp_sane+ , testProperty "prop_addLog_sane" Logs.UUIDBased.prop_addLog_sane+ , testProperty "prop_verifiable_sane" Utility.Verifiable.prop_verifiable_sane+ , testProperty "prop_segment_regressionTest" Utility.Misc.prop_segment_regressionTest+ , testProperty "prop_read_write_transferinfo" Logs.Transfer.prop_read_write_transferinfo+ , testProperty "prop_read_show_inodecache" Utility.InodeCache.prop_read_show_inodecache+ , testProperty "prop_parse_show_log" Logs.Presence.prop_parse_show_log+ , testProperty "prop_read_show_TrustLevel" Types.TrustLevel.prop_read_show_TrustLevel+ , testProperty "prop_parse_show_TrustLog" Logs.Trust.prop_parse_show_TrustLog+ , testProperty "prop_hashes_stable" Utility.Hash.prop_hashes_stable+ , testProperty "prop_schedule_roundtrips" Utility.Scheduled.prop_schedule_roundtrips+ , testProperty "prop_duration_roundtrips" Utility.HumanTime.prop_duration_roundtrips ]- where- check desc prop = do- putStrLn desc- quickCheckResult prop -hunit :: [TestEnv -> IO Counts]-hunit =+unitTests :: TestEnv -> String -> TestTree+unitTests env note = testGroup ("Unit Tests " ++ note) -- test order matters, later tests may rely on state from earlier [ check "init" test_init , check "add" test_add+ , check "add sha1dup" test_add_sha1dup+ , check "add subdirs" test_add_subdirs , check "reinject" test_reinject- , check "unannex" test_unannex- , check "drop" test_drop+ , check "unannex (no copy)" test_unannex_nocopy+ , check "unannex (with copy)" test_unannex_withcopy+ , check "drop (no remote)" test_drop_noremote+ , check "drop (with remote)" test_drop_withremote+ , check "drop (untrusted remote)" test_drop_untrustedremote , check "get" test_get , check "move" test_move , check "copy" test_copy , check "lock" test_lock- , check "edit" test_edit+ , check "edit (no pre-commit)" test_edit+ , check "edit (pre-commit)" test_edit_precommit , check "fix" test_fix , check "trust" test_trust- , check "fsck" test_fsck+ , check "fsck (basics)" test_fsck_basic+ , check "fsck (bare)" test_fsck_bare+ , check "fsck (local untrusted)" test_fsck_localuntrusted+ , check "fsck (remote untrusted)" test_fsck_remoteuntrusted , check "migrate" test_migrate+ , check "migrate (via gitattributes)" test_migrate_via_gitattributes , check" unused" test_unused , check "describe" test_describe , check "find" test_find , check "merge" test_merge- , check "status" test_status+ , check "info" test_info , check "version" test_version , check "sync" test_sync , check "union merge regression" test_union_merge_regression- , check "conflict resolution" test_conflict_resolution+ , check "conflict resolution" test_conflict_resolution_movein_bug+ , check "conflict_resolution (mixed directory and file)" test_mixed_conflict_resolution , check "map" test_map , check "uninit" test_uninit+ , check "uninit (in git-annex branch)" test_uninit_inbranch , check "upgrade" test_upgrade , check "whereis" test_whereis , check "hook remote" test_hook_remote@@ -185,61 +177,74 @@ , check "bup remote" test_bup_remote , check "crypto" test_crypto , check "preferred content" test_preferred_content+ , check "global cleanup" test_global_cleanup ] where- check desc t env = do- putStrLn desc- runTestTT (t env)+ check desc t = testCase desc (t env) -test_init :: TestEnv -> Test-test_init env = "git-annex init" ~: TestCase $ innewrepo env $ do+test_global_cleanup :: TestEnv -> Assertion+test_global_cleanup _env = cleanup tmpdir++test_init :: TestEnv -> Assertion+test_init env = innewrepo env $ do git_annex env "init" [reponame] @? "init failed" handleforcedirect env where reponame = "test repo" -test_add :: TestEnv -> Test-test_add env = "git-annex add" ~: TestList [basic, sha1dup, subdirs]- where- -- this test case runs in the main repo, to set up a basic- -- annexed file that later tests will use- basic = TestCase $ inmainrepo env $ do- writeFile annexedfile $ content annexedfile- git_annex env "add" [annexedfile] @? "add failed"- annexed_present annexedfile- writeFile sha1annexedfile $ content sha1annexedfile- git_annex env "add" [sha1annexedfile, "--backend=SHA1"] @? "add with SHA1 failed"- annexed_present sha1annexedfile- checkbackend sha1annexedfile backendSHA1- writeFile wormannexedfile $ content wormannexedfile- git_annex env "add" [wormannexedfile, "--backend=WORM"] @? "add with WORM failed"- annexed_present wormannexedfile- checkbackend wormannexedfile backendWORM- boolSystem "git" [Params "rm --force -q", File wormannexedfile] @? "git rm failed"- writeFile ingitfile $ content ingitfile- boolSystem "git" [Param "add", File ingitfile] @? "git add failed"- boolSystem "git" [Params "commit -q -m commit"] @? "git commit failed"- git_annex env "add" [ingitfile] @? "add ingitfile should be no-op"- unannexed ingitfile- sha1dup = TestCase $ intmpclonerepo env $ do- writeFile sha1annexedfiledup $ content sha1annexedfiledup- git_annex env "add" [sha1annexedfiledup, "--backend=SHA1"] @? "add of second file with same SHA1 failed"- annexed_present sha1annexedfiledup- annexed_present sha1annexedfile- subdirs = TestCase $ intmpclonerepo env $ do- createDirectory "dir"- writeFile ("dir" </> "foo") $ content annexedfile- git_annex env "add" ["dir"] @? "add of subdir failed"- createDirectory "dir2"- writeFile ("dir2" </> "foo") $ content annexedfile+-- this test case runs in the main repo, to set up a basic+-- annexed file that later tests will use+test_add :: TestEnv -> Assertion+test_add env = inmainrepo env $ do+ writeFile annexedfile $ content annexedfile+ git_annex env "add" [annexedfile] @? "add failed"+ annexed_present annexedfile+ writeFile sha1annexedfile $ content sha1annexedfile+ git_annex env "add" [sha1annexedfile, "--backend=SHA1"] @? "add with SHA1 failed"+ annexed_present sha1annexedfile+ checkbackend sha1annexedfile backendSHA1+ writeFile wormannexedfile $ content wormannexedfile+ git_annex env "add" [wormannexedfile, "--backend=WORM"] @? "add with WORM failed"+ annexed_present wormannexedfile+ checkbackend wormannexedfile backendWORM+ ifM (annexeval Config.isDirect)+ ( do+ boolSystem "rm" [Params "-f", File wormannexedfile] @? "rm failed"+ writeFile ingitfile $ content ingitfile+ not <$> boolSystem "git" [Param "add", File ingitfile] @? "git add failed to fail in direct mode"+ boolSystem "rm" [Params "-f", File ingitfile] @? "rm failed"+ git_annex env "sync" [] @? "sync failed"+ , do+ boolSystem "git" [Params "rm --force -q", File wormannexedfile] @? "git rm failed"+ writeFile ingitfile $ content ingitfile+ boolSystem "git" [Param "add", File ingitfile] @? "git add failed"+ boolSystem "git" [Params "commit -q -m commit"] @? "git commit failed"+ git_annex env "add" [ingitfile] @? "add ingitfile should be no-op"+ unannexed ingitfile+ )++test_add_sha1dup :: TestEnv -> Assertion+test_add_sha1dup env = intmpclonerepo env $ do+ writeFile sha1annexedfiledup $ content sha1annexedfiledup+ git_annex env "add" [sha1annexedfiledup, "--backend=SHA1"] @? "add of second file with same SHA1 failed"+ annexed_present sha1annexedfiledup+ annexed_present sha1annexedfile++test_add_subdirs :: TestEnv -> Assertion+test_add_subdirs env = intmpclonerepo env $ do+ createDirectory "dir"+ writeFile ("dir" </> "foo") $ content annexedfile+ git_annex env "add" ["dir"] @? "add of subdir failed"+ createDirectory "dir2"+ writeFile ("dir2" </> "foo") $ content annexedfile #ifndef mingw32_HOST_OS- {- This does not work on Windows, for whatever reason. -}- setCurrentDirectory "dir"- git_annex env "add" [".." </> "dir2"] @? "add of ../subdir failed"+ {- This does not work on Windows, for whatever reason. -}+ setCurrentDirectory "dir"+ git_annex env "add" [".." </> "dir2"] @? "add of ../subdir failed" #endif -test_reinject :: TestEnv -> Test-test_reinject env = "git-annex reinject/fromkey" ~: TestCase $ intmpclonerepoInDirect env $ do+test_reinject :: TestEnv -> Assertion+test_reinject env = intmpclonerepoInDirect env $ do git_annex env "drop" ["--force", sha1annexedfile] @? "drop failed" writeFile tmp $ content sha1annexedfile r <- annexeval $ Types.Backend.getKey backendSHA1 $@@ -251,54 +256,58 @@ where tmp = "tmpfile" -test_unannex :: TestEnv -> Test-test_unannex env = "git-annex unannex" ~: TestList [nocopy, withcopy]- where- nocopy = "no content" ~: intmpclonerepo env $ do- annexed_notpresent annexedfile- git_annex env "unannex" [annexedfile] @? "unannex failed with no copy"- annexed_notpresent annexedfile- withcopy = "with content" ~: intmpclonerepo env $ do- git_annex env "get" [annexedfile] @? "get failed"- annexed_present annexedfile- git_annex env "unannex" [annexedfile, sha1annexedfile] @? "unannex failed"- unannexed annexedfile- git_annex env "unannex" [annexedfile] @? "unannex failed on non-annexed file"- unannexed annexedfile+test_unannex_nocopy :: TestEnv -> Assertion+test_unannex_nocopy env = intmpclonerepo env $ do+ annexed_notpresent annexedfile+ git_annex env "unannex" [annexedfile] @? "unannex failed with no copy"+ annexed_notpresent annexedfile++test_unannex_withcopy :: TestEnv -> Assertion+test_unannex_withcopy env = intmpclonerepo env $ do+ git_annex env "get" [annexedfile] @? "get failed"+ annexed_present annexedfile+ git_annex env "unannex" [annexedfile, sha1annexedfile] @? "unannex failed"+ unannexed annexedfile+ git_annex env "unannex" [annexedfile] @? "unannex failed on non-annexed file"+ unannexed annexedfile+ unlessM (annexeval Config.isDirect) $ do git_annex env "unannex" [ingitfile] @? "unannex ingitfile should be no-op" unannexed ingitfile -test_drop :: TestEnv -> Test-test_drop env = "git-annex drop" ~: TestList [noremote, withremote, untrustedremote]- where- noremote = "no remotes" ~: TestCase $ intmpclonerepo env $ do- git_annex env "get" [annexedfile] @? "get failed"- boolSystem "git" [Params "remote rm origin"]- @? "git remote rm origin failed"- not <$> git_annex env "drop" [annexedfile] @? "drop wrongly succeeded with no known copy of file"- annexed_present annexedfile- git_annex env "drop" ["--force", annexedfile] @? "drop --force failed"- annexed_notpresent annexedfile- git_annex env "drop" [annexedfile] @? "drop of dropped file failed"+test_drop_noremote :: TestEnv -> Assertion+test_drop_noremote env = intmpclonerepo env $ do+ git_annex env "get" [annexedfile] @? "get failed"+ boolSystem "git" [Params "remote rm origin"]+ @? "git remote rm origin failed"+ not <$> git_annex env "drop" [annexedfile] @? "drop wrongly succeeded with no known copy of file"+ annexed_present annexedfile+ git_annex env "drop" ["--force", annexedfile] @? "drop --force failed"+ annexed_notpresent annexedfile+ git_annex env "drop" [annexedfile] @? "drop of dropped file failed"+ unlessM (annexeval Config.isDirect) $ do git_annex env "drop" [ingitfile] @? "drop ingitfile should be no-op" unannexed ingitfile- withremote = "with remote" ~: TestCase $ intmpclonerepo env $ do- git_annex env "get" [annexedfile] @? "get failed"- annexed_present annexedfile- git_annex env "drop" [annexedfile] @? "drop failed though origin has copy"- annexed_notpresent annexedfile- inmainrepo env $ annexed_present annexedfile- untrustedremote = "untrusted remote" ~: TestCase $ intmpclonerepo env $ do- git_annex env "untrust" ["origin"] @? "untrust of origin failed"- git_annex env "get" [annexedfile] @? "get failed"- annexed_present annexedfile- not <$> git_annex env "drop" [annexedfile] @? "drop wrongly suceeded with only an untrusted copy of the file"- annexed_present annexedfile- inmainrepo env $ annexed_present annexedfile -test_get :: TestEnv -> Test-test_get env = "git-annex get" ~: TestCase $ intmpclonerepo env $ do+test_drop_withremote :: TestEnv -> Assertion+test_drop_withremote env = intmpclonerepo env $ do+ git_annex env "get" [annexedfile] @? "get failed"+ annexed_present annexedfile+ git_annex env "drop" [annexedfile] @? "drop failed though origin has copy"+ annexed_notpresent annexedfile inmainrepo env $ annexed_present annexedfile++test_drop_untrustedremote :: TestEnv -> Assertion+test_drop_untrustedremote env = intmpclonerepo env $ do+ git_annex env "untrust" ["origin"] @? "untrust of origin failed"+ git_annex env "get" [annexedfile] @? "get failed"+ annexed_present annexedfile+ not <$> git_annex env "drop" [annexedfile] @? "drop wrongly suceeded with only an untrusted copy of the file"+ annexed_present annexedfile+ inmainrepo env $ annexed_present annexedfile++test_get :: TestEnv -> Assertion+test_get env = intmpclonerepo env $ do+ inmainrepo env $ annexed_present annexedfile annexed_notpresent annexedfile git_annex env "get" [annexedfile] @? "get of file failed" inmainrepo env $ annexed_present annexedfile@@ -306,14 +315,15 @@ git_annex env "get" [annexedfile] @? "get of file already here failed" inmainrepo env $ annexed_present annexedfile annexed_present annexedfile- inmainrepo env $ unannexed ingitfile- unannexed ingitfile- git_annex env "get" [ingitfile] @? "get ingitfile should be no-op"- inmainrepo env $ unannexed ingitfile- unannexed ingitfile+ unlessM (annexeval Config.isDirect) $ do+ inmainrepo env $ unannexed ingitfile+ unannexed ingitfile+ git_annex env "get" [ingitfile] @? "get ingitfile should be no-op"+ inmainrepo env $ unannexed ingitfile+ unannexed ingitfile -test_move :: TestEnv -> Test-test_move env = "git-annex move" ~: TestCase $ intmpclonerepo env $ do+test_move :: TestEnv -> Assertion+test_move env = intmpclonerepo env $ do annexed_notpresent annexedfile inmainrepo env $ annexed_present annexedfile git_annex env "move" ["--from", "origin", annexedfile] @? "move --from of file failed"@@ -328,17 +338,18 @@ git_annex env "move" ["--to", "origin", annexedfile] @? "move --to of file already there failed" inmainrepo env $ annexed_present annexedfile annexed_notpresent annexedfile- unannexed ingitfile- inmainrepo env $ unannexed ingitfile- git_annex env "move" ["--to", "origin", ingitfile] @? "move of ingitfile should be no-op"- unannexed ingitfile- inmainrepo env $ unannexed ingitfile- git_annex env "move" ["--from", "origin", ingitfile] @? "move of ingitfile should be no-op"- unannexed ingitfile- inmainrepo env $ unannexed ingitfile+ unlessM (annexeval Config.isDirect) $ do+ unannexed ingitfile+ inmainrepo env $ unannexed ingitfile+ git_annex env "move" ["--to", "origin", ingitfile] @? "move of ingitfile should be no-op"+ unannexed ingitfile+ inmainrepo env $ unannexed ingitfile+ git_annex env "move" ["--from", "origin", ingitfile] @? "move of ingitfile should be no-op"+ unannexed ingitfile+ inmainrepo env $ unannexed ingitfile -test_copy :: TestEnv -> Test-test_copy env = "git-annex copy" ~: TestCase $ intmpclonerepo env $ do+test_copy :: TestEnv -> Assertion+test_copy env = intmpclonerepo env $ do annexed_notpresent annexedfile inmainrepo env $ annexed_present annexedfile git_annex env "copy" ["--from", "origin", annexedfile] @? "copy --from of file failed"@@ -353,17 +364,18 @@ git_annex env "move" ["--to", "origin", annexedfile] @? "move --to of file already there failed" annexed_notpresent annexedfile inmainrepo env $ annexed_present annexedfile- unannexed ingitfile- inmainrepo env $ unannexed ingitfile- git_annex env "copy" ["--to", "origin", ingitfile] @? "copy of ingitfile should be no-op"- unannexed ingitfile- inmainrepo env $ unannexed ingitfile- git_annex env "copy" ["--from", "origin", ingitfile] @? "copy of ingitfile should be no-op"- checkregularfile ingitfile- checkcontent ingitfile+ unlessM (annexeval Config.isDirect) $ do+ unannexed ingitfile+ inmainrepo env $ unannexed ingitfile+ git_annex env "copy" ["--to", "origin", ingitfile] @? "copy of ingitfile should be no-op"+ unannexed ingitfile+ inmainrepo env $ unannexed ingitfile+ git_annex env "copy" ["--from", "origin", ingitfile] @? "copy of ingitfile should be no-op"+ checkregularfile ingitfile+ checkcontent ingitfile -test_preferred_content :: TestEnv -> Test-test_preferred_content env = "git-annex preferred-content" ~: TestCase $ intmpclonerepo env $ do+test_preferred_content :: TestEnv -> Assertion+test_preferred_content env = intmpclonerepo env $ do annexed_notpresent annexedfile -- get --auto only looks at numcopies when preferred content is not -- set, and with 1 copy existing, does not get the file.@@ -396,8 +408,8 @@ git_annex env "get" ["--auto", annexedfile] @? "get --auto of file failed with exclude=*" annexed_notpresent annexedfile -test_lock :: TestEnv -> Test-test_lock env = "git-annex unlock/lock" ~: intmpclonerepoInDirect env $ do+test_lock :: TestEnv -> Assertion+test_lock env = intmpclonerepoInDirect env $ do -- regression test: unlock of not present file should skip it annexed_notpresent annexedfile not <$> git_annex env "unlock" [annexedfile] @? "unlock failed to fail with not present file"@@ -423,9 +435,14 @@ r' <- git_annex env "drop" [annexedfile] not r' @? "drop wrongly succeeded with no known copy of modified file" -test_edit :: TestEnv -> Test-test_edit env = "git-annex edit/commit" ~: TestList [t False, t True]- where t precommit = TestCase $ intmpclonerepoInDirect env $ do+test_edit :: TestEnv -> Assertion+test_edit = test_edit' False++test_edit_precommit :: TestEnv -> Assertion+test_edit_precommit = test_edit' True++test_edit' :: Bool -> TestEnv -> Assertion+test_edit' precommit env = intmpclonerepoInDirect env $ do git_annex env "get" [annexedfile] @? "get of file failed" annexed_present annexedfile git_annex env "edit" [annexedfile] @? "edit failed"@@ -443,8 +460,8 @@ assertEqual "content of modified file" c (changedcontent annexedfile) not <$> git_annex env "drop" [annexedfile] @? "drop wrongly succeeded with no known copy of modified file" -test_fix :: TestEnv -> Test-test_fix env = "git-annex fix" ~: intmpclonerepoInDirect env $ do+test_fix :: TestEnv -> Assertion+test_fix env = intmpclonerepoInDirect env $ do annexed_notpresent annexedfile git_annex env "fix" [annexedfile] @? "fix of not present failed" annexed_notpresent annexedfile@@ -463,8 +480,8 @@ subdir = "s" newfile = subdir ++ "/" ++ annexedfile -test_trust :: TestEnv -> Test-test_trust env = "git-annex trust/untrust/semitrust/dead" ~: intmpclonerepo env $ do+test_trust :: TestEnv -> Assertion+test_trust env = intmpclonerepo env $ do git_annex env "trust" [repo] @? "trust failed" trustcheck Logs.Trust.Trusted "trusted 1" git_annex env "trust" [repo] @? "trust of trusted failed"@@ -490,33 +507,15 @@ return $ u `elem` l assertBool msg present -test_fsck :: TestEnv -> Test-test_fsck env = "git-annex fsck" ~: TestList [basicfsck, barefsck, withlocaluntrusted, withremoteuntrusted]+test_fsck_basic :: TestEnv -> Assertion+test_fsck_basic env = intmpclonerepo env $ do+ git_annex env "fsck" [] @? "fsck failed"+ boolSystem "git" [Params "config annex.numcopies 2"] @? "git config failed"+ fsck_should_fail env "numcopies unsatisfied"+ boolSystem "git" [Params "config annex.numcopies 1"] @? "git config failed"+ corrupt annexedfile+ corrupt sha1annexedfile where- basicfsck = TestCase $ intmpclonerepo env $ do- git_annex env "fsck" [] @? "fsck failed"- boolSystem "git" [Params "config annex.numcopies 2"] @? "git config failed"- fsck_should_fail "numcopies unsatisfied"- boolSystem "git" [Params "config annex.numcopies 1"] @? "git config failed"- corrupt annexedfile- corrupt sha1annexedfile- barefsck = TestCase $ intmpbareclonerepo env $ do- git_annex env "fsck" [] @? "fsck failed"- withlocaluntrusted = TestCase $ intmpclonerepo env $ do- git_annex env "get" [annexedfile] @? "get failed"- git_annex env "untrust" ["origin"] @? "untrust of origin repo failed"- git_annex env "untrust" ["."] @? "untrust of current repo failed"- fsck_should_fail "content only available in untrusted (current) repository"- git_annex env "trust" ["."] @? "trust of current repo failed"- git_annex env "fsck" [annexedfile] @? "fsck failed on file present in trusted repo"- withremoteuntrusted = TestCase $ intmpclonerepo env $ do- boolSystem "git" [Params "config annex.numcopies 2"] @? "git config failed"- git_annex env "get" [annexedfile] @? "get failed"- git_annex env "get" [sha1annexedfile] @? "get failed"- git_annex env "fsck" [] @? "fsck failed with numcopies=2 and 2 copies"- git_annex env "untrust" ["origin"] @? "untrust of origin failed"- fsck_should_fail "content not replicated to enough non-untrusted repositories"- corrupt f = do git_annex env "get" [f] @? "get of file failed" Utility.FileMode.allowWrite f@@ -526,12 +525,41 @@ , not <$> git_annex env "fsck" [] @? "fsck failed to fail with corrupted file content" ) git_annex env "fsck" [] @? "fsck unexpectedly failed again; previous one did not fix problem with " ++ f- fsck_should_fail m = do- not <$> git_annex env "fsck" [] @? "fsck failed to fail with " ++ m -test_migrate :: TestEnv -> Test-test_migrate env = "git-annex migrate" ~: TestList [t False, t True]- where t usegitattributes = TestCase $ intmpclonerepoInDirect env $ do+test_fsck_bare :: TestEnv -> Assertion+test_fsck_bare env = intmpbareclonerepo env $ do+ git_annex env "fsck" [] @? "fsck failed"++test_fsck_localuntrusted :: TestEnv -> Assertion+test_fsck_localuntrusted env = intmpclonerepo env $ do+ git_annex env "get" [annexedfile] @? "get failed"+ git_annex env "untrust" ["origin"] @? "untrust of origin repo failed"+ git_annex env "untrust" ["."] @? "untrust of current repo failed"+ fsck_should_fail env "content only available in untrusted (current) repository"+ git_annex env "trust" ["."] @? "trust of current repo failed"+ git_annex env "fsck" [annexedfile] @? "fsck failed on file present in trusted repo"++test_fsck_remoteuntrusted :: TestEnv -> Assertion+test_fsck_remoteuntrusted env = intmpclonerepo env $ do+ boolSystem "git" [Params "config annex.numcopies 2"] @? "git config failed"+ git_annex env "get" [annexedfile] @? "get failed"+ git_annex env "get" [sha1annexedfile] @? "get failed"+ git_annex env "fsck" [] @? "fsck failed with numcopies=2 and 2 copies"+ git_annex env "untrust" ["origin"] @? "untrust of origin failed"+ fsck_should_fail env "content not replicated to enough non-untrusted repositories"++fsck_should_fail :: TestEnv -> String -> Assertion+fsck_should_fail env m = not <$> git_annex env "fsck" []+ @? "fsck failed to fail with " ++ m++test_migrate :: TestEnv -> Assertion+test_migrate = test_migrate' False++test_migrate_via_gitattributes :: TestEnv -> Assertion+test_migrate_via_gitattributes = test_migrate' True++test_migrate' :: Bool -> TestEnv -> Assertion+test_migrate' usegitattributes env = intmpclonerepoInDirect env $ do annexed_notpresent annexedfile annexed_notpresent sha1annexedfile git_annex env "migrate" [annexedfile] @? "migrate of not present failed"@@ -568,9 +596,9 @@ checkbackend annexedfile backendSHA256 checkbackend sha1annexedfile backendSHA256 -test_unused :: TestEnv -> Test+test_unused :: TestEnv -> Assertion -- This test is broken in direct mode-test_unused env = "git-annex unused/dropunused" ~: intmpclonerepoInDirect env $ do+test_unused env = intmpclonerepoInDirect env $ do -- keys have to be looked up before files are removed annexedfilekey <- annexeval $ findkey annexedfile sha1annexedfilekey <- annexeval $ findkey sha1annexedfile@@ -640,13 +668,13 @@ r <- Backend.lookupFile f return $ fst $ fromJust r -test_describe :: TestEnv -> Test-test_describe env = "git-annex describe" ~: intmpclonerepo env $ do+test_describe :: TestEnv -> Assertion+test_describe env = intmpclonerepo env $ do git_annex env "describe" [".", "this repo"] @? "describe 1 failed" git_annex env "describe" ["origin", "origin repo"] @? "describe 2 failed" -test_find :: TestEnv -> Test-test_find env = "git-annex find" ~: intmpclonerepo env $ do+test_find :: TestEnv -> Assertion+test_find env = intmpclonerepo env $ do annexed_notpresent annexedfile git_annex_expectoutput env "find" [] [] git_annex env "get" [annexedfile] @? "get failed"@@ -668,23 +696,23 @@ git_annex_expectoutput env "find" ["--include", "*", "--exclude", annexedfile, "--exclude", sha1annexedfile] ["dir/subfile"] git_annex_expectoutput env "find" ["--exclude", "*"] [] -test_merge :: TestEnv -> Test-test_merge env = "git-annex merge" ~: intmpclonerepo env $ do+test_merge :: TestEnv -> Assertion+test_merge env = intmpclonerepo env $ do git_annex env "merge" [] @? "merge failed" -test_status :: TestEnv -> Test-test_status env = "git-annex status" ~: intmpclonerepo env $ do- json <- git_annex_output env "status" ["--json"]+test_info :: TestEnv -> Assertion+test_info env = intmpclonerepo env $ do+ json <- git_annex_output env "info" ["--json"] case Text.JSON.decodeStrict json :: Text.JSON.Result (Text.JSON.JSObject Text.JSON.JSValue) of Text.JSON.Ok _ -> return () Text.JSON.Error e -> assertFailure e -test_version :: TestEnv -> Test-test_version env = "git-annex version" ~: intmpclonerepo env $ do+test_version :: TestEnv -> Assertion+test_version env = intmpclonerepo env $ do git_annex env "version" [] @? "version failed" -test_sync :: TestEnv -> Test-test_sync env = "git-annex sync" ~: intmpclonerepo env $ do+test_sync :: TestEnv -> Assertion+test_sync env = intmpclonerepo env $ do git_annex env "sync" [] @? "sync failed" {- Regression test for bug fixed in - 7b0970b340d7faeb745c666146c7f701ec71808f, where in direct mode@@ -693,8 +721,8 @@ {- Regression test for union merge bug fixed in - 0214e0fb175a608a49b812d81b4632c081f63027 -}-test_union_merge_regression :: TestEnv -> Test-test_union_merge_regression env = "union merge regression" ~:+test_union_merge_regression :: TestEnv -> Assertion+test_union_merge_regression env = {- We need 3 repos to see this bug. -} withtmpclonerepo env False $ \r1 -> do withtmpclonerepo env False $ \r2 -> do@@ -720,45 +748,47 @@ - thought the file was still in r2 -} git_annex_expectoutput env "find" ["--in", "r2"] [] -test_conflict_resolution :: TestEnv -> Test-test_conflict_resolution env = "automatic conflict resolution" ~:- TestList [movein_bug, check_mixed_conflict True, check_mixed_conflict False]- where- {- Regression test for the automatic conflict resolution bug fixed- - in f4ba19f2b8a76a1676da7bb5850baa40d9c388e2. -}- movein_bug = TestCase $ withtmpclonerepo env False $ \r1 -> do- withtmpclonerepo env False $ \r2 -> do- let rname r = if r == r1 then "r1" else "r2"- forM_ [r1, r2] $ \r -> indir env r $ do- {- Get all files, see check below. -}- git_annex env "get" [] @? "get failed"- pair r1 r2- forM_ [r1, r2] $ \r -> indir env r $ do- {- Set up a conflict. -}- let newcontent = content annexedfile ++ rname r- ifM (annexeval Config.isDirect)- ( writeFile annexedfile newcontent- , do- git_annex env "unlock" [annexedfile] @? "unlock failed" - writeFile annexedfile newcontent- )- {- Sync twice in r1 so it gets the conflict resolution- - update from r2 -}- forM_ [r1, r2, r1] $ \r -> indir env r $ do- git_annex env "sync" [] @? "sync failed in " ++ rname r- {- After the sync, it should be possible to get all- - files. This includes both sides of the conflict,- - although the filenames are not easily predictable.- -- - The bug caused, in direct mode, one repo to- - be missing the content of the file that had- - been put in it. -}- forM_ [r1, r2] $ \r -> indir env r $ do- git_annex env "get" [] @? "unable to get all files after merge conflict resolution in " ++ rname r+{- Regression test for the automatic conflict resolution bug fixed+ - in f4ba19f2b8a76a1676da7bb5850baa40d9c388e2. -}+test_conflict_resolution_movein_bug :: TestEnv -> Assertion+test_conflict_resolution_movein_bug env = withtmpclonerepo env False $ \r1 -> do+ withtmpclonerepo env False $ \r2 -> do+ let rname r = if r == r1 then "r1" else "r2"+ forM_ [r1, r2] $ \r -> indir env r $ do+ {- Get all files, see check below. -}+ git_annex env "get" [] @? "get failed"+ pair env r1 r2+ forM_ [r1, r2] $ \r -> indir env r $ do+ {- Set up a conflict. -}+ let newcontent = content annexedfile ++ rname r+ ifM (annexeval Config.isDirect)+ ( writeFile annexedfile newcontent+ , do+ git_annex env "unlock" [annexedfile] @? "unlock failed" + writeFile annexedfile newcontent+ )+ {- Sync twice in r1 so it gets the conflict resolution+ - update from r2 -}+ forM_ [r1, r2, r1] $ \r -> indir env r $ do+ git_annex env "sync" ["--force"] @? "sync failed in " ++ rname r+ {- After the sync, it should be possible to get all+ - files. This includes both sides of the conflict,+ - although the filenames are not easily predictable.+ -+ - The bug caused, in direct mode, one repo to+ - be missing the content of the file that had+ - been put in it. -}+ forM_ [r1, r2] $ \r -> indir env r $ do+ git_annex env "get" [] @? "unable to get all files after merge conflict resolution in " ++ rname r - {- Check merge conflict resolution when one side is an annexed- - file, and the other is a directory. -}- check_mixed_conflict inr1 = TestCase $ withtmpclonerepo env False $ \r1 ->+{- Check merge conflict resolution when one side is an annexed+ - file, and the other is a directory. -}+test_mixed_conflict_resolution :: TestEnv -> Assertion+test_mixed_conflict_resolution env = do+ check_mixed_conflict True+ check_mixed_conflict False+ where+ check_mixed_conflict inr1 = withtmpclonerepo env False $ \r1 -> withtmpclonerepo env False $ \r2 -> do indir env r1 $ do writeFile conflictor "conflictor"@@ -769,50 +799,59 @@ writeFile (conflictor </> "subfile") "subfile" git_annex env "add" [conflictor] @? "add conflicter failed" git_annex env "sync" [] @? "sync failed"- pair r1 r2+ pair env r1 r2 let r = if inr1 then r1 else r2 indir env r $ do git_annex env "sync" [] @? "sync failed in mixed conflict"+ checkmerge r1+ checkmerge r2 where conflictor = "conflictor"+ variantprefix = conflictor ++ ".variant"+ checkmerge d = do+ doesDirectoryExist (d </> conflictor) @? (d ++ " conflictor directory missing")+ (any (variantprefix `isPrefixOf`) + <$> getDirectoryContents d)+ @? (d ++ "conflictor file missing") - {- Set up repos as remotes of each other;- - remove origin since we're going to sync- - some changes to a file. -}- pair r1 r2 = forM_ [r1, r2] $ \r -> indir env r $ do- when (r /= r1) $- boolSystem "git" [Params "remote add r1", File ("../../" ++ r1)] @? "remote add"- when (r /= r2) $- boolSystem "git" [Params "remote add r2", File ("../../" ++ r2)] @? "remote add"- boolSystem "git" [Params "remote rm origin"] @? "remote rm"+{- Set up repos as remotes of each other;+ - remove origin since we're going to sync+ - some changes to a file. -}+pair :: TestEnv -> FilePath -> FilePath -> Assertion+pair env r1 r2 = forM_ [r1, r2] $ \r -> indir env r $ do+ when (r /= r1) $+ boolSystem "git" [Params "remote add r1", File ("../../" ++ r1)] @? "remote add"+ when (r /= r2) $+ boolSystem "git" [Params "remote add r2", File ("../../" ++ r2)] @? "remote add"+ boolSystem "git" [Params "remote rm origin"] @? "remote rm" -test_map :: TestEnv -> Test-test_map env = "git-annex map" ~: intmpclonerepo env $ do+test_map :: TestEnv -> Assertion+test_map env = intmpclonerepo env $ do -- set descriptions, that will be looked for in the map git_annex env "describe" [".", "this repo"] @? "describe 1 failed" git_annex env "describe" ["origin", "origin repo"] @? "describe 2 failed" -- --fast avoids it running graphviz, not a build dependency git_annex env "map" ["--fast"] @? "map failed" -test_uninit :: TestEnv -> Test-test_uninit env = "git-annex uninit" ~: TestList [inbranch, normal]- where- inbranch = "in branch" ~: intmpclonerepoInDirect env $ do- boolSystem "git" [Params "checkout git-annex"] @? "git checkout git-annex"- not <$> git_annex env "uninit" [] @? "uninit failed to fail when git-annex branch was checked out"- normal = "normal" ~: intmpclonerepo env $ do- git_annex env "get" [] @? "get failed"- annexed_present annexedfile- _ <- git_annex env "uninit" [] -- exit status not checked; does abnormal exit- checkregularfile annexedfile- doesDirectoryExist ".git" @? ".git vanished in uninit"+test_uninit :: TestEnv -> Assertion+test_uninit env = intmpclonerepo env $ do+ git_annex env "get" [] @? "get failed"+ annexed_present annexedfile+ _ <- git_annex env "uninit" [] -- exit status not checked; does abnormal exit+ checkregularfile annexedfile+ doesDirectoryExist ".git" @? ".git vanished in uninit" -test_upgrade :: TestEnv -> Test-test_upgrade env = "git-annex upgrade" ~: intmpclonerepo env $ do+test_uninit_inbranch :: TestEnv -> Assertion+test_uninit_inbranch env = intmpclonerepoInDirect env $ do+ boolSystem "git" [Params "checkout git-annex"] @? "git checkout git-annex"+ not <$> git_annex env "uninit" [] @? "uninit failed to fail when git-annex branch was checked out"++test_upgrade :: TestEnv -> Assertion+test_upgrade env = intmpclonerepo env $ do git_annex env "upgrade" [] @? "upgrade from same version failed" -test_whereis :: TestEnv -> Test-test_whereis env = "git-annex whereis" ~: intmpclonerepo env $ do+test_whereis :: TestEnv -> Assertion+test_whereis env = intmpclonerepo env $ do annexed_notpresent annexedfile git_annex env "whereis" [annexedfile] @? "whereis on non-present file failed" git_annex env "untrust" ["origin"] @? "untrust failed"@@ -821,8 +860,8 @@ annexed_present annexedfile git_annex env "whereis" [annexedfile] @? "whereis on present file failed" -test_hook_remote :: TestEnv -> Test-test_hook_remote env = "git-annex hook remote" ~: intmpclonerepo env $ do+test_hook_remote :: TestEnv -> Assertion+test_hook_remote env = intmpclonerepo env $ do #ifndef mingw32_HOST_OS git_annex env "initremote" (words "foo type=hook encryption=none hooktype=foo") @? "initremote failed" createDirectory dir@@ -854,8 +893,8 @@ noop #endif -test_directory_remote :: TestEnv -> Test-test_directory_remote env = "git-annex directory remote" ~: intmpclonerepo env $ do+test_directory_remote :: TestEnv -> Assertion+test_directory_remote env = intmpclonerepo env $ do createDirectory "dir" git_annex env "initremote" (words $ "foo type=directory encryption=none directory=dir") @? "initremote failed" git_annex env "get" [annexedfile] @? "get of file failed"@@ -869,8 +908,8 @@ not <$> git_annex env "drop" [annexedfile, "--numcopies=2"] @? "drop failed to fail" annexed_present annexedfile -test_rsync_remote :: TestEnv -> Test-test_rsync_remote env = "git-annex rsync remote" ~: intmpclonerepo env $ do+test_rsync_remote :: TestEnv -> Assertion+test_rsync_remote env = intmpclonerepo env $ do #ifndef mingw32_HOST_OS createDirectory "dir" git_annex env "initremote" (words $ "foo type=rsync encryption=none rsyncurl=dir") @? "initremote failed"@@ -889,8 +928,8 @@ noop #endif -test_bup_remote :: TestEnv -> Test-test_bup_remote env = "git-annex bup remote" ~: intmpclonerepo env $ when Build.SysConfig.bup $ do+test_bup_remote :: TestEnv -> Assertion+test_bup_remote env = intmpclonerepo env $ when Build.SysConfig.bup $ do dir <- absPath "dir" -- bup special remote needs an absolute path createDirectory dir git_annex env "initremote" (words $ "foo type=bup encryption=none buprepo="++dir) @? "initremote failed"@@ -906,47 +945,50 @@ annexed_present annexedfile -- gpg is not a build dependency, so only test when it's available-test_crypto :: TestEnv -> Test+test_crypto :: TestEnv -> Assertion #ifndef mingw32_HOST_OS-test_crypto env = "git-annex crypto" ~: TestList $ flip map ["shared","hybrid","pubkey"] $- \scheme -> TestCase $ intmpclonerepo env $ whenM (Utility.Path.inPath Utility.Gpg.gpgcmd) $ do- Utility.Gpg.testTestHarness @? "test harness self-test failed"- Utility.Gpg.testHarness $ do- createDirectory "dir"- let a cmd = git_annex env cmd $- [ "foo"- , "type=directory"- , "encryption=" ++ scheme- , "directory=dir"- , "highRandomQuality=false"- ] ++ if scheme `elem` ["hybrid","pubkey"]- then ["keyid=" ++ Utility.Gpg.testKeyId]- else []- a "initremote" @? "initremote failed"- not <$> a "initremote" @? "initremote failed to fail when run twice in a row"- a "enableremote" @? "enableremote failed"- a "enableremote" @? "enableremote failed when run twice in a row"- git_annex env "get" [annexedfile] @? "get of file failed"- annexed_present annexedfile- git_annex env "copy" [annexedfile, "--to", "foo"] @? "copy --to encrypted remote failed"- (c,k) <- annexeval $ do- uuid <- Remote.nameToUUID "foo"- rs <- Logs.Remote.readRemoteLog- Just (k,_) <- Backend.lookupFile annexedfile- return (fromJust $ M.lookup uuid rs, k)- let key = if scheme `elem` ["hybrid","pubkey"]- then Just $ Utility.Gpg.KeyIds [Utility.Gpg.testKeyId]- else Nothing- testEncryptedRemote scheme key c [k] @? "invalid crypto setup"-- annexed_present annexedfile- git_annex env "drop" [annexedfile, "--numcopies=2"] @? "drop failed"- annexed_notpresent annexedfile- git_annex env "move" [annexedfile, "--from", "foo"] @? "move --from encrypted remote failed"- annexed_present annexedfile- not <$> git_annex env "drop" [annexedfile, "--numcopies=2"] @? "drop failed to fail"- annexed_present annexedfile+test_crypto env = do+ testscheme "shared"+ testscheme "hybrid"+ testscheme "pubkey" where+ testscheme scheme = intmpclonerepo env $ whenM (Utility.Path.inPath Utility.Gpg.gpgcmd) $ do+ Utility.Gpg.testTestHarness @? "test harness self-test failed"+ Utility.Gpg.testHarness $ do+ createDirectory "dir"+ let a cmd = git_annex env cmd $+ [ "foo"+ , "type=directory"+ , "encryption=" ++ scheme+ , "directory=dir"+ , "highRandomQuality=false"+ ] ++ if scheme `elem` ["hybrid","pubkey"]+ then ["keyid=" ++ Utility.Gpg.testKeyId]+ else []+ a "initremote" @? "initremote failed"+ not <$> a "initremote" @? "initremote failed to fail when run twice in a row"+ a "enableremote" @? "enableremote failed"+ a "enableremote" @? "enableremote failed when run twice in a row"+ git_annex env "get" [annexedfile] @? "get of file failed"+ annexed_present annexedfile+ git_annex env "copy" [annexedfile, "--to", "foo"] @? "copy --to encrypted remote failed"+ (c,k) <- annexeval $ do+ uuid <- Remote.nameToUUID "foo"+ rs <- Logs.Remote.readRemoteLog+ Just (k,_) <- Backend.lookupFile annexedfile+ return (fromJust $ M.lookup uuid rs, k)+ let key = if scheme `elem` ["hybrid","pubkey"]+ then Just $ Utility.Gpg.KeyIds [Utility.Gpg.testKeyId]+ else Nothing+ testEncryptedRemote scheme key c [k] @? "invalid crypto setup"+ + annexed_present annexedfile+ git_annex env "drop" [annexedfile, "--numcopies=2"] @? "drop failed"+ annexed_notpresent annexedfile+ git_annex env "move" [annexedfile, "--from", "foo"] @? "move --from encrypted remote failed"+ annexed_present annexedfile+ not <$> git_annex env "drop" [annexedfile, "--numcopies=2"] @? "drop failed to fail"+ annexed_present annexedfile {- Ensure the configuration complies with the encryption scheme, and - that all keys are encrypted properly for the given directory remote. -} testEncryptedRemote scheme ks c keys = case Remote.Helper.Encryptable.extractCipher c of@@ -974,7 +1016,7 @@ key2files cipher = Locations.keyPaths . Crypto.encryptKey Types.Crypto.HmacSha1 cipher #else-test_crypto _env = "git-annex crypto" ~: putStrLn "gpg testing not implemented on Windows"+test_crypto _env = putStrLn "gpg testing not implemented on Windows" #endif -- This is equivilant to running git-annex, but it's all run in-process
Types/Key.hs view
@@ -60,7 +60,9 @@ _ ?: _ = "" file2key :: FilePath -> Maybe Key-file2key s = if key == Just stubKey || (keyName <$> key) == Just "" then Nothing else key+file2key s+ | key == Just stubKey || (keyName <$> key) == Just "" || (keyBackendName <$> key) == Just "" = Nothing+ | otherwise = key where key = startbackend stubKey s @@ -91,6 +93,4 @@ prop_idempotent_key_encode k = Just k == (file2key . key2file) k prop_idempotent_key_decode :: FilePath -> Bool-prop_idempotent_key_decode f- | null f = True -- skip illegal empty filename- | otherwise = maybe True (\k -> key2file k == f) (file2key f)+prop_idempotent_key_decode f = maybe True (\k -> key2file k == f) (file2key f)
Types/Remote.hs view
@@ -18,7 +18,7 @@ import Types.GitConfig import Config.Cost import Utility.Metered-import Git.Remote+import Git.Types import Utility.SafeCommand type RemoteConfigKey = String
Upgrade.hs view
@@ -16,10 +16,28 @@ import qualified Upgrade.V1 #endif import qualified Upgrade.V2+import qualified Upgrade.V4 -upgrade :: Annex Bool-upgrade = go =<< getVersion+checkUpgrade :: Version -> Annex ()+checkUpgrade = maybe noop error <=< needsUpgrade++needsUpgrade :: Version -> Annex (Maybe String)+needsUpgrade v+ | v `elem` supportedVersions = ok+ | v `elem` autoUpgradeableVersions = ifM (upgrade True)+ ( ok+ , err "Automatic upgrade failed!"+ )+ | v `elem` upgradableVersions = err "Upgrade this repository: git-annex upgrade"+ | otherwise = err "Upgrade git-annex." where+ err msg = return $ Just $ "Repository version " ++ v +++ " is not supported. " ++ msg+ ok = return Nothing++upgrade :: Bool -> Annex Bool+upgrade automatic = go =<< getVersion+ where #ifndef mingw32_HOST_OS go (Just "0") = Upgrade.V0.upgrade go (Just "1") = Upgrade.V1.upgrade@@ -28,4 +46,5 @@ go (Just "1") = error "upgrade from v1 on Windows not supported" #endif go (Just "2") = Upgrade.V2.upgrade+ go (Just "4") = Upgrade.V4.upgrade automatic go _ = return True
+ Upgrade/V4.hs view
@@ -0,0 +1,23 @@+{- git-annex v4 -> v5 uppgrade support+ -+ - Copyright 2013 Joey Hess <joey@kitenet.net>+ -+ - Licensed under the GNU GPL version 3 or higher.+ -}++module Upgrade.V4 where++import Common.Annex+import Config+import Annex.Direct++{- Direct mode only upgrade. -}+upgrade :: Bool -> Annex Bool+upgrade automatic = ifM isDirect+ ( do+ unless automatic $+ showAction "v4 to v5"+ setDirect True+ return True+ , return False+ )
Utility/Base64.hs view
@@ -7,7 +7,7 @@ module Utility.Base64 (toB64, fromB64Maybe, fromB64) where -import Codec.Binary.Base64+import "dataenc" Codec.Binary.Base64 import Data.Bits.Utils import Control.Applicative import Data.Maybe
Utility/Batch.hs view
@@ -10,7 +10,9 @@ module Utility.Batch where import Common+#ifndef mingw32_HOST_OS import qualified Build.SysConfig+#endif #if defined(linux_HOST_OS) || defined(__ANDROID__) import Control.Concurrent.Async
Utility/DirWatcher.hs view
@@ -1,10 +1,10 @@ {- generic directory watching interface -- - Uses inotify, or kqueue, or fsevents to watch a directory+ - Uses inotify, or kqueue, or fsevents, or win32-notify to watch a directory - (and subdirectories) for changes, and runs hooks for different - sorts of events as they occur. -- - Copyright 2012 Joey Hess <joey@kitenet.net>+ - Copyright 2012-2013 Joey Hess <joey@kitenet.net> - - Licensed under the GNU GPL version 3 or higher. -}@@ -27,11 +27,15 @@ import qualified Utility.FSEvents as FSEvents import qualified System.OSX.FSEvents as FSEvents #endif+#if WITH_WIN32NOTIFY+import qualified Utility.Win32Notify as Win32Notify+import qualified System.Win32.Notify as Win32Notify+#endif type Pruner = FilePath -> Bool canWatch :: Bool-#if (WITH_INOTIFY || WITH_KQUEUE || WITH_FSEVENTS)+#if (WITH_INOTIFY || WITH_KQUEUE || WITH_FSEVENTS || WITH_WIN32NOTIFY) canWatch = True #else #if defined linux_HOST_OS@@ -47,7 +51,7 @@ - OTOH, with kqueue, often only one event is received, indicating the most - recent state of the file. -} eventsCoalesce :: Bool-#if WITH_INOTIFY+#if (WITH_INOTIFY || WITH_WIN32NOTIFY) eventsCoalesce = False #else #if (WITH_KQUEUE || WITH_FSEVENTS)@@ -68,7 +72,7 @@ - still being written to, and then no add event will be received once the - writer closes it. -} closingTracked :: Bool-#if (WITH_INOTIFY || WITH_FSEVENTS)+#if (WITH_INOTIFY || WITH_FSEVENTS || WITH_WIN32NOTIFY) closingTracked = True #else #if WITH_KQUEUE@@ -83,7 +87,7 @@ - Fsevents generates events when an existing file is reopened and rewritten, - but not necessarily when it's opened once and modified repeatedly. -} modifyTracked :: Bool-#if (WITH_INOTIFY || WITH_FSEVENTS)+#if (WITH_INOTIFY || WITH_FSEVENTS || WITH_WIN32NOTIFY) modifyTracked = True #else #if WITH_KQUEUE@@ -119,27 +123,35 @@ watchDir dir prune hooks runstartup = runstartup $ FSEvents.watchDir dir prune hooks #else+#if WITH_WIN32NOTIFY+type DirWatcherHandle = Win32Notify.WatchManager+watchDir :: FilePath -> Pruner -> WatchHooks -> (IO Win32Notify.WatchManager -> IO Win32Notify.WatchManager) -> IO DirWatcherHandle+watchDir dir prune hooks runstartup =+ runstartup $ Win32Notify.watchDir dir prune hooks+#else type DirWatcherHandle = () watchDir :: FilePath -> Pruner -> WatchHooks -> (IO () -> IO ()) -> IO DirWatcherHandle watchDir = undefined #endif #endif #endif+#endif -#if WITH_INOTIFY stopWatchDir :: DirWatcherHandle -> IO ()+#if WITH_INOTIFY stopWatchDir = INotify.killINotify #else #if WITH_KQUEUE-stopWatchDir :: DirWatcherHandle -> IO () stopWatchDir = killThread #else #if WITH_FSEVENTS-stopWatchDir :: DirWatcherHandle -> IO () stopWatchDir = FSEvents.eventStreamDestroy #else-stopWatchDir :: DirWatcherHandle -> IO ()+#if WITH_WIN32NOTIFY+stopWatchDir = Win32Notify.killWatchManager+#else stopWatchDir = undefined+#endif #endif #endif #endif
Utility/Process.hs view
@@ -44,8 +44,10 @@ import Control.Monad #ifndef mingw32_HOST_OS import System.Posix.IO-import Data.Maybe+#else+import Control.Applicative #endif+import Data.Maybe import Utility.Misc import Utility.Exception@@ -161,6 +163,8 @@ - whether it succeeded or failed. -} processTranscript :: String -> [String] -> (Maybe String) -> IO (String, Bool) #ifndef mingw32_HOST_OS+{- This implementation interleves stdout and stderr in exactly the order+ - the process writes them. -} processTranscript cmd opts input = do (readf, writef) <- createPipe readh <- fdToHandle readf@@ -173,10 +177,7 @@ } hClose writeh - -- fork off a thread to start consuming the output- transcript <- hGetContents readh- outMVar <- newEmptyMVar- _ <- forkIO $ E.evaluate (length transcript) >> putMVar outMVar ()+ get <- mkreader readh -- now write and flush any input case input of@@ -188,15 +189,46 @@ hClose inh Nothing -> return () - -- wait on the output- takeMVar outMVar- hClose readh+ transcript <- get ok <- checkSuccessProcess pid return (transcript, ok) #else-processTranscript = error "processTranscript TODO"+{- This implementation for Windows puts stderr after stdout. -}+processTranscript cmd opts input = do+ p@(_, _, _, pid) <- createProcess $+ (proc cmd opts)+ { std_in = if isJust input then CreatePipe else Inherit+ , std_out = CreatePipe+ , std_err = CreatePipe+ }++ getout <- mkreader (stdoutHandle p)+ geterr <- mkreader (stderrHandle p)++ case input of+ Just s -> do+ let inh = stdinHandle p+ unless (null s) $ do+ hPutStr inh s+ hFlush inh+ hClose inh+ Nothing -> return ()+ + transcript <- (++) <$> getout <*> geterr+ ok <- checkSuccessProcess pid+ return (transcript, ok) #endif+ where+ mkreader h = do+ s <- hGetContents h+ v <- newEmptyMVar+ void $ forkIO $ do+ void $ E.evaluate (length s)+ putMVar v ()+ return $ do+ takeMVar v+ return s {- Runs a CreateProcessRunner, on a CreateProcess structure, that - is adjusted to pipe only from/to a single StdHandle, and passes
+ Utility/Win32Notify.hs view
@@ -0,0 +1,65 @@+{- Win32-notify interface+ -+ - Copyright 2013 Joey Hess <joey@kitenet.net>+ -+ - Licensed under the GNU GPL version 3 or higher.+ -}++module Utility.Win32Notify where++import Common hiding (isDirectory)+import Utility.DirWatcher.Types++import System.Win32.Notify+import qualified System.PosixCompat.Files as Files++watchDir :: FilePath -> (FilePath -> Bool) -> WatchHooks -> IO WatchManager+watchDir dir ignored hooks = do+ scan dir+ wm <- initWatchManager+ void $ watchDirectory wm dir True [Create, Delete, Modify, Move] handle+ return wm+ where+ handle evt+ | ignoredPath ignored (filePath evt) = noop+ | otherwise = case evt of+ (Deleted _ _)+ | isDirectory evt -> runhook delDirHook Nothing+ | otherwise -> runhook delHook Nothing+ (Created _ _)+ | isDirectory evt -> noop+ | otherwise -> runhook addHook Nothing+ (Modified _ _)+ | isDirectory evt -> noop+ {- Add hooks are run when a file is modified for + - compatability with INotify, which calls the add+ - hook when a file is closed, and so tends to call+ - both add and modify for file modifications. -}+ | otherwise -> do+ runhook addHook Nothing+ runhook modifyHook Nothing+ where+ runhook h s = maybe noop (\a -> a (filePath evt) s) (h hooks)++ scan d = unless (ignoredPath ignored d) $+ mapM_ go =<< dirContentsRecursive d+ where + go f+ | ignoredPath ignored f = noop+ | otherwise = do+ ms <- getstatus f+ case ms of+ Nothing -> noop+ Just s+ | Files.isRegularFile s ->+ runhook addHook ms+ | otherwise ->+ noop+ where+ runhook h s = maybe noop (\a -> a f s) (h hooks)+ + getstatus = catchMaybeIO . getFileStatus++{- Check each component of the path to see if it's ignored. -}+ignoredPath :: (FilePath -> Bool) -> FilePath -> Bool+ignoredPath ignored = any ignored . map dropTrailingPathSeparator . splitPath
debian/changelog view
@@ -1,3 +1,48 @@+git-annex (5.20131118) unstable; urgency=low++ * Direct mode repositories now have core.bare=true set, to prevent+ accidentally running git commands that try to operate on the work tree,+ and so do the wrong thing in direct mode.+ * annex.version is now set to 5 for direct mode repositories.+ This upgrade is handled fully automatically, no need to run+ git annex upgrade+ * The "status" command has been renamed to "info", to allow+ "git annex status" to be used in direct mode repositories, now that+ "git status" won't work in them.+ * The -c option now not only modifies the git configuration seen by+ git-annex, but it is passed along to every git command git-annex runs.+ * watcher: Avoid loop when adding a file owned by someone else fails+ in indirect mode because its permissions cannot be modified.+ * webapp: Avoid encoding problems when displaying the daemon log file.+ * webapp: Improve UI around remote that have no annex.uuid set,+ either because setup of them is incomplete, or because the remote+ git repository is not a git-annex repository.+ * Include ssh-keygen in standalone bundle.+ * Allow optionally configuring git-annex with -fEKG to enable awesome+ remote monitoring interfaceat http://localhost:4242/+ * Fix bug that caused bad information to be written to the git-annex branch+ when running describe or other commands with a remote that has no uuid.+ * Work around Android linker problem that had prevented git-annex from+ running on Android 4.3 and 4.4.+ * repair: Handle case where index file is corrupt, but all objects are ok.+ * assistant: Notice on startup when the index file is corrupt, and+ auto-repair.+ * Fix direct mode merge bug when a direct mode file was deleted and replaced+ with a directory. An ordering problem caused the directory to not get+ created in this case.+ Thanks to Tim for the test case.+ * Direct mode .git/annex/objects directories are no longer left writable,+ because that allowed writing to symlinks of files that are not present,+ which followed the link and put bad content in an object location.+ Thanks to Tim for the test case.+ * fsck: Fix up .git/annex/object directory permissions.+ * Switched to the tasty test framework.+ * Android: Adjust default .gitignore to ignore .thumbnails at any location+ in the tree, not just at its top.+ * webapp: Check annex.version.++ -- Joey Hess <joeyh@debian.org> Mon, 18 Nov 2013 10:45:43 -0400+ git-annex (4.20131106) unstable; urgency=low * Improve local pairing behavior when two computers both try to start
debian/control view
@@ -53,7 +53,7 @@ libghc-feed-dev, ikiwiki, perlmagick,- git,+ git (>= 1:1.8.4), rsync, wget, curl,@@ -68,7 +68,7 @@ Architecture: any Section: utils Depends: ${misc:Depends}, ${shlibs:Depends},- git (>= 1:1.7.7.6),+ git (>= 1:1.8.4), rsync, wget, curl,
doc/bare_repositories.mdwn view
@@ -39,7 +39,7 @@ git remote add origin example.com:bare-annex.git git push origin master git-annex -Now `git annex status` should show the configured bare remote. If it does not, you may have to pull from the remote first (older versions of `git-annex`)+Now `git annex info` should show the configured bare remote. If it does not, you may have to pull from the remote first (older versions of `git-annex`) If you wish to configure git such that you can push/pull without arguments, set the upstream branch:
+ doc/bugs/Discrepancy_between_git_annex_add_and_git_annex_watch.mdwn view
@@ -0,0 +1,33 @@+### Please describe the problem.++`git annex add` does not add dotfiles (as per the man page) while `git annex watch` does (nothing on the man page). It's not a bug, but rather a surprise (at least to me).++### What steps will reproduce the problem?++[[!format sh """+git init dotfiles+cd dotfiles+git annex init "my dotfiles"+echo test > test.txt+echo dottest > .dotest.txt+git annex add+git commit -a -m "initial dots"+git annex whereis .dotest.txt # no answer, as expected+git annex watch+git annex whereis .dotest.txt # answers that .dotest.txt is here+"""]]++### What version of git-annex are you using? On what operating system?+git-annex version: 4.20131101, ubuntu 12.04 with all updates.++### 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+++# End of transcript or log.+"""]]++> Improved documentation. [[done]] --[[Joey]]
+ doc/bugs/Incorrect_merge__44___direct_repos___40__2__41__.mdwn view
@@ -0,0 +1,44 @@+### Please describe the problem.+Incorrect merge of direct repos.++### What steps will reproduce the problem?++[[!format sh """+# setting up stuff+test/a$ git init+test/a$ git annex init+test/a$ git annex direct+test/a$ touch firstfile+test/a$ git annex add firstfile+$ git clone test/a+$ mv a test/b+test/b$ git annex direct++# actual scenario+test/b$ echo bbbb > f+test/b$ git annex add f+test/b$ git annex sync+test/a$ mkdir f+test/a$ echo aaaa > f/f+test/a$ git annex add f/f+test/a$ git annex sync+test/b$ git annex sync+test/b$ rm f+test/b$ git annex sync+test/b$ ls+test/b$ firstfile+test/b$ f.variant-SHA256E-s5--4551db5fd4d56e27be71a8a943070cfaa4342b8e960a326e2d6427b3aa0a5a48.variant-43f5+test/a$ git annex sync # A's f/f is no longer to be found+"""]]++### What version of git-annex are you using? On what operating system?+[[!format sh """+git-annex version: 4.20131031-g7d99d14+build flags: Assistant Webapp Pairing Testsuite S3 WebDAV Inotify DBus 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 glacier hook++Linux ceilingcat 3.11.6-1-ARCH #1 SMP PREEMPT Fri Oct 18 23:22:36 CEST 2013 x86_64 GNU/Linux+"""]]++> [[fixed|done]] --[[Joey]]
+ doc/bugs/Incorrect_merge___40__a_special_case__41__.mdwn view
@@ -0,0 +1,48 @@+### Please describe the problem.+(Minor issue.)++Incorrect merge of direct repos in the special case where at repo A a symlink to a file whose contents aren't yet available, are overwritten, while at repo B the file is deleted.++Result: file is deleted on both side.++Expected: B.f is gone, A.f is still present++### What steps will reproduce the problem?++[[!format sh """+# setting up stuff+test/a$ git init+test/a$ git annex init+test/a$ git annex direct+test/a$ touch firstfile+test/a$ git annex add firstfile+$ git clone test/a+$ mv a test/b+test/b$ git annex direct++# actual scenario+test/b$ echo bbbb > f+test/b$ git annex add f+test/b$ git annex sync+test/a$ git annex sync+test/a$ echo aaaa > f+test/a$ git annex add f+test/a$ git annex sync+test/b$ rm f+test/b$ git annex sync+test/a$ git annex sync+# test/a/f is now gone, lost+"""]]++### What version of git-annex are you using? On what operating system?+[[!format sh """+git-annex version: 4.20131031-g7d99d14+build flags: Assistant Webapp Pairing Testsuite S3 WebDAV Inotify DBus 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 glacier hook++Linux ceilingcat 3.11.6-1-ARCH #1 SMP PREEMPT Fri Oct 18 23:22:36 CEST 2013 x86_64 GNU/Linux+"""]]++> [[fixed|done]]; direct mode now freezes the content directory as indirect+> mode already did. fsck will fix up the permissions too. --[[Joey]]
+ doc/bugs/Mac_OS_10.9_GPG_erro_when_creating_USB_repo___40__solved__41__.mdwn view
@@ -0,0 +1,23 @@+### Please describe the problem.++Creating a USB repo fails with a GPG error.++### What steps will reproduce the problem?++ * Build git-annex and git-annex assistant using the instructions at https://gist.github.com/calmyournerves/7144127+ * Run git-annex app to launch web interface+ * Create local repo using web interface+ * Try to create USB repo using web interface++### What version of git-annex are you using? On what operating system?++git-annex version 4.20131105-g136b030 on Mac OS 10.9 Mavericks.++### Please provide any additional information below.++[[!format sh """+07/Nov/2013:06:51:07 +1100 [Error#yesod-core] user error (gpg ["--batch","--no-tty","--use-agent","--quiet","--trust-model","always","--with-colons","--list-secret-keys","--fixed-list-mode"] exited 5) @(yesod-core-1.2.4.5:Yesod.Core.Class.Yesod ./Yesod/Core/Class/Yesod.hs:485:5)+"""]]++> [[fixed|done]]; it seems that this was a local build issue ad does not+> affect the autobuild. --[[Joey]]
+ doc/bugs/Mac_OS_10.9_GPG_error_adding_S3_repo___40__solved__41__.mdwn view
@@ -0,0 +1,28 @@+### Please describe the problem.++Creating a remote S3 repository using the git-annex assistant web interface fails with a GPG error. (I'm also getting a GPG error trying to create a USB repo but it's slightly different so I'll post a different bug.)++### What steps will reproduce the problem?++ * Build git-annex and git-annex assistant using the instructions at https://gist.github.com/calmyournerves/7144127+ * Run git-annex app to launch web interface+ * Create local repo using web interface+ * Try to create encrypted S3 remote repo using web interface++### What version of git-annex are you using? On what operating system?++git-annex version 4.20131105-g136b030 on MacOS 10.9 Mavericks.++### Please provide any additional information below.++[[!format sh """++(encryption setup) dyld: Library not loaded: @rpath/libz.1.2.8.dylib+ Referenced from: /Applications/git-annex.app/Contents/MacOS/bundle/gpg+ Reason: image not found+07/Nov/2013:06:38:27 +1100 [Error#yesod-core] user error (gpg ["--batch","--no-tty","--use-agent","--quiet","--trust-model","always","--gen-random","--armor","1","512"] exited 5) @(yesod-core-1.2.4.5:Yesod.Core.Class.Yesod ./Yesod/Core/Class/Yesod.hs:485:5)++"""]]++> [[fixed|done]]; it seems that this was a local build issue ad does not+> affect the autobuild. --[[Joey]]
+ doc/bugs/OSX_.dmg_unnecessarily_large_and_not_inherently_compressed.mdwn view
@@ -0,0 +1,68 @@+### Please describe the problem.++The .dmg the OSX build is distributed in is unnecessarily large (fixed size) and is externally compressed.++I did a quick survey of .dmg images used for distributing other pieces of software which I had downloaded to my Mac, and most of them seem to be the UDBZ or the (older) UDZO formats which are internally compressed with bzip2 or zlib. According to "man hdiutil", the UDBZ format is supported since 10.4 (Tiger).++Below are a pair of patches: first to enable "make clean" to work on OSX, second to build the .dmg in the UDBZ format and without an explicit size (it seems to infer a correct size). When I tested building it, it results in a .dmg which is slightly smaller than the old .dmg.bz2++(This will also require a change to remove the .bz2 from the download links elsewhere in the wiki.)++<pre>+From 251e23bbe66cc63e98089554f91b2528a097e818 Mon Sep 17 00:00:00 2001+From: Mike Magin <git@mike.magin.org>+Date: Sun, 17 Nov 2013 08:11:05 -0800+Subject: [PATCH 1/2] Add explicit path to find invocation in "make clean" target.++---+ Makefile | 4 ++--+ 1 file changed, 2 insertions(+), 2 deletions(-)++diff --git a/Makefile b/Makefile+index 3f3ed35..5a0cebb 100644+--- a/Makefile++++ b/Makefile+@@ -83,8 +83,8 @@ clean:+ Setup Build/InstallDesktopFile Build/EvilSplicer \+ Build/Standalone Build/OSXMkLibs \+ git-union-merge git-recover-repository+- find -name \*.o -exec rm {} \;+- find -name \*.hi -exec rm {} \;++ find . -name \*.o -exec rm {} \;++ find . -name \*.hi -exec rm {} \;+ + Build/InstallDesktopFile: Build/InstallDesktopFile.hs+ $(GHC) --make $@+-- +1.8.4.3++From e66f767893b5ef70cbf69d420cb589071f88c784 Mon Sep 17 00:00:00 2001+From: Mike Magin <git@mike.magin.org>+Date: Sun, 17 Nov 2013 08:40:07 -0800+Subject: [PATCH 2/2] Change .dmg build to include compression and not be fixed size.++---+ Makefile | 3 +--+ 1 file changed, 1 insertion(+), 2 deletions(-)++diff --git a/Makefile b/Makefile+index 5a0cebb..b6ac549 100644+--- a/Makefile++++ b/Makefile+@@ -162,10 +162,9 @@ osxapp: Build/Standalone Build/OSXMkLibs+ + ./Build/OSXMkLibs $(OSXAPP_BASE)+ rm -f tmp/git-annex.dmg+- hdiutil create -size 640m -format UDRW -srcfolder tmp/build-dmg \++ hdiutil create -format UDBZ -srcfolder tmp/build-dmg \+ -volname git-annex -o tmp/git-annex.dmg+ rm -f tmp/git-annex.dmg.bz2+- bzip2 --fast tmp/git-annex.dmg+ + ANDROID_FLAGS?=-f-XMPP+ # Cross compile for Android.+-- +1.8.4.3+</pre>++> Ah, that never seemed optimal. [[done]] --[[Joey]]
+ doc/bugs/get_from_bup-remote_with_pubkey_failing.mdwn view
@@ -0,0 +1,93 @@+### Please describe the problem.++I'm unable to 'git annex get' a file from a bup-remote with encryption set to 'pubkey'.++### What steps will reproduce the problem?+ +I added a bup-remote using [these instructions](http://git-annex.branchable.com/walkthrough/using_bup/):++ bash-3.2$ git annex initremote mybup type=bup encryption=pubkey keyid=0xABE8244505D63E81 buprepo=gumdrop:/home/gert/.bup++ # now adding files and moving them:+ bash-3.2$ mkdir orgmode && touch orgmode/some.org+ bash-3.2$ git annex add orgmode/some.org+ add orgmode/some.org (checksum...) ok+ (Recording state in git...)+ bash-3.2$ git commit+ [master bce8c83] Some.org+ 1 file changed, 1 insertion(+)+ create mode 120000 orgmode/some.org+ bash-3.2$ git annex move orgmode/ --to=mybup+ move orgmode/another.org (gpg)+ U moet een geheime zin opgeven om de geheime sleutel te gebruiken+ van: “email”+ 4096-bit RSA key, ID 0xFF8DE378DE223820, created 2013-11-10+ (sub-sleutel bij hoofd sleutel ID 0xE9B90528FDA4E1E6)++ (checking mybup...) ok+ (Recording state in git...)+ bash-3.2$ less orgmode/another.org+ orgmode/another.org: No such file or directory+ bash-3.2$ git annex get orgmode/another.org --debug+ [2013-11-13 16:18:07 CET] read: git ["--git-dir=/Users/gert/annex/.git","--work-tree=/Users/gert/annex","ls-files","--cached","-z","--","orgmode/another.org"]+ get orgmode/another.org [2013-11-13 16:18:08 CET] read: git ["--git-dir=/Users/gert/annex/.git","--work-tree=/Users/gert/annex","show-ref","git-annex"]+ [2013-11-13 16:18:08 CET] read: git ["--git-dir=/Users/gert/annex/.git","--work-tree=/Users/gert/annex","show-ref","--hash","refs/heads/git-annex"]+ [2013-11-13 16:18:08 CET] read: git ["--git-dir=/Users/gert/annex/.git","--work-tree=/Users/gert/annex","log","refs/heads/git-annex..f25f9bb2b78a8b9c4b64087f1378c68fb5c0a2f1","--oneline","-n1"]+ [2013-11-13 16:18:08 CET] read: git ["--git-dir=/Users/gert/annex/.git","--work-tree=/Users/gert/annex","log","refs/heads/git-annex..1b0a3dd72be437d800e58d659837d6e528cbbc39","--oneline","-n1"]+ [2013-11-13 16:18:08 CET] read: git ["--git-dir=/Users/gert/annex/.git","--work-tree=/Users/gert/annex","log","refs/heads/git-annex..f62419efea58245d232a52ceaf0eaefe3b0fdced","--oneline","-n1"]+ [2013-11-13 16:18:08 CET] read: git ["--git-dir=/Users/gert/annex/.git","--work-tree=/Users/gert/annex","log","refs/heads/git-annex..eb6f0cd983d9a3637e984aa815537fe20a5c2a69","--oneline","-n1"]+ [2013-11-13 16:18:08 CET] read: git ["--git-dir=/Users/gert/annex/.git","--work-tree=/Users/gert/annex","log","refs/heads/git-annex..5362118e643462a0875bfe31d493ffe64413f2d8","--oneline","-n1"]+ [2013-11-13 16:18:08 CET] read: git ["--git-dir=/Users/gert/annex/.git","--work-tree=/Users/gert/annex","log","refs/heads/git-annex..e5afaf82ce25f60a108c0ae873b6fd57c5d28ca7","--oneline","-n1"]+ [2013-11-13 16:18:08 CET] chat: git ["--git-dir=/Users/gert/annex/.git","--work-tree=/Users/gert/annex","cat-file","--batch"]+ [2013-11-13 16:18:08 CET] read: git ["config","--null","--list"]+ (from mybup...) (gpg) [2013-11-13 16:18:08 CET] chat: gpg ["--quiet","--trust-model","always","--decrypt"]++ U moet een geheime zin opgeven om de geheime sleutel te gebruiken+ van: “<email>”+ 4096-bit RSA key, ID 0xFF8DE378DE223820, created 2013-11-10+ (sub-sleutel bij hoofd sleutel ID 0xE9B90528FDA4E1E6)++ [2013-11-13 16:18:15 CET] read: bup ["join","-r","gumdrop:/home/gert/.bup","GPGHMACSHA1--67aec1b62d05d000442cf8e7d9df8d327eaf26d5"]+ [2013-11-13 16:18:15 CET] chat: gpg ["--quiet","--trust-model","always","--batch","--decrypt"]+ gpg: kan geheime zin niet opvragen in batch modus+ gpg: decoderen mislukt: secret key not available++ Unable to access these remotes: mybup++ Try making some of these repositories available:+ 080e97d2-4f82-4292-acb7-a48d82009258 -- mybup (mybupmy bup repository at gumdrop)++ (Note that these git remotes have annex-ignore set: origin)+ failed+ git-annex: get: 1 failed++### What version of git-annex are you using? On what operating system?++Running git-annex version 4.20131105-g136b030 on OSX 10.8.5.++### Please provide any additional information below.++My ideas:++"Unable to access these remotes: mybup" is weird, I just moved files there.++"secret key not available" makes me think it's looking for the primary secret key (which is indeed offline).+When I encrypt a file with the same key I used to create the remote it just works:++ $ gpg --armor --recipient 0xABE8244505D63E81 --encrypt file.txt+ $ gpg --decrypt file.txt.asc++When prompting for my passphrase it states "4096-bit RSA key, ID 0xFF8DE378DE223820, created 2013-11-10".+That is a different subkey than what I entered when I setting up the remote.++My keys/subkeys:++ pub 4096R/0xE9B90528FDA4E1E6 aangemaakt: 2013-11-10 vervaldatum: 2014-11-10 gebruik: SC+ vertrouwen: ultimate geldigheid: ultimate+ sub 4096R/0x98816CFB398B4666 aangemaakt: 2013-11-10 vervaldatum: 2014-11-10 gebruik: E+ sub 4096R/0x91951718D5F11CDD aangemaakt: 2013-11-10 vervaldatum: 2014-11-10 gebruik: S+ sub 4096R/0xABE8244505D63E81 aangemaakt: 2013-11-10 vervaldatum: 2014-11-10 gebruik: E+ sub 4096R/0xB44520A46B27144D aangemaakt: 2013-11-10 vervaldatum: 2014-11-10 gebruik: S+ sub 4096R/0xFF8DE378DE223820 aangemaakt: 2013-11-10 vervaldatum: 2014-11-10 gebruik: E++> This was already fixed in version 4.20131106. [[done]] --[[Joey]]
doc/bugs/git-annex_broken_on_Android_4.3.mdwn view
@@ -1,3 +1,7 @@ As per [[install/Android/#comment-e218073735d67691a2c3f66cc53ca6ac]] and [[install/Android/#comment-29bd13ab9cb830ffcd7850b84fb111c8]] : git-annex is broken on Android 4.3; both on Nexus 4 and Nexus 7.++> [[Fixed|done]]. A 4.3 build of the apk is now available. +> (Unfortunately the fix breaks support for older versions of Android, +> so two versions of the apk have to be built now.) --[[Joey]]
+ doc/bugs/git_annex_describe_can_break_uuid.log.mdwn view
@@ -0,0 +1,46 @@+### Please describe the problem.++`uuid.log` can end up in a state where `git annex describe` (and probably other things) stops working.++### What steps will reproduce the problem?++Run `git annex describe` against a remote that is not a an initialized git-annex repo.++### What version of git-annex are you using? On what operating system?++debian-packaged git-annex 4.20131106 on Linux Mint 13/Maya (Ubuntu Precise/12.04)++### Please provide any additional information below.++I will follow comments, but can also be found at [[https://microca.st/clacke]].++Full transcript to reproduce:++[[!format sh """+$ git init a+Initialized empty Git repository in /tmp/annex/a/.git/+$ git init b+Initialized empty Git repository in /tmp/annex/b/.git/+$ cd a/+$ git annex init+init ok+(Recording state in git...)+$ git remote add -f b ../b+Updating b+$ git annex describe b b # this should not be ok+describe b ok+(Recording state in git...)+$ git annex describe b b+describe b git-annex: Prelude.last: empty list+$ git cat-file blob git-annex:uuid.log+ b timestamp=1383987654.900868s+...++# End of transcript.+"""]]++> Fixed the bug and made git breakage not crash git-annex. [[done]]+> --[[Joey]] ++> > Update: Also made it automatically clean up the cruft this put in the+> > log. --[[Joey]]
doc/bugs/git_annex_doesn__39__t_work_in_Max_OS_X_10.9.mdwn view
@@ -216,3 +216,5 @@ # End of transcript or log. """]]++> [[fixed|done]] --[[Joey]]
doc/bugs/git_version_in_prebuilt_linux_tarball_is_outdated.mdwn view
@@ -6,3 +6,6 @@ ### What version of git-annex are you using? On what operating system? git-annex-standalone-amd64.tar.gz 2013-09-22 09:56 (Linux Ubuntu Precise)++> Updated to wheezy backport 1.8.4. [[done]] for now, obviously it will go+> out of date again eventually.. --[[Joey]]
+ doc/bugs/gitignore_for_DCIM_on_Android_misses_some_files.mdwn view
@@ -0,0 +1,17 @@+### Please describe the problem.++When git-annex assistant on Android setups up the DCIM repo a .gitignore file is dropped into place which ignores .thumbnails/* . Unfortunately this doesn't match .thumbnails/.thumbdata* - I have a 700MB file which matches this pattern.++I suspect that making the pattern in .gitignore just .thumbnails should resolve this.++### What steps will reproduce the problem?++Create a repo++### What version of git-annex are you using? On what operating system?++Nightly build for Android from yesterday (2013-11-16)++### Please provide any additional information below.++> [[fixed|done]] --[[Joey]]
doc/bugs/ssh-keygen_failed_when_adding_remote_server_repo.mdwn view
@@ -40,3 +40,5 @@ # End of transcript or log. """]]++> Added ssh-keygen to bundle. [[fixed|done]] --[[Joey]]
+ doc/bugs/typo_on_the_Mac_OS_10.7.5_Lion_build.mdwn view
@@ -0,0 +1,11 @@+As told in http://git-annex.branchable.com/bugs/OSX_app_issues/#comment-2a69d531bd3bb593c1a49dc8cdb34b1e the Mac OS 10.7.5 (Lion) build fails to run.++ $ /Applications/git-annex.app/Contents/MacOS/git-annex++ /Applications/git-annex.app/Contents/MacOS/runshell: line 25: syntax error near unexpected token `&'++Manually editing /Applications/git-annex.app/Contents/MacOS/runshell as told in http://git-annex.branchable.com/bugs/OSX_app_issues/#comment-5579c2150ad4d2ccc207a253fe57612a fixes the issue.++Furthermore, this build is quite outdated...++> [[fixed|done]] --[[Joey]]
doc/bugs/unfinished_repository_when_using_annex-ignore_true_.mdwn view
@@ -21,3 +21,5 @@ upgrade supported from repository versions: 0 1 2 Kubuntu 13.10 x86_64++> [[fixed|done]] --[[Joey]]
doc/bugs/web_app_loops_over_a_non-addable_file.mdwn view
@@ -52,3 +52,5 @@ Turns out that file is owned by root, so it's an expected failure. But the webapp should simply skip this file, not loop over it. The workaround is obviously to give this file to the proper user. --[[anarcat]]++> [[fixed|done]] --[[Joey]]
+ doc/bugs/webapp_usability:_fails_mysteriously_on_newer_repo_layouts.mdwn view
@@ -0,0 +1,34 @@+### Please describe the problem.++Starting the webapp on a repository that was hastily created by copying an existing one with an older version yields an undecipherable error.++Rather minor.++### What steps will reproduce the problem?++1. Install git-annex from git+2. make a repo+3. copy it over to an external hard drive+4. connect that drive to a wheezy box running git-annex from backports+5. add the external hard drive to the webapp as a new repo+6. boom++I expected git-annex to tell me:++ git-annex: Repository version 5 is not supported. Upgrade git-annex.++Instead, it popped a red box saying a scary "Internal server error". I couldn't read the daemon logs either.++### What version of git-annex are you using? On what operating system?++original version is:++ git-annex version: 5.20131109-gf2cb5b9++the failing version is running the one from wheezy backports.++### Please provide any additional information below.++screenshot coming up.++> [[fixed|done]] --[[Joey]]
doc/design/assistant/encrypted_git_remotes.mdwn view
@@ -1,5 +1,5 @@ Encrypted git remotes are now possible -using [git-remote-gcrypt](https://github.com/blake2-ppc/git-remote-gcrypt).+using [git-remote-gcrypt](https://github.com/joeyh/git-remote-gcrypt). There are at least two use cases for this in the assistant:
+ doc/design/assistant/polls/2013_user_survey.mdwn view
@@ -0,0 +1,1 @@+The 2013 git-annex user survey is in progress [[here|/polls/2013]].
doc/design/roadmap.mdwn view
@@ -5,8 +5,8 @@ (starting September 2013). * Month 1 [[!traillink assistant/encrypted_git_remotes]]-* **Month 2 [[!traillink assistant/disaster_recovery]]**-* Month 3 user-driven features and polishing+* Month 2 [[!traillink assistant/disaster_recovery]]+* **Month 3 user-driven features and polishing** * Month 4 improve special remote interface & git-annex enhancement contest * Month 5 [[!traillink assistant/xmpp_security]] * Month 6 Windows assistant and webapp
− doc/devblog/day_50__.mdwn
@@ -1,16 +0,0 @@-Spent half the day tracking down a strange bug that was apparently-ubuntu-specific and caused git-annex branch changes to get committed to-master. Root cause turned out to failing to recover from an-exception. I'm kicking myself about that, because I remember looking at the-code where the bug was at least twice before and thinking "hmm, should add-exception handling here? nah..".--I made a release with a fix for that and a few minor other accumulated-changes since last Friday's release. The pain point of this release is to-fix building without the webapp (so it will propigate to Debian testing,-etc). This release does not include the direct mode guard, so I'll have a-few weeks until the next release to get that tested.--BTW, Kevin tells me that the machine used to build git-annex for OSX is-going to be upgraded to 10.9 soon. So, hopefully I'll be making autobuilds-of that. I may have to stop the 1.8.
+ doc/devblog/day_50__grab_bag.mdwn view
@@ -0,0 +1,34 @@+Started by tracking down a strange bug that was apparently+ubuntu-specific and caused git-annex branch changes to get committed to+master. Root cause turned out to failing to recover from an+exception. I'm kicking myself about that, because I remember looking at the+code where the bug was at least twice before and thinking "hmm, should add+exception handling here? nah..". Exceptions are horrible.++Made a release with a fix for that and a few minor other accumulated+changes since last Friday's release. The pain point of this release is to+fix building without the webapp (so it will propigate to Debian testing,+etc). This release does not include the direct mode guard, so I'll have a+few weeks until the next release to get that tested.++Fixed the test suite in `directguard`. This branch is now nearly ready to+merge to master, but one command that is badly needed in guarded direct+mode is "git status". So I am planning to rename "git annex status" to+"git annex info", and make "git annex status" display something similar+to "git status".++Also took half an hour and added optional [[EKG]] support to git-annex.+This is a Haskell library that can add a terrific monitoring console web+UI to any program in 2 lines of code. Here we can see the git-annex+webapp using resources at startup, followed in a few seconds by the+assistant's startup scan of the repository.++[[!img ekg/ekg.png]]++BTW, Kevin tells me that the machine used to build git-annex for OSX is+going to be upgraded to 10.9 soon. So, hopefully I'll be making autobuilds+of that. I may have to stop the 10.8.2 autobuilds though.++----++Today's work was sponsored by [Protonet](http://protonet.info/).
+ doc/devblog/day_51__direct_mode_guard_finished.mdwn view
@@ -0,0 +1,6 @@+Finished the direct mode guard, including the new `git annex status`+command.++Spent the rest of the day working on various bug fixes. One of them turned+into rather a lot of work to make the webapp's UI better for git+remotes that do not have an annex.uuid.
+ doc/devblog/day_52__slowly_but_surely.mdwn view
@@ -0,0 +1,5 @@+Been chipping away at my backlog of messages, and it's down to 23 items.++Finally managed to get ghc to build with a newer version of the NDK.+This *might* mean a solution to git-annex on Android 4.2. I +[need help with testing](http://git-annex.branchable.com/bugs/git-annex_broken_on_Android_4.3/#comment-90b82735cd6090a7765f423b743fffd3).
+ doc/devblog/day_54__android_bisection_minions.mdwn view
@@ -0,0 +1,9 @@+Finally found the [root cause](http://git-annex.branchable.com/bugs/git-annex_broken_on_Android_4.3/#comment-452bee7d0a816300ccb4a34f9758134e)+of the Android 4.3/4.4 trouble, and a fix is now in place!++As a bonus, it looks like I've fixed a problem accessing the+environment on Android that had been worked around in an ugly way before.++Big thanks to my remote hands Michael Alan, Sören, and subito. All+told they ran 19 separate tests to help me narrow down this tricky+problem, often repeating long command lines on software keyboards.
+ doc/devblog/day_55__fireside_porting.mdwn view
@@ -0,0 +1,22 @@+Annoyingly, the Android 4.3 fix breaks git-annex on Android 4.0 (probably+through 4.2), so I now have two separate builds of the Android app.++---++Worked on Windows porting today. I've managed to get the assistant+and watcher (but not yet webapp) to build on Windows.+The `git annex transferrer` interface needs POSIX stuff, and seems to be+the main thing that will need porting for Windows for the assistant to+work, besides of course file change detection. For that, I've hooked up+[Win32-notify](http://hackage.haskell.org/package/Win32-notify).++So the watcher might work on Windows. +At least in theory. Problem is, while all the code builds ok, +it fails to link:++ ghc.exe: could not execute: C:\Program Files (x86)\Haskell Platform\2012.4.0.0\lib/../mingw/bin/gcc.exe++I wonder if this is case of too many parameters being passed?++This happens both on the autobuilder and on my laptop, so I'm stuck here.+Oh well, I was not planning to work on this anyway until February...
+ doc/devblog/day_56__git-annex_user_survey.mdwn view
@@ -0,0 +1,20 @@+One of my goals for this month is to get a better sense of how git-annex is+being used, how it's working out for people, and what areas need to be+concentrated on. To start on that, I am doing the +[2013 git-annex user survey](http://git-annex-survey.branchable.com/polls/2013/), similar to the git user+surveys. I will be adding some less general polls later (suggestions for+topics appreciated!), but you can go vote in any or all of 10 polls now.++----++Found a workaround for yesterday's Windows build problem. Seems that only+cabal runs gcc in a way that fails, so `ghc --make` builds is successfully.+However, the watcher doesn't quite work on Windows. It does get events when+files are created, but it seems to then hang before it can add the file to+git, or indeed finish printing out a debug log message about the event.+This looks like it could be a problem with the threaded ghc runtime on+Windows, or something like that.++Main work today was improving the git repository repair to handle corrupt+index files. The assistant can now start up, detect that the index file is+corrupt, and regenerate it all automatically.
+ doc/devblog/day_57__mavericks.mdwn view
@@ -0,0 +1,14 @@+The user survey is producing some interesting and useful results! +Added two more polls: [using with](http://git-annex-survey.branchable.com/polls/2013/using_with/) and [blocking problems](http://git-annex-survey.branchable.com/polls/2013/blocking_problems/) +(There were some load issues so if you were unable to vote yesterday, try+again..)++Worked on getting the autobuilder for OS X Mavericks set up. Eventually+succeeded, after patching a few packages to work around a cpp that thinks+it should parse haskell files as if they're C code.+Also, Jimmy has resuscitated the OS X Lion autobuilder.++A not too bad bug in automatic merge conflict resolution has been reported,+so I will need to dig into that tomorrow. Didn't feel up to it today, so+instead have been spending the remaining time finishing up a branch that+switches the test suite to use the tasty test framework.
+ doc/devblog/day_58__urgle.mdwn view
@@ -0,0 +1,16 @@+Fixed two difficult bugs with direct mode. One happened (sometimes) when a+file was deleted and replaced with a directory by the same name and then+those changes were merged into a direct mode repository.++The other problem was that direct mode did not prevent writes to+.git/annex/objects the way that indirect mode does, so when a file in the+repository was not currently present, writing to the dangling symlink would+follow it and write into the object directory.++Hmm, I was going to say that it's a pity that direct mode still has so many+bugs being found and fixed, but the last real bug fix to direct mode was+made last May! Instead, I probably have to thank Tim for being a very+thorough tester.++Finished switching the test suite to use the tasty framework, and prepared+tasty packages for Debian.
doc/direct_mode.mdwn view
@@ -4,8 +4,7 @@ The advantage of direct mode is that you can access files directly, including modifying them. The disadvantage is that most regular git-commands cannot safely be used, and only a subset of git-annex commands-can be used.+commands cannot be used in a direct mode repository. Normally, git-annex repositories start off in indirect mode. With some exceptions:@@ -21,7 +20,7 @@ Any repository can be converted to use direct mode at any time, and if you decide not to use it, you can convert back to indirect mode just as easily. Also, you can have one clone of a repository using direct mode, and another-using indirect mode; direct mode interoperates.+using indirect mode. To start using direct mode: @@ -52,7 +51,6 @@ ## use a direct mode repository You can use most git-annex commands as usual in a direct mode repository.-A very few commands don't work in direct mode, and will refuse to do anything. Direct mode also works well with the git-annex assistant. @@ -63,23 +61,33 @@ and will pull and merge any changes made on other repositories into the local repository. -While you generally will just use `git annex sync`, if you want to,-you can use `git commit --staged`, or plain `git commit`.-But not `git commit -a`, or `git commit <file>` ..-that'd commit whole large files into git!- ## what doesn't work in direct mode -`git annex status` shows incomplete information. A few other commands,-like `git annex unlock` don't make sense in direct mode and will refuse to-run.+A very few git-annex commands don't work in direct mode, and will refuse+to do anything. For example, `git annex unlock` doesn't make sense in+direct mode. -As for git commands, you can probably use some git working tree-manipulation commands, like `git checkout` and `git revert` in useful-ways... But beware, these commands can replace files that are present in-your repository with broken symlinks. If that file was the only copy you-had of something, it'll be lost. +As for git commands, direct mode prevents using any git command that would+modify or access the work tree. So you cannot `git commit` or `git pull`+(use `git annex sync` for both instead), or run `git status` (use `git+annex status` instead). These git commands will complain "fatal: This+operation must be run in a work tree". -This is one more reason it's wise to make git-annex untrust your direct mode-repositories. Still, you can lose data using these sort of git commands, so-use extreme caution.+The reason for this is that git doesn't understand how git-annex uses the+work tree in direct mode. Where git expects the symlinks that get checked+into git to be checked out in the work tree, direct mode instead replaces+them with the actual content of files, as managed by git-annex.++There are still lots of git commands you can use in direct mode. For+example, you can run `git log` on files, run `git push`, `git fetch`,+`git config`, `git remote add` etc.++## forcing git to use the work tree in direct mode++This is for experts only. You can lose data doing this, or check enormous+files directly into your git repository, and it's your fault if you do!+Also, there should be no good reason to need to do this, ever.++Ok, with the warnings out of the way, all you need to do to make any+git command access the work tree in direct mode is pass it +`-c core.bare=false`
− doc/direct_mode/comment_10_94284a476604e9c812b7ee475ca22959._comment
@@ -1,12 +0,0 @@-[[!comment format=mdwn- username="http://olivier.berger.myopenid.com/"- nickname="obergix"- subject="How to sync changes made in another remote when in direct mode"- date="2013-08-17T21:53:57Z"- content="""-Re-reading @joey's reponse above, I see that merge/pull don't seem to be safe and will create dangling symlinks. That corresponds to those files I can see on cifs, I guess.--But then, how can a direct repo sync with changes made in other remotes, if there no pull/fetch available.--Can it then be only the source of changes which will propagate to indirect remotes ?-"""]]
− doc/direct_mode/comment_1_93fc31e8dc0ad16248a2593a1482d375._comment
@@ -1,8 +0,0 @@-[[!comment format=mdwn- username="https://www.google.com/accounts/o8/id?id=AItOawl2Jj8q2upJL4ZQAc2lp7ugTxJiGtcICv8"- nickname="Michael"- subject="comment 1"- date="2013-02-18T23:24:11Z"- content="""-So, just which git commands *are* safe? It seems like I'm going to have to use direct mode, so it'd be nice to know just what I'm allowed to do, and what the workflow should be.-"""]]
− doc/direct_mode/comment_2_7f7086b34ed136851963f145868a1d23._comment
@@ -1,12 +0,0 @@-[[!comment format=mdwn- username="http://joeyh.name/"- ip="4.152.108.183"- subject="safe and unsafe commands"- date="2013-02-19T02:55:13Z"- content="""-All git commands that do not change files in the work tee (and do not stage files from the work tree), are safe. I don't have a complete list; it includes `git log`, `git show`, `git diff`, `git commit` (but not -a or with a file as a parameter), `git branch`, `git fetch`, `git push`, `git grep`, `git status`, `git tag`, `git mv` (this one is somewhat surprising, but I've tested it and it's ok)--git commands that change files in the work tree will replace your data with dangling symlinks. This includes things like `git revert`, `git checkout`, `git merge`, `git pull`, `git reset`--git commands that stage files from the work tree will commit your data to git directly. This includes `git add`, `git commit -a`, and `git commit file`-"""]]
doc/direct_mode/comment_4_97c26bd82f623a3b2d56bab4afff0126._comment view
@@ -6,7 +6,6 @@ content=""" <pre> git annex add $file-git commit -m changed git annex sync git annex copy $file --to otherrepo </pre>
− doc/direct_mode/comment_9_cff56dbcdfec60375c30d5b1b1c60614._comment
@@ -1,12 +0,0 @@-[[!comment format=mdwn- username="http://olivier.berger.myopenid.com/"- nickname="obergix"- subject="Mixing indirect mode and direct mode on different remotes"- date="2013-08-17T20:35:40Z"- content="""-I'd like to have an indirect mode repo on my laptop cloned on a cifs mount point (mounted off an SMB NAS) thus in direct mode. But all I can see on the clone after merge/pull is text files of length 207 chars containg the symlink in plain text.--I guess this is what git manages internally for the symlinks... so I'm afraid git annex doesn't work in such case.--Can you confirm that indirect and direct modes can coexist on clones of the same repo ?-"""]]
+ doc/ekg.mdwn view
@@ -0,0 +1,14 @@+You can `cabal configure -fEKG` to build a git-annex that includes+the EKG remote monitoring interface.++To access the EKG control panel, go to+<http://localhost:4242/> while a git-annex command is running.++This EKG build is mostly useful for debugging resource usage problems.++[[!img ekg.png caption="git-annex webapp startup, and assistant startup scan"]]++Note that since only one process can open port 4242 at a time, running+more than one git-annex process with EKG support at the same time can+result in some "resource busy (Address already in use)" messages -- but+git-annex will continue to work.
+ doc/ekg/ekg.png view
binary file changed (absent → 57392 bytes)
+ doc/forum/Effectively_replicating_backup_files.mdwn view
@@ -0,0 +1,25 @@+I currently use duply/duplicity to back up my networked computers to my home server. I have two external HDDs and, every week or so, I bring one of these home and copy the backup files to the hard drive (I leave them on the server to easily restore files and because I have a large hard drive in that). I use some hand-written scripts to keep a copy these backup files in the cloud (Ubuntu One) until they have been copied to both hard drives, ensuring that there are always two copies of the files somewhere offsite. Out of paranoia, I also have some "standalone backups" that are just huge encrypted archives of important folders (say, my entire Photos directory) as at a certain date - in case for some reason duplicity ever stops working or I need to roll something back to a version years earlier. I am less worried about these standalone backups and manually keep one copy of each somewhere.++It sounds like Git-Annex could automate things quite nicely (and give me some neat extras, like knowing where they were). This is how I understand I should do it, but please let me know if it is the right approach or if you have any suggestions:++1. Create a folder on my server called "annex" and make a Git-Annex "large backup" repository in there.+2. Create a folder within that called "archive" and put a "backup" folder within that. I understand that having the backups within an archive folder will mean that they aren't automatically copied to my desktop machines etc. +3. Within that "backup" folder, create two folders, one called "duplicity" and one called "standalone". Put the backups in the respective folders.+4. Set up gcrypt Git-Annex repositories on my two external HDDs as "small backups". This seems to just start copying files across. That surprised me, as the files are in the archive folder and I thought the default was numcopies=1. Is there some autosync option that I need to turn off? Ideally, I would like it to encrypt/decrypt primarily with my server GPG key (which I'm not worried about copying around my computers), but also encrypt to my personal GPG key (where I'd only put my public key on the server, but I know I will not lose the secret key for that). Am I right that to do that I would need to set the repos up manually with:++ git init --bare /mnt/externalHDD1++ git annex initremote externalHDD1 type=gcrypt gitrepo=/mnt/externalHDD1 keyid=$serverkey keyid=$personalkey++ git annex sync externalHDD1++ Or should the gitrepo be the location of my main Git-Annex repository? How do I make it sync up with my other repos?++5. I understand that I would then need to set numcopies=3 in a .gitattributes file in the "archive/backup/duplicity" directory and, say, a numcopies=2 in the "archive/backup/standalone".+6. I could then add a cloud repository as a "transfer" repository and Git-Annex should only keep files on that that are not already in the right number of places (similar to what my scripts are doing now).+7. I have recently upgraded my hard drive, so I have my old 1TB internal hard drive that I will be putting in a cupboard somewhere. I was thinking that I could make this an archive drive for things like one copy of my duplicity/standalone backups. I wouldn't want it to be the only copy of anything. If I just set it as an archive drive, would this work?+8. Are there more clever ways of doing this? I consider my external HDDs and the cloud repo as "offsite" repositories and ideally there would always be one copy of my backups offsite (in addition to at least three overall). There would also ideally be one of each of my files "live" (in most cases my server) that could instantly push files into a cloud repo and then to wherever I am. Is there any ability to put repositories in groups and write rules like that?++Any thoughts greatly appreciated!++Aaron
+ doc/forum/Help_on_my_usecase.mdwn view
@@ -0,0 +1,22 @@+I am using git-annex assistant for a few months now and still don't think I have it all setup correctly. My setup is:++* Laptop Computer with low storage. Content creator, assistant: file source+* Desktop Computer with medium storage capacity. Consumer, assistant: manual Mode+* 2TB USB HD (EXT4) Backup, assistant: full backup+* 2.5" portable 500GB drive NTFS formatted. transfer to backup: assistant: tried transfer and partial backup+* Root Server on the web, not yet in the mix. Planned: Index only / content creator++My primary goal is getting the stuff from the Laptop to the 2TB USB drive, syncing the annex with the desktop so I can get files on the desktop from the backup.+What works:++* Checking stuff into the annex on the Laptop+* When the 2TB drive is connected to the Laptop, stuff is automatically moved there too+* Bare Repo on the 2.5" configured as partial backup automatically backups the data++What doesn't work:++* Connecting the 2.5" bare repo to the Desktop to move stuff to the backup drive automatically+* Having a human readable folder Structure on the 2.5" NTFS drive. I'd be ok to have a bare repo plus a special remote on the drive, but I don't know how to configure it+* How do I drop stuff from the bare repo on the 2.5" drive? I think a partial backup should drop content that is in a full backup, but it doesn't++Thanks for reading this long post. If anyone has any tips on how to configure the assistant, thats much appreciated.
+ doc/forum/_preferred_content:_lastpresent.mdwn view
@@ -0,0 +1,1 @@+Is there any kind of "lastpresent" in the preferred-content expression? If set, git-annex would see if "git log --follow $path -n 1" (or some configurable -n) was present.
+ doc/forum/git-annex_assistant_with_2_dedicated_servers.mdwn view
@@ -0,0 +1,11 @@+Hello,++I am looking for a solution to replicate lots of files between 2 servers (with dedicated IP address) over WAN. (I already looked at GlusterFS, DRBD, Bittorent-Sync and ownCloud, but comments are welcome). Now I am evaluating git-annex but it is (kind of) hard to get the concepts as I am not familiar with git.++I could already connect the servers by following the steps of "remote sharing walkthrough" but I feel that using a 3rd special node (as "transfer repository" / rsync or ssh) is an overhead and should not be needed. But no matter how hard I tried, I couldn't make the 2 servers do a sync without a special node. ++Could you please give me a hint how to do it? Or even better, some detailed steps. :)++Thanks,++David
+ doc/forum/git_annex_test_on_windows.mdwn view
@@ -0,0 +1,5 @@+is it worth sharing back git annex test failures occourring on some windows setup ?+i'm having 3 failures, what kind of report can i produce shall it be of any use ?+is it enough a test log coming from git annex test > test.log 2>&1 ?+thanks again+
+ doc/forum/rsyncing_.git__47__annex__47__objects.mdwn view
@@ -0,0 +1,24 @@+In short: is it safe to rsync .git/annex/objects/ to other clones?++I'm in the process of migrating a lot of my files to a new backend. Most them+still use the old non-file-size-tracking SHA1 backend from when WORM was the+default. I have multiple clones that each use about 460 GB of their 500 GB+drives.++I've noticed that git-annex creates hardlinks to migrated content in+.git/annex/objects, so I'm able to migrate all content despite only having 40+GB of free space. Excellent.++Now I'm planning to `rsync -a --hard-links .git/annex/objects/+${CLONE}/.git/annex/objects/` to recreate the hardlinks and save space on the+clones as well. If I `fsck` afterwards, this should be fine, right?++I've tried this with a test repository and it works but I'd like to be extra+sure that I'm not missing something crucial.++The alternatives that I'm aware of are:++ * making space first: `git annex dropunused "1-20000"` and `git annex get .`+ * running `git annex migrate` in each clone.++I expect rsync to be safer and faster than these alternatives.
doc/git-annex.mdwn view
@@ -103,6 +103,13 @@ To avoid contacting the remote to check if it has every file, specify `--fast` +* `status` [path ...]`++ Similar to `git status --short`, displays the status of the files in the+ working tree. Shows files that are not checked into git, files that+ have been deleted, and files that have been modified. + Particulary useful in direct mode.+ * `unlock [path ...]` Normally, the content of annexed files is protected from being changed.@@ -253,6 +260,14 @@ background, you no longer need to manually run git commands when manipulating your files. + By default, all files in the directory will be added to the repository.+ (Including dotfiles.) To block some files from being added, use+ `.gitignore` files.+ + By default, all files that are added are added to the annex, the same+ as when you run `git annex add`. If you configure annex.largefiles,+ files that it does not match will instead be added with `git add`.+ To not daemonize, run with `--foreground` ; to stop a running daemon, run with `--stop` @@ -563,10 +578,6 @@ # QUERY COMMANDS -* `version`-- Shows the version of git-annex, as well as repository version information.- * `find [path ...]` Outputs a list of annexed files in the specified path. With no path,@@ -607,24 +618,27 @@ To generate output suitable for the gource visualisation program, specify `--gource`. -* `status [directory ...]`+* `info [directory ...]` Displays some statistics and other information, including how much data is in the annex and a list of all known repositories. To only show the data that can be gathered quickly, use `--fast`. - When a directory is specified, shows a differently formatted status+ When a directory is specified, shows a differently formatted info display for that directory. In this mode, all of the file matching options can be used to filter the files that will be included in- the status.+ the information. For example, suppose you want to run "git annex get .", but would first like to see how much disk space that will use. Then run: - git annex status --fast . --not --in here+ git annex info --fast . --not --in here+* `version` + Shows the version of git-annex, as well as repository version information.+ * `map` Helps you keep track of your repositories, and the connections between them,@@ -676,8 +690,8 @@ Use this to undo an accidental `git annex add` command. It puts the file back how it was before the add. - Note that for safety, the content of the file remains in the annex (as a- hard link), until you use `git annex unused` and `git annex dropunused`.+ Note that for safety, the content of the file remains in the annex,+ until you use `git annex unused` and `git annex dropunused`. This is not the command you should use if you intentionally annexed a file and don't want its contents any more. In that case you should use@@ -698,13 +712,22 @@ * `pre-commit [path ...]` + This is meant to be called from git's pre-commit hook. `git annex init`+ automatically creates a pre-commit hook using this.+ Fixes up symlinks that are staged as part of a commit, to ensure they point to annexed content. Also handles injecting changes to unlocked files into the annex. - This is meant to be called from git's pre-commit hook. `git annex init`- automatically creates a pre-commit hook using this.+* `update-hook refname olvrev newrev` + This is meant to be called from git's update hook. `git annex init`+ automatically creates an update hook using this.++ This denies updates being pushed for the currently checked out branch.+ While receive.denyCurrentBranch normally prevents that, it does+ not for fake bare repositories, as used by direct mode.+ * `fromkey key file` This plumbing-level command can be used to manually set up a file@@ -788,7 +811,7 @@ Rather than the normal output, generate JSON. This is intended to be parsed by programs that use git-annex. Each line of output is a JSON object. Note that json output is only usable with some git-annex commands,- like status and find.+ like info and find. * `--debug` @@ -1088,7 +1111,7 @@ up to 500000 keys. If your repository is larger than that, you can adjust this to avoid `git annex unused` not noticing some unused data files. Increasing this will make `git-annex unused` consume more memory;- run `git annex status` for memory usage numbers.+ run `git annex info` for memory usage numbers. * `annex.bloomaccuracy` @@ -1096,7 +1119,7 @@ `git annex unused`. The default accuracy is 1000 -- 1 unused file out of 1000 will be missed by `git annex unused`. Increasing the accuracy will make `git annex unused` consume more memory;- run `git annex status` for memory usage numbers.+ run `git annex info` for memory usage numbers. * `annex.sshcaching`
doc/install/Android.mdwn view
@@ -7,15 +7,20 @@ First, ensure your Android device is configured to allow installation of the app. Go to Setup -> Security, and enable "Unknown Sources". -[Download the git-annex.apk](http://downloads.kitenet.net/git-annex/android/current/)-onto your Android device, and open it to install.+Then download the git-annex.apk for your version of Android, and +open it to install. +* [Android 4.4 and 4.3 git-annex.apk](http://downloads.kitenet.net/git-annex/android/current/4.3/git-annex.apk)+* [Android 4.0 to 4.2 git-annex.apk](http://downloads.kitenet.net/git-annex/android/current/4.0/git-annex.apk)+ ## autobuilds A daily build is also available, thanks to Mesar Hameed and the University of Bath CS department. -* [download apk](http://downloads.kitenet.net/git-annex/autobuild/android/git-annex.apk) ([build logs](http://downloads.kitenet.net/git-annex/autobuild/android/))+* [Android 4.4 and 4.3 git-annex.apk](http://downloads.kitenet.net/git-annex/autobuild/android/4.3/git-annex.apk)+* [Android 4.0 to 4.2 git-annex.apk](http://downloads.kitenet.net/git-annex/autobuild/android/4.0/git-annex.apk)+* [build logs](http://downloads.kitenet.net/git-annex/autobuild/android/) ## building it yourself
− doc/install/Android/comment_13_f077a27c04131da89db1d7abcab3e68f._comment
@@ -1,20 +0,0 @@-[[!comment format=mdwn- username="https://www.google.com/accounts/o8/id?id=AItOawmK0703vNSIQsP1mGf-4MAPnsBZiSc6yVo"- nickname="Emre"- subject="adding ssh server"- date="2013-10-16T16:37:10Z"- content="""-Thanks Joey, I will try this direct mode tonight. I'm following git-annex development since your first days, but I just decided to give it a try so bear with me :)--I also have a VPS and I did try yesterday night to add it as a cloud server to make android & linux sync. It also contained git-annex. When I add it from the PC, it appeared in Android but it was not possible to use it somehow. I had to add a new cloud server with exactly the same settings like th PC, which made things complicated to understand for me as to what happens on the server side when both computers try to setup a repository. (the sync didn't work neither)-Maybe I hit a bug here so wanted to share with you.-What I expected is that, -1) Add a VPS/ssh/git-annex cloud option from PC.-2) It shall appear in the Android webapp using the XMPP control channel-3) if the password or private key can't be synced over the XMPP due to security concern, then the Android webapp shall just ask for the password to enable it, nothing more.--2nd thing, when I add this VPS/SSH/Git-annex from the PC, if I do not choose any encryption, it is marked as \"sync enabled\". IF I choose \"shared encryption\" instead, then sync gets disabled and there's nowhere any comment why the sync is disabled. So, by trial and error, I concluded that the sync is not supported in shared encryption remotes?--3rd thing: The remote cloud can be configured for example as \"full backup\" or \"transfer host\". What is not clear is that if I configure it as a \"full backup\" host, then can Android and PC still use it as a \"transfer host\" to sync between themselves? What I would expect is that once I add this cloud vps as a \"full backup\" host, then everybody syncs with it and gets a copy from it if they can't communicate directly themselves. -Hope I did not confuse things much, thanks a lot even if you don't find time to write answers.-"""]]
− doc/install/Android/comment_5_40cb6cb72c4ad4aa19a4a40f41a6a757._comment
@@ -1,13 +0,0 @@-[[!comment format=mdwn- username="https://www.google.com/accounts/o8/id?id=AItOawnljkMF1zhScDfvJYMhXXubnar_DakLoas"- nickname="Tony"- subject="broken under 4.3?"- date="2013-07-28T00:36:51Z"- content="""-Things seem broken under the recently released 4.3 release for nexus devices:-->Falling back to hardcoded app location; cannot find expected files in /data/app-lib->u0_a33@mako:/sdcard/git-annex.home $ git annex webapp->CANNOT LINK EXECUTABLE: git-annex invalid R_ARM_COPY relocation against DT_SYMBOLIC shared library libc.so (built. with -Bsymbolic?)->1|u0_a33@mako:/sdcard/git-annex.home $-"""]]
− doc/install/Android/comment_6_b0f723538e7328d5070c563f070858bd._comment
@@ -1,8 +0,0 @@-[[!comment format=mdwn- username="justjohn"- ip="71.233.149.123"- subject="Broken on 4.3 on Nexus 7"- date="2013-07-28T16:14:18Z"- content="""-I'm seeing the same error as the previous comment from Tony on my Nexus 7 after I updated it to the stock (albeit rooted) 4.3 release from Google.-"""]]
− doc/install/Android/comment_7_c6dc23d0e6f4138c4bf8e3452755676f._comment
@@ -1,8 +0,0 @@-[[!comment format=mdwn- username="https://www.google.com/accounts/o8/id?id=AItOawl9sYlePmv1xK-VvjBdN-5doOa_Xw-jH4U"- nickname="Richard"- subject="comment 7"- date="2013-07-30T15:02:51Z"- content="""-@Tony @justjohn: I created a proper bug for this: [[bugs/git-annex_broken_on_Android_4.3]]-"""]]
doc/install/OSX.mdwn view
@@ -1,12 +1,13 @@ ## git-annex.app [[!img /assistant/osx-app.png align=right link=/assistant]]-For easy installation, use the-[beta release of git-annex.app](https://downloads.kitenet.net/git-annex/OSX/current/).+For easy installation, use the prebuilt app bundle. -Be sure to select the build matching your version of OSX.+* 10.9 Mavericks: [git-annex.dmg.bz2](https://downloads.kitenet.net/git-annex/OSX/current/10.9_Mavericks/git-annex.dmg.bz2)+* 10.8.2 Mountain Lion: [git-annex.dmg.bz2](https://downloads.kitenet.net/git-annex/OSX/current/10.8.2_Mountain_Lion/git-annex.dmg.bz2) **warning: not being updated any longer**+* 10.7.5 Lion: [git-annex.dmg.bz2](https://downloads.kitenet.net/git-annex/OSX/current/10.7.5_Lion/git-annex.dmg.bz2) -If you want to run the [[git-annex_assistant|/assistant]], just+To run the [[git-annex_assistant|/assistant]], just install the app, look for the icon, and start it up. To use git-annex at the command line, you can add@@ -17,20 +18,17 @@ programs bundled inside the app, including not just git-annex, but git, and several more. Handy if you don't otherwise have git installed. -This is still a work in progress. See [[/bugs/OSX_app_issues]] for problem-reports.- ## autobuilds [Jimmy Tang](http://www.sgenomics.org/~jtang/) autobuilds the app for OSX Lion. -* [autobuild of git-annex.app](http://www.sgenomics.org/~jtang/gitbuilder-git-annex-x00-x86_64-apple-darwin10.8.0-binary/ref/master/git-annex.dmg.bz2) ([build logs](http://www.sgenomics.org/~jtang/gitbuilder-git-annex-x00-x86_64-apple-darwin10.8.0-binary/))+* [autobuild of git-annex.dmg.bz2](http://www.sgenomics.org/~jtang/gitbuilder-git-annex-x00-x86_64-apple-darwin10.8.0-binary/ref/master/git-annex.dmg.bz2) ([build logs](http://www.sgenomics.org/~jtang/gitbuilder-git-annex-x00-x86_64-apple-darwin10.8.0-binary/)) * [past builds](http://www.sgenomics.org/~jtang/gitbuilder-git-annex-x00-x86_64-apple-darwin10.8.0-binary/sha1/) -- directories are named from the commitid's -[[Joey]] autobuilds the app for Mountain Lion.+[[Joey]] autobuilds the app for Mavericks. -* [autobuild of git-annex.app](https://downloads.kitenet.net/git-annex/autobuild/x86_64-apple-mountain-lion/git-annex.dmg.bz2) ([build logs](https://downloads.kitenet.net/git-annex/autobuild/x86_64-apple-mountain-lion/))+* [autobuild of git-annex.dmg](https://downloads.kitenet.net/git-annex/autobuild/x86_64-apple-mavericks/git-annex.dmg) ([build logs](https://downloads.kitenet.net/git-annex/autobuild/x86_64-apple-mavericks/)) ## using Brew
doc/install/Ubuntu.mdwn view
@@ -1,6 +1,16 @@-## Saucy, Raring+## Saucy sudo apt-get install git-annex++Warning: The version of git-annex shipped in Ubuntu Saucy had+[a bug that can cause problems when creating repositories using the webapp](http://git-annex.branchable.com/bugs/Freshly_initialized_repo_has_staged_change___34__deleted:_uuid.log__34__/).++## Raring+ + sudo apt-get install git-annex++Note: This version is too old to include the [[assistant]] or its WebApp,+but is otherwise usable. ## Precise
doc/install/cabal.mdwn view
@@ -50,3 +50,9 @@ cabal configure cabal build cabal install --bindir=$HOME/bin++## EKG++When building with cabal, you can optionally enable the +[[EKG monitoring interface|ekg]]. This is great for debugging resource+usage problems.
+ doc/internals/comment_1_4b8ed353dca4f484b3b6eb463fa02fd8._comment view
@@ -0,0 +1,8 @@+[[!comment format=mdwn+ username="stoile"+ ip="2a01:198:242:0:219:66ff:fef2:c021"+ subject="tmp missing"+ date="2013-11-16T12:16:48Z"+ content="""+There's no information about .git/annex/tmp here.+"""]]
+ doc/internals/comment_2_c19232d5cc4976c2e5b014aef6e8d9ec._comment view
@@ -0,0 +1,8 @@+[[!comment format=mdwn+ username="http://joeyh.name/"+ ip="209.250.56.246"+ subject="comment 2"+ date="2013-11-16T17:23:02Z"+ content="""+.git/annex/tmp is not very interesting. It's a temporary file directory. When transferring a key's content, git-annex uses a stable filename, which allows resuming interrupted downloads, or cleaning up aborted downloads with `git annex unused`.+"""]]
− doc/news/version_4.20130909.mdwn
@@ -1,36 +0,0 @@-git-annex 4.20130909 released with [[!toggle text="these changes"]]-[[!toggleable text="""- * initremote: Syntax change when setting up an encrypted special remote.- Now use keyid=$KEYID rather than the old encryption=$KEYID- * forget: New command, causes git-annex branch history to be forgotten- in a way that will spread to other clones of the repository.- (As long as they're running this version or newer of git-annex.)- * forget --drop-dead: Completely removes mentions of repositories that- have been marked as dead from the git-annex branch.- * sync, assistant: Force push of the git-annex branch. Necessary- to ensure it gets pushed to remotes after being rewritten by forget.- * Added gcrypt support. This combines a fully encrypted git- repository (using git-remote-gcrypt) with an encrypted git-annex special- remote.- * sync: Support syncing with gcrypt remotes.- * importfeed: Also ignore transient problems with downloading content- from feeds.- * Honor core.sharedrepository when receiving and adding files in direct- mode.- * enableremote: gpg keys can be removed from those a remote encrypts- to by passing "keyid-=$KEYID". keyid+= is also provided.- (Thanks, guilhem for the patch.)- * Added encryption=pubkey scheme, which encrypts to public keys directly- rather than the hybrid approach. See documentation for advantages- and disadvantages, but encryption=hybrid is the recommended scheme still.- (Thanks, guilhem for the patch.)- * Fix Feeds display in build flags.- * Remind user when annex-ignore is set for some remotes, if unable to- get or drop a file, possibly because it's on an ignored remote.- * gpg: Force --no-textmode in case the user has it turned on in config.- * webapp: Improve javascript's handling of longpolling connection- failures, by reloading the current page in this case.- Works around chromium behavior where ajax connections to urls- that were already accessed are denied after navigating back to- a previous page.- * Allow building without quvi support."""]]
+ doc/news/version_5.20131118.mdwn view
@@ -0,0 +1,42 @@+git-annex 5.20131118 released with [[!toggle text="these changes"]]+[[!toggleable text="""+ * Direct mode repositories now have core.bare=true set, to prevent+ accidentally running git commands that try to operate on the work tree,+ and so do the wrong thing in direct mode.+ * annex.version is now set to 5 for direct mode repositories.+ This upgrade is handled fully automatically, no need to run+ git annex upgrade+ * The "status" command has been renamed to "info", to allow+ "git annex status" to be used in direct mode repositories, now that+ "git status" won't work in them.+ * The -c option now not only modifies the git configuration seen by+ git-annex, but it is passed along to every git command git-annex runs.+ * watcher: Avoid loop when adding a file owned by someone else fails+ in indirect mode because its permissions cannot be modified.+ * webapp: Avoid encoding problems when displaying the daemon log file.+ * webapp: Improve UI around remote that have no annex.uuid set,+ either because setup of them is incomplete, or because the remote+ git repository is not a git-annex repository.+ * Include ssh-keygen in standalone bundle.+ * Allow optionally configuring git-annex with -fEKG to enable awesome+ remote monitoring interfaceat http://localhost:4242/+ * Fix bug that caused bad information to be written to the git-annex branch+ when running describe or other commands with a remote that has no uuid.+ * Work around Android linker problem that had prevented git-annex from+ running on Android 4.3 and 4.4.+ * repair: Handle case where index file is corrupt, but all objects are ok.+ * assistant: Notice on startup when the index file is corrupt, and+ auto-repair.+ * Fix direct mode merge bug when a direct mode file was deleted and replaced+ with a directory. An ordering problem caused the directory to not get+ created in this case.+ Thanks to Tim for the test case.+ * Direct mode .git/annex/objects directories are no longer left writable,+ because that allowed writing to symlinks of files that are not present,+ which followed the link and put bad content in an object location.+ Thanks to Tim for the test case.+ * fsck: Fix up .git/annex/object directory permissions.+ * Switched to the tasty test framework.+ * Android: Adjust default .gitignore to ignore .thumbnails at any location+ in the tree, not just at its top.+ * webapp: Check annex.version."""]]
+ doc/polls.mdwn view
@@ -0,0 +1,2 @@+* [[2013 git-annex user survey|2013]]+* [[old polls|design/assistant/polls]]
+ doc/polls/2013.mdwn view
@@ -0,0 +1,5 @@+This has moved to a separate site due to load issues.++<http://git-annex-survey.branchable.com/polls/2013/>++Any votes you made here were carried over, so no need to vote twice!
+ doc/shortcuts.mdwn view
@@ -0,0 +1,12 @@+[[!if test="enabled(shortcut)"+ then="This wiki has shortcuts **enabled**."+ else="This wiki has shortcuts **disabled**."]]++This page controls what shortcut links the wiki supports.++* [[!shortcut name=debbug url="http://bugs.debian.org/%S" desc="Debian bug #%s"]]+* [[!shortcut name=iki url="http://ikiwiki.info/%S/"]]+* [[!shortcut name=rfc url="https://www.ietf.org/rfc/rfc%s.txt" desc="RFC %s"]]+* [[!shortcut name=cve url="https://cve.mitre.org/cgi-bin/cvename.cgi?name=%s"]]+* [[!shortcut name=hackage url="http://hackage.haskell.org/package/%s"]]+* [[!shortcut name=commit url="http://source.git-annex.branchable.com/?p=source.git;a=commitdiff;h=%s"]]
+ doc/testimonials/comment_1_2bf439f7a3bc3d6fab91849017946182._comment view
@@ -0,0 +1,8 @@+[[!comment format=mdwn+ username="gjost"+ ip="108.205.152.179"+ subject="distributed digital repository"+ date="2013-11-14T00:39:49Z"+ content="""+I am in the process of building a distributed digital repository using Git and git-annex as a foundation. Our project is to collect and preserve archival-quality audio and video from multiple bandwidth-challenged remote sites. We're using git-annex to help us sneakernet the metadata and binaries around and to maintain multiple copies in geographically separate locations. Git very neatly addresses the problem of tracking changes, while git-annex makes it possible to track the flow of information through a network of distributed repositories. +"""]]
doc/tips/Decentralized_repository_behind_a_Firewall.mdwn view
@@ -25,7 +25,7 @@ git annex sync git annex get on-the-go some/big/file- git annex status+ git annex info You can add more computers by repeating with a different port, e.g. 2202 or 2203 (or any other).
+ doc/tips/The_perfect_preferred_content_settings_for_my_android_phone.mdwn view
@@ -0,0 +1,32 @@+I have an annex that syncs my personal files on all my computers. It works great. Phones are different.++For one, everything's a bit slower to sync, there's battery considerations, and I just don't need every last old file on my phone. Then there's some files I explicitly don't want on my phone in case it gets lost, like family pictures, passport scans, or private keys.++But I still want photos, videos and voice recordings I make on my phone to be synced to my server. A transfer repo would work, but I want to keep them. Then there's my PDF book collection; that would certainly be nice to always have around in case I have half on hour on a bus. And my music collection ought to be around as well.++So I came up with this solution, and I'm very happy with it.++ include=Music/* or include=Books/* or present++This will sync my music and book collections to my phone whenever I add something new on my computers, and it will sync and keep anything I add to the annex on my phone. Best of all worlds! Impressed how flexible preferred content is. More full-sync folders can be added like this: ++ include=Music/* or include=Books/* or Notes/* or present++To add them, I first had to figure out the uuid of my phone repo. So I added a new tab on android, and did++ cd /sdcard/annex+ git config annex.uuid++Then I went to one of my computers, and did++ git annex vicfg++And changed the line++ content [phone-uuid] = standard++to++ content [phone-uuid] = include=Music/* or include=Books/* or Notes/* or present++And waited for it to sync.
doc/tips/migrating_two_seperate_disconnected_directories_to_git_annex.mdwn view
@@ -31,7 +31,7 @@ git init git remote add marcos marcos.example.com:/srv/mp3 git fetch marcos- git annex status # this should display the two repos+ git annex info # this should display the two repos git annex add . This will, again, checksum all files and add them to git annex. Once that is done, you can verify that the files are really the same as marcos with `whereis`:
+ doc/tips/recovering_from_a_corrupt_git_repository.mdwn view
@@ -0,0 +1,17 @@+I have found this the most reliable way to recover from a corrupt git repository. I have had a lot of them lately, there might be a regression in btrfs in Ubuntu's Linux 3.8.0-33 (!).++1. Create a clone of a known good repository.+2. Add the clone as an object alternate to the broken repository.+3. Do a `git-repack -a -d` to lift the external objects into repo-local packs.+4. Remove the clone++[[!format sh """+$ cd /tmp/+$ git clone good-host:/path/to/good-repo+$ cd /home/user/broken-repo+$ echo /tmp/good-repo/.git/objects/ > .git/objects/info/alternates+$ git repack -a -d+$ rm -rf /tmp/good-repo+"""]]++... and push early, push often. ;-)
+ doc/todo/Check_if_an_upgrade_is_available_in_the_webapp.mdwn view
@@ -0,0 +1,3 @@+Especially on Mac OSX (and Windows, and maybe Android), it would be great to be able to check in the webapp if an upgrade is available. A deeper integration with these OS would be even better: for example on Mac OSX, an icon on the status bar list available upgrades for some programs, including LibreOffice and others which are not installed by default.++Also, it would be great to be able to download and install git-annex upgrades directly from the webapp.
doc/todo/direct_mode_guard.mdwn view
@@ -77,6 +77,29 @@ behaviors in a bare repo, so will need to recognise that this repo is not really bare, and avoid them. +> [[done]]!! --[[Joey]]+ (Git may also have some bare repo behaviors that are unwanted. One example is that git allows pushes to the current branch in a bare repo, even when `receive.denyCurrentBranch` is set.)++> This is indeed a problem. Indeed, `git annex sync` successfully+> pushes changes to the master branch of a fake bare direct mode repo.+> +> And then, syncing in the repo that was pushed to causes the changes+> that were pushed to the master branch to get reverted! This happens+> because sync commits; commit sees that files are staged in index+> differing from the (pushed) master, and commits the "changes"+> which revert it.+> +> Could fix this using an update hook, to reject the updated of the master+> branch. However, won't work on crippled filesystems! (No +x bit)+> +> Could make git annex sync detect this. It could reset the master+> branch to the last one committed, before committing. Seems very racy+> and hard to get right!+>+> Could make direct mode operate on a different branch, like+> `annex/direct/master` rather than `master`. Avoid pushing to that+> branch (`git annex sync` can map back from it to `master` and push there+> instead). A bit clumsy, but works.
+ doc/todo/smudge/comment_3_4e7c25fe24a1e71f58a8354fa64f41c2._comment view
@@ -0,0 +1,10 @@+[[!comment format=mdwn+ username="https://www.google.com/accounts/o8/id?id=AItOawn1QhtPvsRBV7pfaDW_ZTPFv_ZIxSzQ8Rg"+ nickname="Paul Léo"+ subject="comment 3"+ date="2013-11-13T20:41:52Z"+ content="""+> SHA1 has a harder job. Would not want to re-sha1 the file every time, probably. So it'd need a local cache of file stat info, mapped to known objects.++I think that is not true? If gits wants the file to be cleaned, it thinks that the file was changed. So you would have to SHA1 it anyway if you don't want rely on WORM (which git already does in the first step anyway).+"""]]
doc/todo/windows_support.mdwn view
@@ -9,7 +9,15 @@ * rsync special remotes are known buggy. * Bad file locking, it's probably not safe to run more than one git-annex process at the same time on Windows.-* No support for the assistant or webapp. * Ssh connection caching does not work on Windows, so `git annex get` has to connect twice to the remote system over ssh per file, which is much slower than on systems supporting connection caching.+* Webapp doesn't build yet.+* `git annex watch` builds, but does not quite work.+* `git annex assistant` builds, but has not been tested, and is known+ to not download any files. (transferrer doesn't built yet)+* watch and assistant cannot be built with cabal. Possibly due to too many+ files overflowing command line length limit at link stage.+ To build a binary with them: + `ghc --make git-annex.hs -threaded -XPackageImports -DWITH_ASSISTANT=1 -DWITH_WIN32NOTIFY=1`+ (should add all the other flags cabal uses)
+ doc/todo/wishlist:_detection_of_merge_conflicts.mdwn view
@@ -0,0 +1,13 @@+A conflict during sync or merge is something that requires user intervention, or at least notification. For that reason it would be nice if git annex returned a nonzero exit status when such a conflict happened during a sync or a merge. This is what git does after a conflicting pull, and would make it easier to spot a conflict in automated syncs without having to parse annex output or the logs.++> Good idea, [[done]]. --[[Joey]] ++Also, it would be nice if your new `git annex status` were able to inform about remaining conflicts in the repo, for instance by reporting files with variant-XXX suffix.++> Hmm, that would need a separate pass through the whole tree, since+> currently it can use `git ls-files` to find only modified/deleted/new+> files. I would rather not make the new `git annex status` slower for+> this.+> +> It would be possible to add it to `git annex info` (old `status`)+> which already has to look through the entire work tree.
doc/todo/wishlist:_disable_automatic_commits.mdwn view
@@ -33,4 +33,4 @@ > You can do this now by pausing committing via the webapp, > or setting `annex.autocommit=false`. > -> The assustant probably doesn't push such commits yet.+> The assistant probably doesn't push such commits yet.
doc/upgrades.mdwn view
@@ -18,10 +18,18 @@ ## Upgrade events, so far +### v4 -> v5 (git-annex version 5.x)++v5 is only used for [[direct_mode]]. The upgrade from v4 to v5 is handled+automatically.++This upgrade involves changing direct mode repositories to operate with+core.bare=true.+ ### v3 -> v4 (git-annex version 4.x) -v4 is only used for [[direct_mode]], and no upgrade needs to be done from-existing v3 repositories, they will continue to work.+v4 was only used for [[direct_mode]], to ensure that a version of git-annex+that understands direct mode was used with a direct mode repository. ### v2 -> v3 (git-annex version 3.x)
+ doc/users/clacke.mdwn view
@@ -0,0 +1,3 @@+Claes Wallin (韋嘉誠)++[[https://microca.st/clacke]]
git-annex.1 view
@@ -94,6 +94,12 @@ .IP To avoid contacting the remote to check if it has every file, specify \fB\-\-fast\fP .IP+.IP "\fBstatus\fP [path ...]"+Similar to \fBgit status \-\-short\fP, displays the status of the files in the+working tree. Shows files that are not checked into git, files that+have been deleted, and files that have been modified. +Particulary useful in direct mode.+.IP .IP "\fBunlock [path ...]\fP" Normally, the content of annexed files is protected from being changed. Unlocking a annexed file allows it to be modified. This replaces the@@ -233,6 +239,14 @@ background, you no longer need to manually run git commands when manipulating your files. .IP+By default, all files in the directory will be added to the repository.+(Including dotfiles.) To block some files from being added, use+\fB.gitignore\fP files.+.IP+By default, all files that are added are added to the annex, the same+as when you run \fBgit annex add\fP. If you configure annex.largefiles,+files that it does not match will instead be added with \fBgit add\fP.+.IP To not daemonize, run with \fB\-\-foreground\fP ; to stop a running daemon, run with \fB\-\-stop\fP .IP@@ -517,11 +531,8 @@ to make sure that the git\-annex branch reflects reality. .IP .SH QUERY COMMANDS-.IP "\fBversion\fP"-.IP-Shows the version of git\-annex, as well as repository version information.-.IP .IP "\fBfind [path ...]\fP"+.IP Outputs a list of annexed files in the specified path. With no path, finds files in the current directory and its subdirectories. .IP@@ -557,23 +568,26 @@ To generate output suitable for the gource visualisation program, specify \fB\-\-gource\fP. .IP-.IP "\fBstatus [directory ...]\fP"+.IP "\fBinfo [directory ...]\fP" Displays some statistics and other information, including how much data is in the annex and a list of all known repositories. .IP To only show the data that can be gathered quickly, use \fB\-\-fast\fP. .IP-When a directory is specified, shows a differently formatted status+When a directory is specified, shows a differently formatted info display for that directory. In this mode, all of the file matching options can be used to filter the files that will be included in-the status.+the information. .IP For example, suppose you want to run "git annex get .", but would first like to see how much disk space that will use. Then run: .IP- git annex status \-\-fast . \-\-not \-\-in here+ git annex info \-\-fast . \-\-not \-\-in here+.IP "\fBversion\fP" .IP+Shows the version of git\-annex, as well as repository version information.+.IP .IP "\fBmap\fP" Helps you keep track of your repositories, and the connections between them, by going out and looking at all the ones it can get to, and generating a@@ -621,8 +635,8 @@ Use this to undo an accidental \fBgit annex add\fP command. It puts the file back how it was before the add. .IP-Note that for safety, the content of the file remains in the annex (as a-hard link), until you use \fBgit annex unused\fP and \fBgit annex dropunused\fP.+Note that for safety, the content of the file remains in the annex,+until you use \fBgit annex unused\fP and \fBgit annex dropunused\fP. .IP This is not the command you should use if you intentionally annexed a file and don't want its contents any more. In that case you should use@@ -641,13 +655,21 @@ .SH PLUMBING COMMANDS .IP "\fBpre\-commit [path ...]\fP" .IP+This is meant to be called from git's pre\-commit hook. \fBgit annex init\fP+automatically creates a pre\-commit hook using this.+.IP Fixes up symlinks that are staged as part of a commit, to ensure they point to annexed content. Also handles injecting changes to unlocked files into the annex. .IP-This is meant to be called from git's pre\-commit hook. \fBgit annex init\fP-automatically creates a pre\-commit hook using this.+.IP "\fBupdate\-hook refname olvrev newrev\fP"+This is meant to be called from git's update hook. \fBgit annex init\fP+automatically creates an update hook using this. .IP+This denies updates being pushed for the currently checked out branch.+While receive.denyCurrentBranch normally prevents that, it does+not for fake bare repositories, as used by direct mode.+.IP .IP "\fBfromkey key file\fP" This plumbing\-level command can be used to manually set up a file in the git repository to link to a specified key.@@ -717,7 +739,7 @@ Rather than the normal output, generate JSON. This is intended to be parsed by programs that use git\-annex. Each line of output is a JSON object. Note that json output is only usable with some git\-annex commands,-like status and find.+like info and find. .IP .IP "\fB\-\-debug\fP" Show debug messages.@@ -978,14 +1000,14 @@ up to 500000 keys. If your repository is larger than that, you can adjust this to avoid \fBgit annex unused\fP not noticing some unused data files. Increasing this will make \fBgit\-annex unused\fP consume more memory;-run \fBgit annex status\fP for memory usage numbers.+run \fBgit annex info\fP for memory usage numbers. .IP .IP "\fBannex.bloomaccuracy\fP" Adjusts the accuracy of the bloom filter used by \fBgit annex unused\fP. The default accuracy is 1000 \-\- 1 unused file out of 1000 will be missed by \fBgit annex unused\fP. Increasing the accuracy will make \fBgit annex unused\fP consume more memory;-run \fBgit annex status\fP for memory usage numbers.+run \fBgit annex info\fP for memory usage numbers. .IP .IP "\fBannex.sshcaching\fP" By default, git\-annex caches ssh connections
git-annex.cabal view
@@ -1,5 +1,5 @@ Name: git-annex-Version: 4.20131106+Version: 5.20131118 Cabal-Version: >= 1.8 License: GPL-3 Maintainer: Joey Hess <joey@kitenet.net>@@ -74,6 +74,10 @@ Flag CryptoHash Description: Enable use of cryptohash for checksumming +Flag EKG+ Description: Enable use of EKG to monitor git-annex as it runs (at http://localhost:4242/)+ Default: False+ Executable git-annex Main-Is: git-annex.hs Build-Depends: MissingH, hslogger, directory, filepath,@@ -101,7 +105,7 @@ Build-Depends: unix if flag(TestSuite)- Build-Depends: HUnit+ Build-Depends: tasty, tasty-hunit, tasty-quickcheck CPP-Options: -DWITH_TESTSUITE if flag(TDFA)@@ -120,14 +124,10 @@ Build-Depends: DAV (>= 0.3), http-conduit, xml-conduit, http-types CPP-Options: -DWITH_WEBDAV - if flag(Assistant) && ! os(windows) && ! os(solaris)+ if flag(Assistant) && ! os(solaris) Build-Depends: stm (>= 2.3) CPP-Options: -DWITH_ASSISTANT - if flag(Android)- Build-Depends: data-endian- CPP-Options: -D__ANDROID__- if flag(Assistant) if os(linux) && flag(Inotify) Build-Depends: hinotify@@ -137,17 +137,25 @@ Build-Depends: hfsevents CPP-Options: -DWITH_FSEVENTS else- if (! os(windows) && ! os(solaris) && ! os(linux))- if flag(Android)- Build-Depends: hinotify- CPP-Options: -DWITH_INOTIFY- else- CPP-Options: -DWITH_KQUEUE- C-Sources: Utility/libkqueue.c+ if os(windows)+ Build-Depends: Win32-notify+ CPP-Options: -DWITH_WIN32NOTIFY+ else+ if (! os(solaris) && ! os(linux))+ if flag(Android)+ Build-Depends: hinotify+ CPP-Options: -DWITH_INOTIFY+ else+ CPP-Options: -DWITH_KQUEUE+ C-Sources: Utility/libkqueue.c if os(linux) && flag(Dbus) Build-Depends: dbus (>= 0.10.3) CPP-Options: -DWITH_DBUS+ + if flag(Android)+ Build-Depends: data-endian+ CPP-Options: -D__ANDROID__ if flag(Webapp) && (! os(windows)) Build-Depends:@@ -176,6 +184,11 @@ if flag(Quvi) Build-Depends: aeson CPP-Options: -DWITH_QUVI++ if flag(EKG)+ Build-Depends: ekg+ GHC-Options: -with-rtsopts=-T+ CPP-Options: -DWITH_EKG source-repository head type: git
standalone/android/Makefile view
@@ -2,7 +2,7 @@ # and builds the Android app. # Add Android cross-compiler to PATH (as installed by ghc-android)-ANDROID_CROSS_COMPILER?=$(HOME)/.ghc/android-14/arm-linux-androideabi-4.7/bin+ANDROID_CROSS_COMPILER?=$(HOME)/.ghc/$(shell cat abiversion)/bin PATH:=$(ANDROID_CROSS_COMPILER):$(PATH) # Paths to the Android SDK and NDK.@@ -31,7 +31,6 @@ # Install executables as pseudo-libraries so they will be # unpacked from the .apk. mkdir -p $(GIT_ANNEX_ANDROID_SOURCETREE)/term/libs/armeabi- cp ../../tmp/androidtree/dist/build/git-annex/git-annex $(GIT_ANNEX_ANDROID_SOURCETREE)/term/libs/armeabi/lib.git-annex.so cp $(GIT_ANNEX_ANDROID_SOURCETREE)/busybox/busybox $(GIT_ANNEX_ANDROID_SOURCETREE)/term/libs/armeabi/lib.busybox.so cp $(GIT_ANNEX_ANDROID_SOURCETREE)/openssh/ssh $(GIT_ANNEX_ANDROID_SOURCETREE)/term/libs/armeabi/lib.ssh.so cp $(GIT_ANNEX_ANDROID_SOURCETREE)/openssh/ssh-keygen $(GIT_ANNEX_ANDROID_SOURCETREE)/term/libs/armeabi/lib.ssh-keygen.so@@ -74,9 +73,15 @@ git rev-parse HEAD > $(GIT_ANNEX_ANDROID_SOURCETREE)/term/libs/armeabi/lib.version.so + mkdir -p ../../tmp/4.0 ../../tmp/4.3+ + cp ../../tmp/androidtree/dist/build/git-annex/4.3/git-annex $(GIT_ANNEX_ANDROID_SOURCETREE)/term/libs/armeabi/lib.git-annex.so cd $(GIT_ANNEX_ANDROID_SOURCETREE)/term && ant debug- mkdir -p ../../tmp- cp $(GIT_ANNEX_ANDROID_SOURCETREE)/term/bin/Term-debug.apk ../../tmp/git-annex.apk+ cp $(GIT_ANNEX_ANDROID_SOURCETREE)/term/bin/Term-debug.apk ../../tmp/4.3/git-annex.apk+ + cp ../../tmp/androidtree/dist/build/git-annex/4.0/git-annex $(GIT_ANNEX_ANDROID_SOURCETREE)/term/libs/armeabi/lib.git-annex.so+ cd $(GIT_ANNEX_ANDROID_SOURCETREE)/term && ant debug+ cp $(GIT_ANNEX_ANDROID_SOURCETREE)/term/bin/Term-debug.apk ../../tmp/4.0/git-annex.apk $(GIT_ANNEX_ANDROID_SOURCETREE)/openssl/build-stamp: cd $(GIT_ANNEX_ANDROID_SOURCETREE)/openssl && CC=$$(which cc) ./Configure android
+ standalone/android/abiversion view
@@ -0,0 +1,1 @@+android-14/arm-linux-androideabi-4.8
standalone/android/buildchroot view
@@ -8,6 +8,7 @@ debootstrap --arch=i386 stable debian-stable-android cp $0-inchroot debian-stable-android/tmp cp $0-inchroot-asuser debian-stable-android/tmp+cp $(dirname $0)/abiversion debian-stable-android/tmp # Don't use these vars in the chroot. unset TMP
standalone/android/buildchroot-inchroot-asuser view
@@ -29,8 +29,7 @@ rm -rf adt-bundle-linux-x86/eclipse # The git-annex android Makefile needs this cc symlink.-ln -s arm-linux-androideabi-gcc \- $HOME/.ghc/android-14/arm-linux-androideabi-4.7/bin/cc+ln -s arm-linux-androideabi-gcc $HOME/.ghc/$(cat /tmp/abiversion)/bin/cc cd git clone git://git-annex.branchable.com/ git-annex
standalone/android/clean-haskell-packages view
@@ -2,5 +2,5 @@ # Removes all currently installed cross-compiled haskell packages # except those part of ghc. # Useful if the build failed.-rm -f $(grep -l $HOME/.ghc/android-14/arm-linux-androideabi-4.7/.cabal/lib/ $HOME/.ghc/android-14/arm-linux-androideabi-4.7/lib/*-ghc-*/package.conf.d/*.conf)-$HOME/.ghc/android-14/arm-linux-androideabi-4.7/arm-linux-androideabi/bin/ghc-pkg recache+rm -f $(grep -l $HOME/.ghc/$(cat abiversion)/.cabal/lib/ $HOME/.ghc/android-14/arm-linux-androideabi-4.8/lib/*-ghc-*/package.conf.d/*.conf)+$HOME/.ghc/$(cat abiversion)/arm-linux-androideabi/bin/ghc-pkg recache
+ standalone/android/haskell-patches/crypto-numbers_build-fix.patch view
@@ -0,0 +1,235 @@+From f6ed5c3093111ffe0276f5b5bb6241783611ab1c Mon Sep 17 00:00:00 2001+From: androidbuilder <androidbuilder@example.com>+Date: Mon, 11 Nov 2013 01:54:25 +0000+Subject: [PATCH] hack to build++---+ Crypto/Number/Basic.hs | 17 -----------------+ Crypto/Number/ModArithmetic.hs | 29 -----------------------------+ Crypto/Number/Prime.hs | 18 ------------------+ crypto-numbers.cabal | 2 +-+ 4 files changed, 1 insertion(+), 65 deletions(-)++diff --git a/Crypto/Number/Basic.hs b/Crypto/Number/Basic.hs+index af03052..5de8518 100644+--- a/Crypto/Number/Basic.hs++++ b/Crypto/Number/Basic.hs+@@ -1,8 +1,5 @@+ {-# LANGUAGE BangPatterns #-}+ {-# LANGUAGE CPP #-}+-#if MIN_VERSION_integer_gmp(0,5,1)+-{-# LANGUAGE UnboxedTuples #-}+-#endif+ -- |+ -- Module : Crypto.Number.Basic+ -- License : BSD-style+@@ -17,11 +14,7 @@ module Crypto.Number.Basic+ , areEven+ ) where+ +-#if MIN_VERSION_integer_gmp(0,5,1)+-import GHC.Integer.GMP.Internals+-#else+ import Data.Bits+-#endif+ + -- | sqrti returns two integer (l,b) so that l <= sqrt i <= b+ -- the implementation is quite naive, use an approximation for the first number+@@ -60,25 +53,16 @@ sqrti i+ -- gcde 'a' 'b' find (x,y,gcd(a,b)) where ax + by = d+ --+ gcde :: Integer -> Integer -> (Integer, Integer, Integer)+-#if MIN_VERSION_integer_gmp(0,5,1)+-gcde a b = (s, t, g)+- where (# g, s #) = gcdExtInteger a b+- t = (g - s * a) `div` b+-#else+ gcde a b = if d < 0 then (-x,-y,-d) else (x,y,d) where+ (d, x, y) = f (a,1,0) (b,0,1)+ f t (0, _, _) = t+ f (a', sa, ta) t@(b', sb, tb) =+ let (q, r) = a' `divMod` b' in+ f t (r, sa - (q * sb), ta - (q * tb))+-#endif+ + -- | get the extended GCD of two integer using the extended binary algorithm (HAC 14.61)+ -- get (x,y,d) where d = gcd(a,b) and x,y satisfying ax + by = d+ gcde_binary :: Integer -> Integer -> (Integer, Integer, Integer)+-#if MIN_VERSION_integer_gmp(0,5,1)+-gcde_binary = gcde+-#else+ gcde_binary a' b'+ | b' == 0 = (1,0,a')+ | a' >= b' = compute a' b'+@@ -102,7 +86,6 @@ gcde_binary a' b'+ in if u2 >= v2+ then loop g x y (u2 - v2) v2 (a2 - c2) (b2 - d2) c2 d2+ else loop g x y u2 (v2 - u2) a2 b2 (c2 - a2) (d2 - b2)+-#endif+ + -- | check if a list of integer are all even+ areEven :: [Integer] -> Bool+diff --git a/Crypto/Number/ModArithmetic.hs b/Crypto/Number/ModArithmetic.hs+index 031f477..38b22b7 100644+--- a/Crypto/Number/ModArithmetic.hs++++ b/Crypto/Number/ModArithmetic.hs+@@ -26,12 +26,8 @@ module Crypto.Number.ModArithmetic+ import Control.Exception (throw, Exception)+ import Data.Typeable+ +-#if MIN_VERSION_integer_gmp(0,5,1)+-import GHC.Integer.GMP.Internals+-#else+ import Crypto.Number.Basic (gcde_binary)+ import Data.Bits+-#endif+ + -- | Raised when two numbers are supposed to be coprimes but are not.+ data CoprimesAssertionError = CoprimesAssertionError+@@ -52,13 +48,7 @@ expSafe :: Integer -- ^ base+ -> Integer -- ^ exponant+ -> Integer -- ^ modulo+ -> Integer -- ^ result+-#if MIN_VERSION_integer_gmp(0,5,1)+-expSafe b e m+- | odd m = powModSecInteger b e m+- | otherwise = powModInteger b e m+-#else+ expSafe = exponentiation+-#endif+ + -- | Compute the modular exponentiation of base^exponant using+ -- the fastest algorithm without any consideration for+@@ -71,11 +61,7 @@ expFast :: Integer -- ^ base+ -> Integer -- ^ modulo+ -> Integer -- ^ result+ expFast =+-#if MIN_VERSION_integer_gmp(0,5,1)+- powModInteger+-#else+ exponentiation+-#endif+ + -- note on exponentiation: 0^0 is treated as 1 for mimicking the standard library;+ -- the mathematic debate is still open on whether or not this is true, but pratically+@@ -84,22 +70,15 @@ expFast =+ -- | exponentiation_rtl_binary computes modular exponentiation as b^e mod m+ -- using the right-to-left binary exponentiation algorithm (HAC 14.79)+ exponentiation_rtl_binary :: Integer -> Integer -> Integer -> Integer+-#if MIN_VERSION_integer_gmp(0,5,1)+-exponentiation_rtl_binary = expSafe+-#else+ exponentiation_rtl_binary 0 0 m = 1 `mod` m+ exponentiation_rtl_binary b e m = loop e b 1+ where sq x = (x * x) `mod` m+ loop !0 _ !a = a `mod` m+ loop !i !s !a = loop (i `shiftR` 1) (sq s) (if odd i then a * s else a)+-#endif+ + -- | exponentiation computes modular exponentiation as b^e mod m+ -- using repetitive squaring.+ exponentiation :: Integer -> Integer -> Integer -> Integer+-#if MIN_VERSION_integer_gmp(0,5,1)+-exponentiation = expSafe+-#else+ exponentiation b e m+ | b == 1 = b+ | e == 0 = 1+@@ -107,7 +86,6 @@ exponentiation b e m+ | even e = let p = (exponentiation b (e `div` 2) m) `mod` m+ in (p^(2::Integer)) `mod` m+ | otherwise = (b * exponentiation b (e-1) m) `mod` m+-#endif+ + --{-# DEPRECATED exponantiation_rtl_binary "typo in API name it's called exponentiation_rtl_binary #-}+ exponantiation_rtl_binary :: Integer -> Integer -> Integer -> Integer+@@ -119,17 +97,10 @@ exponantiation = exponentiation+ + -- | inverse computes the modular inverse as in g^(-1) mod m+ inverse :: Integer -> Integer -> Maybe Integer+-#if MIN_VERSION_integer_gmp(0,5,1)+-inverse g m+- | r == 0 = Nothing+- | otherwise = Just r+- where r = recipModInteger g m+-#else+ inverse g m+ | d > 1 = Nothing+ | otherwise = Just (x `mod` m)+ where (x,_,d) = gcde_binary g m+-#endif+ + -- | Compute the modular inverse of 2 coprime numbers.+ -- This is equivalent to inverse except that the result+diff --git a/Crypto/Number/Prime.hs b/Crypto/Number/Prime.hs+index 2060f4d..61d37c0 100644+--- a/Crypto/Number/Prime.hs++++ b/Crypto/Number/Prime.hs+@@ -1,8 +1,6 @@+ {-# LANGUAGE CPP #-}+ {-# LANGUAGE BangPatterns #-}+-#if MIN_VERSION_integer_gmp(0,5,1)+ {-# LANGUAGE MagicHash #-}+-#endif+ -- |+ -- Module : Crypto.Number.Prime+ -- License : BSD-style+@@ -27,12 +25,7 @@ import Crypto.Number.Generate+ import Crypto.Number.Basic (sqrti, gcde_binary)+ import Crypto.Number.ModArithmetic (exponantiation)+ +-#if MIN_VERSION_integer_gmp(0,5,1)+-import GHC.Integer.GMP.Internals+-import GHC.Base+-#else+ import Data.Bits+-#endif+ + -- | returns if the number is probably prime.+ -- first a list of small primes are implicitely tested for divisibility,+@@ -75,21 +68,11 @@ findPrimeFromWith rng prop !n+ -- | find a prime from a starting point with no specific property.+ findPrimeFrom :: CPRG g => g -> Integer -> (Integer, g)+ findPrimeFrom rng n =+-#if MIN_VERSION_integer_gmp(0,5,1)+- (nextPrimeInteger n, rng)+-#else+ findPrimeFromWith rng (\g _ -> (True, g)) n+-#endif+ + -- | Miller Rabin algorithm return if the number is probably prime or composite.+ -- the tries parameter is the number of recursion, that determines the accuracy of the test.+ primalityTestMillerRabin :: CPRG g => g -> Int -> Integer -> (Bool, g)+-#if MIN_VERSION_integer_gmp(0,5,1)+-primalityTestMillerRabin rng (I# tries) !n =+- case testPrimeInteger n tries of+- 0# -> (False, rng)+- _ -> (True, rng)+-#else+ primalityTestMillerRabin rng tries !n+ | n <= 3 = error "Miller-Rabin requires tested value to be > 3"+ | even n = (False, rng)+@@ -126,7 +109,6 @@ primalityTestMillerRabin rng tries !n+ | x2 == 1 = False+ | x2 /= nm1 = loop' ws ((x2*x2) `mod` n) (r+1)+ | otherwise = loop ws+-#endif+ + {-+ n < z -> witness to test+diff --git a/crypto-numbers.cabal b/crypto-numbers.cabal+index 05c00c1..8da5e2a 100644+--- a/crypto-numbers.cabal++++ b/crypto-numbers.cabal+@@ -15,7 +15,7 @@ Extra-Source-Files: Tests/*.hs+ + Flag integer-gmp+ Description: Are we using integer-gmp?+- Default: True++ Default: False+ + Library+ Build-Depends: base >= 4 && < 5+-- +1.7.10.4+
standalone/android/haskell-patches/socks_0.4.2_0001-remove-IPv6-stuff.patch view
@@ -1,7 +1,7 @@-From 28e6a6599ee91e15aa7b2f9d25433490f192f22e Mon Sep 17 00:00:00 2001-From: foo <foo@bar>-Date: Sat, 21 Sep 2013 23:17:29 +0000-Subject: [PATCH] remove IPv6 stuff+From e1a2f80f6bec25921ab645a0aaf1c6422a8917ab Mon Sep 17 00:00:00 2001+From: dummy <dummy@example.com>+Date: Mon, 11 Nov 2013 01:06:58 +0000+Subject: [PATCH] fix --- Network/Socks5/Command.hs | 8 +-------@@ -12,10 +12,10 @@ 5 files changed, 2 insertions(+), 28 deletions(-) diff --git a/Network/Socks5/Command.hs b/Network/Socks5/Command.hs-index 8ce06ec..222d954 100644+index db95fbd..fdba5ec 100644 --- a/Network/Socks5/Command.hs +++ b/Network/Socks5/Command.hs-@@ -12,7 +12,6 @@ module Network.Socks5.Command+@@ -13,7 +13,6 @@ module Network.Socks5.Command , Connect(..) , Command(..) , connectIPV4@@ -23,7 +23,7 @@ , connectDomainName -- * lowlevel interface , rpc-@@ -28,7 +27,7 @@ import qualified Data.ByteString as B+@@ -29,7 +28,7 @@ import qualified Data.ByteString as B import qualified Data.ByteString.Char8 as BC import Data.Serialize @@ -32,7 +32,7 @@ import Network.Socket.ByteString import Network.Socks5.Types-@@ -64,11 +63,6 @@ connectIPV4 socket hostaddr port = onReply <$> rpc_ socket (Connect $ SocksAddre+@@ -65,11 +64,6 @@ connectIPV4 socket hostaddr port = onReply <$> rpc_ socket (Connect $ SocksAddre where onReply (SocksAddrIPV4 h, p) = (h, p) onReply _ = error "ipv4 requested, got something different" @@ -114,14 +114,14 @@ data SocksAddress = SocksAddress !SocksHostAddress !PortNumber deriving (Show,Eq,Ord) diff --git a/Network/Socks5/Wire.hs b/Network/Socks5/Wire.hs-index 3ab95a8..2881988 100644+index 10bd262..a30f32e 100644 --- a/Network/Socks5/Wire.hs +++ b/Network/Socks5/Wire.hs @@ -46,12 +46,10 @@ data SocksResponse = SocksResponse - getAddr 1 = SocksAddrIPV4 <$> getWord32be+ getAddr 1 = SocksAddrIPV4 <$> getWord32host getAddr 3 = SocksAddrDomainName <$> (getWord8 >>= getByteString . fromIntegral)--getAddr 4 = SocksAddrIPV6 <$> (liftM4 (,,,) getWord32le getWord32le getWord32le getWord32le)+-getAddr 4 = SocksAddrIPV6 <$> (liftM4 (,,,) getWord32host getWord32host getWord32host getWord32host) getAddr n = error ("cannot get unknown socket address type: " ++ show n) putAddr (SocksAddrIPV4 h) = putWord8 1 >> putWord32host h
standalone/android/haskell-patches/yesod-form_spliced-TH.patch view
@@ -1,11 +1,8 @@-From c5b0db193fd6e9fd6be22891ae988babbfac3ff0 Mon Sep 17 00:00:00 2001+From f645acc0efbfcba7715cd2b6734f0e9df98f7020 Mon Sep 17 00:00:00 2001 From: dummy <dummy@example.com>-Date: Sat, 19 Oct 2013 02:14:38 +0000-Subject: [PATCH] spliced TH--Used EvilSplicer. Needed a few syntax fixes, and a lot of added imports.+Date: Mon, 11 Nov 2013 01:26:56 +0000+Subject: [PATCH] update -Removed some things I don't need, rather than re-splicing to handle a new version. --- Yesod/Form/Fields.hs | 771 +++++++++++++++++++++++++++++++++++------------ Yesod/Form/Functions.hs | 237 ++++++++++++---@@ -13,10 +10,10 @@ Yesod/Form/MassInput.hs | 233 +++++++++++--- Yesod/Form/Nic.hs | 61 +++- yesod-form.cabal | 1 +- 6 files changed, 1123 insertions(+), 305 deletions(-)+ 6 files changed, 1122 insertions(+), 306 deletions(-) diff --git a/Yesod/Form/Fields.hs b/Yesod/Form/Fields.hs-index b8109df..9bde340 100644+index 0689859..1e9d49b 100644 --- a/Yesod/Form/Fields.hs +++ b/Yesod/Form/Fields.hs @@ -1,4 +1,3 @@@@ -209,16 +206,16 @@ , fieldEnctype = UrlEncoded } where showVal = either id (pack . renderHtml)-@@ -168,7 +233,7 @@ $newline never- -- | A newtype wrapper around a 'Text' that converts newlines to HTML+@@ -169,8 +234,6 @@ $newline never -- br-tags. newtype Textarea = Textarea { unTextarea :: Text }-- deriving (Show, Read, Eq, PersistField, PersistFieldSql, Ord)-+ deriving (Show, Read, Eq, PersistField, Ord)+ deriving (Show, Read, Eq, PersistField, Ord)+-instance PersistFieldSql Textarea where+- sqlType _ = SqlString instance ToHtml Textarea where toHtml = unsafeByteString-@@ -186,10 +251,18 @@ instance ToHtml Textarea where+@@ -188,10 +251,18 @@ instance ToHtml Textarea where textareaField :: Monad m => RenderMessage (HandlerSite m) FormMessage => Field m Textarea textareaField = Field { fieldParse = parseHelper $ Right . Textarea@@ -241,7 +238,7 @@ , fieldEnctype = UrlEncoded } -@@ -197,10 +270,19 @@ hiddenField :: (Monad m, PathPiece p, RenderMessage (HandlerSite m) FormMessage)+@@ -199,10 +270,19 @@ hiddenField :: (Monad m, PathPiece p, RenderMessage (HandlerSite m) FormMessage) => Field m p hiddenField = Field { fieldParse = parseHelper $ maybe (Left MsgValueRequired) Right . fromPathPiece@@ -265,7 +262,7 @@ , fieldEnctype = UrlEncoded } -@@ -208,20 +290,55 @@ textField :: Monad m => RenderMessage (HandlerSite m) FormMessage => Field m Tex+@@ -210,20 +290,55 @@ textField :: Monad m => RenderMessage (HandlerSite m) FormMessage => Field m Tex textField = Field { fieldParse = parseHelper $ Right , fieldView = \theId name attrs val isReq ->@@ -329,7 +326,7 @@ , fieldEnctype = UrlEncoded } -@@ -293,10 +410,24 @@ emailField = Field+@@ -295,10 +410,24 @@ emailField = Field case Email.canonicalizeEmail $ encodeUtf8 s of Just e -> Right $ decodeUtf8With lenientDecode e Nothing -> Left $ MsgInvalidEmail s@@ -358,7 +355,7 @@ , fieldEnctype = UrlEncoded } -@@ -305,20 +436,78 @@ searchField :: Monad m => RenderMessage (HandlerSite m) FormMessage => AutoFocus+@@ -307,20 +436,78 @@ searchField :: Monad m => RenderMessage (HandlerSite m) FormMessage => AutoFocus searchField autoFocus = Field { fieldParse = parseHelper Right , fieldView = \theId name attrs val isReq -> do@@ -449,7 +446,7 @@ , fieldEnctype = UrlEncoded } -@@ -329,7 +518,30 @@ urlField = Field+@@ -331,7 +518,30 @@ urlField = Field Nothing -> Left $ MsgInvalidUrl s Just _ -> Right s , fieldView = \theId name attrs val isReq ->@@ -481,7 +478,7 @@ , fieldEnctype = UrlEncoded } -@@ -342,18 +554,56 @@ selectField :: (Eq a, RenderMessage site FormMessage)+@@ -344,18 +554,56 @@ selectField :: (Eq a, RenderMessage site FormMessage) => HandlerT site IO (OptionList a) -> Field (HandlerT site IO) a selectField = selectFieldHelper@@ -550,7 +547,7 @@ multiSelectFieldList :: (Eq a, RenderMessage site FormMessage, RenderMessage site msg) => [(msg, a)]-@@ -376,11 +626,48 @@ multiSelectField ioptlist =+@@ -378,11 +626,48 @@ multiSelectField ioptlist = view theId name attrs val isReq = do opts <- fmap olOptions $ handlerToWidget ioptlist let selOpts = map (id &&& (optselected val)) opts@@ -604,7 +601,7 @@ where optselected (Left _) _ = False optselected (Right vals) opt = (optionInternalValue opt) `elem` vals-@@ -390,67 +677,172 @@ radioFieldList :: (Eq a, RenderMessage site FormMessage, RenderMessage site msg)+@@ -392,67 +677,172 @@ radioFieldList :: (Eq a, RenderMessage site FormMessage, RenderMessage site msg) -> Field (HandlerT site IO) a radioFieldList = radioField . optionsPairs @@ -828,7 +825,7 @@ , fieldEnctype = UrlEncoded } where-@@ -476,10 +868,25 @@ $newline never+@@ -478,10 +868,25 @@ $newline never checkBoxField :: Monad m => RenderMessage (HandlerSite m) FormMessage => Field m Bool checkBoxField = Field { fieldParse = \e _ -> return $ checkBoxParser e@@ -858,7 +855,7 @@ , fieldEnctype = UrlEncoded } -@@ -523,49 +930,7 @@ optionsPairs opts = do+@@ -525,49 +930,7 @@ optionsPairs opts = do optionsEnum :: (MonadHandler m, Show a, Enum a, Bounded a) => m (OptionList a) optionsEnum = optionsPairs $ map (\x -> (pack $ show x, x)) [minBound..maxBound] @@ -909,7 +906,7 @@ selectFieldHelper :: (Eq a, RenderMessage site FormMessage)-@@ -609,9 +974,21 @@ fileField = Field+@@ -611,9 +974,21 @@ fileField = Field case files of [] -> Right Nothing file:_ -> Right $ Just file@@ -934,7 +931,7 @@ , fieldEnctype = Multipart } -@@ -638,10 +1015,20 @@ fileAFormReq fs = AForm $ \(site, langs) menvs ints -> do+@@ -640,10 +1015,20 @@ fileAFormReq fs = AForm $ \(site, langs) menvs ints -> do { fvLabel = toHtml $ renderMessage site langs $ fsLabel fs , fvTooltip = fmap (toHtml . renderMessage site langs) $ fsTooltip fs , fvId = id'@@ -959,7 +956,7 @@ , fvErrors = errs , fvRequired = True }-@@ -670,10 +1057,20 @@ fileAFormOpt fs = AForm $ \(master, langs) menvs ints -> do+@@ -672,10 +1057,20 @@ fileAFormOpt fs = AForm $ \(master, langs) menvs ints -> do { fvLabel = toHtml $ renderMessage master langs $ fsLabel fs , fvTooltip = fmap (toHtml . renderMessage master langs) $ fsTooltip fs , fvId = id'@@ -1770,7 +1767,7 @@ } where diff --git a/yesod-form.cabal b/yesod-form.cabal-index afd2de5..49fd684 100644+index 39fa680..88ed066 100644 --- a/yesod-form.cabal +++ b/yesod-form.cabal @@ -19,6 +19,7 @@ library
standalone/android/install-haskell-packages view
@@ -50,7 +50,7 @@ installgitannexdeps () { pushd ../..- echo cabal install --only-dependencies+ echo cabal install --only-dependencies "$@" cabal install --only-dependencies "$@" popd }@@ -90,11 +90,14 @@ patched yesod-core patched yesod-persistent patched yesod-form+ patched crypto-numbers patched yesod-auth patched yesod patched async patched gnuidn patched DAV+ patched language-javascript+ patched uuid cd .. @@ -112,6 +115,6 @@ echo echo cross build echo-PATH=$HOME/.ghc/android-14/arm-linux-androideabi-4.7/bin:$HOME/.ghc/android-14/arm-linux-androideabi-4.7/arm-linux-androideabi/bin:$PATH+PATH=$HOME/.ghc/$(cat abiversion)/bin:$HOME/.ghc/$(cat abiversion)/arm-linux-androideabi/bin:$PATH cabal update install_pkgs
+ standalone/android/start view
binary file changed (absent → 6492 bytes)
− templates/configurators/checkunfinished.hamlet
@@ -1,16 +0,0 @@-<div .span9 .hero-unit>- $if null stalled- <h2>- The repository is still not finished being set up. Patience..- <p>- If you suspect something is wrong, you might want to take a look #- at the - <a href="@{LogR}">- Log- $else- <h2>- Setting up this repository seems to have stalled!- <p>- Make sure the remote system is available and- <a .btn .btn-primary href="@{RetryUnfinishedRepositoriesR}">- Retry
+ templates/configurators/edit/nonannexremote.hamlet view
@@ -0,0 +1,18 @@+<div .span9 .hero-unit>+ <h2>+ Just a git repository+ <p>+ This repository is not currently set up as a git annex; #+ only git metadata is synced with this repository.+ $if sshrepo+ <p>+ If this repository's ssh server has git-annex installed, you can #+ upgrade this repository to a full git annex, which will store the+ contents of your files, not only their metadata.+ <p>+ <a .btn href="@{UpgradeRepositoryR r}">+ Upgrade Repository+ <h2>+ Repository information+ <p>+ ^{repoInfo}
+ templates/configurators/edit/repository.hamlet view
@@ -0,0 +1,37 @@+<div .span9 .hero-unit>+ <h2>+ $if new+ Setup complete+ $else+ Editing repository+ $if new+ <p>+ This repository is set up and ready to go!+ <p>+ Now you can do a little more configuring of it, if you like. #+ Perhaps enter a better name than the automatically generated one.+ $if istransfer+ <div .alert .alert-info>+ This repository is currently in the transfer group. That's the #+ right choice if you'll use it to shuttle data back and forth #+ between other repositories. Otherwise, pick one of the other groups.+ <p>+ <form method="post" .form-horizontal enctype=#{enctype}>+ <fieldset>+ ^{form}+ ^{webAppFormAuthToken}+ <div .form-actions>+ <button .btn .btn-primary type=submit>+ Save Changes #+ <a .btn href="@{DashboardR}">+ Cancel #+ $if new+ <p>+ In a hurry? Feel free to skip this step! You can always come back #+ and configure this repository later.+ <h3>+ Repository information+ <p>+ ^{repoInfo}+ <p>+ ^{repoEncryption}
− templates/configurators/editrepository.hamlet
@@ -1,37 +0,0 @@-<div .span9 .hero-unit>- <h2>- $if new- Setup complete- $else- Editing repository- $if new- <p>- This repository is set up and ready to go!- <p>- Now you can do a little more configuring of it, if you like. #- Perhaps enter a better name than the automatically generated one.- $if istransfer- <div .alert .alert-info>- This repository is currently in the transfer group. That's the #- right choice if you'll use it to shuttle data back and forth #- between other repositories. Otherwise, pick one of the other groups.- <p>- <form method="post" .form-horizontal enctype=#{enctype}>- <fieldset>- ^{form}- ^{webAppFormAuthToken}- <div .form-actions>- <button .btn .btn-primary type=submit>- Save Changes #- <a .btn href="@{DashboardR}">- Cancel #- $if new- <p>- In a hurry? Feel free to skip this step! You can always come back #- and configure this repository later.- <h3>- Repository information- <p>- ^{repoInfo}- <p>- ^{repoEncryption}
templates/dashboard/transfers.hamlet view
@@ -17,7 +17,7 @@ $of Download ← <small>- <a href="@{EditRepositoryR $ transferUUID transfer}">+ <a href="@{EditRepositoryR $ RepoUUID $ transferUUID transfer}"> #{maybe "unknown" Remote.name $ transferRemote info} $with size <- maybe "unknown" (roughSize dataUnits True) $ keySize $ transferKey transfer $if isJust $ startedTime info
templates/repolist.hamlet view
@@ -11,52 +11,44 @@ Repositories <table .table .table-condensed> <tbody #costsortable>- $forall (name, uuid, actions) <- repolist- $if unfinished uuid- <tr .repoline>- <td>- <a .btn .btn-mini .disabled>- <i .icon-time></i>- unfinished repository- <td>- <a href="@{CheckUnfinishedRepositoriesR}">- <i .icon-question-sign></i> check status- <td>- $else- <tr .repoline ##{fromUUID uuid}>- <td .handle>- <a .btn .btn-mini .disabled>- <i .icon-resize-vertical></i>- #{name}- <td .draghide>- $if needsEnabled actions- <a href="@{setupRepoLink actions}">- <i .icon-warning-sign></i> not enabled- $else- $if notWanted actions- <i .icon-trash></i> cleaning out..- $else- <a href="@{syncToggleLink actions}">- $if notSyncing actions- <i .icon-ban-circle></i> syncing disabled- $else- <i .icon-refresh></i> syncing enabled- <td .draghide>- $if needsEnabled actions- <a href="@{setupRepoLink actions}">- enable+ $forall (name, repoid, actions) <- repolist+ <tr .repoline ##{show repoid}>+ <td .handle>+ <a .btn .btn-mini .disabled>+ <i .icon-resize-vertical></i>+ #{name}+ <td .draghide>+ $if needsEnabled actions+ <a href="@{setupRepoLink actions}">+ <i .icon-warning-sign></i> not enabled+ $else+ $if notWanted actions+ <i .icon-trash></i> cleaning out.. $else- <span .dropdown #menu-#{fromUUID uuid}>- <a .dropdown-toggle data-toggle="dropdown" href="#menu-#{fromUUID uuid}">- <i .icon-cog></i> settings- <b .caret></b>- <ul .dropdown-menu>- <li>- <a href="@{setupRepoLink actions}">- <i .icon-pencil></i> Edit- <a href="@{DisableRepositoryR uuid}">+ <a href="@{syncToggleLink actions}">+ $if notSyncing actions+ <i .icon-ban-circle></i> syncing disabled+ $else+ <i .icon-refresh></i> syncing enabled #+ $if lacksUUID repoid+ (metadata only)+ <td .draghide>+ $if needsEnabled actions+ <a href="@{setupRepoLink actions}">+ enable+ $else+ <span .dropdown #menu-#{show repoid}>+ <a .dropdown-toggle data-toggle="dropdown" href="#menu-#{show repoid}">+ <i .icon-cog></i> settings+ <b .caret></b>+ <ul .dropdown-menu>+ <li>+ <a href="@{setupRepoLink actions}">+ <i .icon-pencil></i> Edit+ $if not (lacksUUID repoid)+ <a href="@{DisableRepositoryR $ asUUID repoid}"> <i .icon-minus></i> Disable- <a href="@{DeleteRepositoryR uuid}">+ <a href="@{DeleteRepositoryR $ asUUID repoid}"> <i .icon-trash></i> Delete $if addmore <tr>