packages feed

git-annex 5.20140717 → 5.20140817

raw patch · 271 files changed

+5676/−2531 lines, 271 filesdep −HTTPdep −extensible-exceptionsdep −lifted-basedep ~DAVdep ~unix-compatbinary-added

Dependencies removed: HTTP, extensible-exceptions, lifted-base

Dependency ranges changed: DAV, unix-compat

Files

Annex.hs view
@@ -64,14 +64,16 @@ import Utility.InodeCache  import "mtl" Control.Monad.Reader-import Control.Monad.Catch import Control.Concurrent import qualified Data.Map as M import qualified Data.Set as S  {- git-annex's monad is a ReaderT around an AnnexState stored in a MVar.- - This allows modifying the state in an exception-safe fashion.  - The MVar is not exposed outside this module.+ -+ - Note that when an Annex action fails and the exception is caught,+ - ny changes the action has made to the AnnexState are retained,+ - due to the use of the MVar to store the state.  -} newtype Annex a = Annex { runAnnex :: ReaderT (MVar AnnexState) IO a } 	deriving (
Annex/Branch/Transitions.hs view
@@ -12,8 +12,9 @@  import Logs import Logs.Transitions-import Logs.UUIDBased as UUIDBased-import Logs.Presence.Pure as Presence+import qualified Logs.UUIDBased as UUIDBased+import qualified Logs.Presence.Pure as Presence+import qualified Logs.Chunk.Pure as Chunk import Types.TrustLevel import Types.UUID @@ -37,9 +38,11 @@ 		-- because git remotes may still exist, and they need 		-- to still know it's dead. 		| f == trustLog -> PreserveFile-		| otherwise -> ChangeFile $ UUIDBased.showLog id $ dropDeadFromUUIDBasedLog trustmap $ UUIDBased.parseLog Just content+		| otherwise -> ChangeFile $ UUIDBased.showLog id $ dropDeadFromMapLog trustmap id $ UUIDBased.parseLog Just content 	Just NewUUIDBasedLog -> ChangeFile $-		UUIDBased.showLogNew id $ dropDeadFromUUIDBasedLog trustmap $ UUIDBased.parseLogNew Just content+		UUIDBased.showLogNew id $ dropDeadFromMapLog trustmap id $ UUIDBased.parseLogNew Just content+	Just (ChunkLog _) -> ChangeFile $+		Chunk.showLog $ dropDeadFromMapLog trustmap fst $ Chunk.parseLog content 	Just (PresenceLog _) -> 		let newlog = Presence.compactLog $ dropDeadFromPresenceLog trustmap $ Presence.parseLog content 		in if null newlog@@ -48,8 +51,8 @@ 	Just OtherLog -> PreserveFile 	Nothing -> PreserveFile -dropDeadFromUUIDBasedLog :: TrustMap -> UUIDBased.Log String -> UUIDBased.Log String-dropDeadFromUUIDBasedLog trustmap = M.filterWithKey $ notDead trustmap . const+dropDeadFromMapLog :: Ord k => TrustMap -> (k -> UUID) -> M.Map k v -> M.Map k v+dropDeadFromMapLog trustmap getuuid = M.filterWithKey $ \k _v -> notDead trustmap getuuid k  {- Presence logs can contain UUIDs or other values. Any line that matches  - a dead uuid is dropped; any other values are passed through. -}
Annex/Content.hs view
@@ -16,6 +16,7 @@ 	getViaTmpChecked, 	getViaTmpUnchecked, 	prepGetViaTmpChecked,+	prepTmp, 	withTmp, 	checkDiskSpace, 	moveAnnex,@@ -55,7 +56,6 @@ import Annex.Link import Annex.Content.Direct import Annex.ReplaceFile-import Annex.Exception  #ifdef mingw32_HOST_OS import Utility.WinLock@@ -166,7 +166,7 @@ 	contentfile <- calcRepo $ gitAnnexLocation key 	lockfile <- contentLockFile key 	maybe noop setuplockfile lockfile-	bracketAnnex (liftIO $ lock contentfile lockfile) (unlock lockfile) (const a)+	bracket (liftIO $ lock contentfile lockfile) (unlock lockfile) (const a)   where 	alreadylocked = error "content is locked" 	setuplockfile lockfile = modifyContent lockfile $@@ -264,7 +264,10 @@ 	createAnnexDirectory (parentDir tmp) 	return tmp -{- Creates a temp file, runs an action on it, and cleans up the temp file. -}+{- Creates a temp file for a key, runs an action on it, and cleans up+ - the temp file. If the action throws an exception, the temp file is+ - left behind, which allows for resuming.+ -} withTmp :: Key -> (FilePath -> Annex a) -> Annex a withTmp key action = do 	tmp <- prepTmp key@@ -416,7 +419,7 @@ cleanObjectLoc :: Key -> Annex () -> Annex () cleanObjectLoc key cleaner = do 	file <- calcRepo $ gitAnnexLocation key-	void $ tryAnnexIO $ thawContentDir file+	void $ tryIO $ thawContentDir file 	cleaner 	liftIO $ removeparents file (3 :: Int)   where
Annex/Direct.hs view
@@ -32,7 +32,6 @@ import Utility.CopyFile import Annex.Perms import Annex.ReplaceFile-import Annex.Exception import Annex.VariantFile import Git.Index import Annex.Index@@ -252,7 +251,7 @@ 	go makeabs getsha getmode a araw (f, item) 		| getsha item == nullSha = noop 		| otherwise = void $-			tryAnnex . maybe (araw item makeabs f) (\k -> void $ a item makeabs k f)+			tryNonAsync . maybe (araw item makeabs f) (\k -> void $ a item makeabs k f) 				=<< catKey (getsha item) (getmode item)  	moveout _ _ = removeDirect@@ -354,11 +353,8 @@ 		void $ addAssociatedFile k f 		modifyContent loc $ do 			thawContent loc-			replaceFileOr f-				(liftIO . moveFile loc)-				$ \tmp -> do -- rollback-					liftIO (moveFile tmp loc)-					freezeContent loc+			liftIO (replaceFileFrom loc f)+				`catchIO` (\_ -> freezeContent loc) 	fromdirect loc = do 		replaceFile f $ 			liftIO . void . copyFileExternal loc
Annex/Drop.hs view
@@ -16,7 +16,6 @@ import qualified Command.Drop import Command import Annex.Wanted-import Annex.Exception import Config import Annex.Content.Direct @@ -120,5 +119,5 @@  	slocs = S.fromList locs 	-	safely a = either (const False) id <$> tryAnnex a+	safely a = either (const False) id <$> tryNonAsync a
Annex/Environment.hs view
@@ -13,7 +13,6 @@ import Utility.UserInfo import qualified Git.Config import Config-import Annex.Exception  #ifndef mingw32_HOST_OS import Utility.Env@@ -58,7 +57,7 @@ {- Runs an action that commits to the repository, and if it fails,   - sets user.email and user.name to a dummy value and tries the action again. -} ensureCommit :: Annex a -> Annex a-ensureCommit a = either retry return =<< tryAnnex a +ensureCommit a = either retry return =<< tryNonAsync a    where   	retry _ = do 		name <- liftIO myUserName
− Annex/Exception.hs 
@@ -1,50 +0,0 @@-{- exception handling in the git-annex monad- -- - Note that when an Annex action fails and the exception is handled- - by these functions, any changes the action has made to the- - AnnexState are retained. This works because the Annex monad- - internally stores the AnnexState in a MVar.- -- - Copyright 2011-2013 Joey Hess <joey@kitenet.net>- -- - Licensed under the GNU GPL version 3 or higher.- -}--{-# LANGUAGE PackageImports #-}--module Annex.Exception (-	bracketIO,-	bracketAnnex,-	tryAnnex,-	tryAnnexIO,-	throwAnnex,-	catchAnnex,-) where--import qualified Control.Monad.Catch as M-import Control.Exception--import Common.Annex--{- Runs an Annex action, with setup and cleanup both in the IO monad. -}-bracketIO :: IO v -> (v -> IO b) -> (v -> Annex a) -> Annex a-bracketIO setup cleanup = M.bracket (liftIO setup) (liftIO . cleanup)--bracketAnnex :: Annex v -> (v -> Annex b) -> (v -> Annex a) -> Annex a-bracketAnnex = M.bracket--{- try in the Annex monad -}-tryAnnex :: Annex a -> Annex (Either SomeException a)-tryAnnex = M.try--{- try in the Annex monad, but only catching IO exceptions -}-tryAnnexIO :: Annex a -> Annex (Either IOException a)-tryAnnexIO = M.try--{- throw in the Annex monad -}-throwAnnex :: Exception e => e -> Annex a-throwAnnex = M.throwM--{- catch in the Annex monad -}-catchAnnex :: Exception e => Annex a -> (e -> Annex a) -> Annex a-catchAnnex = M.catch
Annex/Index.hs view
@@ -18,7 +18,6 @@ import Git.Types import qualified Annex import Utility.Env-import Annex.Exception  {- Runs an action using a different git index file. -} withIndexFile :: FilePath -> Annex a -> Annex a@@ -26,7 +25,7 @@ 	g <- gitRepo 	g' <- liftIO $ addGitEnv g "GIT_INDEX_FILE" f -	r <- tryAnnex $ do+	r <- tryNonAsync $ do 		Annex.changeState $ \s -> s { Annex.repo = g' } 		a 	Annex.changeState $ \s -> s { Annex.repo = (Annex.repo s) { gitEnv = gitEnv g} }
Annex/Journal.hs view
@@ -14,7 +14,6 @@ module Annex.Journal where  import Common.Annex-import Annex.Exception import qualified Git import Annex.Perms import Annex.LockFile
Annex/LockFile.hs view
@@ -18,7 +18,6 @@ import Annex import Types.LockPool import qualified Git-import Annex.Exception import Annex.Perms  import qualified Data.Map as M
Annex/Perms.hs view
@@ -21,7 +21,6 @@ import Utility.FileMode import Git.SharedRepository import qualified Annex-import Annex.Exception import Config  import System.Posix.Types@@ -120,6 +119,6 @@ modifyContent :: FilePath -> Annex a -> Annex a modifyContent f a = do 	createContentDir f -- also thaws it-	v <- tryAnnex a+	v <- tryNonAsync a 	freezeContentDir f-	either throwAnnex return v+	either throwM return v
Annex/ReplaceFile.hs view
@@ -9,7 +9,6 @@  import Common.Annex import Annex.Perms-import Annex.Exception  {- Replaces a possibly already existing file with a new version,   - atomically, by running an action.@@ -31,14 +30,21 @@ replaceFileOr file action rollback = do 	tmpdir <- fromRepo gitAnnexTmpMiscDir 	void $ createAnnexDirectory tmpdir-	bracketAnnex (liftIO $ setup tmpdir) rollback $ \tmpfile -> do-		action tmpfile-		liftIO $ catchIO (rename tmpfile file) (fallback tmpfile)+	tmpfile <- liftIO $ setup tmpdir+	go tmpfile `catchNonAsync` (const $ rollback tmpfile)   where   	setup tmpdir = do 		(tmpfile, h) <- openTempFileWithDefaultPermissions tmpdir "tmp" 		hClose h 		return tmpfile-	fallback tmpfile _ = do-		createDirectoryIfMissing True $ parentDir file-		moveFile tmpfile file+	go tmpfile = do+		action tmpfile+		liftIO $ replaceFileFrom tmpfile file++replaceFileFrom :: FilePath -> FilePath -> IO ()+replaceFileFrom src dest = go `catchIO` fallback+  where+	go = moveFile src dest+	fallback _ = do+		createDirectoryIfMissing True $ parentDir dest+		go
Annex/Transfer.hs view
@@ -12,6 +12,7 @@ 	upload, 	download, 	runTransfer,+	alwaysRunTransfer, 	noRetry, 	forwardRetry, ) where@@ -20,7 +21,6 @@ import Logs.Transfer as X import Annex.Notification as X import Annex.Perms-import Annex.Exception import Utility.Metered #ifdef mingw32_HOST_OS import Utility.WinLock@@ -47,12 +47,23 @@  - no transfer information or lock file is used.  -} runTransfer :: Transfer -> Maybe FilePath -> RetryDecider -> (MeterUpdate -> Annex Bool) -> Annex Bool-runTransfer t file shouldretry a = do+runTransfer = runTransfer' False++{- Like runTransfer, but ignores any existing transfer lock file for the+ - transfer, allowing re-running a transfer that is already in progress.+ -+ - Note that this may result in confusing progress meter display in the+ - webapp, if multiple processes are writing to the transfer info file. -}+alwaysRunTransfer :: Transfer -> Maybe FilePath -> RetryDecider -> (MeterUpdate -> Annex Bool) -> Annex Bool+alwaysRunTransfer = runTransfer' True++runTransfer' :: Bool -> Transfer -> Maybe FilePath -> RetryDecider -> (MeterUpdate -> Annex Bool) -> Annex Bool+runTransfer' ignorelock t file shouldretry a = do 	info <- liftIO $ startTransferInfo file 	(meter, tfile, metervar) <- mkProgressUpdater t info 	mode <- annexFileMode 	(fd, inprogress) <- liftIO $ prep tfile mode info-	if inprogress+	if inprogress && not ignorelock 		then do 			showNote "transfer already in progress" 			return False@@ -103,10 +114,11 @@ 		void $ tryIO $ removeFile $ transferLockFile tfile #endif 	retry oldinfo metervar run = do-		v <- tryAnnex run+		v <- tryNonAsync run 		case v of 			Right b -> return b-			Left _ -> do+			Left e -> do+				warning (show e) 				b <- getbytescomplete metervar 				let newinfo = oldinfo { bytesComplete = Just b } 				if shouldretry oldinfo newinfo
Annex/Url.hs view
@@ -26,7 +26,7 @@ 	Just . fromMaybe defaultUserAgent . Annex.useragent  getUrlOptions :: Annex U.UrlOptions-getUrlOptions = U.UrlOptions+getUrlOptions = mkUrlOptions 	<$> getUserAgent 	<*> headers 	<*> options
Annex/View.hs view
@@ -410,19 +410,19 @@   where 	handleremovals item 		| DiffTree.srcsha item /= nullSha =-			handle item removemeta+			handlechange item removemeta 				=<< catKey (DiffTree.srcsha item) (DiffTree.srcmode item) 		| otherwise = noop 	handleadds makeabs item 		| DiffTree.dstsha item /= nullSha = -			handle item addmeta+			handlechange item addmeta 				=<< ifM isDirect 					( catKey (DiffTree.dstsha item) (DiffTree.dstmode item) 					-- optimisation 					, isAnnexLink $ makeabs $ DiffTree.file item 					) 		| otherwise = noop-	handle item a = maybe noop+	handlechange item a = maybe noop 		(void . commandAction . a (getTopFilePath $ DiffTree.file item))  {- Generates a branch for a view. This is done using a different index
Assistant/Install.hs view
@@ -22,6 +22,7 @@ import Utility.OSX #else import Utility.FreeDesktop+import Utility.UserInfo import Assistant.Install.Menu #endif @@ -36,13 +37,13 @@  - Note that this is done every time it's started, so if the user moves  - it around, the paths this sets up won't break.  -- - Nautilus hook script installation is done even for packaged apps,- - since it has to go into the user's home directory.+ - File manager hook script installation is done even for+ - packaged apps, since it has to go into the user's home directory.  -} ensureInstalled :: IO () ensureInstalled = go =<< standaloneAppBase   where-	go Nothing = installNautilus "git-annex"+	go Nothing = installFileManagerHooks "git-annex" 	go (Just base) = do 		let program = base </> "git-annex" 		programfile <- programFile@@ -78,7 +79,7 @@ 			, runshell "\"$@\"" 			] -		installNautilus program+		installFileManagerHooks program  installWrapper :: FilePath -> String -> IO () installWrapper file content = do@@ -88,15 +89,23 @@ 		viaTmp writeFile file content 		modifyFileMode file $ addModes [ownerExecuteMode] -installNautilus :: FilePath -> IO ()+installFileManagerHooks :: FilePath -> IO () #ifdef linux_HOST_OS-installNautilus program = do-	scriptdir <- (\d -> d </> "nautilus" </> "scripts") <$> userDataDir-	createDirectoryIfMissing True scriptdir-	genscript scriptdir "get"-	genscript scriptdir "drop"+installFileManagerHooks program = do+	-- Gnome+	nautilusScriptdir <- (\d -> d </> "nautilus" </> "scripts") <$> userDataDir+	createDirectoryIfMissing True nautilusScriptdir+	genNautilusScript nautilusScriptdir "get"+	genNautilusScript nautilusScriptdir "drop"++	-- KDE+	home <- myHomeDir+	let kdeServiceMenusdir = home </> ".kde" </> "share" </> "kde4" </> "services" </> "ServiceMenus"+	createDirectoryIfMissing True kdeServiceMenusdir+	writeFile (kdeServiceMenusdir </> "git-annex.desktop")+		(kdeDesktopFile ["get", "drop"])   where-	genscript scriptdir action =+	genNautilusScript scriptdir action = 		installscript (scriptdir </> scriptname action) $ unlines 			[ shebang_local 			, autoaddedcomment@@ -108,9 +117,38 @@ 		modifyFileMode f $ addModes [ownerExecuteMode] 	safetoinstallscript f = catchDefaultIO True $ 		elem autoaddedcomment . lines <$> readFileStrict f-	autoaddedcomment = "# Automatically added by git-annex, do not edit. (To disable, chmod 600 this file.)"+	autoaddedcomment = "# " ++ autoaddedmsg ++ " (To disable, chmod 600 this file.)"+	autoaddedmsg = "Automatically added by git-annex, do not edit."++	kdeDesktopFile actions = unlines $ concat $+		kdeDesktopHeader actions : map kdeDesktopAction actions+	kdeDesktopHeader actions =+		[ "# " ++ autoaddedmsg+		, "[Desktop Entry]"+		, "Type=Service"+		, "ServiceTypes=all/allfiles"+		, "MimeType=all/all;"+		, "Actions=" ++ intercalate ";" (map kdeDesktopSection actions)+		, "X-KDE-Priority=TopLevel"+		, "X-KDE-Submenu=Git-Annex"+		, "X-KDE-Icon=git-annex"+		, "X-KDE-ServiceTypes=KonqPopupMenu/Plugin"+		]+	kdeDesktopSection command = "GitAnnex" ++ command+	kdeDesktopAction command = +		[ ""+		, "[Desktop Action " ++ kdeDesktopSection command ++ "]"+		, "Name=" ++ command+		, "Icon=git-annex"+		, unwords+			[ "Exec=sh -c 'cd \"$(dirname '%U')\" &&"+			, program+			, command+			, "--notify-start --notify-finish -- %U'"+			]+		] #else-installNautilus _ = noop+installFileManagerHooks _ = noop #endif  {- Returns a cleaned up environment that lacks settings used to make the
Assistant/Pairing/Network.hs view
@@ -20,7 +20,6 @@ import Network.Multicast import Network.Info import Network.Socket-import Control.Exception (bracket) import qualified Data.Map as M import Control.Concurrent
Assistant/Threads/Committer.hs view
@@ -27,7 +27,6 @@ import qualified Utility.DirWatcher as DirWatcher import Types.KeySource import Config-import Annex.Exception import Annex.Content import Annex.Link import Annex.CatFile@@ -217,7 +216,7 @@ commitStaged = do 	{- This could fail if there's another commit being made by 	 - something else. -}-	v <- tryAnnex Annex.Queue.flush+	v <- tryNonAsync Annex.Queue.flush 	case v of 		Left _ -> return False 		Right _ -> do
Assistant/Threads/Cronner.hs view
@@ -191,10 +191,10 @@ 	mapM_ reget =<< liftAnnex (dirKeys gitAnnexBadDir)   where 	reget k = queueTransfers "fsck found bad file; redownloading" Next k Nothing Download-runActivity' urlrenderer (ScheduledRemoteFsck u s d) = handle =<< liftAnnex (remoteFromUUID u)+runActivity' urlrenderer (ScheduledRemoteFsck u s d) = dispatch =<< liftAnnex (remoteFromUUID u)   where-	handle Nothing = debug ["skipping remote fsck of uuid without a configured remote", fromUUID u, fromSchedule s]-	handle (Just rmt) = void $ case Remote.remoteFsck rmt of+	dispatch Nothing = debug ["skipping remote fsck of uuid without a configured remote", fromUUID u, fromSchedule s]+	dispatch (Just rmt) = void $ case Remote.remoteFsck rmt of 		Nothing -> go rmt $ do 			program <- readProgramFile 			void $ batchCommand program $
Assistant/Threads/NetWatcher.hs view
@@ -117,7 +117,7 @@ #else 	listen client matcher #endif-		$ \event -> mapM_ handle+		$ \event -> mapM_ handleevent 			(map dictionaryItems $ mapMaybe fromVariant $ signalBody event)   where 	matcher = matchAny@@ -128,7 +128,7 @@ 	nm_activatingconnection_key = toVariant ("ActivatingConnection" :: String) 	noconnections = Just $ toVariant $ toVariant ([] :: [ObjectPath]) 	rootconnection = Just $ toVariant $ toVariant $ objectPath_ "/"-	handle m+	handleevent m 		| lookup nm_active_connections_key m == noconnections = 			setconnected False 		| lookup nm_activatingconnection_key m == rootconnection =@@ -150,7 +150,7 @@ 	match connmatcher $ \event -> 		when (any (== wicd_success) (signalBody event)) $ 			setconnected True-	match statusmatcher $ \event -> handle (signalBody event)+	match statusmatcher $ \event -> handleevent (signalBody event)   where 	connmatcher = matchAny 		{ matchInterface = Just "org.wicd.daemon"@@ -162,7 +162,7 @@ 		} 	wicd_success = toVariant ("success" :: String) 	wicd_disconnected = toVariant [toVariant ("" :: String)]-	handle status+	handleevent status 		| any (== wicd_disconnected) status = setconnected False 		| otherwise = noop 	match matcher a =
Assistant/Threads/SanityChecker.hs view
@@ -40,7 +40,6 @@ import Config.Files import Utility.DiskFree import qualified Annex-import Annex.Exception #ifdef WITH_WEBAPP import Assistant.WebApp.Types #endif@@ -85,7 +84,7 @@ 	liftIO $ fixUpSshRemotes  	{- Clean up old temp files. -}-	void $ liftAnnex $ tryAnnex $ do+	void $ liftAnnex $ tryNonAsync $ do 		cleanOldTmpMisc 		cleanReallyOldTmp
Assistant/Threads/Watcher.hs view
@@ -104,13 +104,13 @@ 		, errHook = errhook 		} 	scanevents <- liftAnnex $ annexStartupScan <$> Annex.getGitConfig-	handle <- liftIO $ watchDir "." ignored scanevents hooks startup+	h <- liftIO $ watchDir "." ignored scanevents hooks startup 	debug [ "watching", "."] 	 	{- Let the DirWatcher thread run until signalled to pause it, 	 - then wait for a resume signal, and restart. -} 	waitFor PauseWatcher $ do-		liftIO $ stopWatchDir handle+		liftIO $ stopWatchDir h 		waitFor ResumeWatcher runWatcher   where 	hook a = Just <$> asIO2 (runHandler a)@@ -184,7 +184,7 @@ runHandler handler file filestatus = void $ do 	r <- tryIO <~> handler (normalize file) filestatus 	case r of-		Left e -> liftIO $ print e+		Left e -> liftIO $ warningIO $ show e 		Right Nothing -> noop 		Right (Just change) -> do 			-- Just in case the commit thread is not
Assistant/Threads/XMPPClient.hs view
@@ -117,7 +117,7 @@ 		void $ liftIO $ atomically . swapTMVar lasttraffic =<< getCurrentTime 		inAssistant $ debug 			["received:", show $ map logXMPPEvent l]-		mapM_ (handle selfjid) l+		mapM_ (handlemsg selfjid) l 	sendpings selfjid lasttraffic = forever $ do 		putStanza pingstanza @@ -133,21 +133,21 @@ 		 - cause traffic, so good enough. -} 	  	pingstanza = xmppPing selfjid -	handle selfjid (PresenceMessage p) = do+	handlemsg selfjid (PresenceMessage p) = do 		void $ inAssistant $  			updateBuddyList (updateBuddies p) <<~ buddyList 		resendImportantMessages selfjid p-	handle _ (GotNetMessage QueryPresence) = putStanza gitAnnexSignature-	handle _ (GotNetMessage (NotifyPush us)) = void $ inAssistant $ pull us-	handle selfjid (GotNetMessage (PairingNotification stage c u)) =+	handlemsg _ (GotNetMessage QueryPresence) = putStanza gitAnnexSignature+	handlemsg _ (GotNetMessage (NotifyPush us)) = void $ inAssistant $ pull us+	handlemsg selfjid (GotNetMessage (PairingNotification stage c u)) = 		maybe noop (inAssistant . pairMsgReceived urlrenderer stage u selfjid) (parseJID c)-	handle _ (GotNetMessage m@(Pushing _ pushstage))+	handlemsg _ (GotNetMessage m@(Pushing _ pushstage)) 		| isPushNotice pushstage = inAssistant $ handlePushNotice m 		| isPushInitiation pushstage = inAssistant $ queuePushInitiation m 		| otherwise = inAssistant $ storeInbox m-	handle _ (Ignorable _) = noop-	handle _ (Unknown _) = noop-	handle _ (ProtocolError _) = noop+	handlemsg _ (Ignorable _) = noop+	handlemsg _ (Unknown _) = noop+	handlemsg _ (ProtocolError _) = noop  	resendImportantMessages selfjid (Presence { presenceFrom = Just jid }) = do 		let c = formatJID jid
Assistant/WebApp/Configurators/AWS.hs view
@@ -129,6 +129,7 @@ 				, ("type", "S3") 				, ("datacenter", T.unpack $ datacenter input) 				, ("storageclass", show $ storageClass input)+				, ("chunk", "1MiB") 				] 		_ -> $(widgetFile "configurators/adds3") #else
Assistant/WebApp/Configurators/Edit.hs view
@@ -42,6 +42,7 @@ import Annex.UUID import Assistant.Ssh import Config+import Logs.Web (webUUID)  import qualified Data.Text as T import qualified Data.Map as M@@ -191,26 +192,29 @@ postEditNewCloudRepositoryR uuid = connectionNeeded >> editForm True (RepoUUID uuid)  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) $-			error "unknown remote"-	curr <- liftAnnex $ getRepoConfig uuid mremote-	liftAnnex $ checkAssociatedDirectory curr mremote-	((result, form), enctype) <- liftH $-		runFormPostNoToken $ renderBootstrap3 bootstrapFormLayout $ editRepositoryAForm mremote curr-	case result of-		FormSuccess input -> liftH $ do-			setRepoConfig uuid mremote curr input-			liftAnnex $ checkAssociatedDirectory input mremote-			redirect DashboardR-		_ -> do-			let istransfer = repoGroup curr == RepoGroupStandard TransferGroup-			config <- liftAnnex $ M.lookup uuid <$> readRemoteLog-			let repoInfo = getRepoInfo mremote config-			let repoEncryption = getRepoEncryption mremote config-			$(widgetFile "configurators/edit/repository")+editForm new (RepoUUID uuid)+	| uuid == webUUID = page "The web" (Just Configuration) $ do+		$(widgetFile "configurators/edit/webrepository")+	| otherwise = page "Edit repository" (Just Configuration) $ do+		mremote <- liftAnnex $ Remote.remoteFromUUID uuid+		when (mremote == Nothing) $+			whenM ((/=) uuid <$> liftAnnex getUUID) $+				error "unknown remote"+		curr <- liftAnnex $ getRepoConfig uuid mremote+		liftAnnex $ checkAssociatedDirectory curr mremote+		((result, form), enctype) <- liftH $+			runFormPostNoToken $ renderBootstrap3 bootstrapFormLayout $ editRepositoryAForm mremote curr+		case result of+			FormSuccess input -> liftH $ do+				setRepoConfig uuid mremote curr input+				liftAnnex $ checkAssociatedDirectory input mremote+				redirect DashboardR+			_ -> do+				let istransfer = repoGroup curr == RepoGroupStandard TransferGroup+				config <- liftAnnex $ M.lookup uuid <$> readRemoteLog+				let repoInfo = getRepoInfo mremote config+				let repoEncryption = getRepoEncryption mremote config+				$(widgetFile "configurators/edit/repository") editForm _new r@(RepoName _) = page "Edit repository" (Just Configuration) $ do 	mr <- liftAnnex (repoIdRemote r) 	let repoInfo = getRepoInfo mr Nothing
Assistant/XMPP/Client.hs view
@@ -15,7 +15,6 @@ import Network import Control.Concurrent import qualified Data.Text as T-import Control.Exception (SomeException)  {- Everything we need to know to connect to an XMPP server. -} data XMPPCreds = XMPPCreds@@ -34,18 +33,18 @@  {- Do a SRV lookup, but if it fails, fall back to the cached xmppHostname. -} connectXMPP' :: JID -> XMPPCreds -> (JID -> XMPP a) -> IO [(HostPort, Either SomeException ())]-connectXMPP' jid c a = reverse <$> (handle =<< lookupSRV srvrecord)+connectXMPP' jid c a = reverse <$> (handlesrv =<< lookupSRV srvrecord)   where 	srvrecord = mkSRVTcp "xmpp-client" $ 		T.unpack $ strDomain $ jidDomain jid 	serverjid = JID Nothing (jidDomain jid) Nothing -	handle [] = do+	handlesrv [] = do 		let h = xmppHostname c 		let p = PortNumber $ fromIntegral $ xmppPort c 		r <- run h p $ a jid 		return [r]-	handle srvs = go [] srvs+	handlesrv srvs = go [] srvs  	go l [] = return l 	go l ((h,p):rest) = do
Assistant/XMPP/Git.hs view
@@ -150,16 +150,16 @@ 					SendPackOutput seqnum' b 				toxmpp seqnum' inh 	-	fromxmpp outh controlh = withPushMessagesInSequence cid SendPack handle+	fromxmpp outh controlh = withPushMessagesInSequence cid SendPack handlemsg 	  where-	  	handle (Just (Pushing _ (ReceivePackOutput _ b))) = +	  	handlemsg (Just (Pushing _ (ReceivePackOutput _ b))) =  			liftIO $ writeChunk outh b-		handle (Just (Pushing _ (ReceivePackDone exitcode))) =+		handlemsg (Just (Pushing _ (ReceivePackDone exitcode))) = 			liftIO $ do 				hPrint controlh exitcode 				hFlush controlh-		handle (Just _) = noop-		handle Nothing = do+		handlemsg (Just _) = noop+		handlemsg Nothing = do 			debug ["timeout waiting for git receive-pack output via XMPP"] 			-- Send a synthetic exit code to git-annex 			-- xmppgit, which will exit and cause git push@@ -264,12 +264,12 @@ 			let seqnum' = succ seqnum 			sendNetMessage $ Pushing cid $ ReceivePackOutput seqnum' b 			relaytoxmpp seqnum' outh-	relayfromxmpp inh = withPushMessagesInSequence cid ReceivePack handle+	relayfromxmpp inh = withPushMessagesInSequence cid ReceivePack handlemsg 	  where-	  	handle (Just (Pushing _ (SendPackOutput _ b))) =+	  	handlemsg (Just (Pushing _ (SendPackOutput _ b))) = 			liftIO $ writeChunk inh b-		handle (Just _) = noop-		handle Nothing = do+		handlemsg (Just _) = noop+		handlemsg Nothing = do 			debug ["timeout waiting for git send-pack output via XMPP"] 			-- closing the handle will make git receive-pack exit 			liftIO $ do
Backend.hs view
@@ -14,7 +14,8 @@ 	isAnnexLink, 	chooseBackend, 	lookupBackendName,-	maybeLookupBackendName+	maybeLookupBackendName,+	isStableKey, ) where  import Common.Annex@@ -32,6 +33,8 @@ import qualified Backend.WORM import qualified Backend.URL +import qualified Data.Map as M+ list :: [Backend] list = Backend.Hash.backends ++ Backend.WORM.backends ++ Backend.URL.backends @@ -116,7 +119,13 @@ lookupBackendName s = fromMaybe unknown $ maybeLookupBackendName s   where 	unknown = error $ "unknown backend " ++ s+ maybeLookupBackendName :: String -> Maybe Backend-maybeLookupBackendName s = headMaybe matches-  where-	matches = filter (\b -> s == B.name b) list+maybeLookupBackendName s = M.lookup s nameMap++nameMap :: M.Map String Backend+nameMap = M.fromList $ zip (map B.name list) list++isStableKey :: Key -> Bool+isStableKey k = maybe False (`B.isStableKey` k) +	(maybeLookupBackendName (keyBackendName k))
Backend/Hash.hs view
@@ -7,7 +7,10 @@  {-# LANGUAGE CPP #-} -module Backend.Hash (backends) where+module Backend.Hash (+	backends,+	testKeyBackend,+) where  import Common.Annex import qualified Annex@@ -36,24 +39,23 @@  {- The SHA256E backend is the default, so genBackendE comes first. -} backends :: [Backend]-backends = catMaybes $ map genBackendE hashes ++ map genBackend hashes+backends = map genBackendE hashes ++ map genBackend hashes -genBackend :: Hash -> Maybe Backend-genBackend hash = Just Backend+genBackend :: Hash -> Backend+genBackend hash = Backend 	{ name = hashName hash 	, getKey = keyValue hash 	, fsckKey = Just $ checkKeyChecksum hash 	, canUpgradeKey = Just needsUpgrade 	, fastMigrate = Just trivialMigrate+	, isStableKey = const True 	} -genBackendE :: Hash -> Maybe Backend-genBackendE hash = do-	b <- genBackend hash-	return $ b -		{ name = hashNameE hash-		, getKey = keyValueE hash-		}+genBackendE :: Hash -> Backend+genBackendE hash = (genBackend hash)+	{ name = hashNameE hash+	, getKey = keyValueE hash+	}  hashName :: Hash -> String hashName (SHAHash size) = "SHA" ++ show size@@ -175,3 +177,18 @@ 	| hashsize == 512 = show . skein512 #endif 	| otherwise = error $ "unsupported skein size " ++ show hashsize++{- A varient of the SHA256E backend, for testing that needs special keys+ - that cannot collide with legitimate keys in the repository.+ -+ - This is accomplished by appending a special extension to the key,+ - that is not one that selectExtension would select (due to being too+ - long).+ -}+testKeyBackend :: Backend+testKeyBackend = +	let b = genBackendE (SHAHash 256)+	in b { getKey = (fmap addE) <$$> getKey b } +  where+	addE k = k { keyName = keyName k ++ longext }+	longext = ".this-is-a-test-key"
Backend/URL.hs view
@@ -25,6 +25,9 @@ 	, fsckKey = Nothing 	, canUpgradeKey = Nothing 	, fastMigrate = Nothing+	-- The content of an url can change at any time, so URL keys are+	-- not stable.+	, isStableKey = const False 	}  {- Every unique url has a corresponding key. -}
Backend/WORM.hs view
@@ -23,6 +23,7 @@ 	, fsckKey = Nothing 	, canUpgradeKey = Nothing 	, fastMigrate = Nothing+	, isStableKey = const True 	}  {- The key includes the file size, modification time, and the@@ -35,8 +36,8 @@ keyValue :: KeySource -> Annex (Maybe Key) keyValue source = do 	stat <- liftIO $ getFileStatus $ contentLocation source-	n <- genKeyName $ keyFilename source-	return $ Just Key+	n <- genKeyName $ takeFileName $ keyFilename source+	return $ Just $ stubKey 		{ keyName = n 		, keyBackendName = name backend 		, keySize = Just $ fromIntegral $ fileSize stat
Build/EvilSplicer.hs view
@@ -46,7 +46,7 @@  import Utility.Monad import Utility.Misc-import Utility.Exception+import Utility.Exception hiding (try) import Utility.Path import Utility.FileSystemEncoding
CHANGELOG view
@@ -1,3 +1,48 @@+git-annex (5.20140817) unstable; urgency=medium++  * New chunk= option to chunk files stored in special remotes.+    Supported by: directory, S3, webdav, gcrypt, rsync, and all external+    and hook special remotes.+  * Partially transferred files are automatically resumed when using+    chunked remotes!+  * The old chunksize= option is deprecated. Do not use for new remotes.+  * Legacy code for directory remotes using the old chunksize= option+    will keep them working, but more slowly than before.+  * webapp: Automatically install Konqueror integration scripts+    to get and drop files.+  * repair: Removing bad objects could leave fsck finding no more+    unreachable objects, but some branches no longer accessible.+    Fix this, including support for fixing up repositories that+    were incompletely repaired before.+  * Fix cost calculation for non-encrypted remotes.+  * Display exception message when a transfer fails due to an exception.+  * WebDAV: Sped up by avoiding making multiple http connections+    when storing a file.+  * WebDAV: Avoid buffering whole file in memory when uploading and+    downloading.+  * WebDAV: Dropped support for DAV before 1.0.+  * testremote: New command to test uploads/downloads to a remote.+  * Dropping an object from a bup special remote now deletes the git branch+    for the object, although of course the object's content cannot be deleted+    due to the nature of bup.+  * unlock: Better error handling; continue past files that are not available+    or cannot be unlocked due to disk space, and try all specified files.+  * Windows: Now uses actual inode equivilants in new direct mode+    repositories, for safer detection of eg, renaming of files with the same+    size and mtime.+  * direct: Fix ugly warning messages.+  * WORM backend: When adding a file in a subdirectory, avoid including the+    subdirectory in the key name.+  * S3, Glacier, WebDAV: Fix bug that prevented accessing the creds+    when the repository was configured with encryption=shared embedcreds=yes.+  * direct: Avoid leaving file content in misctemp if interrupted.+  * git-annex-shell sendkey: Don't fail if a remote asks for a key to be sent+    that already has a transfer lock file indicating it's being sent to that+    remote. The remote may have moved between networks, or reconnected.+  * Switched from the old haskell HTTP library to http-conduit.++ -- Joey Hess <joeyh@debian.org>  Sun, 17 Aug 2014 10:30:58 -0400+ git-annex (5.20140717) unstable; urgency=high    * Fix minor FD leak in journal code. Closes: #754608
CmdLine/Action.hs view
@@ -13,7 +13,6 @@ import qualified Annex import Types.Command import qualified Annex.Queue-import Annex.Exception  type CommandActionRunner = CommandStart -> CommandCleanup @@ -37,14 +36,14 @@  -   - This should only be run in the seek stage. -} commandAction :: CommandActionRunner-commandAction a = handle =<< tryAnnexIO go+commandAction a = account =<< tryIO go   where 	go = do 		Annex.Queue.flushWhenFull 		callCommandAction a-	handle (Right True) = return True-	handle (Right False) = incerr-	handle (Left err) = do+	account (Right True) = return True+	account (Right False) = incerr+	account (Left err) = do 		showErr err 		showEndFail 		incerr
CmdLine/GitAnnex.hs view
@@ -96,9 +96,10 @@ #endif import qualified Command.RemoteDaemon #endif-import qualified Command.Test #ifdef WITH_TESTSUITE+import qualified Command.Test import qualified Command.FuzzTest+import qualified Command.TestRemote #endif #ifdef WITH_EKG import System.Remote.Monitoring@@ -187,9 +188,10 @@ #endif 	, Command.RemoteDaemon.def #endif-	, Command.Test.def #ifdef WITH_TESTSUITE+	, Command.Test.def 	, Command.FuzzTest.def+	, Command.TestRemote.def #endif 	]
Command/Add.hs view
@@ -10,7 +10,6 @@ module Command.Add where  import Common.Annex-import Annex.Exception import Command import Types.KeySource import Backend@@ -33,6 +32,8 @@ import Annex.ReplaceFile import Utility.Tmp +import Control.Exception (IOException)+ def :: [Command] def = [notBareRepo $ withOptions [includeDotFilesOption] $ 	command "add" paramPaths seek SectionCommon@@ -103,7 +104,7 @@ lockDown' :: FilePath -> Annex (Either IOException KeySource) lockDown' file = ifM crippledFileSystem 	( withTSDelta $ liftIO . tryIO . nohardlink-	, tryAnnexIO $ do+	, tryIO $ do 		tmp <- fromRepo gitAnnexTmpMiscDir 		createAnnexDirectory tmp 		go tmp@@ -167,7 +168,7 @@ 		)  	goindirect (Just (key, _)) mcache ms = do-		catchAnnex (moveAnnex key $ contentLocation source)+		catchNonAsync (moveAnnex key $ contentLocation source) 			(undo (keyFilename source) key) 		maybe noop (genMetaData key (keyFilename source)) ms 		liftIO $ nukeFile $ keyFilename source@@ -206,23 +207,23 @@  {- On error, put the file back so it doesn't seem to have vanished.  - This can be called before or after the symlink is in place. -}-undo :: FilePath -> Key -> IOException -> Annex a+undo :: FilePath -> Key -> SomeException -> Annex a undo file key e = do 	whenM (inAnnex key) $ do 		liftIO $ nukeFile file-		catchAnnex (fromAnnex key file) tryharder+		catchNonAsync (fromAnnex key file) tryharder 		logStatus key InfoMissing-	throwAnnex e+	throwM e   where 	-- fromAnnex could fail if the file ownership is weird-	tryharder :: IOException -> Annex ()+	tryharder :: SomeException -> Annex () 	tryharder _ = do 		src <- calcRepo $ gitAnnexLocation key 		liftIO $ moveFile src file  {- Creates the symlink to the annexed content, returns the link target. -} link :: FilePath -> Key -> Maybe InodeCache -> Annex String-link file key mcache = flip catchAnnex (undo file key) $ do+link file key mcache = flip catchNonAsync (undo file key) $ do 	l <- inRepo $ gitAnnexLink file key 	replaceFile file $ makeAnnexLink l
Command/Direct.hs view
@@ -7,8 +7,6 @@  module Command.Direct where -import Control.Exception.Extensible- import Common.Annex import Command import qualified Git@@ -16,7 +14,6 @@ import qualified Git.Branch import Config import Annex.Direct-import Annex.Exception  def :: [Command] def = [notBareRepo $ noDaemonRunning $@@ -52,7 +49,7 @@ 			Nothing -> noop 			Just a -> do 				showStart "direct" f-				r' <- tryAnnex a+				r' <- tryNonAsync a 				case r' of 					Left e -> warnlocked e 					Right _ -> showEndOk
Command/FuzzTest.hs view
@@ -13,7 +13,6 @@ import qualified Git.Config import Config import Utility.ThreadScheduler-import Annex.Exception import Utility.DiskFree  import Data.Time.Clock@@ -22,7 +21,7 @@ import Control.Concurrent  def :: [Command]-def = [ notBareRepo $ command "fuzztest" paramNothing seek SectionPlumbing+def = [ notBareRepo $ command "fuzztest" paramNothing seek SectionTesting 	"generates fuzz test files"]  seek :: CommandSeek@@ -56,7 +55,7 @@ fuzz logh = do 	action <- genFuzzAction 	record logh $ flip Started action-	result <- tryAnnex $ runFuzzAction action+	result <- tryNonAsync $ runFuzzAction action 	record logh $ flip Finished $ 		either (const False) (const True) result
Command/ImportFeed.hs view
@@ -227,9 +227,13 @@ #endif  extractMetaData :: ToDownload -> MetaData+#if MIN_VERSION_feed(0,3,9) extractMetaData i = case getItemPublishDate (item i) :: Maybe (Maybe UTCTime) of 	Just (Just d) -> unionMetaData meta (dateMetaData d meta) 	_ -> meta+#else+extractMetaData i = meta+#endif   where 	tometa (k, v) = (mkMetaFieldUnchecked k, S.singleton (toMetaValue v)) 	meta = MetaData $ M.fromList $ map tometa $ extractFields i
Command/Indirect.hs view
@@ -7,8 +7,6 @@  module Command.Indirect where -import Control.Exception.Extensible- import Common.Annex import Command import qualified Git@@ -21,7 +19,6 @@ import Annex.Content import Annex.Content.Direct import Annex.CatFile-import Annex.Exception import Annex.Init import qualified Command.Add @@ -88,12 +85,12 @@ 		removeInodeCache k 		removeAssociatedFiles k 		whenM (liftIO $ not . isSymbolicLink <$> getSymbolicLinkStatus f) $ do-			v <-tryAnnexIO (moveAnnex k f)+			v <- tryNonAsync (moveAnnex k f) 			case v of 				Right _ -> do  					l <- inRepo $ gitAnnexLink f k 					liftIO $ createSymbolicLink l f-				Left e -> catchAnnex (Command.Add.undo f k e)+				Left e -> catchNonAsync (Command.Add.undo f k e) 					warnlocked 		showEndOk
Command/Map.hs view
@@ -7,7 +7,6 @@  module Command.Map where -import Control.Exception.Extensible import qualified Data.Map as M  import Common.Annex@@ -201,7 +200,7 @@ 	  where 		p = proc cmd $ toCommand params -	configlist = Ssh.onRemote r (pipedconfig, Nothing) "configlist" [] []+	configlist = Ssh.onRemote r (pipedconfig, return Nothing) "configlist" [] [] 	manualconfiglist = do 		gc <- Annex.getRemoteGitConfig r 		sshparams <- Ssh.toRepo r gc [Param sshcmd]@@ -247,7 +246,7 @@  safely :: IO Git.Repo -> IO (Maybe Git.Repo) safely a = do-	result <- try a :: IO (Either SomeException Git.Repo)+	result <- tryNonAsync a 	case result of 		Left _ -> return Nothing 		Right r' -> return $ Just r'
Command/Move.hs view
@@ -152,17 +152,17 @@ fromPerform :: Remote -> Bool -> Key -> AssociatedFile -> CommandPerform fromPerform src move key afile = moveLock move key $ 	ifM (inAnnex key)-		( handle move True-		, handle move =<< go+		( dispatch move True+		, dispatch move =<< go 		)   where 	go = notifyTransfer Download afile $  		download (Remote.uuid src) key afile noRetry $ \p -> do 			showAction $ "from " ++ Remote.name src 			getViaTmp key $ \t -> Remote.retrieveKeyFile src key afile t p-	handle _ False = stop -- failed-	handle False True = next $ return True -- copy complete-	handle True True = do -- finish moving+	dispatch _ False = stop -- failed+	dispatch False True = next $ return True -- copy complete+	dispatch True True = do -- finish moving 		ok <- Remote.removeKey src key 		next $ Command.Drop.cleanupRemote key src ok
Command/PreCommit.hs view
@@ -19,7 +19,6 @@ import Annex.View import Annex.View.ViewedFile import Annex.Perms-import Annex.Exception import Logs.View import Logs.MetaData import Types.View
Command/RecvKey.hs view
@@ -28,18 +28,15 @@ seek = withKeys start  start :: Key -> CommandStart-start key = ifM (inAnnex key)-	( error "key is already present in annex"-	, fieldTransfer Download key $ \_p ->-		ifM (getViaTmp key go)-			( do-				-- forcibly quit after receiving one key,-				-- and shutdown cleanly-				_ <- shutdown True-				return True-			, return False-			)-	)+start key = fieldTransfer Download key $ \_p ->+	ifM (getViaTmp key go)+		( do+			-- forcibly quit after receiving one key,+			-- and shutdown cleanly+			_ <- shutdown True+			return True+		, return False+		)   where 	go tmp = do 		opts <- filterRsyncSafeOptions . maybe [] words
Command/SendKey.hs view
@@ -44,6 +44,14 @@ fieldTransfer direction key a = do 	afile <- Fields.getField Fields.associatedFile 	ok <- maybe (a $ const noop)-		(\u -> runTransfer (Transfer direction (toUUID u) key) afile noRetry a)+		(\u -> runner (Transfer direction (toUUID u) key) afile noRetry a) 		=<< Fields.getField Fields.remoteUUID 	liftIO $ exitBool ok+  where+	{- Allow the key to be sent to the remote even if there seems to be+	 - another transfer of that key going on to that remote.+	 - That one may be stale, etc.+	 -}+	runner+		| direction == Upload = alwaysRunTransfer+		| otherwise = runTransfer
Command/Test.hs view
@@ -13,7 +13,7 @@  def :: [Command] def = [ noRepo startIO $ dontCheck repoExists $-	command "test" paramNothing seek SectionPlumbing+	command "test" paramNothing seek SectionTesting 		"run built-in test suite"]  seek :: CommandSeek
+ Command/TestRemote.hs view
@@ -0,0 +1,228 @@+{- git-annex command+ -+ - Copyright 2014 Joey Hess <joey@kitenet.net>+ -+ - Licensed under the GNU GPL version 3 or higher.+ -}++module Command.TestRemote where++import Common+import Command+import qualified Annex+import qualified Remote+import qualified Types.Remote as Remote+import Types+import Types.Key (key2file, keyBackendName, keySize)+import Types.Backend (getKey, fsckKey)+import Types.KeySource+import Annex.Content+import Backend+import qualified Backend.Hash+import Utility.Tmp+import Utility.Metered+import Utility.DataUnits+import Utility.CopyFile+import Messages+import Types.Messages+import Remote.Helper.Chunked+import Locations++import Test.Tasty+import Test.Tasty.Runners+import Test.Tasty.HUnit+import "crypto-api" Crypto.Random+import qualified Data.ByteString as B+import qualified Data.ByteString.Lazy as L+import qualified Data.Map as M++def :: [Command]+def = [ withOptions [sizeOption] $+		command "testremote" paramRemote seek SectionTesting+			"test transfers to/from a remote"]++sizeOption :: Option+sizeOption = fieldOption [] "size" paramSize "base key size (default 1MiB)"++seek :: CommandSeek+seek ps = do+	basesz <- fromInteger . fromMaybe (1024 * 1024)+		<$> getOptionField sizeOption (pure . getsize)+	withWords (start basesz) ps+  where+	getsize v = v >>= readSize dataUnits++start :: Int -> [String] -> CommandStart+start basesz ws = do+	let name = unwords ws+	showStart "testremote" name+	r <- either error id <$> Remote.byName' name+	showSideAction "generating test keys"+	fast <- Annex.getState Annex.fast+	ks <- mapM randKey (keySizes basesz fast)+	rs <- catMaybes <$> mapM (adjustChunkSize r) (chunkSizes basesz fast)+	rs' <- concat <$> mapM encryptionVariants rs+	unavailrs  <- catMaybes <$> mapM Remote.mkUnavailable [r]+	next $ perform rs' unavailrs ks++perform :: [Remote] -> [Remote] -> [Key] -> CommandPerform+perform rs unavailrs ks = do+	st <- Annex.getState id+	let tests = testGroup "Remote Tests" $ concat+		[ [ testGroup "unavailable remote" (testUnavailable st r (Prelude.head ks)) | r <- unavailrs ]+		, [ testGroup (desc r k) (test st r k) | k <- ks, r <- rs ]+		]+	ok <- case tryIngredients [consoleTestReporter] mempty tests of+		Nothing -> error "No tests found!?"+		Just act -> liftIO act+	next $ cleanup rs ks ok+  where+	desc r' k = intercalate "; " $ map unwords+		[ [ "key size", show (keySize k) ]+		, [ show (getChunkConfig (Remote.config r')) ]+		, ["encryption", fromMaybe "none" (M.lookup "encryption" (Remote.config r'))]+		]++adjustChunkSize :: Remote -> Int -> Annex (Maybe Remote)+adjustChunkSize r chunksize = adjustRemoteConfig r+	(M.insert "chunk" (show chunksize))++-- Variants of a remote with no encryption, and with simple shared+-- encryption. Gpg key based encryption is not tested.+encryptionVariants :: Remote -> Annex [Remote]+encryptionVariants r = do+	noenc <- adjustRemoteConfig r (M.insert "encryption" "none")+	sharedenc <- adjustRemoteConfig r $+		M.insert "encryption" "shared" .+		M.insert "highRandomQuality" "false"+	return $ catMaybes [noenc, sharedenc]++-- Regenerate a remote with a modified config.+adjustRemoteConfig :: Remote -> (Remote.RemoteConfig -> Remote.RemoteConfig) -> Annex (Maybe Remote)+adjustRemoteConfig r adjustconfig = Remote.generate (Remote.remotetype r)+	(Remote.repo r)+	(Remote.uuid r)+	(adjustconfig (Remote.config r))+	(Remote.gitconfig r)++test :: Annex.AnnexState -> Remote -> Key -> [TestTree]+test st r k =+	[ check "removeKey when not present" remove+	, present False+	, check "storeKey" store+	, present True+	, check "storeKey when already present" store+	, present True+	, check "retrieveKeyFile" $ do+		removeAnnex k+		get+	, check "fsck downloaded object" fsck+	, check "retrieveKeyFile resume from 33%" $ do+		loc <- Annex.calcRepo (gitAnnexLocation k)+		tmp <- prepTmp k+		partial <- liftIO $ bracket (openBinaryFile loc ReadMode) hClose $ \h -> do+			sz <- hFileSize h+			L.hGet h $ fromInteger $ sz `div` 3+		liftIO $ L.writeFile tmp partial+		removeAnnex k+		get+	, check "fsck downloaded object" fsck+	, check "retrieveKeyFile resume from 0" $ do+		tmp <- prepTmp k+		liftIO $ writeFile tmp ""+		removeAnnex k+		get+	, check "fsck downloaded object" fsck+	, check "retrieveKeyFile resume from end" $ do+		loc <- Annex.calcRepo (gitAnnexLocation k)+		tmp <- prepTmp k+		void $ liftIO $ copyFileExternal loc tmp+		removeAnnex k+		get+	, check "fsck downloaded object" fsck+	, check "removeKey when present" remove+	, present False+	]+  where+	check desc a = testCase desc $+		Annex.eval st (Annex.setOutput QuietOutput >> a) @? "failed"+	present b = check ("present " ++ show b) $+		(== Right b) <$> Remote.hasKey r k+	fsck = case maybeLookupBackendName (keyBackendName k) of+		Nothing -> return True+		Just b -> case fsckKey b of+			Nothing -> return True+			Just fscker -> fscker k (key2file k)+	get = getViaTmp k $ \dest ->+		Remote.retrieveKeyFile r k Nothing dest nullMeterUpdate+	store = Remote.storeKey r k Nothing nullMeterUpdate+	remove = Remote.removeKey r k++testUnavailable :: Annex.AnnexState -> Remote -> Key -> [TestTree]+testUnavailable st r k =+	[ check (== Right False) "removeKey" $+		Remote.removeKey r k+	, check (== Right False) "storeKey" $+		Remote.storeKey r k Nothing nullMeterUpdate+	, check (`notElem` [Right True, Right False]) "checkPresent" $+		Remote.checkPresent r k+	, check (== Right False) "retrieveKeyFile" $+		getViaTmp k $ \dest ->+			Remote.retrieveKeyFile r k Nothing dest nullMeterUpdate+	, check (== Right False) "retrieveKeyFileCheap" $+		getViaTmp k $ \dest ->+			Remote.retrieveKeyFileCheap r k dest+	]+  where+	check checkval desc a = testCase desc $ do+		v <- Annex.eval st $ do+			Annex.setOutput QuietOutput+			either (Left  . show) Right <$> tryNonAsync a+		checkval v  @? ("(got: " ++ show v ++ ")")++cleanup :: [Remote] -> [Key] -> Bool -> CommandCleanup+cleanup rs ks ok = do+	forM_ rs $ \r -> forM_ ks (Remote.removeKey r)+	forM_ ks removeAnnex+	return ok++chunkSizes :: Int -> Bool -> [Int]+chunkSizes base False =+	[ 0 -- no chunking+	, base `div` 100+	, base `div` 1000+	, base+	]+chunkSizes _ True =+	[ 0+	]++keySizes :: Int -> Bool -> [Int]+keySizes base fast = filter want+	[ 0 -- empty key is a special case when chunking+	, base+	, base + 1+	, base - 1+	, base * 2+	]+  where+	want sz+		| fast = sz <= base && sz > 0+		| otherwise = sz > 0++randKey :: Int -> Annex Key+randKey sz = withTmpFile "randkey" $ \f h -> do+	gen <- liftIO (newGenIO :: IO SystemRandom)+	case genBytes sz gen of+		Left e -> error $ "failed to generate random key: " ++ show e+		Right (rand, _) -> liftIO $ B.hPut h rand+	liftIO $ hClose h+	let ks = KeySource+		{ keyFilename = f+		, contentLocation = f+		, inodeCache = Nothing+		}+	k <- fromMaybe (error "failed to generate random key")+		<$> getKey Backend.Hash.testKeyBackend ks+	moveAnnex k f+	return k
Command/Unlock.hs view
@@ -28,13 +28,20 @@ start :: FilePath -> Key -> CommandStart start file key = do 	showStart "unlock" file-	next $ perform file key+	ifM (inAnnex key)+		( ifM (checkDiskSpace Nothing key 0)+			( next $ perform file key+			, do+				warning "not enough disk space to copy file"+				next $ next $ return False+			)+		, do+			warning "content not present; cannot unlock"+			next $ next $ return False+		)  perform :: FilePath -> Key -> CommandPerform perform dest key = do-	unlessM (inAnnex key) $ error "content not present"-	unlessM (checkDiskSpace Nothing key 0) $ error "cannot unlock"- 	src <- calcRepo $ gitAnnexLocation key 	tmpdest <- fromRepo $ gitAnnexTmpObjectLocation key 	liftIO $ createDirectoryIfMissing True (parentDir tmpdest)@@ -46,5 +53,7 @@ 				moveFile tmpdest dest 			thawContent dest 			next $ return True-		, error "copy failed!"+		, do+			warning "copy failed!"+			next $ return False 		)
Command/Vicfg.hs view
@@ -217,7 +217,7 @@ 		| null l = Right cfg 		| "#" `isPrefixOf` l = Right cfg 		| null setting || null f = Left "missing field"-		| otherwise = handle cfg f setting value'+		| otherwise = parsed cfg f setting value' 	  where 		(setting, rest) = separate isSpace l 		(r, value) = separate (== '=') rest@@ -225,7 +225,7 @@ 		f = reverse $ trimspace $ reverse $ trimspace r 		trimspace = dropWhile isSpace -	handle cfg f setting value+	parsed cfg f setting value 		| setting == "trust" = case readTrustLevel value of 			Nothing -> badval "trust value" value 			Just t ->
Common.hs view
@@ -6,7 +6,6 @@ import Control.Monad.IfElse as X import Control.Applicative as X import "mtl" Control.Monad.State.Strict as X (liftIO)-import Control.Exception.Extensible as X (IOException)  import Data.Maybe as X import Data.List as X hiding (head, tail, init, last)
Creds.hs view
@@ -23,7 +23,7 @@ import Utility.FileMode import Crypto import Types.Remote (RemoteConfig, RemoteConfigKey)-import Remote.Helper.Encryptable (remoteCipher, embedCreds)+import Remote.Helper.Encryptable (remoteCipher, remoteCipher', embedCreds) import Utility.Env (getEnv)  import qualified Data.ByteString.Lazy.Char8 as L@@ -85,15 +85,19 @@ 	fromcache = maybe fromconfig (return . Just) =<< readCacheCredPair storage 	fromconfig = case credPairRemoteKey storage of 		Just key -> do-			mcipher <- remoteCipher c-			case (M.lookup key c, mcipher) of-				(Nothing, _) -> return Nothing-				(Just enccreds, Just cipher) -> do+			mcipher <- remoteCipher' c+			case (mcipher, M.lookup key c) of+				(_, Nothing) -> return Nothing+				(Just (_cipher, SharedCipher {}), Just bcreds) ->+					-- When using a shared cipher, the+					-- creds are not stored encrypted.+					fromcreds $ fromB64 bcreds+				(Just (cipher, _), Just enccreds) -> do 					creds <- liftIO $ decrypt cipher 						(feedBytes $ L.pack $ fromB64 enccreds) 						(readBytes $ return . L.unpack) 					fromcreds creds-				(Just bcreds, Nothing) ->+				(Nothing, Just bcreds) -> 					fromcreds $ fromB64 bcreds 		Nothing -> return Nothing 	fromcreds creds = case decodeCredPair creds of
Crypto.hs view
@@ -3,16 +3,18 @@  - Currently using gpg; could later be modified to support different  - crypto backends if neccessary.  -- - Copyright 2011-2012 Joey Hess <joey@kitenet.net>+ - Copyright 2011-2014 Joey Hess <joey@kitenet.net>  -  - Licensed under the GNU GPL version 3 or higher.  -}  {-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE Rank2Types #-}  module Crypto ( 	Cipher, 	KeyIds(..),+	EncKey, 	StorableCipher(..), 	genEncryptedCipher, 	genSharedCipher,@@ -20,6 +22,7 @@ 	describeCipher, 	decryptCipher,		 	encryptKey,+	isEncKey, 	feedFile, 	feedBytes, 	readBytes,@@ -34,6 +37,7 @@ import Data.ByteString.Lazy.UTF8 (fromString) import Control.Applicative import qualified Data.Map as M+import Control.Monad.IO.Class  import Common.Annex import qualified Utility.Gpg as Gpg@@ -138,19 +142,25 @@ 		Hybrid -> Cipher 		PubKey -> MacOnlyCipher +type EncKey = Key -> Key+ {- Generates an encrypted form of a Key. The encryption does not need to be  - reversable, nor does it need to be the same type of encryption used  - on content. It does need to be repeatable. -}-encryptKey :: Mac -> Cipher -> Key -> Key-encryptKey mac c k = Key+encryptKey :: Mac -> Cipher -> EncKey+encryptKey mac c k = stubKey 	{ keyName = macWithCipher mac c (key2file k)-	, keyBackendName = "GPG" ++ showMac mac-	, keySize = Nothing -- size and mtime omitted-	, keyMtime = Nothing -- to avoid leaking data+	, keyBackendName = encryptedBackendNamePrefix ++ showMac mac 	} +encryptedBackendNamePrefix :: String+encryptedBackendNamePrefix = "GPG"++isEncKey :: Key -> Bool+isEncKey k = encryptedBackendNamePrefix `isPrefixOf` keyBackendName k+ type Feeder = Handle -> IO ()-type Reader a = Handle -> IO a+type Reader m a = Handle -> m a  feedFile :: FilePath -> Feeder feedFile f h = L.hPut h =<< L.readFile f@@ -158,8 +168,8 @@ feedBytes :: L.ByteString -> Feeder feedBytes = flip L.hPut -readBytes :: (L.ByteString -> IO a) -> Reader a-readBytes a h = L.hGetContents h >>= a+readBytes :: (MonadIO m) => (L.ByteString -> m a) -> Reader m a+readBytes a h = liftIO (L.hGetContents h) >>= a  {- Runs a Feeder action, that generates content that is symmetrically  - encrypted with the Cipher (unless it is empty, in which case@@ -167,7 +177,7 @@  - read by the Reader action.  Note: For public-key encryption,  - recipients MUST be included in 'params' (for instance using  - 'getGpgEncParams'). -}-encrypt :: [CommandParam] -> Cipher -> Feeder -> Reader a -> IO a+encrypt :: (MonadIO m, MonadMask m) => [CommandParam] -> Cipher -> Feeder -> Reader m a -> m a encrypt params cipher = case cipher of 	Cipher{} -> Gpg.feedRead (params ++ Gpg.stdEncryptionParams True) $ 			cipherPassphrase cipher@@ -176,7 +186,7 @@ {- Runs a Feeder action, that generates content that is decrypted with the  - Cipher (or using a private key if the Cipher is empty), and read by the  - Reader action. -}-decrypt :: Cipher -> Feeder -> Reader a -> IO a+decrypt :: (MonadIO m, MonadMask m) => Cipher -> Feeder -> Reader m a -> m a decrypt cipher = case cipher of 	Cipher{} -> Gpg.feedRead [Param "--decrypt"] $ cipherPassphrase cipher 	MacOnlyCipher{} -> Gpg.pipeLazy [Param "--decrypt"]
Git/Config.hs view
@@ -9,7 +9,6 @@  import qualified Data.Map as M import Data.Char-import Control.Exception.Extensible  import Common import Git
Git/Repair.hs view
@@ -8,6 +8,7 @@ module Git.Repair ( 	runRepair, 	runRepairOf,+	removeBadBranches, 	successfulRepair, 	cleanCorruptObjects, 	retrieveMissingObjects,@@ -191,8 +192,11 @@  - any branches (filtered by a predicate) that reference them  - Returns a list of all removed branches.  -}-removeBadBranches :: (Ref -> Bool) -> MissingObjects -> GoodCommits -> Repo -> IO ([Branch], GoodCommits)-removeBadBranches removablebranch missing goodcommits r =+removeBadBranches :: (Ref -> Bool) -> Repo -> IO [Branch]+removeBadBranches removablebranch r = fst <$> removeBadBranches' removablebranch S.empty emptyGoodCommits r++removeBadBranches' :: (Ref -> Bool) -> MissingObjects -> GoodCommits -> Repo -> IO ([Branch], GoodCommits)+removeBadBranches' removablebranch missing goodcommits r = 	go [] goodcommits =<< filter removablebranch <$> getAllRefs r   where 	go removed gcs [] = return (removed, gcs)@@ -204,6 +208,11 @@ 				nukeBranchRef b r 				go (b:removed) gcs' bs +badBranches :: MissingObjects -> Repo -> IO [Branch]+badBranches missing r = filterM isbad =<< getAllRefs r+  where+	isbad b = not . fst <$> verifyCommit missing emptyGoodCommits b r+ {- Gets all refs, including ones that are corrupt.  - git show-ref does not output refs to commits that are directly  - corrupted, so it is not used.@@ -439,8 +448,12 @@ 	if foundBroken fsckresult 		then runRepair' removablebranch fsckresult forced Nothing g 		else do-			putStrLn "No problems found."-			return (True, [])+			bad <- badBranches S.empty g+			if null bad+				then do+					putStrLn "No problems found."+					return (True, [])+				else runRepair' removablebranch fsckresult forced Nothing g  runRepairOf :: FsckResults -> (Ref -> Bool) -> Bool -> Maybe FilePath -> Repo -> IO (Bool, [Branch]) runRepairOf fsckresult removablebranch forced referencerepo g = do@@ -455,9 +468,9 @@ 	case stillmissing of 		FsckFoundMissing s t 			| S.null s -> if repoIsLocalBare g-				then successfulfinish []+				then checkbadbranches s 				else ifM (checkIndex g)-					( successfulfinish []+					( checkbadbranches s 					, do 						putStrLn "No missing objects found, but the index file is corrupt!" 						if forced@@ -488,7 +501,7 @@ 			| otherwise -> unsuccessfulfinish   where 	repairbranches missing = do-		(removedbranches, goodcommits) <- removeBadBranches removablebranch missing emptyGoodCommits g+		(removedbranches, goodcommits) <- removeBadBranches' removablebranch missing emptyGoodCommits g 		let remotebranches = filter isTrackingBranch removedbranches 		unless (null remotebranches) $ 			putStrLn $ unwords@@ -502,6 +515,16 @@ 		displayList (map fromRef deletedbranches) 			"Deleted these local branches, which could not be recovered due to missing objects:" 		return (resetbranches ++ deletedbranches)++	checkbadbranches missing = do+		bad <- badBranches missing g+		case (null bad, forced) of+			(True, _) -> successfulfinish []+			(False, False) -> do+				displayList (map fromRef bad)+					"Some git branches refer to missing objects:"+				unsuccessfulfinish+			(False, True) -> successfulfinish =<< repairbranches missing  	forcerepair missing fscktruncated = do 		modifiedbranches <- repairbranches missing
Git/UpdateIndex.hs view
@@ -29,8 +29,6 @@ import Git.FilePath import Git.Sha -import Control.Exception (bracket)- {- Streamers are passed a callback and should feed it lines in the form  - read by update-index, and generated by ls-tree. -} type Streamer = (String -> IO ()) -> IO ()
INSTALL view
@@ -3,7 +3,7 @@ [[!table format=dsv header=yes data=""" detailed instructions             | quick install [[OSX]]                           | [download git-annex.app](http://downloads.kitenet.net/git-annex/OSX/current/)-&nbsp;&nbsp;[[Homebrew]]            | `brew install git-annex`+&nbsp;&nbsp;[[OSX/Homebrew]]      | `brew install git-annex` [[Android]]                       | [download git-annex.apk](http://downloads.kitenet.net/git-annex/android/current/) **beta** [[Linux|linux_standalone]]        | [download prebuilt linux tarball](http://downloads.kitenet.net/git-annex/linux/current/) &nbsp;&nbsp;[[Debian]]            | `apt-get install git-annex`@@ -16,8 +16,11 @@ &nbsp;&nbsp;[[ScientificLinux5]]  | &nbsp;&nbsp;[[openSUSE]]          |  &nbsp;&nbsp;[[Docker]]            | -[[Windows]]                       | [download installer](http://downloads.kitenet.net/git-annex/windows/current/) **alpha**+[[Windows]]                       | [download installer](http://downloads.kitenet.net/git-annex/windows/current/) **beta** """]]++All the downloads above use https for security. For added security, see+[[verifying_downloads]].  ## Using cabal
Limit.hs view
@@ -152,8 +152,8 @@ 	go num good = case readish num of 		Nothing -> Left "bad number for copies" 		Just n -> Right $ \notpresent -> checkKey $-			handle n good notpresent-	handle n good notpresent key = do+			go' n good notpresent+	go' n good notpresent key = do 		us <- filter (`S.notMember` notpresent) 			<$> (filterM good =<< Remote.keyLocations key) 		return $ length us >= n@@ -170,10 +170,10 @@ limitLackingCopies :: Bool -> MkLimit Annex limitLackingCopies approx want = case readish want of 	Just needed -> Right $ \notpresent mi -> flip checkKey mi $-		handle mi needed notpresent+		go mi needed notpresent 	Nothing -> Left "bad value for number of lacking copies"   where-	handle mi needed notpresent key = do+	go mi needed notpresent key = do 		NumCopies numcopies <- if approx 			then approxNumCopies 			else case mi of
Locations.hs view
@@ -421,6 +421,7 @@  - which do not allow using a directory "XX" when "xx" already exists.  - To support that, most repositories use the lower case hash for new data. -} type Hasher = Key -> FilePath+ annexHashes :: [Hasher] annexHashes = [hashDirLower, hashDirMixed] @@ -428,12 +429,12 @@ hashDirMixed k = addTrailingPathSeparator $ take 2 dir </> drop 2 dir   where 	dir = take 4 $ display_32bits_as_dir =<< [a,b,c,d]-	ABCD (a,b,c,d) = md5 $ md5FilePath $ key2file k+	ABCD (a,b,c,d) = md5 $ md5FilePath $ key2file $ nonChunkKey k  hashDirLower :: Hasher hashDirLower k = addTrailingPathSeparator $ take 3 dir </> drop 3 dir   where-	dir = take 6 $ md5s $ md5FilePath $ key2file k+	dir = take 6 $ md5s $ md5FilePath $ key2file $ nonChunkKey k  {- modified version of display_32bits_as_hex from Data.Hash.MD5  -   Copyright (C) 2001 Ian Lynagh
Logs.hs view
@@ -14,6 +14,7 @@ data LogVariety 	= UUIDBasedLog 	| NewUUIDBasedLog+	| ChunkLog Key 	| PresenceLog Key 	| OtherLog 	deriving (Show)@@ -24,6 +25,7 @@ getLogVariety f 	| f `elem` topLevelUUIDBasedLogs = Just UUIDBasedLog 	| isRemoteStateLog f = Just NewUUIDBasedLog+	| isChunkLog f = ChunkLog <$> chunkLogFileKey f 	| isMetaDataLog f || f `elem` otherLogs = Just OtherLog 	| otherwise = PresenceLog <$> firstJust (presenceLogs f) @@ -133,6 +135,25 @@ isRemoteStateLog :: FilePath -> Bool isRemoteStateLog path = remoteStateLogExt `isSuffixOf` path +{- The filename of the chunk log for a given key. -}+chunkLogFile :: Key -> FilePath+chunkLogFile key = hashDirLower key </> keyFile key ++ chunkLogExt++chunkLogFileKey :: FilePath -> Maybe Key+chunkLogFileKey path+	| ext == chunkLogExt = fileKey base+	| otherwise = Nothing+  where+  	file = takeFileName path+	(base, ext) = splitAt (length file - extlen) file+	extlen = length chunkLogExt++chunkLogExt :: String+chunkLogExt = ".log.cnk"++isChunkLog :: FilePath -> Bool+isChunkLog path = chunkLogExt `isSuffixOf` path+ {- The filename of the metadata log for a given key. -} metaDataLogFile :: Key -> FilePath metaDataLogFile key = hashDirLower key </> keyFile key ++ metaDataLogExt@@ -146,20 +167,23 @@ prop_logs_sane :: Key -> Bool prop_logs_sane dummykey = and 	[ isNothing (getLogVariety "unknown")-	, expect isUUIDBasedLog (getLogVariety uuidLog)-	, expect isPresenceLog (getLogVariety $ locationLogFile dummykey)-	, expect isPresenceLog (getLogVariety $ urlLogFile dummykey)-	, expect isNewUUIDBasedLog (getLogVariety $ remoteStateLogFile dummykey)-	, expect isOtherLog (getLogVariety $ metaDataLogFile dummykey)-	, expect isOtherLog (getLogVariety $ numcopiesLog)+	, expect gotUUIDBasedLog (getLogVariety uuidLog)+	, expect gotPresenceLog (getLogVariety $ locationLogFile dummykey)+	, expect gotPresenceLog (getLogVariety $ urlLogFile dummykey)+	, expect gotNewUUIDBasedLog (getLogVariety $ remoteStateLogFile dummykey)+	, expect gotChunkLog (getLogVariety $ chunkLogFile dummykey)+	, expect gotOtherLog (getLogVariety $ metaDataLogFile dummykey)+	, expect gotOtherLog (getLogVariety $ numcopiesLog) 	]   where   	expect = maybe False-  	isUUIDBasedLog UUIDBasedLog = True-	isUUIDBasedLog _ = False-  	isNewUUIDBasedLog NewUUIDBasedLog = True-	isNewUUIDBasedLog _ = False-	isPresenceLog (PresenceLog k) = k == dummykey-	isPresenceLog _ = False-	isOtherLog OtherLog = True-	isOtherLog _ = False+	gotUUIDBasedLog UUIDBasedLog = True+	gotUUIDBasedLog _ = False+  	gotNewUUIDBasedLog NewUUIDBasedLog = True+	gotNewUUIDBasedLog _ = False+	gotChunkLog (ChunkLog k) = k == dummykey+	gotChunkLog _ = False+	gotPresenceLog (PresenceLog k) = k == dummykey+	gotPresenceLog _ = False+	gotOtherLog OtherLog = True+	gotOtherLog _ = False
+ Logs/Chunk.hs view
@@ -0,0 +1,51 @@+{- Chunk logs.+ -+ - An object can be stored in chunked for on a remote; these logs keep+ - track of the chunk size used, and the number of chunks.+ -+ - It's possible for a single object to be stored multiple times on the+ - same remote using different chunk sizes. So, while this is a MapLog, it+ - is not a normal UUIDBased log. Intead, it's a map from UUID and chunk+ - size to number of chunks.+ -+ - Format: "timestamp uuid:chunksize chunkcount"+ -+ - Copyright 2014 Joey Hess <joey@kitenet.net>+ -+ - Licensed under the GNU GPL version 3 or higher.+ -}++module Logs.Chunk (+	ChunkMethod(..),+	ChunkSize,+	ChunkCount,+	chunksStored,+	chunksRemoved,+	getCurrentChunks,+) where++import Common.Annex+import Logs+import Logs.MapLog+import qualified Annex.Branch+import Logs.Chunk.Pure++import qualified Data.Map as M+import Data.Time.Clock.POSIX++chunksStored :: UUID -> Key -> ChunkMethod -> ChunkCount -> Annex ()+chunksStored u k chunkmethod chunkcount = do+	ts <- liftIO getPOSIXTime+	Annex.Branch.change (chunkLogFile k) $+		showLog . changeMapLog ts (u, chunkmethod) chunkcount . parseLog++chunksRemoved :: UUID -> Key -> ChunkMethod -> Annex ()+chunksRemoved u k chunkmethod = chunksStored u k chunkmethod 0++getCurrentChunks :: UUID -> Key -> Annex [(ChunkMethod, ChunkCount)]+getCurrentChunks u k = select . parseLog <$> Annex.Branch.get (chunkLogFile k)+  where+	select = filter (\(_m, ct) -> ct > 0)+		. map (\((_ku, m), l) -> (m, value l))+		. M.toList+		. M.filterWithKey (\(ku, _m) _ -> ku == u)
+ Logs/Chunk/Pure.hs view
@@ -0,0 +1,55 @@+{- Chunk logs, pure operations.+ -+ - Copyright 2014 Joey Hess <joey@kitenet.net>+ -+ - Licensed under the GNU GPL version 3 or higher.+ -}++module Logs.Chunk.Pure +	( ChunkMethod(..)+	, ChunkSize+	, ChunkCount+	, ChunkLog+	, parseLog+	, showLog+	) where++import Common.Annex+import Logs.MapLog+import Data.Int++-- Currently chunks are all fixed size, but other chunking methods+-- may be added.+data ChunkMethod = FixedSizeChunks ChunkSize | UnknownChunks String+	deriving (Ord, Eq, Show)++type ChunkSize = Int64++-- 0 when chunks are no longer present+type ChunkCount = Integer++type ChunkLog = MapLog (UUID, ChunkMethod) ChunkCount++parseChunkMethod :: String -> ChunkMethod+parseChunkMethod s = maybe (UnknownChunks s) FixedSizeChunks (readish s)++showChunkMethod :: ChunkMethod -> String+showChunkMethod (FixedSizeChunks sz) = show sz+showChunkMethod (UnknownChunks s) = s++parseLog :: String -> ChunkLog+parseLog = parseMapLog fieldparser valueparser+  where+	fieldparser s =+		let (u,m) = separate (== sep) s+		in Just (toUUID u, parseChunkMethod m)+	valueparser = readish++showLog :: ChunkLog -> String+showLog = showMapLog fieldshower valueshower+  where+	fieldshower (u, m) = fromUUID u ++ sep : showChunkMethod m+	valueshower = show++sep :: Char+sep = ':'
Logs/Transfer.hs view
@@ -11,7 +11,6 @@  import Common.Annex import Annex.Perms-import Annex.Exception import qualified Git import Types.Key import Utility.Metered@@ -94,7 +93,7 @@ mkProgressUpdater :: Transfer -> TransferInfo -> Annex (MeterUpdate, FilePath, MVar Integer) mkProgressUpdater t info = do 	tfile <- fromRepo $ transferFile t-	_ <- tryAnnex $ createAnnexDirectory $ takeDirectory tfile+	_ <- tryNonAsync $ createAnnexDirectory $ takeDirectory tfile 	mvar <- liftIO $ newMVar 0 	return (liftIO . updater tfile mvar, tfile, mvar)   where
Logs/UUIDBased.hs view
@@ -1,6 +1,6 @@ {- git-annex uuid-based logs  -- - This is used to store information about a UUID in a way that can+ - This is used to store information about UUIDs in a way that can  - be union merged.  -  - A line of the log will look like: "UUID[ INFO[ timestamp=foo]]"
Makefile view
@@ -187,7 +187,8 @@ # Some additional dependencies needed by the expanded splices. 	sed -i 's/^  Build-Depends: /  Build-Depends: yesod-routes, yesod-core, shakespeare-css, shakespeare-js, shakespeare, blaze-markup, file-embed, wai-app-static, /' tmp/no-th-tree/git-annex.cabal # Avoid warnings due to sometimes unused imports added for the splices.-	sed -i 's/GHC-Options: \(.*\)-Wall/GHC-Options: \1-Wall -fno-warn-unused-imports -XMagicHash /i' tmp/no-th-tree/git-annex.cabal+	sed -i 's/GHC-Options: \(.*\)-Wall/GHC-Options: \1-Wall -fno-warn-unused-imports /i' tmp/no-th-tree/git-annex.cabal+	sed -i 's/Extensions: /Extensions: MagicHash /i' tmp/no-th-tree/git-annex.cabal  # Run on the arm system, after stage1 no-th-webapp-stage2: @@ -216,7 +217,8 @@ # Some additional dependencies needed by the expanded splices. 	sed -i 's/^  Build-Depends: /  Build-Depends: yesod-routes, yesod-core, shakespeare-css, shakespeare-js, shakespeare, blaze-markup, file-embed, wai-app-static, /' tmp/androidtree/git-annex.cabal # Avoid warnings due to sometimes unused imports added for the splices.-	sed -i 's/GHC-Options: \(.*\)-Wall/GHC-Options: \1-Wall -fno-warn-unused-imports -XMagicHash /i' tmp/androidtree/git-annex.cabal+	sed -i 's/GHC-Options: \(.*\)-Wall/GHC-Options: \1-Wall -fno-warn-unused-imports /i' tmp/androidtree/git-annex.cabal+	sed -i 's/Extensions: /Extensions: MagicHash /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.
Messages.hs view
@@ -47,7 +47,7 @@ import System.Log.Handler.Simple import qualified Data.Set as S -import Common+import Common hiding (handle) import Types import Types.Messages import qualified Messages.JSON as JSON
Remote.hs view
@@ -113,10 +113,10 @@  byName' :: RemoteName -> Annex (Either String Remote) byName' "" = return $ Left "no remote specified"-byName' n = handle . filter matching <$> remoteList+byName' n = go . filter matching <$> remoteList   where-	handle [] = Left $ "there is no available git remote named \"" ++ n ++ "\""-	handle (match:_) = Right match+	go [] = Left $ "there is no available git remote named \"" ++ n ++ "\""+	go (match:_) = Right match 	matching r = n == name r || toUUID n == uuid r  {- Only matches remote name, not UUID -}@@ -312,3 +312,9 @@ isXMPPRemote remote = Git.repoIsUrl r && "xmpp::" `isPrefixOf` Git.repoLocation r   where 	r = repo remote++hasKey :: Remote -> Key -> Annex (Either String Bool)+hasKey r k = either (Left  . show) Right <$> tryNonAsync (checkPresent r k)++hasKeyCheap :: Remote -> Bool+hasKeyCheap = checkPresentCheap
Remote/Bup.hs view
@@ -1,15 +1,14 @@ {- Using bup as a remote.  -- - Copyright 2011 Joey Hess <joey@kitenet.net>+ - Copyright 2011-2014 Joey Hess <joey@kitenet.net>  -  - Licensed under the GNU GPL version 3 or higher.  -}  module Remote.Bup (remote) where -import qualified Data.ByteString.Lazy as L import qualified Data.Map as M-import System.Process+import qualified Data.ByteString.Lazy as L import Data.ByteString.Lazy.UTF8 (fromString)  import Common.Annex@@ -26,12 +25,9 @@ import Config.Cost import qualified Remote.Helper.Ssh as Ssh import Remote.Helper.Special-import Remote.Helper.Encryptable import Remote.Helper.Messages-import Crypto import Utility.Hash import Utility.UserInfo-import Annex.Content import Annex.UUID import Utility.Metered @@ -54,16 +50,16 @@ 			else expensiveRemoteCost 	(u', bupr') <- getBupUUID bupr u 	-	let new = Remote+	let this = Remote 		{ uuid = u' 		, cost = cst 		, name = Git.repoDescribe r-		, storeKey = store new buprepo-		, retrieveKeyFile = retrieve buprepo+		, storeKey = storeKeyDummy+		, retrieveKeyFile = retreiveKeyFileDummy 		, retrieveKeyFileCheap = retrieveCheap buprepo-		, removeKey = remove-		, hasKey = checkPresent r bupr'-		, hasKeyCheap = bupLocal buprepo+		, removeKey = removeKeyDummy+		, checkPresent = checkPresentDummy+		, checkPresentCheap = bupLocal buprepo 		, whereisKey = Nothing 		, remoteFsck = Nothing 		, repairRepo = Nothing@@ -76,13 +72,20 @@ 		, remotetype = remote 		, availability = if bupLocal buprepo then LocallyAvailable else GloballyAvailable 		, readonly = False+		, mkUnavailable = return Nothing 		}-	return $ Just $ encryptableRemote c-		(storeEncrypted new buprepo)-		(retrieveEncrypted buprepo)-		new+	return $ Just $ specialRemote' specialcfg c+		(simplyPrepare $ store this buprepo)+		(simplyPrepare $ retrieve buprepo)+		(simplyPrepare $ remove buprepo)+		(simplyPrepare $ checkKey r bupr')+		this   where 	buprepo = fromMaybe (error "missing buprepo") $ remoteAnnexBupRepo gc+	specialcfg = (specialRemoteCfg c)+		-- chunking would not improve bup+		{ chunkConfig = NoChunks+		}  bupSetup :: Maybe UUID -> Maybe CredPair -> RemoteConfig -> Annex (RemoteConfig, UUID) bupSetup mu _ c = do@@ -115,85 +118,61 @@ 	showOutput -- make way for bup output 	liftIO $ boolSystem "bup" $ bupParams command buprepo params -pipeBup :: [CommandParam] -> Maybe Handle -> Maybe Handle -> IO Bool-pipeBup params inh outh = do-	p <- runProcess "bup" (toCommand params)-		Nothing Nothing inh outh Nothing-	ok <- waitForProcess p-	case ok of-		ExitSuccess -> return True-		_ -> return False- bupSplitParams :: Remote -> BupRepo -> Key -> [CommandParam] -> Annex [CommandParam] bupSplitParams r buprepo k src = do 	let os = map Param $ remoteAnnexBupSplitOptions $ gitconfig r 	showOutput -- make way for bup output 	return $ bupParams "split" buprepo -		(os ++ [Param "-n", Param (bupRef k)] ++ src)--store :: Remote -> BupRepo -> Key -> AssociatedFile -> MeterUpdate -> Annex Bool-store r buprepo k _f _p = sendAnnex k (rollback k buprepo) $ \src -> do-	params <- bupSplitParams r buprepo k [File src]-	liftIO $ boolSystem "bup" params+		(os ++ [Param "-q", Param "-n", Param (bupRef k)] ++ src) -storeEncrypted :: Remote -> BupRepo -> (Cipher, Key) -> Key -> MeterUpdate -> Annex Bool-storeEncrypted r buprepo (cipher, enck) k _p =-	sendAnnex k (rollback enck buprepo) $ \src -> do-		params <- bupSplitParams r buprepo enck []-		liftIO $ catchBoolIO $-			encrypt (getGpgEncParams r) cipher (feedFile src) $ \h ->-				pipeBup params (Just h) Nothing+store :: Remote -> BupRepo -> Storer+store r buprepo = byteStorer $ \k b p -> do+	params <- bupSplitParams r buprepo k []+	let cmd = proc "bup" (toCommand params)+	liftIO $ withHandle StdinHandle createProcessSuccess cmd $ \h -> do+		meteredWrite p h b+		return True -retrieve :: BupRepo -> Key -> AssociatedFile -> FilePath -> MeterUpdate -> Annex Bool-retrieve buprepo k _f d _p = do+retrieve :: BupRepo -> Retriever+retrieve buprepo = byteRetriever $ \k sink -> do 	let params = bupParams "join" buprepo [Param $ bupRef k]-	liftIO $ catchBoolIO $ withFile d WriteMode $-		pipeBup params Nothing . Just+	let p = proc "bup" (toCommand params)+	(_, Just h, _, pid) <- liftIO $ createProcess $ p { std_out = CreatePipe }+	liftIO (hClose h >> forceSuccessProcess p pid)+		`after` (sink =<< liftIO (L.hGetContents h))  retrieveCheap :: BupRepo -> Key -> FilePath -> Annex Bool retrieveCheap _ _ _ = return False -retrieveEncrypted :: BupRepo -> (Cipher, Key) -> Key -> FilePath -> MeterUpdate -> Annex Bool-retrieveEncrypted buprepo (cipher, enck) _ f _p = liftIO $ catchBoolIO $-	withHandle StdoutHandle createProcessSuccess p $ \h -> do-		decrypt cipher (\toh -> L.hPut toh =<< L.hGetContents h) $-			readBytes $ L.writeFile f-		return True-  where-	params = bupParams "join" buprepo [Param $ bupRef enck]-	p = proc "bup" $ toCommand params--remove :: Key -> Annex Bool-remove _ = do-	warning "content cannot be removed from bup remote"-	return False- {- Cannot revert having stored a key in bup, but at least the data for the  - key will be used for deltaing data of other keys stored later.  -  - We can, however, remove the git branch that bup created for the key.  -}-rollback :: Key -> BupRepo -> Annex ()-rollback k bupr = go =<< liftIO (bup2GitRemote bupr)+remove :: BupRepo -> Remover+remove buprepo k = do+	go =<< liftIO (bup2GitRemote buprepo)+	warning "content cannot be completely removed from bup remote"+	return True   where 	go r 		| Git.repoIsUrl r = void $ onBupRemote r boolSystem "git" params-		| otherwise = void $ liftIO $ catchMaybeIO $-			boolSystem "git" $ Git.Command.gitCommandLine params r-	params = [ Params "branch -D", Param (bupRef k) ]+		| otherwise = void $ liftIO $ catchMaybeIO $ do+			r' <- Git.Config.read r+			boolSystem "git" $ Git.Command.gitCommandLine params r'+	params = [ Params "branch -q -D", Param (bupRef k) ]  {- Bup does not provide a way to tell if a given dataset is present  - in a bup repository. One way it to check if the git repository has  - a branch matching the name (as created by bup split -n).  -}-checkPresent :: Git.Repo -> Git.Repo -> Key -> Annex (Either String Bool)-checkPresent r bupr k+checkKey :: Git.Repo -> Git.Repo -> CheckPresent+checkKey r bupr k 	| Git.repoIsUrl bupr = do 		showChecking r-		ok <- onBupRemote bupr boolSystem "git" params-		return $ Right ok-	| otherwise = liftIO $ catchMsgIO $-		boolSystem "git" $ Git.Command.gitCommandLine params bupr+		onBupRemote bupr boolSystem "git" params+	| otherwise = liftIO $ boolSystem "git" $+		Git.Command.gitCommandLine params bupr   where 	params =  		[ Params "show-ref --quiet --verify"
Remote/Ddar.hs view
@@ -8,11 +8,9 @@  module Remote.Ddar (remote) where -import Control.Exception-import qualified Data.ByteString.Lazy as L import qualified Data.Map as M+import qualified Data.ByteString.Lazy as L import System.IO.Error-import System.Process  import Data.String.Utils import Common.Annex@@ -23,12 +21,8 @@ import Config import Config.Cost import Remote.Helper.Special-import Remote.Helper.Encryptable-import Crypto-import Annex.Content import Annex.Ssh import Annex.UUID-import Utility.Metered  type DdarRepo = String @@ -46,17 +40,23 @@ 		if ddarLocal ddarrepo 			then nearlyCheapRemoteCost 			else expensiveRemoteCost--	let new = Remote+	return $ Just $ specialRemote' specialcfg c+		(simplyPrepare $ store ddarrepo)+		(simplyPrepare $ retrieve ddarrepo)+		(simplyPrepare $ remove ddarrepo)+		(simplyPrepare $ checkKey ddarrepo)+		(this cst)+  where+	this cst = Remote 		{ uuid = u 		, cost = cst 		, name = Git.repoDescribe r-		, storeKey = store ddarrepo-		, retrieveKeyFile = retrieve ddarrepo+		, storeKey = storeKeyDummy+		, retrieveKeyFile = retreiveKeyFileDummy 		, retrieveKeyFileCheap = retrieveCheap-		, removeKey = remove ddarrepo-		, hasKey = checkPresent ddarrepo-		, hasKeyCheap = ddarLocal ddarrepo+		, removeKey = removeKeyDummy+		, checkPresent = checkPresentDummy+		, checkPresentCheap = ddarLocal ddarrepo 		, whereisKey = Nothing 		, remoteFsck = Nothing 		, repairRepo = Nothing@@ -69,13 +69,13 @@ 		, remotetype = remote 		, availability = if ddarLocal ddarrepo then LocallyAvailable else GloballyAvailable 		, readonly = False+		, mkUnavailable = return Nothing 		}-	return $ Just $ encryptableRemote c-		(storeEncrypted new ddarrepo)-		(retrieveEncrypted ddarrepo)-		new-  where 	ddarrepo = fromMaybe (error "missing ddarrepo") $ remoteAnnexDdarRepo gc+	specialcfg = (specialRemoteCfg c)+		-- chunking would not improve ddar+		{ chunkConfig = NoChunks+		}  ddarSetup :: Maybe UUID -> Maybe CredPair -> RemoteConfig -> Annex (RemoteConfig, UUID) ddarSetup mu _ c = do@@ -92,17 +92,8 @@  	return (c', u) -pipeDdar :: [CommandParam] -> Maybe Handle -> Maybe Handle -> IO Bool-pipeDdar params inh outh = do-	p <- runProcess "ddar" (toCommand params)-		Nothing Nothing inh outh Nothing-	ok <- waitForProcess p-	case ok of-		ExitSuccess -> return True-		_ -> return False--store :: DdarRepo -> Key -> AssociatedFile -> MeterUpdate -> Annex Bool-store ddarrepo k _f _p = sendAnnex k (void $ remove ddarrepo k) $ \src -> do+store :: DdarRepo -> Storer+store ddarrepo = fileStorer $ \k src _p -> do 	let params = 		[ Param "c" 		, Param "-N"@@ -112,21 +103,6 @@ 		] 	liftIO $ boolSystem "ddar" params -storeEncrypted :: Remote -> DdarRepo -> (Cipher, Key) -> Key -> MeterUpdate -> Annex Bool-storeEncrypted r ddarrepo (cipher, enck) k _p =-	sendAnnex k (void $ remove ddarrepo k) $ \src ->-		liftIO $ catchBoolIO $-			encrypt (getGpgEncParams r) cipher (feedFile src) $ \h ->-				pipeDdar params (Just h) Nothing-  where-	params =-		[ Param "c"-		, Param "-N"-		, Param $ key2file enck-		, Param ddarrepo-		, Param "-"-		]- {- Convert remote DdarRepo to host and path on remote end -} splitRemoteDdarRepo :: DdarRepo -> (String, String) splitRemoteDdarRepo ddarrepo =@@ -155,28 +131,18 @@ ddarExtractRemoteCall ddarrepo k = 	ddarRemoteCall ddarrepo 'x' [Param "--force-stdout", Param $ key2file k] -retrieve :: DdarRepo -> Key -> AssociatedFile -> FilePath -> MeterUpdate -> Annex Bool-retrieve ddarrepo k _f d _p = do+retrieve :: DdarRepo -> Retriever+retrieve ddarrepo = byteRetriever $ \k sink -> do 	(cmd, params) <- ddarExtractRemoteCall ddarrepo k-	liftIO $ catchBoolIO $ withFile d WriteMode $ \h -> do-		let p = (proc cmd $ toCommand params){ std_out = UseHandle h }-		(_, _, _, pid) <- Common.Annex.createProcess p-		forceSuccessProcess p pid-		return True+	let p = (proc cmd $ toCommand params) { std_out = CreatePipe }+	(_, Just h, _, pid) <- liftIO $ createProcess p+	liftIO (hClose h >> forceSuccessProcess p pid)+		`after` (sink =<< liftIO (L.hGetContents h))  retrieveCheap :: Key -> FilePath -> Annex Bool retrieveCheap _ _ = return False -retrieveEncrypted :: DdarRepo -> (Cipher, Key) -> Key -> FilePath -> MeterUpdate -> Annex Bool-retrieveEncrypted ddarrepo (cipher, enck) _ f _p = do-	(cmd, params) <- ddarExtractRemoteCall ddarrepo enck-	let p = proc cmd $ toCommand params-	liftIO $ catchBoolIO $ withHandle StdoutHandle createProcessSuccess p $ \h -> do-		decrypt cipher (\toh -> L.hPut toh =<< L.hGetContents h) $-			readBytes $ L.writeFile f-		return True--remove :: DdarRepo -> Key -> Annex Bool+remove :: DdarRepo -> Remover remove ddarrepo key = do 	(cmd, params) <- ddarRemoteCall ddarrepo 'd' [Param $ key2file key] 	liftIO $ boolSystem cmd params@@ -217,13 +183,14 @@   where 	k' = key2file k -checkPresent :: DdarRepo -> Key -> Annex (Either String Bool)-checkPresent ddarrepo key = do+checkKey :: DdarRepo -> CheckPresent+checkKey ddarrepo key = do 	directoryExists <- ddarDirectoryExists ddarrepo 	case directoryExists of-		Left e -> return $ Left e-		Right True -> inDdarManifest ddarrepo key-		Right False -> return $ Right False+		Left e -> error e+		Right True -> either error return+			=<< inDdarManifest ddarrepo key+		Right False -> return False  ddarLocal :: DdarRepo -> Bool ddarLocal = notElem ':'
Remote/Directory.hs view
@@ -1,18 +1,20 @@ {- A "remote" that is just a filesystem directory.  -- - Copyright 2011-2012 Joey Hess <joey@kitenet.net>+ - Copyright 2011-2014 Joey Hess <joey@kitenet.net>  -  - Licensed under the GNU GPL version 3 or higher.  -}  {-# LANGUAGE CPP #-} -module Remote.Directory (remote) where+module Remote.Directory (+	remote,+	finalizeStoreGeneric,+	removeDirGeneric,+) where  import qualified Data.ByteString.Lazy as L-import qualified Data.ByteString as S import qualified Data.Map as M-import Data.Int  import Common.Annex import Types.Remote@@ -22,9 +24,7 @@ import Config import Utility.FileMode import Remote.Helper.Special-import Remote.Helper.Encryptable-import Remote.Helper.Chunked-import Crypto+import qualified Remote.Directory.LegacyChunked as Legacy import Annex.Content import Annex.UUID import Utility.Metered@@ -40,20 +40,22 @@ gen :: Git.Repo -> UUID -> RemoteConfig -> RemoteGitConfig -> Annex (Maybe Remote) gen r u c gc = do 	cst <- remoteCost gc cheapRemoteCost-	let chunksize = chunkSize c-	return $ Just $ encryptableRemote c-		(storeEncrypted dir (getGpgEncParams (c,gc)) chunksize)-		(retrieveEncrypted dir chunksize)+	let chunkconfig = getChunkConfig c+	return $ Just $ specialRemote c+		(prepareStore dir chunkconfig)+		(retrieve dir chunkconfig)+		(simplyPrepare $ remove dir)+		(simplyPrepare $ checkKey dir chunkconfig) 		Remote { 			uuid = u, 			cost = cst, 			name = Git.repoDescribe r,-			storeKey = store dir chunksize,-			retrieveKeyFile = retrieve dir chunksize,-			retrieveKeyFileCheap = retrieveCheap dir chunksize,-			removeKey = remove dir,-			hasKey = checkPresent dir chunksize,-			hasKeyCheap = True,+			storeKey = storeKeyDummy,+			retrieveKeyFile = retreiveKeyFileDummy,+			retrieveKeyFileCheap = retrieveCheap dir chunkconfig,+			removeKey = removeKeyDummy,+			checkPresent = checkPresentDummy,+			checkPresentCheap = True, 			whereisKey = Nothing, 			remoteFsck = Nothing, 			repairRepo = Nothing,@@ -63,7 +65,9 @@ 			localpath = Just dir, 			readonly = False, 			availability = LocallyAvailable,-			remotetype = remote+			remotetype = remote,+			mkUnavailable = gen r u c $+				gc { remoteAnnexDirectory = Just "/dev/null" } 		}   where 	dir = fromMaybe (error "missing directory") $ remoteAnnexDirectory gc@@ -84,172 +88,118 @@ 	gitConfigSpecialRemote u c' "directory" absdir 	return (M.delete "directory" c', u) -{- Locations to try to access a given Key in the Directory.- - We try more than since we used to write to different hash directories. -}+{- Locations to try to access a given Key in the directory.+ - We try more than one since we used to write to different hash+ - directories. -} locations :: FilePath -> Key -> [FilePath] locations d k = map (d </>) (keyPaths k) +{- Returns the location off a Key in the directory. If the key is+ - present, returns the location that is actually used, otherwise+ - returns the first, default location. -}+getLocation :: FilePath -> Key -> IO FilePath+getLocation d k = do+	let locs = locations d k+	fromMaybe (Prelude.head locs) <$> firstM doesFileExist locs+ {- Directory where the file(s) for a key are stored. -} storeDir :: FilePath -> Key -> FilePath storeDir d k = addTrailingPathSeparator $ d </> hashDirLower k </> keyFile k -{- Where we store temporary data for a key as it's being uploaded. -}+{- Where we store temporary data for a key, in the directory, as it's being+ - written. -} tmpDir :: FilePath -> Key -> FilePath tmpDir d k = addTrailingPathSeparator $ d </> "tmp" </> keyFile k -withCheckedFiles :: (FilePath -> IO Bool) -> ChunkSize -> FilePath -> Key -> ([FilePath] -> IO Bool) -> IO Bool-withCheckedFiles _ _ [] _ _ = return False-withCheckedFiles check Nothing d k a = go $ locations d k-  where-	go [] = return False-	go (f:fs) = ifM (check f) ( a [f] , go fs )-withCheckedFiles check (Just _) d k a = go $ locations d k-  where-	go [] = return False-	go (f:fs) = do-		let chunkcount = f ++ chunkCount-		ifM (check chunkcount)-			( do-				chunks <- listChunks f <$> readFile chunkcount-				ifM (allM check chunks)-					( a chunks , return False )-			, do-				chunks <- probeChunks f check-				if null chunks-					then go fs-					else a chunks-			)--withStoredFiles :: ChunkSize -> FilePath -> Key -> ([FilePath] -> IO Bool) -> IO Bool-withStoredFiles = withCheckedFiles doesFileExist--store :: FilePath -> ChunkSize -> Key -> AssociatedFile -> MeterUpdate -> Annex Bool-store d chunksize k _f p = sendAnnex k (void $ remove d k) $ \src ->-	metered (Just p) k $ \meterupdate -> -		storeHelper d chunksize k k $ \dests ->-			case chunksize of-				Nothing -> do-					let dest = Prelude.head dests-					meteredWriteFile meterupdate dest-						=<< L.readFile src-					return [dest]-				Just _ ->-					storeSplit meterupdate chunksize dests-						=<< L.readFile src--storeEncrypted :: FilePath -> [CommandParam] -> ChunkSize -> (Cipher, Key) -> Key -> MeterUpdate -> Annex Bool-storeEncrypted d gpgOpts chunksize (cipher, enck) k p = sendAnnex k (void $ remove d enck) $ \src ->-	metered (Just p) k $ \meterupdate ->-		storeHelper d chunksize enck k $ \dests ->-			encrypt gpgOpts cipher (feedFile src) $ readBytes $ \b ->-				case chunksize of-					Nothing -> do-						let dest = Prelude.head dests-						meteredWriteFile meterupdate dest b-						return [dest]-					Just _ -> storeSplit meterupdate chunksize dests b--{- Splits a ByteString into chunks and writes to dests, obeying configured- - chunk size (not to be confused with the L.ByteString chunk size).- - Note: Must always write at least one file, even for empty ByteString. -}-storeSplit :: MeterUpdate -> ChunkSize -> [FilePath] -> L.ByteString -> IO [FilePath]-storeSplit _ Nothing _ _ = error "bad storeSplit call"-storeSplit _ _ [] _ = error "bad storeSplit call"-storeSplit meterupdate (Just chunksize) alldests@(firstdest:_) b-	| L.null b = do-		-- must always write at least one file, even for empty-		L.writeFile firstdest b-		return [firstdest]-	| otherwise = storeSplit' meterupdate chunksize alldests (L.toChunks b) []-storeSplit' :: MeterUpdate -> Int64 -> [FilePath] -> [S.ByteString] -> [FilePath] -> IO [FilePath]-storeSplit' _ _ [] _ _ = error "ran out of dests"-storeSplit' _ _  _ [] c = return $ reverse c-storeSplit' meterupdate chunksize (d:dests) bs c = do-	bs' <- withFile d WriteMode $-		feed zeroBytesProcessed chunksize bs-	storeSplit' meterupdate chunksize dests bs' (d:c)-  where-	feed _ _ [] _ = return []-	feed bytes sz (l:ls) h = do-		let len = S.length l-		let s = fromIntegral len-		if s <= sz || sz == chunksize-			then do-				S.hPut h l-				let bytes' = addBytesProcessed bytes len-				meterupdate bytes'-				feed bytes' (sz - s) ls h-			else return (l:ls)+{- Check if there is enough free disk space in the remote's directory to+ - store the key. Note that the unencrypted key size is checked. -}+prepareStore :: FilePath -> ChunkConfig -> Preparer Storer+prepareStore d chunkconfig = checkPrepare+	(\k -> checkDiskSpace (Just d) k 0)+	(byteStorer $ store d chunkconfig) -storeHelper :: FilePath -> ChunkSize -> Key -> Key -> ([FilePath] -> IO [FilePath]) -> Annex Bool-storeHelper d chunksize key origkey storer = check <&&> go+store :: FilePath -> ChunkConfig -> Key -> L.ByteString -> MeterUpdate -> Annex Bool+store d chunkconfig k b p = liftIO $ do+	void $ tryIO $ createDirectoryIfMissing True tmpdir+	case chunkconfig of+		LegacyChunks chunksize -> Legacy.store chunksize finalizeStoreGeneric k b p tmpdir destdir+		_ -> do+			let tmpf = tmpdir </> keyFile k+			meteredWriteFile p tmpf b+			finalizeStoreGeneric tmpdir destdir+			return True   where-	tmpdir = tmpDir d key-	destdir = storeDir d key-	{- An encrypted key does not have a known size,-	 - so check that the size of the original key is available as free-	 - space. -}-	check = do-		liftIO $ createDirectoryIfMissing True tmpdir-		checkDiskSpace (Just tmpdir) origkey 0-	go = liftIO $ catchBoolIO $-		storeChunks key tmpdir destdir chunksize storer recorder finalizer-	finalizer tmp dest = do-		void $ tryIO $ allowWrite dest -- may already exist-		void $ tryIO $ removeDirectoryRecursive dest -- or not exist-		createDirectoryIfMissing True (parentDir dest)-		renameDirectory tmp dest-		-- may fail on some filesystems-		void $ tryIO $ do-			mapM_ preventWrite =<< dirContents dest-			preventWrite dest-	recorder f s = do-		void $ tryIO $ allowWrite f-		writeFile f s-		void $ tryIO $ preventWrite f+	tmpdir = tmpDir d k+	destdir = storeDir d k -retrieve :: FilePath -> ChunkSize -> Key -> AssociatedFile -> FilePath -> MeterUpdate -> Annex Bool-retrieve d chunksize k _ f p = metered (Just p) k $ \meterupdate ->-	liftIO $ withStoredFiles chunksize d k $ \files ->-		catchBoolIO $ do-			meteredWriteFileChunks meterupdate f files L.readFile-			return True+{- Passed a temp directory that contains the files that should be placed+ - in the dest directory, moves it into place. Anything already existing+ - in the dest directory will be deleted. File permissions will be locked+ - down. -}+finalizeStoreGeneric :: FilePath -> FilePath -> IO ()+finalizeStoreGeneric tmp dest = do+	void $ tryIO $ allowWrite dest -- may already exist+	void $ tryIO $ removeDirectoryRecursive dest -- or not exist+	createDirectoryIfMissing True (parentDir dest)+	renameDirectory tmp dest+	-- may fail on some filesystems+	void $ tryIO $ do+		mapM_ preventWrite =<< dirContents dest+		preventWrite dest -retrieveEncrypted :: FilePath -> ChunkSize -> (Cipher, Key) -> Key -> FilePath -> MeterUpdate -> Annex Bool-retrieveEncrypted d chunksize (cipher, enck) k f p = metered (Just p) k $ \meterupdate ->-	liftIO $ withStoredFiles chunksize d enck $ \files ->-		catchBoolIO $ do-			decrypt cipher (feeder files) $-				readBytes $ meteredWriteFile meterupdate f-			return True-  where-	feeder files h = forM_ files $ L.hPut h <=< L.readFile+retrieve :: FilePath -> ChunkConfig -> Preparer Retriever+retrieve d (LegacyChunks _) = Legacy.retrieve locations d+retrieve d _ = simplyPrepare $ byteRetriever $ \k sink ->+	sink =<< liftIO (L.readFile =<< getLocation d k) -retrieveCheap :: FilePath -> ChunkSize -> Key -> FilePath -> Annex Bool-retrieveCheap _ (Just _) _ _ = return False -- no cheap retrieval for chunks+retrieveCheap :: FilePath -> ChunkConfig -> Key -> FilePath -> Annex Bool+-- no cheap retrieval possible for chunks+retrieveCheap _ (UnpaddedChunks _) _ _ = return False+retrieveCheap _ (LegacyChunks _) _ _ = return False #ifndef mingw32_HOST_OS-retrieveCheap d _ k f = liftIO $ withStoredFiles Nothing d k go-  where-	go [file] = catchBoolIO $ createSymbolicLink file f >> return True-	go _files = return False+retrieveCheap d NoChunks k f = liftIO $ catchBoolIO $ do+	file <- getLocation d k+	createSymbolicLink file f+	return True #else retrieveCheap _ _ _ _ = return False #endif -remove :: FilePath -> Key -> Annex Bool-remove d k = liftIO $ do+remove :: FilePath -> Remover+remove d k = liftIO $ removeDirGeneric d (storeDir d k)++{- Removes the directory, which must be located under the topdir.+ -+ - Succeeds even on directories and contents that do not have write+ - permission.+ -+ - If the directory does not exist, succeeds as long as the topdir does+ - exist. If the topdir does not exist, fails, because in this case the+ - remote is not currently accessible and probably still has the content+ - we were supposed to remove from it.+ -}+removeDirGeneric :: FilePath -> FilePath -> IO Bool+removeDirGeneric topdir dir = do 	void $ tryIO $ allowWrite dir #ifdef mingw32_HOST_OS 	{- Windows needs the files inside the directory to be writable 	 - before it can delete them. -} 	void $ tryIO $ mapM_ allowWrite =<< dirContents dir #endif-	catchBoolIO $ do+	ok <- catchBoolIO $ do 		removeDirectoryRecursive dir 		return True-  where-	dir = storeDir d k+	if ok+		then return ok+		else doesDirectoryExist topdir <&&> (not <$> doesDirectoryExist dir) -checkPresent :: FilePath -> ChunkSize -> Key -> Annex (Either String Bool)-checkPresent d chunksize k = liftIO $ catchMsgIO $ withStoredFiles chunksize d k $-	const $ return True -- withStoredFiles checked that it exists+checkKey :: FilePath -> ChunkConfig -> CheckPresent+checkKey d (LegacyChunks _) k = Legacy.checkKey d locations k+checkKey d _ k = liftIO $+	ifM (anyM doesFileExist (locations d k))+		( return True+		, ifM (doesDirectoryExist d)+			( return False+			, error $ "directory " ++ d ++ " is not accessible"+			)+		)
+ Remote/Directory/LegacyChunked.hs view
@@ -0,0 +1,109 @@+{- Legacy chunksize support for directory special remote.+ -+ - Can be removed eventually.+ -+ - Copyright 2011-2012 Joey Hess <joey@kitenet.net>+ -+ - Licensed under the GNU GPL version 3 or higher.+ -}++module Remote.Directory.LegacyChunked where++import qualified Data.ByteString.Lazy as L+import qualified Data.ByteString as S++import Common.Annex+import Utility.FileMode+import Remote.Helper.Special+import qualified Remote.Helper.Chunked.Legacy as Legacy+import Annex.Perms+import Utility.Metered++withCheckedFiles :: (FilePath -> IO Bool) -> FilePath -> (FilePath -> Key -> [FilePath]) -> Key -> ([FilePath] -> IO Bool) -> IO Bool+withCheckedFiles _ [] _locations _ _ = return False+withCheckedFiles check d locations k a = go $ locations d k+  where+	go [] = return False+	go (f:fs) = do+		let chunkcount = f ++ Legacy.chunkCount+		ifM (check chunkcount)+			( do+				chunks <- Legacy.listChunks f <$> readFile chunkcount+				ifM (allM check chunks)+					( a chunks , return False )+			, do+				chunks <- Legacy.probeChunks f check+				if null chunks+					then go fs+					else a chunks+			)+withStoredFiles :: FilePath -> (FilePath -> Key -> [FilePath]) -> Key -> ([FilePath] -> IO Bool) -> IO Bool+withStoredFiles = withCheckedFiles doesFileExist++{- Splits a ByteString into chunks and writes to dests, obeying configured+ - chunk size (not to be confused with the L.ByteString chunk size). -}+storeLegacyChunked :: MeterUpdate -> ChunkSize -> [FilePath] -> L.ByteString -> IO [FilePath]+storeLegacyChunked _ _ [] _ = error "bad storeLegacyChunked call"+storeLegacyChunked meterupdate chunksize alldests@(firstdest:_) b+	| L.null b = do+		-- always write at least one file, even for empty+		L.writeFile firstdest b+		return [firstdest]+	| otherwise = storeLegacyChunked' meterupdate chunksize alldests (L.toChunks b) []+storeLegacyChunked' :: MeterUpdate -> ChunkSize -> [FilePath] -> [S.ByteString] -> [FilePath] -> IO [FilePath]+storeLegacyChunked' _ _ [] _ _ = error "ran out of dests"+storeLegacyChunked' _ _  _ [] c = return $ reverse c+storeLegacyChunked' meterupdate chunksize (d:dests) bs c = do+	bs' <- withFile d WriteMode $+		feed zeroBytesProcessed chunksize bs+	storeLegacyChunked' meterupdate chunksize dests bs' (d:c)+  where+	feed _ _ [] _ = return []+	feed bytes sz (l:ls) h = do+		let len = S.length l+		let s = fromIntegral len+		if s <= sz || sz == chunksize+			then do+				S.hPut h l+				let bytes' = addBytesProcessed bytes len+				meterupdate bytes'+				feed bytes' (sz - s) ls h+			else return (l:ls)++storeHelper :: (FilePath -> FilePath -> IO ()) -> Key -> ([FilePath] -> IO [FilePath]) -> FilePath -> FilePath -> IO Bool+storeHelper finalizer key storer tmpdir destdir = do+	void $ liftIO $ tryIO $ createDirectoryIfMissing True tmpdir+	Legacy.storeChunks key tmpdir destdir storer recorder finalizer+  where+	recorder f s = do+		void $ tryIO $ allowWrite f+		writeFile f s+		void $ tryIO $ preventWrite f++store :: ChunkSize -> (FilePath -> FilePath -> IO ()) -> Key -> L.ByteString -> MeterUpdate -> FilePath -> FilePath -> IO Bool+store chunksize finalizer k b p = storeHelper finalizer k $ \dests ->+	storeLegacyChunked p chunksize dests b++{- Need to get a single ByteString containing every chunk.+ - Done very innefficiently, by writing to a temp file.+ - :/ This is legacy code..+ -}+retrieve :: (FilePath -> Key -> [FilePath]) -> FilePath -> Preparer Retriever+retrieve locations d basek a = do+	showLongNote "This remote uses the deprecated chunksize setting. So this will be quite slow."+	tmpdir <- fromRepo $ gitAnnexTmpMiscDir+	createAnnexDirectory tmpdir+	let tmp = tmpdir </> keyFile basek ++ ".directorylegacy.tmp"+	a $ Just $ byteRetriever $ \k sink -> do+		liftIO $ void $ withStoredFiles d locations k $ \fs -> do+			forM_ fs $+				S.appendFile tmp <=< S.readFile+			return True+		b <- liftIO $ L.readFile tmp+		liftIO $ nukeFile tmp+		sink b++checkKey :: FilePath -> (FilePath -> Key -> [FilePath]) -> Key -> Annex Bool+checkKey d locations k = liftIO $ withStoredFiles d locations k $+	-- withStoredFiles checked that it exists+	const $ return True
Remote/External.hs view
@@ -15,22 +15,17 @@ import qualified Git import Config import Remote.Helper.Special-import Remote.Helper.Encryptable-import Crypto import Utility.Metered import Logs.Transfer import Logs.PreferredContent.Raw import Logs.RemoteState import Config.Cost-import Annex.Content import Annex.UUID-import Annex.Exception import Creds  import Control.Concurrent.STM import System.Log.Logger (debugM) import qualified Data.Map as M-import qualified Data.ByteString.Lazy as L  remote :: RemoteType remote = RemoteType {@@ -46,19 +41,21 @@ 	Annex.addCleanup (RemoteCleanup u) $ stopExternal external 	cst <- getCost external r gc 	avail <- getAvailability external r gc-	return $ Just $ encryptableRemote c-		(storeEncrypted external $ getGpgEncParams (c,gc))-		(retrieveEncrypted external)+	return $ Just $ specialRemote c+		(simplyPrepare $ store external)+		(simplyPrepare $ retrieve external)+		(simplyPrepare $ remove external)+		(simplyPrepare $ checkKey external) 		Remote { 			uuid = u, 			cost = cst, 			name = Git.repoDescribe r,-			storeKey = store external,-			retrieveKeyFile = retrieve external,+			storeKey = storeKeyDummy,+			retrieveKeyFile = retreiveKeyFileDummy, 			retrieveKeyFileCheap = \_ _ -> return False,-			removeKey = remove external,-			hasKey = checkPresent external,-			hasKeyCheap = False,+			removeKey = removeKeyDummy,+			checkPresent = checkPresentDummy,+			checkPresentCheap = False, 			whereisKey = Nothing, 			remoteFsck = Nothing, 			repairRepo = Nothing,@@ -68,7 +65,9 @@ 			gitconfig = gc, 			readonly = False, 			availability = avail,-			remotetype = remote+			remotetype = remote,+			mkUnavailable = gen r u c $+				gc { remoteAnnexExternalType = Just "!dne!" } 		}   where 	externaltype = fromMaybe (error "missing externaltype") (remoteAnnexExternalType gc)@@ -90,25 +89,8 @@ 	gitConfigSpecialRemote u c'' "externaltype" externaltype 	return (c'', u) -store :: External -> Key -> AssociatedFile -> MeterUpdate -> Annex Bool-store external k _f p = sendAnnex k rollback $ \f ->-	metered (Just p) k $-		storeHelper external k f-  where-	rollback = void $ remove external k--storeEncrypted :: External -> [CommandParam] -> (Cipher, Key) -> Key -> MeterUpdate -> Annex Bool-storeEncrypted external gpgOpts (cipher, enck) k p = withTmp enck $ \tmp ->-	sendAnnex k rollback $ \src -> do-		metered (Just p) k $ \meterupdate -> do-			liftIO $ encrypt gpgOpts cipher (feedFile src) $-				readBytes $ L.writeFile tmp-			storeHelper external enck tmp meterupdate-  where-	rollback = void $ remove external enck--storeHelper :: External -> Key -> FilePath -> MeterUpdate -> Annex Bool-storeHelper external k f p = safely $+store :: External -> Storer+store external = fileStorer $ \k f p -> 	handleRequest external (TRANSFER Upload k f) (Just p) $ \resp -> 		case resp of 			TRANSFER_SUCCESS Upload k' | k == k' ->@@ -119,34 +101,18 @@ 					return False 			_ -> Nothing -retrieve :: External -> Key -> AssociatedFile -> FilePath -> MeterUpdate -> Annex Bool-retrieve external k _f d p = metered (Just p) k $-	retrieveHelper external k d--retrieveEncrypted :: External -> (Cipher, Key) -> Key -> FilePath -> MeterUpdate -> Annex Bool-retrieveEncrypted external (cipher, enck) k f p = withTmp enck $ \tmp ->-	metered (Just p) k $ \meterupdate -> -		ifM (retrieveHelper external enck tmp meterupdate)-			( liftIO $ catchBoolIO $ do-				decrypt cipher (feedFile tmp) $-					readBytes $ L.writeFile f-				return True-			, return False-			)--retrieveHelper :: External -> Key -> FilePath -> MeterUpdate -> Annex Bool-retrieveHelper external k d p = safely $+retrieve :: External -> Retriever+retrieve external = fileRetriever $ \d k p ->  	handleRequest external (TRANSFER Download k d) (Just p) $ \resp -> 		case resp of 			TRANSFER_SUCCESS Download k'-				| k == k' -> Just $ return True+				| k == k' -> Just $ return () 			TRANSFER_FAILURE Download k' errmsg 				| k == k' -> Just $ do-					warning errmsg-					return False+					error errmsg 			_ -> Nothing -remove :: External -> Key -> Annex Bool+remove :: External -> Remover remove external k = safely $  	handleRequest external (REMOVE k) Nothing $ \resp -> 		case resp of@@ -158,8 +124,8 @@ 					return False 			_ -> Nothing -checkPresent :: External -> Key -> Annex (Either String Bool)-checkPresent external k = either (Left . show) id <$> tryAnnex go+checkKey :: External -> CheckPresent+checkKey external k = either error id <$> go   where 	go = handleRequest external (CHECKPRESENT k) Nothing $ \resp -> 		case resp of@@ -172,7 +138,7 @@ 			_ -> Nothing  safely :: Annex Bool -> Annex Bool-safely a = go =<< tryAnnex a+safely a = go =<< tryNonAsync a   where 	go (Right r) = return r 	go (Left e) = do
Remote/External/Types.hs view
@@ -32,7 +32,6 @@ ) where  import Common.Annex-import Annex.Exception import Types.Key (file2key, key2file) import Types.StandardGroups (PreferredContentExpression) import Utility.Metered (BytesProcessed(..))
Remote/GCrypt.hs view
@@ -7,7 +7,7 @@  module Remote.GCrypt ( 	remote,-	gen,+	chainGen, 	getGCryptUUID, 	coreGCryptId, 	setupRepo@@ -15,7 +15,7 @@  import qualified Data.Map as M import qualified Data.ByteString.Lazy as L-import Control.Exception.Extensible+import Control.Exception  import Common.Annex import Types.Remote@@ -29,7 +29,6 @@ import qualified Git.Construct import qualified Git.Types as Git () import qualified Annex.Branch-import qualified Annex.Content import Config import Config.Cost import Remote.Helper.Git@@ -38,16 +37,15 @@ import Remote.Helper.Messages import qualified Remote.Helper.Ssh as Ssh import Utility.Metered-import Crypto import Annex.UUID import Annex.Ssh import qualified Remote.Rsync+import qualified Remote.Directory import Utility.Rsync import Utility.Tmp import Logs.Remote import Logs.Transfer import Utility.Gpg-import Annex.Content  remote :: RemoteType remote = RemoteType {@@ -59,19 +57,24 @@ 	setup = gCryptSetup } -gen :: Git.Repo -> UUID -> RemoteConfig -> RemoteGitConfig -> Annex (Maybe Remote)-gen gcryptr u c gc = do+chainGen :: Git.Repo -> UUID -> RemoteConfig -> RemoteGitConfig -> Annex (Maybe Remote)+chainGen gcryptr u c gc = do 	g <- gitRepo 	-- get underlying git repo with real path, not gcrypt path 	r <- liftIO $ Git.GCrypt.encryptedRemote g gcryptr 	let r' = r { Git.remoteName = Git.remoteName gcryptr }+	gen r' u c gc++gen :: Git.Repo -> UUID -> RemoteConfig -> RemoteGitConfig -> Annex (Maybe Remote)+gen baser u c gc = do 	-- doublecheck that cache matches underlying repo's gcrypt-id 	-- (which might not be set), only for local repos-	(mgcryptid, r'') <- getGCryptId True r'-	case (mgcryptid, Git.GCrypt.remoteRepoId g (Git.remoteName gcryptr)) of+	(mgcryptid, r) <- getGCryptId True baser+	g <- gitRepo+	case (mgcryptid, Git.GCrypt.remoteRepoId g (Git.remoteName baser)) of 		(Just gcryptid, Just cachedgcryptid)-			| gcryptid /= cachedgcryptid -> resetup gcryptid r''-		_ -> gen' r'' u c gc+			| gcryptid /= cachedgcryptid -> resetup gcryptid r+		_ -> gen' r u c gc   where 	-- A different drive may have been mounted, making a different 	-- gcrypt remote available. So need to set the cached@@ -81,10 +84,10 @@ 	resetup gcryptid r = do 		let u' = genUUIDInNameSpace gCryptNameSpace gcryptid 		v <- M.lookup u' <$> readRemoteLog-		case (Git.remoteName gcryptr, v) of+		case (Git.remoteName baser, v) of 			(Just remotename, Just c') -> do 				setGcryptEncryption c' remotename-				setConfig (remoteConfig gcryptr "uuid") (fromUUID u')+				setConfig (remoteConfig baser "uuid") (fromUUID u') 				setConfig (ConfigKey $ Git.GCrypt.remoteConfigKey "gcrypt-id" remotename) gcryptid 				gen' r u' c' gc 			_ -> do@@ -101,12 +104,12 @@ 		{ uuid = u 		, cost = cst 		, name = Git.repoDescribe r-		, storeKey = \_ _ _ -> noCrypto-		, retrieveKeyFile = \_ _ _ _ -> noCrypto+		, storeKey = storeKeyDummy+		, retrieveKeyFile = retreiveKeyFileDummy 		, retrieveKeyFileCheap = \_ _ -> return False-		, removeKey = remove this rsyncopts-		, hasKey = checkPresent this rsyncopts-		, hasKeyCheap = repoCheap r+		, removeKey = removeKeyDummy+		, checkPresent = checkPresentDummy+		, checkPresentCheap = repoCheap r 		, whereisKey = Nothing 		, remoteFsck = Nothing 		, repairRepo = Nothing@@ -117,11 +120,20 @@ 		, readonly = Git.repoIsHttp r 		, availability = availabilityCalc r 		, remotetype = remote+		, mkUnavailable = return Nothing 	}-	return $ Just $ encryptableRemote c-		(store this rsyncopts)-		(retrieve this rsyncopts)+	return $ Just $ specialRemote' specialcfg c+		(simplyPrepare $ store this rsyncopts)+		(simplyPrepare $ retrieve this rsyncopts)+		(simplyPrepare $ remove this rsyncopts)+		(simplyPrepare $ checkKey this rsyncopts) 		this+  where+	specialcfg+		| Git.repoIsUrl r = (specialRemoteCfg c)+			-- Rsync displays its own progress.+			{ displayProgress = False }+		| otherwise = specialRemoteCfg c  rsyncTransportToObjects :: Git.Repo -> Annex ([CommandParam], String) rsyncTransportToObjects r = do@@ -147,7 +159,7 @@ noCrypto :: Annex a noCrypto = error "cannot use gcrypt remote without encryption enabled" -unsupportedUrl :: Annex a+unsupportedUrl :: a unsupportedUrl = error "using non-ssh remote repo url with gcrypt is not supported"  gCryptSetup :: Maybe UUID -> Maybe CredPair -> RemoteConfig -> Annex (RemoteConfig, UUID)@@ -244,19 +256,24 @@  	{-  Ask git-annex-shell to configure the repository as a gcrypt 	 -  repository. May fail if it is too old. -}-	gitannexshellsetup = Ssh.onRemote r (boolSystem, False)+	gitannexshellsetup = Ssh.onRemote r (boolSystem, return False) 		"gcryptsetup" [ Param gcryptid ] []  	denyNonFastForwards = "receive.denyNonFastForwards" -shellOrRsync :: Remote -> Annex a -> Annex a -> Annex a-shellOrRsync r ashell arsync = case method of-	AccessShell -> ashell-	_ -> arsync+isShell :: Remote -> Bool+isShell r = case method of+	AccessShell -> True+	_ -> False   where   	method = toAccessMethod $ fromMaybe "" $ 		remoteAnnexGCrypt $ gitconfig r +shellOrRsync :: Remote -> Annex a -> Annex a -> Annex a+shellOrRsync r ashell arsync+	| isShell r = ashell+	| otherwise = arsync+ {- Configure gcrypt to use the same list of keyids that  - were passed to initremote as its participants.  - Also, configure it to use a signing key that is in the list of@@ -287,73 +304,55 @@   where 	remoteconfig n = ConfigKey $ n remotename -store :: Remote -> Remote.Rsync.RsyncOpts -> (Cipher, Key) -> Key -> MeterUpdate -> Annex Bool-store r rsyncopts (cipher, enck) k p-	| not $ Git.repoIsUrl (repo r) = guardUsable (repo r) False $-		metered (Just p) k $ \meterupdate -> spoolencrypted $ \h -> do-			let dest = gCryptLocation r enck-			createDirectoryIfMissing True $ parentDir dest-			readBytes (meteredWriteFile meterupdate dest) h+store :: Remote -> Remote.Rsync.RsyncOpts -> Storer+store r rsyncopts+	| not $ Git.repoIsUrl (repo r) = +		byteStorer $ \k b p -> guardUsable (repo r) (return False) $ liftIO $ do+			let tmpdir = Git.repoLocation (repo r) </> "tmp" </> keyFile k+			void $ tryIO $ createDirectoryIfMissing True tmpdir+			let tmpf = tmpdir </> keyFile k+			meteredWriteFile p tmpf b+			let destdir = parentDir $ gCryptLocation r k+			Remote.Directory.finalizeStoreGeneric tmpdir destdir 			return True-	| Git.repoIsSsh (repo r) = shellOrRsync r storeshell storersync+	| Git.repoIsSsh (repo r) = if isShell r+		then fileStorer $ \k f p -> Ssh.rsyncHelper (Just p)+			=<< Ssh.rsyncParamsRemote False r Upload k f Nothing+		else fileStorer $ Remote.Rsync.store rsyncopts 	| otherwise = unsupportedUrl-  where-  	gpgopts = getGpgEncParams r-	storersync = Remote.Rsync.storeEncrypted rsyncopts gpgopts (cipher, enck) k p-	storeshell = withTmp enck $ \tmp ->-		ifM (spoolencrypted $ readBytes $ \b -> catchBoolIO $ L.writeFile tmp b >> return True)-			( Ssh.rsyncHelper (Just p)-				=<< Ssh.rsyncParamsRemote False r Upload enck tmp Nothing-			, return False-			)-	spoolencrypted a = Annex.Content.sendAnnex k noop $ \src ->-		liftIO $ catchBoolIO $-			encrypt gpgopts cipher (feedFile src) a -retrieve :: Remote -> Remote.Rsync.RsyncOpts -> (Cipher, Key) -> Key -> FilePath -> MeterUpdate -> Annex Bool-retrieve r rsyncopts (cipher, enck) k d p-	| not $ Git.repoIsUrl (repo r) = guardUsable (repo r) False $ do-		retrievewith $ L.readFile src-		return True-	| Git.repoIsSsh (repo r) = shellOrRsync r retrieveshell retrieversync+retrieve :: Remote -> Remote.Rsync.RsyncOpts -> Retriever+retrieve r rsyncopts+	| not $ Git.repoIsUrl (repo r) = byteRetriever $ \k sink ->+		guardUsable (repo r) (return False) $+			sink =<< liftIO (L.readFile $ gCryptLocation r k)+	| Git.repoIsSsh (repo r) = if isShell r+		then fileRetriever $ \f k p ->+			unlessM (Ssh.rsyncHelper (Just p) =<< Ssh.rsyncParamsRemote False r Download k f Nothing) $+				error "rsync failed"+		else fileRetriever $ Remote.Rsync.retrieve rsyncopts 	| otherwise = unsupportedUrl   where-	src = gCryptLocation r enck-	retrievewith a = metered (Just p) k $ \meterupdate -> liftIO $-		a >>= \b -> -			decrypt cipher (feedBytes b)-				(readBytes $ meteredWriteFile meterupdate d)-	retrieversync = Remote.Rsync.retrieveEncrypted rsyncopts (cipher, enck) k d p-	retrieveshell = withTmp enck $ \tmp ->-		ifM (Ssh.rsyncHelper (Just p) =<< Ssh.rsyncParamsRemote False r Download enck tmp Nothing)-			( liftIO $ catchBoolIO $ do-				decrypt cipher (feedFile tmp) $-					readBytes $ L.writeFile d-				return True-			, return False-			) -remove :: Remote -> Remote.Rsync.RsyncOpts -> Key -> Annex Bool+remove :: Remote -> Remote.Rsync.RsyncOpts -> Remover remove r rsyncopts k-	| not $ Git.repoIsUrl (repo r) = guardUsable (repo r) False $ do-		liftIO $ removeDirectoryRecursive $ parentDir $ gCryptLocation r k-		return True+	| not $ Git.repoIsUrl (repo r) = guardUsable (repo r) (return False) $+		liftIO $ Remote.Directory.removeDirGeneric (Git.repoLocation (repo r)) (parentDir (gCryptLocation r k)) 	| Git.repoIsSsh (repo r) = shellOrRsync r removeshell removersync 	| otherwise = unsupportedUrl   where 	removersync = Remote.Rsync.remove rsyncopts k 	removeshell = Ssh.dropKey (repo r) k -checkPresent :: Remote -> Remote.Rsync.RsyncOpts -> Key -> Annex (Either String Bool)-checkPresent r rsyncopts k+checkKey :: Remote -> Remote.Rsync.RsyncOpts -> CheckPresent+checkKey r rsyncopts k 	| not $ Git.repoIsUrl (repo r) = 		guardUsable (repo r) (cantCheck $ repo r) $-			liftIO $ catchDefaultIO (cantCheck $ repo r) $-				Right <$> doesFileExist (gCryptLocation r k)+			liftIO $ doesFileExist (gCryptLocation r k) 	| Git.repoIsSsh (repo r) = shellOrRsync r checkshell checkrsync 	| otherwise = unsupportedUrl   where-  	checkrsync = Remote.Rsync.checkPresent (repo r) rsyncopts k+  	checkrsync = Remote.Rsync.checkKey (repo r) rsyncopts k 	checkshell = Ssh.inAnnex (repo r) k  {- Annexed objects are hashed using lower-case directories for max@@ -391,7 +390,7 @@ 	| Git.repoIsLocal r || Git.repoIsLocalUnknown r = extract <$> 		liftIO (catchMaybeIO $ Git.Config.read r) 	| not fast = extract . liftM fst <$> getM (eitherToMaybe <$>)-		[ Ssh.onRemote r (Git.Config.fromPipe r, Left undefined) "configlist" [] []+		[ Ssh.onRemote r (Git.Config.fromPipe r, return (Left undefined)) "configlist" [] [] 		, getConfigViaRsync r 		] 	| otherwise = return (Nothing, r)
Remote/Git.hs view
@@ -27,7 +27,6 @@ import Logs.Presence import Annex.Transfer import Annex.UUID-import Annex.Exception import qualified Annex.Content import qualified Annex.BranchState import qualified Annex.Branch@@ -56,7 +55,7 @@ import Control.Concurrent import Control.Concurrent.MSampleVar import qualified Data.Map as M-import Control.Exception.Extensible+import Network.URI  remote :: RemoteType remote = RemoteType {@@ -127,7 +126,7 @@  gen :: Git.Repo -> UUID -> RemoteConfig -> RemoteGitConfig -> Annex (Maybe Remote) gen r u c gc-	| Git.GCrypt.isEncrypted r = Remote.GCrypt.gen r u c gc+	| Git.GCrypt.isEncrypted r = Remote.GCrypt.chainGen r u c gc 	| otherwise = go <$> remoteCost gc defcst   where 	defcst = if repoCheap r then cheapRemoteCost else expensiveRemoteCost@@ -141,8 +140,8 @@ 			, retrieveKeyFile = copyFromRemote new 			, retrieveKeyFileCheap = copyFromRemoteCheap new 			, removeKey = dropKey new-			, hasKey = inAnnex new-			, hasKeyCheap = repoCheap r+			, checkPresent = inAnnex new+			, checkPresentCheap = repoCheap r 			, whereisKey = Nothing 			, remoteFsck = if Git.repoIsUrl r 				then Nothing@@ -158,8 +157,22 @@ 			, readonly = Git.repoIsHttp r 			, availability = availabilityCalc r 			, remotetype = remote+			, mkUnavailable = unavailable r u c gc 			} +unavailable :: Git.Repo -> UUID -> RemoteConfig -> RemoteGitConfig -> Annex (Maybe Remote)+unavailable r u c gc = gen r' u c gc+  where+	r' = case Git.location r of+		Git.Local { Git.gitdir = d } ->+			r { Git.location = Git.LocalUnknown d }+		Git.Url url -> case uriAuthority url of+			Just auth -> +				let auth' = auth { uriRegName = "!dne!" }+				in r { Git.location = Git.Url (url { uriAuthority = Just auth' })}+			Nothing -> r { Git.location = Git.Unknown }+		_ -> r -- already unavailable+ {- Checks relatively inexpensively if a repository is available for use. -} repoAvail :: Git.Repo -> Annex Bool repoAvail r @@ -182,7 +195,7 @@ tryGitConfigRead r  	| haveconfig r = return r -- already read 	| Git.repoIsSsh r = store $ do-		v <- Ssh.onRemote r (pipedconfig, Left undefined) "configlist" [] []+		v <- Ssh.onRemote r (pipedconfig, return (Left undefined)) "configlist" [] [] 		case v of 			Right r' 				| haveconfig r' -> return r'@@ -281,14 +294,11 @@ 		s <- Annex.new r 		Annex.eval s $ do 			Annex.BranchState.disableUpdate-			void $ tryAnnex $ ensureInitialized+			void $ tryNonAsync $ ensureInitialized 			Annex.getState Annex.repo -{- Checks if a given remote has the content for a key inAnnex.- - If the remote cannot be accessed, or if it cannot determine- - whether it has the content, returns a Left error message.- -}-inAnnex :: Remote -> Key -> Annex (Either String Bool)+{- Checks if a given remote has the content for a key in its annex. -}+inAnnex :: Remote -> Key -> Annex Bool inAnnex rmt key 	| Git.repoIsHttp r = checkhttp 	| Git.repoIsUrl r = checkremote@@ -298,17 +308,13 @@ 	checkhttp = do 		showChecking r 		ifM (Url.withUrlOptions $ \uo -> anyM (\u -> Url.checkBoth u (keySize key) uo) (keyUrls rmt key))-			( return $ Right True-			, return $ Left "not found"+			( return True+			, error "not found" 			) 	checkremote = Ssh.inAnnex r key-	checklocal = guardUsable r (cantCheck r) $ dispatch <$> check-	  where-		check = either (Left . show) Right -			<$> tryAnnex (onLocal rmt $ Annex.Content.inAnnexSafe key)-		dispatch (Left e) = Left e-		dispatch (Right (Just b)) = Right b-		dispatch (Right Nothing) = cantCheck r+	checklocal = guardUsable r (cantCheck r) $+		maybe (cantCheck r) return+			=<< onLocal rmt (Annex.Content.inAnnexSafe key)  keyUrls :: Remote -> Key -> [String] keyUrls r key = map tourl locs'@@ -328,14 +334,15 @@ dropKey :: Remote -> Key -> Annex Bool dropKey r key 	| not $ Git.repoIsUrl (repo r) =-		guardUsable (repo r) False $ commitOnCleanup r $ onLocal r $ do-			ensureInitialized-			whenM (Annex.Content.inAnnex key) $ do-				Annex.Content.lockContent key $-					Annex.Content.removeAnnex key-				logStatus key InfoMissing-				Annex.Content.saveState True-			return True+		guardUsable (repo r) (return False) $+			commitOnCleanup r $ onLocal r $ do+				ensureInitialized+				whenM (Annex.Content.inAnnex key) $ do+					Annex.Content.lockContent key $+						Annex.Content.removeAnnex key+					logStatus key InfoMissing+					Annex.Content.saveState True+				return True 	| Git.repoIsHttp (repo r) = error "dropping from http remote not supported" 	| otherwise = commitOnCleanup r $ Ssh.dropKey (repo r) key @@ -344,7 +351,7 @@ copyFromRemote r key file dest _p = copyFromRemote' r key file dest copyFromRemote' :: Remote -> Key -> AssociatedFile -> FilePath -> Annex Bool copyFromRemote' r key file dest-	| not $ Git.repoIsUrl (repo r) = guardUsable (repo r) False $ do+	| not $ Git.repoIsUrl (repo r) = guardUsable (repo r) (return False) $ do 		params <- Ssh.rsyncParams r Download 		u <- getUUID 		-- run copy from perspective of remote@@ -390,6 +397,7 @@ 		Just (cmd, params) <- Ssh.git_annex_shell (repo r) "transferinfo"  			[Param $ key2file key] fields 		v <- liftIO (newEmptySV :: IO (MSampleVar Integer))+		pidv <- liftIO $ newEmptyMVar 		tid <- liftIO $ forkIO $ void $ tryIO $ do 			bytes <- readSV v 			p <- createProcess $@@ -397,6 +405,7 @@ 					{ std_in = CreatePipe 					, std_err = CreatePipe 					}+			putMVar pidv (processHandle p) 			hClose $ stderrHandle p 			let h = stdinHandle p 			let send b = do@@ -406,12 +415,17 @@ 			forever $ 				send =<< readSV v 		let feeder = writeSV v . fromBytesProcessed-		bracketIO noop (const $ tryIO $ killThread tid) (const $ a feeder)+		let cleanup = do+			void $ tryIO $ killThread tid+			tryNonAsync $+				maybe noop (void . waitForProcess)+					=<< tryTakeMVar pidv+		bracketIO noop (const cleanup) (const $ a feeder)  copyFromRemoteCheap :: Remote -> Key -> FilePath -> Annex Bool #ifndef mingw32_HOST_OS copyFromRemoteCheap r key file-	| not $ Git.repoIsUrl (repo r) = guardUsable (repo r) False $ do+	| not $ Git.repoIsUrl (repo r) = guardUsable (repo r) (return False) $ do 		loc <- liftIO $ gitAnnexLocation key (repo r) $ 			fromJust $ remoteGitConfig $ gitconfig r 		liftIO $ catchBoolIO $ createSymbolicLink loc file >> return True@@ -429,7 +443,7 @@ copyToRemote :: Remote -> Key -> AssociatedFile -> MeterUpdate -> Annex Bool copyToRemote r key file p 	| not $ Git.repoIsUrl (repo r) =-		guardUsable (repo r) False $ commitOnCleanup r $+		guardUsable (repo r) (return False) $ commitOnCleanup r $ 			copylocal =<< Annex.Content.prepSendAnnex key 	| Git.repoIsSsh (repo r) = commitOnCleanup r $ 		Annex.Content.sendAnnex key noop $ \object -> do
Remote/Glacier.hs view
@@ -9,6 +9,7 @@  import qualified Data.Map as M import qualified Data.Text as T+import qualified Data.ByteString.Lazy as L  import Common.Annex import Types.Remote@@ -17,13 +18,10 @@ import Config import Config.Cost import Remote.Helper.Special-import Remote.Helper.Encryptable import qualified Remote.Helper.AWS as AWS-import Crypto import Creds import Utility.Metered import qualified Annex-import Annex.Content import Annex.UUID import Utility.Env @@ -41,21 +39,23 @@ gen :: Git.Repo -> UUID -> RemoteConfig -> RemoteGitConfig -> Annex (Maybe Remote) gen r u c gc = new <$> remoteCost gc veryExpensiveRemoteCost   where-	new cst = Just $ encryptableRemote c-		(storeEncrypted this)-		(retrieveEncrypted this)+	new cst = Just $ specialRemote' specialcfg c+		(prepareStore this)+		(prepareRetrieve this)+		(simplyPrepare $ remove this)+		(simplyPrepare $ checkKey this) 		this 	  where 		this = Remote { 			uuid = u, 			cost = cst, 			name = Git.repoDescribe r,-			storeKey = store this,-			retrieveKeyFile = retrieve this,+			storeKey = storeKeyDummy,+			retrieveKeyFile = retreiveKeyFileDummy, 			retrieveKeyFileCheap = retrieveCheap this,-			removeKey = remove this,-			hasKey = checkPresent this,-			hasKeyCheap = False,+			removeKey = removeKeyDummy,+			checkPresent = checkPresentDummy,+			checkPresentCheap = False, 			whereisKey = Nothing, 			remoteFsck = Nothing, 			repairRepo = Nothing,@@ -65,8 +65,13 @@ 			localpath = Nothing, 			readonly = False, 			availability = GloballyAvailable,-			remotetype = remote+			remotetype = remote,+			mkUnavailable = return Nothing 		}+	specialcfg = (specialRemoteCfg c)+		-- Disabled until jobList gets support for chunks.+		{ chunkConfig = NoChunks+		}  glacierSetup :: Maybe UUID -> Maybe CredPair -> RemoteConfig -> Annex (RemoteConfig, UUID) glacierSetup mu mcreds c = do@@ -89,38 +94,18 @@ 		, ("vault", defvault) 		] -store :: Remote -> Key -> AssociatedFile -> MeterUpdate -> Annex Bool-store r k _f p+prepareStore :: Remote -> Preparer Storer+prepareStore r = checkPrepare nonEmpty (byteStorer $ store r)++nonEmpty :: Key -> Annex Bool+nonEmpty k 	| keySize k == Just 0 = do 		warning "Cannot store empty files in Glacier." 		return False-	| otherwise = sendAnnex k (void $ remove r k) $ \src ->-		metered (Just p) k $ \meterupdate ->-			storeHelper r k $ streamMeteredFile src meterupdate--storeEncrypted :: Remote -> (Cipher, Key) -> Key -> MeterUpdate -> Annex Bool-storeEncrypted r (cipher, enck) k p = sendAnnex k (void $ remove r enck) $ \src ->-	metered (Just p) k $ \meterupdate ->-		storeHelper r enck $ \h ->-			encrypt (getGpgEncParams r) cipher (feedFile src)-				(readBytes $ meteredWrite meterupdate h)--retrieve :: Remote -> Key -> AssociatedFile -> FilePath -> MeterUpdate -> Annex Bool-retrieve r k _f d p = metered (Just p) k $ \meterupdate ->-	retrieveHelper r k $-		readBytes $ meteredWriteFile meterupdate d--retrieveCheap :: Remote -> Key -> FilePath -> Annex Bool-retrieveCheap _ _ _ = return False--retrieveEncrypted :: Remote -> (Cipher, Key) -> Key -> FilePath -> MeterUpdate -> Annex Bool-retrieveEncrypted r (cipher, enck) k d p = metered (Just p) k $ \meterupdate ->-	retrieveHelper r enck $ readBytes $ \b ->-		decrypt cipher (feedBytes b) $-			readBytes $ meteredWriteFile meterupdate d+	| otherwise = return True -storeHelper :: Remote -> Key -> (Handle -> IO ()) -> Annex Bool-storeHelper r k feeder = go =<< glacierEnv c u+store :: Remote -> Key -> L.ByteString -> MeterUpdate -> Annex Bool+store r k b p = go =<< glacierEnv c u   where 	c = config r 	u = uuid r@@ -133,14 +118,17 @@ 		] 	go Nothing = return False 	go (Just e) = do-		let p = (proc "glacier" (toCommand params)) { env = Just e }+		let cmd = (proc "glacier" (toCommand params)) { env = Just e } 		liftIO $ catchBoolIO $-			withHandle StdinHandle createProcessSuccess p $ \h -> do-				feeder h+			withHandle StdinHandle createProcessSuccess cmd $ \h -> do+				meteredWrite p h b 				return True -retrieveHelper :: Remote -> Key -> (Handle -> IO ()) -> Annex Bool-retrieveHelper r k reader = go =<< glacierEnv c u+prepareRetrieve :: Remote -> Preparer Retriever+prepareRetrieve = simplyPrepare . byteRetriever . retrieve++retrieve :: Remote -> Key -> (L.ByteString -> Annex Bool) -> Annex Bool+retrieve r k sink = go =<< glacierEnv c u   where 	c = config r 	u = uuid r@@ -151,48 +139,49 @@ 		, Param $ getVault $ config r 		, Param $ archive r k 		]-	go Nothing = return False+	go Nothing = error "cannot retrieve from glacier" 	go (Just e) = do-		let p = (proc "glacier" (toCommand params)) { env = Just e }-		ok <- liftIO $ catchBoolIO $-			withHandle StdoutHandle createProcessSuccess p $ \h ->-				ifM (hIsEOF h)-					( return False-					, do-						reader h-						return True-					)-		unless ok later+		let cmd = (proc "glacier" (toCommand params)) { env = Just e }+		(_, Just h, _, pid) <- liftIO $ createProcess cmd+		-- Glacier cannot store empty files, so if the output is+		-- empty, the content is not available yet.+		ok <- ifM (liftIO $ hIsEOF h)+			( return False+			, sink =<< liftIO (L.hGetContents h)+			)+		liftIO $ hClose h+		liftIO $ forceSuccessProcess cmd pid+		unless ok $ do+			showLongNote "Recommend you wait up to 4 hours, and then run this command again." 		return ok-	later = showLongNote "Recommend you wait up to 4 hours, and then run this command again." -remove :: Remote -> Key -> Annex Bool+retrieveCheap :: Remote -> Key -> FilePath -> Annex Bool+retrieveCheap _ _ _ = return False++remove :: Remote -> Remover remove r k = glacierAction r 	[ Param "archive"+	 	, Param "delete" 	, Param $ getVault $ config r 	, Param $ archive r k 	] -checkPresent :: Remote -> Key -> Annex (Either String Bool)-checkPresent r k = do+checkKey :: Remote -> CheckPresent+checkKey r k = do 	showAction $ "checking " ++ name r 	go =<< glacierEnv (config r) (uuid r)   where-	go Nothing = return $ Left "cannot check glacier"+	go Nothing = error "cannot check glacier" 	go (Just e) = do 		{- glacier checkpresent outputs the archive name to stdout if 		 - it's present. -}-		v <- liftIO $ catchMsgIO $ -			readProcessEnv "glacier" (toCommand params) (Just e)-		case v of-			Right s -> do-				let probablypresent = key2file k `elem` lines s-				if probablypresent-					then ifM (Annex.getFlag "trustglacier")-						( return $ Right True, untrusted )-					else return $ Right False-			Left err -> return $ Left err+		s <- liftIO $ readProcessEnv "glacier" (toCommand params) (Just e)+		let probablypresent = key2file k `elem` lines s+		if probablypresent+			then ifM (Annex.getFlag "trustglacier")+				( return True, error untrusted )+			else return False  	params = glacierParams (config r) 		[ Param "archive"@@ -202,7 +191,7 @@ 		, Param $ archive r k 		] -	untrusted = return $ Left $ unlines+	untrusted = unlines 			[ "Glacier's inventory says it has a copy." 			, "However, the inventory could be out of date, if it was recently removed." 			, "(Use --trust-glacier if you're sure it's still in Glacier.)"@@ -261,6 +250,10 @@  -  - A complication is that `glacier job list` will display the encrypted  - keys when the remote is encrypted.+ -+ - Dealing with encrypted chunked keys would be tricky. However, there+ - seems to be no benefit to using chunking with glacier, so chunking is+ - not supported.  -} jobList :: Remote -> [Key] -> Annex ([Key], [Key]) jobList r keys = go =<< glacierEnv (config r) (uuid r)@@ -282,7 +275,8 @@ 			then return nada 			else do 				enckeys <- forM keys $ \k ->-					maybe k snd <$> cipherKey (config r) k+					maybe k (\(_, enck) -> enck k)+						<$> cipherKey (config r) 				let keymap = M.fromList $ zip enckeys keys 				let convert = mapMaybe (`M.lookup` keymap) 				return (convert succeeded, convert failed)
Remote/Helper/Chunked.hs view
@@ -1,144 +1,401 @@ {- git-annex chunked remotes  -- - Copyright 2012 Joey Hess <joey@kitenet.net>+ - Copyright 2014 Joey Hess <joey@kitenet.net>  -  - Licensed under the GNU GPL version 3 or higher.  -} -module Remote.Helper.Chunked where+module Remote.Helper.Chunked (+	ChunkSize,+	ChunkConfig(..),+	getChunkConfig,+	storeChunks,+	removeChunks,+	retrieveChunks,+	checkPresentChunks,+) where  import Common.Annex import Utility.DataUnits+import Types.StoreRetrieve import Types.Remote+import Types.Key+import Logs.Chunk import Utility.Metered+import Crypto (EncKey)+import Backend (isStableKey) -import qualified Data.Map as M import qualified Data.ByteString.Lazy as L-import Data.Int-import qualified Control.Exception as E+import qualified Data.Map as M -type ChunkSize = Maybe Int64+data ChunkConfig+	= NoChunks+	| UnpaddedChunks ChunkSize+	| LegacyChunks ChunkSize+	deriving (Show) -{- Gets a remote's configured chunk size. -}-chunkSize :: RemoteConfig -> ChunkSize-chunkSize m =+noChunks :: ChunkConfig -> Bool+noChunks NoChunks = True+noChunks _ = False++getChunkConfig :: RemoteConfig -> ChunkConfig+getChunkConfig m = 	case M.lookup "chunksize" m of-		Nothing -> Nothing-		Just v -> case readSize dataUnits v of-			Nothing -> error "bad chunksize"-			Just size-				| size <= 0 -> error "bad chunksize"-				| otherwise -> Just $ fromInteger size+		Nothing -> case M.lookup "chunk" m of+			Nothing -> NoChunks+			Just v -> readsz UnpaddedChunks v "chunk"+		Just v -> readsz LegacyChunks v "chunksize"+  where+	readsz c v f = case readSize dataUnits v of+		Just size+			| size == 0 -> NoChunks+			| size > 0 -> c (fromInteger size)+		_ -> error $ "bad configuration " ++ f ++ "=" ++ v -{- This is an extension that's added to the usual file (or whatever)- - where the remote stores a key. -}-type ChunkExt = String+-- An infinite stream of chunk keys, starting from chunk 1.+newtype ChunkKeyStream = ChunkKeyStream [Key] -{- A record of the number of chunks used.+chunkKeyStream :: Key -> ChunkSize -> ChunkKeyStream+chunkKeyStream basek chunksize = ChunkKeyStream $ map mk [1..]+  where+	mk chunknum = sizedk { keyChunkNum = Just chunknum }+	sizedk = basek { keyChunkSize = Just (toInteger chunksize) }++nextChunkKeyStream :: ChunkKeyStream -> (Key, ChunkKeyStream)+nextChunkKeyStream (ChunkKeyStream (k:l)) = (k, ChunkKeyStream l)+nextChunkKeyStream (ChunkKeyStream []) = undefined -- stream is infinite!++takeChunkKeyStream :: ChunkCount -> ChunkKeyStream -> [Key]+takeChunkKeyStream n (ChunkKeyStream l) = genericTake n l++-- Number of chunks already consumed from the stream.+numChunks :: ChunkKeyStream -> Integer+numChunks = pred . fromJust . keyChunkNum . fst . nextChunkKeyStream++{- Splits up the key's content into chunks, passing each chunk to+ - the storer action, along with a corresponding chunk key and a+ - progress meter update callback.  -- - While this can be guessed at based on the size of the key, encryption- - makes that larger. Also, using this helps deal with changes to chunksize- - over the life of a remote.+ - To support resuming, the checker is used to find the first missing+ - chunk key. Storing starts from that chunk.+ -+ - This buffers each chunk in memory, so can use a lot of memory+ - with a large ChunkSize.+ - More optimal versions of this can be written, that rely+ - on L.toChunks to split the lazy bytestring into chunks (typically+ - smaller than the ChunkSize), and eg, write those chunks to a Handle.+ - But this is the best that can be done with the storer interface that+ - writes a whole L.ByteString at a time.  -}-chunkCount :: ChunkExt-chunkCount = ".chunkcount"+storeChunks+	:: UUID+	-> ChunkConfig+	-> Key+	-> FilePath+	-> MeterUpdate+	-> Storer+	-> CheckPresent+	-> Annex Bool+storeChunks u chunkconfig k f p storer checker = +	case chunkconfig of+		(UnpaddedChunks chunksize) | isStableKey k -> +			bracketIO open close (go chunksize)+		_ -> storer k (FileContent f) p+  where+	open = tryIO $ openBinaryFile f ReadMode -{- An infinite stream of extensions to use for chunks. -}-chunkStream :: [ChunkExt]-chunkStream = map (\n -> ".chunk" ++ show n) [1 :: Integer ..]+	close (Right h) = hClose h+	close (Left _) = noop -{- Parses the String from the chunkCount file, and returns the files that- - are used to store the chunks. -}-listChunks :: FilePath -> String -> [FilePath]-listChunks basedest chunkcount = take count $ map (basedest ++) chunkStream-  where-	count = fromMaybe 0 $ readish chunkcount+	go _ (Left e) = do+		warning (show e)+		return False+	go chunksize (Right h) = do+		let chunkkeys = chunkKeyStream k chunksize+		(chunkkeys', startpos) <- seekResume h chunkkeys checker+		b <- liftIO $ L.hGetContents h+		gochunks p startpos chunksize b chunkkeys' -{- For use when there is no chunkCount file; uses the action to find- - chunks, and returns them, or Nothing if none found. Relies on- - storeChunks's finalizer atomically moving the chunks into place once all- - are written.+	gochunks :: MeterUpdate -> BytesProcessed -> ChunkSize -> L.ByteString -> ChunkKeyStream -> Annex Bool+	gochunks meterupdate startpos chunksize = loop startpos . splitchunk+	  where+		splitchunk = L.splitAt chunksize+	+		loop bytesprocessed (chunk, bs) chunkkeys+			| L.null chunk && numchunks > 0 = do+ 				-- Once all chunks are successfully+				-- stored, update the chunk log.+				chunksStored u k (FixedSizeChunks chunksize) numchunks+				return True+			| otherwise = do+				liftIO $ meterupdate' zeroBytesProcessed+				let (chunkkey, chunkkeys') = nextChunkKeyStream chunkkeys+				ifM (storer chunkkey (ByteContent chunk) meterupdate')+					( do+						let bytesprocessed' = addBytesProcessed bytesprocessed (L.length chunk)+						loop bytesprocessed' (splitchunk bs) chunkkeys'+					, return False+					)+		  where+			numchunks = numChunks chunkkeys+ 			{- The MeterUpdate that is passed to the action+			 - storing a chunk is offset, so that it reflects+			 - the total bytes that have already been stored+			 - in previous chunks. -}+			meterupdate' = offsetMeterUpdate meterupdate bytesprocessed++{- Check if any of the chunk keys are present. If found, seek forward+ - in the Handle, so it will be read starting at the first missing chunk.+ - Returns the ChunkKeyStream truncated to start at the first missing+ - chunk, and the number of bytes skipped due to resuming.  -- - This is only needed to work around a bug that caused the chunkCount file- - not to be written.+ - As an optimisation, if the file fits into a single chunk, there's no need+ - to check if that chunk is present -- we know it's not, because otherwise+ - the whole file would be present and there would be no reason to try to+ - store it.  -}-probeChunks :: FilePath -> (FilePath -> IO Bool) -> IO [FilePath]-probeChunks basedest check = go [] $ map (basedest ++) chunkStream+seekResume+	:: Handle+	-> ChunkKeyStream+	-> CheckPresent+	-> Annex (ChunkKeyStream, BytesProcessed)+seekResume h chunkkeys checker = do+	sz <- liftIO (hFileSize h)+	if sz <= fromMaybe 0 (keyChunkSize $ fst $ nextChunkKeyStream chunkkeys)+		then return (chunkkeys, zeroBytesProcessed)+		else check 0 chunkkeys sz   where-	go l [] = return (reverse l)-	go l (c:cs) = ifM (check c)-		( go (c:l) cs-		, go l []-		)+	check pos cks sz+		| pos >= sz = do+			-- All chunks are already stored!+			liftIO $ hSeek h AbsoluteSeek sz+			return (cks, toBytesProcessed sz)+		| otherwise = do+			v <- tryNonAsync (checker k)+			case v of+				Right True ->+					check pos' cks' sz+				_ -> do+					when (pos > 0) $+						liftIO $ hSeek h AbsoluteSeek pos+					return (cks, toBytesProcessed pos)+	  where+		(k, cks') = nextChunkKeyStream cks+		pos' = pos + fromMaybe 0 (keyChunkSize k) -{- Given the base destination to use to store a value,- - generates a stream of temporary destinations (just one when not chunking)- - and passes it to an action, which should chunk and store the data,- - and return the destinations it stored to, or [] on error. Then- - calls the recorder to write the chunk count (if chunking). Finally, the- - finalizer is called to rename the tmp into the dest - - (and do any other cleanup).+{- Removes all chunks of a key from a remote, by calling a remover+ - action on each.+ -+ - The remover action should succeed even if asked to+ - remove a key that is not present on the remote.+ -+ - This action may be called on a chunked key. It will simply remove it.  -}-storeChunks :: Key -> FilePath -> FilePath -> ChunkSize -> ([FilePath] -> IO [FilePath]) -> (FilePath -> String -> IO ()) -> (FilePath -> FilePath -> IO ()) -> IO Bool-storeChunks key tmp dest chunksize storer recorder finalizer = either onerr return-	=<< (E.try go :: IO (Either E.SomeException Bool))+removeChunks :: (Key -> Annex Bool) -> UUID -> ChunkConfig -> EncKey -> Key -> Annex Bool+removeChunks remover u chunkconfig encryptor k = do+	ls <- chunkKeys u chunkconfig k+	ok <- allM (remover . encryptor) (concat ls)+	when ok $ do+		let chunksizes = catMaybes $ map (keyChunkSize <=< headMaybe) ls+		forM_ chunksizes $ chunksRemoved u k . FixedSizeChunks . fromIntegral+	return ok++{- Retrieves a key from a remote, using a retriever action.+ -+ - When the remote is chunked, tries each of the options returned by+ - chunkKeys until it finds one where the retriever successfully+ - gets the first chunked key. The content of that key, and any+ - other chunks in the list is fed to the sink.+ -+ - If retrival of one of the subsequent chunks throws an exception,+ - gives up and returns False. Note that partial data may have been+ - written to the sink in this case.+ -+ - Resuming is supported when using chunks. When the destination file+ - already exists, it skips to the next chunked key that would be needed+ - to resume.+ -}+retrieveChunks +	:: Retriever+	-> UUID+	-> ChunkConfig+	-> EncKey+	-> Key+	-> FilePath+	-> MeterUpdate+	-> (Maybe Handle -> Maybe MeterUpdate -> ContentSource -> Annex Bool)+	-> Annex Bool+retrieveChunks retriever u chunkconfig encryptor basek dest basep sink+	| noChunks chunkconfig =+		-- Optimisation: Try the unchunked key first, to avoid+		-- looking in the git-annex branch for chunk counts+		-- that are likely not there.+		getunchunked `catchNonAsync`+			const (go =<< chunkKeysOnly u basek)+	| otherwise = go =<< chunkKeys u chunkconfig basek   where-	go = do-		stored <- storer tmpdests-		when (isJust chunksize) $ do-			let chunkcount = basef ++ chunkCount-			recorder chunkcount (show $ length stored)-		finalizer tmp dest-		return (not $ null stored)-	onerr e = do-		print e+	go ls = do+		currsize <- liftIO $ catchMaybeIO $+			toInteger . fileSize <$> getFileStatus dest+		let ls' = maybe ls (setupResume ls) currsize+		if any null ls'+			then return True -- dest is already complete+			else firstavail currsize ls' `catchNonAsync` giveup++	giveup e = do+		warning (show e) 		return False -	basef = tmp ++ keyFile key-	tmpdests-		| isNothing chunksize = [basef]-		| otherwise = map (basef ++ ) chunkStream+	firstavail _ [] = return False+	firstavail currsize ([]:ls) = firstavail currsize ls+	firstavail currsize ((k:ks):ls)+		| k == basek = getunchunked+			`catchNonAsync` (const $ firstavail currsize ls)+		| otherwise = do+			let offset = resumeOffset currsize k+			let p = maybe basep+				(offsetMeterUpdate basep . toBytesProcessed)+				offset+			v <- tryNonAsync $+				retriever (encryptor k) p $ \content ->+					bracketIO (maybe opennew openresume offset) hClose $ \h -> do+						void $ tosink (Just h) p content+						let sz = toBytesProcessed $+							fromMaybe 0 $ keyChunkSize k+						getrest p h sz sz ks+							`catchNonAsync` giveup+			case v of+				Left e+					| null ls -> giveup e+					| otherwise -> firstavail currsize ls+				Right r -> return r -{- Given a list of destinations to use, chunks the data according to the- - ChunkSize, and runs the storer action to store each chunk. Returns- - the destinations where data was stored, or [] on error.+	getrest _ _ _ _ [] = return True+	getrest p h sz bytesprocessed (k:ks) = do+		let p' = offsetMeterUpdate p bytesprocessed+		liftIO $ p' zeroBytesProcessed+		ifM (retriever (encryptor k) p' $ tosink (Just h) p')+			( getrest p h sz (addBytesProcessed bytesprocessed sz) ks+			, giveup "chunk retrieval failed"+			)++	getunchunked = retriever (encryptor basek) basep $ tosink Nothing basep++	opennew = openBinaryFile dest WriteMode++	-- Open the file and seek to the start point in order to resume.+	openresume startpoint = do+		-- ReadWriteMode allows seeking; AppendMode does not.+		h <- openBinaryFile dest ReadWriteMode+		hSeek h AbsoluteSeek startpoint+		return h++ 	{- Progress meter updating is a bit tricky: If the Retriever+	 - populates a file, it is responsible for updating progress+	 - as the file is being retrieved. +	 -+	 - However, if the Retriever generates a lazy ByteString,+	 - it is not responsible for updating progress (often it cannot).+	 - Instead, the sink is passed a meter to update as it consumes+	 - the ByteString.+	 -}+	tosink h p content = sink h p' content+	  where+		p'+			| isByteContent content = Just p+			| otherwise = Nothing++{- Can resume when the chunk's offset is at or before the end of+ - the dest file. -}+resumeOffset :: Maybe Integer -> Key -> Maybe Integer+resumeOffset Nothing _ = Nothing+resumeOffset currsize k+	| offset <= currsize = offset+	| otherwise = Nothing+  where+	offset = chunkKeyOffset k++{- Drops chunks that are already present in a file, based on its size.+ - Keeps any non-chunk keys.+ -}+setupResume :: [[Key]] -> Integer -> [[Key]]+setupResume ls currsize = map dropunneeded ls+  where+	dropunneeded [] = []+	dropunneeded l@(k:_) = case keyChunkSize k of+		Just chunksize | chunksize > 0 ->+			genericDrop (currsize `div` chunksize) l+		_ -> l++{- Checks if a key is present in a remote. This requires any one+ - of the lists of options returned by chunkKeys to all check out+ - as being present using the checker action.  -- - This buffers each chunk in memory.- - More optimal versions of this can be written, that rely- - on L.toChunks to split the lazy bytestring into chunks (typically- - smaller than the ChunkSize), and eg, write those chunks to a Handle.- - But this is the best that can be done with the storer interface that- - writes a whole L.ByteString at a time.+ - Throws an exception if the remote is not accessible.  -}-storeChunked :: ChunkSize -> [FilePath] -> (FilePath -> L.ByteString -> IO ()) -> L.ByteString -> IO [FilePath]-storeChunked chunksize dests storer content = either onerr return-	=<< (E.try (go chunksize dests) :: IO (Either E.SomeException [FilePath]))+checkPresentChunks+	:: CheckPresent+	-> UUID+	-> ChunkConfig+	-> EncKey+	-> Key+	-> Annex Bool+checkPresentChunks checker u chunkconfig encryptor basek+	| noChunks chunkconfig = do+		-- Optimisation: Try the unchunked key first, to avoid+		-- looking in the git-annex branch for chunk counts+		-- that are likely not there.+		v <- check basek+		case v of+			Right True -> return True+			Left e -> checklists (Just e) =<< chunkKeysOnly u basek+			_ -> checklists Nothing =<< chunkKeysOnly u basek+	| otherwise = checklists Nothing =<< chunkKeys u chunkconfig basek   where-	go _ [] = return [] -- no dests!?-	go Nothing (d:_) = do-		storer d content-		return [d]-	go (Just sz) _-		-- always write a chunk, even if the data is 0 bytes-		| L.null content = go Nothing dests-		| otherwise = storechunks sz [] dests content-		-	onerr e = do-		print e-		return []+	checklists Nothing [] = return False+	checklists (Just deferrederror) [] = throwM deferrederror+	checklists d (l:ls)+		| not (null l) = do+			v <- checkchunks l+			case v of+				Left e -> checklists (Just e) ls+				Right True -> return True+				Right False -> checklists Nothing ls+		| otherwise = checklists d ls 	-	storechunks _ _ [] _ = return [] -- ran out of dests-	storechunks sz useddests (d:ds) b-		| L.null b = return $ reverse useddests-		| otherwise = do-			let (chunk, b') = L.splitAt sz b-			storer d chunk-			storechunks sz (d:useddests) ds b'+	checkchunks :: [Key] -> Annex (Either SomeException Bool)+	checkchunks [] = return (Right True)+	checkchunks (k:ks) = do+		v <- check k+		case v of+			Right True -> checkchunks ks+			Right False -> return $ Right False+			Left e -> return $ Left e -{- Writes a series of chunks to a file. The feeder is called to get- - each chunk. -}-meteredWriteFileChunks :: MeterUpdate -> FilePath -> [v] -> (v -> IO L.ByteString) -> IO ()-meteredWriteFileChunks meterupdate dest chunks feeder =-	withBinaryFile dest WriteMode $ \h ->-		forM_ chunks $-			meteredWrite meterupdate h <=< feeder+	check = tryNonAsync . checker . encryptor++{- A key can be stored in a remote unchunked, or as a list of chunked keys.+ - This can be the case whether or not the remote is currently configured+ - to use chunking.+ -+ - It's even possible for a remote to have the same key stored multiple+ - times with different chunk sizes!+ -+ - This finds all possible lists of keys that might be on the remote that+ - can be combined to get back the requested key, in order from most to+ - least likely to exist.+ -}+chunkKeys :: UUID -> ChunkConfig -> Key -> Annex [[Key]]+chunkKeys u chunkconfig k = do+	l <- chunkKeysOnly u k+	return $ if noChunks chunkconfig+		then [k] : l+		else l ++ [[k]]++chunkKeysOnly :: UUID -> Key -> Annex [[Key]]+chunkKeysOnly u k = map (toChunkList k) <$> getCurrentChunks u k++toChunkList :: Key -> (ChunkMethod, ChunkCount) -> [Key]+toChunkList k (FixedSizeChunks chunksize, chunkcount) =+	takeChunkKeyStream chunkcount $ chunkKeyStream k chunksize+toChunkList _ (UnknownChunks _, _) = []
+ Remote/Helper/Chunked/Legacy.hs view
@@ -0,0 +1,126 @@+{- legacy git-annex chunked remotes+ -+ - Copyright 2012 Joey Hess <joey@kitenet.net>+ -+ - Licensed under the GNU GPL version 3 or higher.+ -}++module Remote.Helper.Chunked.Legacy where++import Common.Annex+import Remote.Helper.Chunked+import Utility.Metered++import qualified Data.ByteString.Lazy as L+import qualified Control.Exception as E++{- This is an extension that's added to the usual file (or whatever)+ - where the remote stores a key. -}+type ChunkExt = String++{- A record of the number of chunks used.+ -+ - While this can be guessed at based on the size of the key, encryption+ - makes that larger. Also, using this helps deal with changes to chunksize+ - over the life of a remote.+ -}+chunkCount :: ChunkExt+chunkCount = ".chunkcount"++{- An infinite stream of extensions to use for chunks. -}+chunkStream :: [ChunkExt]+chunkStream = map (\n -> ".chunk" ++ show n) [1 :: Integer ..]++{- Parses the String from the chunkCount file, and returns the files that+ - are used to store the chunks. -}+listChunks :: FilePath -> String -> [FilePath]+listChunks basedest chunkcount = take count $ map (basedest ++) chunkStream+  where+	count = fromMaybe 0 $ readish chunkcount++{- For use when there is no chunkCount file; uses the action to find+ - chunks, and returns them, or Nothing if none found. Relies on+ - storeChunks's finalizer atomically moving the chunks into place once all+ - are written.+ -+ - This is only needed to work around a bug that caused the chunkCount file+ - not to be written.+ -}+probeChunks :: FilePath -> (FilePath -> IO Bool) -> IO [FilePath]+probeChunks basedest check = go [] $ map (basedest ++) chunkStream+  where+	go l [] = return (reverse l)+	go l (c:cs) = ifM (check c)+		( go (c:l) cs+		, go l []+		)++{- Given the base destination to use to store a value,+ - generates a stream of temporary destinations,+ - and passes it to an action, which should chunk and store the data,+ - and return the destinations it stored to, or [] on error. Then+ - calls the recorder to write the chunk count. Finally, the+ - finalizer is called to rename the tmp into the dest + - (and do any other cleanup).+ -}+storeChunks :: Key -> FilePath -> FilePath -> ([FilePath] -> IO [FilePath]) -> (FilePath -> String -> IO ()) -> (FilePath -> FilePath -> IO ()) -> IO Bool+storeChunks key tmp dest storer recorder finalizer = either onerr return+	=<< (E.try go :: IO (Either E.SomeException Bool))+  where+	go = do+		stored <- storer tmpdests+		let chunkcount = basef ++ chunkCount+		recorder chunkcount (show $ length stored)+		finalizer tmp dest+		return (not $ null stored)+	onerr e = do+		warningIO (show e)+		return False++	basef = tmp ++ keyFile key+	tmpdests = map (basef ++ ) chunkStream++{- Given a list of destinations to use, chunks the data according to the+ - ChunkSize, and runs the storer action to store each chunk. Returns+ - the destinations where data was stored, or [] on error.+ -+ - This buffers each chunk in memory.+ - More optimal versions of this can be written, that rely+ - on L.toChunks to split the lazy bytestring into chunks (typically+ - smaller than the ChunkSize), and eg, write those chunks to a Handle.+ - But this is the best that can be done with the storer interface that+ - writes a whole L.ByteString at a time.+ -}+storeChunked :: ChunkSize -> [FilePath] -> (FilePath -> L.ByteString -> IO ()) -> L.ByteString -> IO [FilePath]+storeChunked chunksize dests storer content = either onerr return+	=<< (E.try (go (Just chunksize) dests) :: IO (Either E.SomeException [FilePath]))+  where+	go _ [] = return [] -- no dests!?+	go Nothing (d:_) = do+		storer d content+		return [d]+	go (Just sz) _+		-- always write a chunk, even if the data is 0 bytes+		| L.null content = go Nothing dests+		| otherwise = storechunks sz [] dests content+		+	onerr e = do+		warningIO (show e)+		return []+	+	storechunks _ _ [] _ = return [] -- ran out of dests+	storechunks sz useddests (d:ds) b+		| L.null b = return $ reverse useddests+		| otherwise = do+			let (chunk, b') = L.splitAt sz b+			storer d chunk+			storechunks sz (d:useddests) ds b'++{- Writes a series of chunks to a file. The feeder is called to get+ - each chunk.+ -}+meteredWriteFileChunks :: MeterUpdate -> FilePath -> [v] -> (v -> IO L.ByteString) -> IO ()+meteredWriteFileChunks meterupdate dest chunks feeder =+	withBinaryFile dest WriteMode $ \h ->+		forM_ chunks $+			meteredWrite meterupdate h <=< feeder
Remote/Helper/Encryptable.hs view
@@ -14,9 +14,7 @@ import Crypto import Types.Crypto import qualified Annex-import Config.Cost import Utility.Base64-import Utility.Metered  {- Encryption setup for a remote. The user must specify whether to use  - an encryption key, or not encrypt. An encrypted cipher is created, or is@@ -66,57 +64,28 @@ 	c' = foldr M.delete c                 -- git-annex used to remove 'encryption' as well, since                 -- it was redundant; we now need to keep it for-                -- public-key incryption, hence we leave it on newer+                -- public-key encryption, hence we leave it on newer                 -- remotes (while being backward-compatible). 		[ "keyid", "keyid+", "keyid-", "highRandomQuality" ] -{- Modifies a Remote to support encryption.- -- - Two additional functions must be provided by the remote,- - to support storing and retrieving encrypted content. -}-encryptableRemote-	:: RemoteConfig-	-> ((Cipher, Key) -> Key -> MeterUpdate -> Annex Bool)-	-> ((Cipher, Key) -> Key -> FilePath -> MeterUpdate -> Annex Bool)-	-> Remote-	-> Remote-encryptableRemote c storeKeyEncrypted retrieveKeyFileEncrypted r = -	r {-		storeKey = store,-		retrieveKeyFile = retrieve,-		retrieveKeyFileCheap = retrieveCheap,-		removeKey = withkey $ removeKey r,-		hasKey = withkey $ hasKey r,-		cost = cost r + encryptedRemoteCostAdj-	}-  where-	store k f p = cip k >>= maybe-		(storeKey r k f p)-		(\enck -> storeKeyEncrypted enck k p)-	retrieve k f d p = cip k >>= maybe-		(retrieveKeyFile r k f d p)-		(\enck -> retrieveKeyFileEncrypted enck k d p)-	retrieveCheap k d = cip k >>= maybe-		(retrieveKeyFileCheap r k d)-		(\_ -> return False)-	withkey a k = cip k >>= maybe (a k) (a . snd)-	cip = cipherKey c- {- Gets encryption Cipher. The decrypted Ciphers are cached in the Annex  - state. -} remoteCipher :: RemoteConfig -> Annex (Maybe Cipher)-remoteCipher c = go $ extractCipher c+remoteCipher = fmap fst <$$> remoteCipher'++remoteCipher' :: RemoteConfig -> Annex (Maybe (Cipher, StorableCipher))+remoteCipher' c = go $ extractCipher c   where 	go Nothing = return Nothing 	go (Just encipher) = do 		cache <- Annex.getState Annex.ciphers 		case M.lookup encipher cache of-			Just cipher -> return $ Just cipher+			Just cipher -> return $ Just (cipher, encipher) 			Nothing -> do 				showNote "gpg" 				cipher <- liftIO $ decryptCipher encipher 				Annex.changeState (\s -> s { Annex.ciphers = M.insert encipher cipher cache })-				return $ Just cipher+				return $ Just (cipher, encipher)  {- Checks if the remote's config allows storing creds in the remote's config.  - @@ -133,11 +102,11 @@ 	| isJust (M.lookup "cipherkeys" c) && isJust (M.lookup "cipher" c) = True 	| otherwise = False -{- Gets encryption Cipher, and encrypted version of Key. -}-cipherKey :: RemoteConfig -> Key -> Annex (Maybe (Cipher, Key))-cipherKey c k = fmap make <$> remoteCipher c+{- Gets encryption Cipher, and key encryptor. -}+cipherKey :: RemoteConfig -> Annex (Maybe (Cipher, EncKey))+cipherKey c = fmap make <$> remoteCipher c   where-	make ciphertext = (ciphertext, encryptKey mac ciphertext k)+	make ciphertext = (ciphertext, encryptKey mac ciphertext) 	mac = fromMaybe defaultMac $ M.lookup "mac" c >>= readMac  {- Stores an StorableCipher in a remote's configuration. -}
Remote/Helper/Git.hs view
@@ -26,7 +26,7 @@  {- Avoids performing an action on a local repository that's not usable.  - Does not check that the repository is still available on disk. -}-guardUsable :: Git.Repo -> a -> Annex a -> Annex a-guardUsable r onerr a-	| Git.repoIsLocalUnknown r = return onerr+guardUsable :: Git.Repo -> Annex a -> Annex a -> Annex a+guardUsable r fallback a+	| Git.repoIsLocalUnknown r = fallback 	| otherwise = a
Remote/Helper/Hooks.hs view
@@ -39,7 +39,7 @@ 		, retrieveKeyFile = \k f d p -> wrapper $ retrieveKeyFile r k f d p 		, retrieveKeyFileCheap = \k f -> wrapper $ retrieveKeyFileCheap r k f 		, removeKey = wrapper . removeKey r-		, hasKey = wrapper . hasKey r+		, checkPresent = wrapper . checkPresent r 		} 	  where 		wrapper = runHooks r' starthook stophook
+ Remote/Helper/Http.hs view
@@ -0,0 +1,55 @@+{- helpers for remotes using http+ -+ - Copyright 2014 Joey Hess <joey@kitenet.net>+ -+ - Licensed under the GNU GPL version 3 or higher.+ -}++module Remote.Helper.Http where++import Common.Annex+import Types.StoreRetrieve+import Utility.Metered+import Remote.Helper.Special+import Network.HTTP.Client (RequestBody(..), Response, responseStatus, responseBody, BodyReader)+import Network.HTTP.Types++import qualified Data.ByteString.Lazy as L+import qualified Data.ByteString as S+import Control.Concurrent++-- A storer that expects to be provided with a http RequestBody containing+-- the content to store.+--+-- Implemented as a fileStorer, so that the content can be streamed+-- from the file in constant space.+httpStorer :: (Key -> RequestBody -> Annex Bool) -> Storer+httpStorer a = fileStorer $ \k f m -> do+	size <- liftIO $ (fromIntegral . fileSize <$> getFileStatus f :: IO Integer)+	let streamer sink = withMeteredFile f m $ \b -> do+		mvar <- newMVar $ L.toChunks b+		let getnextchunk = modifyMVar mvar $ pure . pop+		sink getnextchunk+	let body = RequestBodyStream (fromInteger size) streamer+	a k body+  where+	pop [] = ([], S.empty)+	pop (c:cs) = (cs, c)++-- Reads the http body and stores it to the specified file, updating the+-- meter as it goes.+httpBodyRetriever :: FilePath -> MeterUpdate -> Response BodyReader -> IO ()+httpBodyRetriever dest meterupdate resp+	| responseStatus resp /= ok200 = error $ show $ responseStatus resp+	| otherwise = bracket (openBinaryFile dest WriteMode) hClose (go zeroBytesProcessed)+  where+	reader = responseBody resp+	go sofar h = do+		b <- reader+		if S.null b+			then return ()+			else do+				let sofar' = addBytesProcessed sofar $ S.length b+				S.hPut h b+				meterupdate sofar'+				go sofar' h
Remote/Helper/Messages.hs view
@@ -9,9 +9,19 @@  import Common.Annex import qualified Git+import qualified Types.Remote as Remote  showChecking :: Git.Repo -> Annex () showChecking r = showAction $ "checking " ++ Git.repoDescribe r -cantCheck :: Git.Repo -> Either String Bool-cantCheck r = Left $ "unable to check " ++ Git.repoDescribe r+class Checkable a where+	descCheckable :: a -> String++instance Checkable Git.Repo where+	descCheckable = Git.repoDescribe++instance Checkable (Remote.RemoteA a) where+	descCheckable = Remote.name++cantCheck :: Checkable a => a -> e+cantCheck v = error $ "unable to check " ++ descCheckable v
Remote/Helper/Special.hs view
@@ -1,20 +1,54 @@-{- common functions for special remotes+{- helpers for special remotes  -- - Copyright 2011 Joey Hess <joey@kitenet.net>+ - Copyright 2011-2014 Joey Hess <joey@kitenet.net>  -  - Licensed under the GNU GPL version 3 or higher.  -} -module Remote.Helper.Special where--import qualified Data.Map as M+module Remote.Helper.Special (+	findSpecialRemotes,+	gitConfigSpecialRemote,+	Preparer,+	Storer,+	Retriever,+	Remover,+	CheckPresent,+	simplyPrepare,+	ContentSource,+	checkPrepare,+	resourcePrepare,+	fileStorer,+	byteStorer,+	fileRetriever,+	byteRetriever,+	storeKeyDummy,+	retreiveKeyFileDummy,+	removeKeyDummy,+	checkPresentDummy,+	SpecialRemoteCfg(..),+	specialRemoteCfg,+	specialRemote,+	specialRemote',+	module X+) where  import Common.Annex+import Types.StoreRetrieve import Types.Remote+import Crypto+import Config.Cost+import Utility.Metered+import Remote.Helper.Chunked as X+import Remote.Helper.Encryptable as X+import Remote.Helper.Messages+import Annex.Content import qualified Git import qualified Git.Command import qualified Git.Construct +import qualified Data.ByteString.Lazy as L+import qualified Data.Map as M+ {- Special remotes don't have a configured url, so Git.Repo does not  - automatically generate remotes for them. This looks for a different  - configuration key instead.@@ -38,3 +72,198 @@ 		[Param "config", Param (configsetting a), Param b] 	remotename = fromJust (M.lookup "name" c) 	configsetting s = "remote." ++ remotename ++ "." ++ s++-- Use when nothing needs to be done to prepare a helper.+simplyPrepare :: helper -> Preparer helper+simplyPrepare helper _ a = a $ Just helper++-- Use to run a check when preparing a helper.+checkPrepare :: (Key -> Annex Bool) -> helper -> Preparer helper+checkPrepare checker helper k a = ifM (checker k)+	( a (Just helper)+	, a Nothing+	)++-- Use to acquire a resource when preparing a helper.+resourcePrepare :: (Key -> (r -> Annex Bool) -> Annex Bool) -> (r -> helper) -> Preparer helper+resourcePrepare withr helper k a = withr k $ \r ->+        a (Just (helper r))++-- A Storer that expects to be provided with a file containing+-- the content of the key to store.+fileStorer :: (Key -> FilePath -> MeterUpdate -> Annex Bool) -> Storer+fileStorer a k (FileContent f) m = a k f m+fileStorer a k (ByteContent b) m = withTmp k $ \f -> do+	liftIO $ L.writeFile f b+	a k f m++-- A Storer that expects to be provided with a L.ByteString of+-- the content to store.+byteStorer :: (Key -> L.ByteString -> MeterUpdate -> Annex Bool) -> Storer+byteStorer a k c m = withBytes c $ \b -> a k b m++-- A Retriever that writes the content of a Key to a provided file.+-- It is responsible for updating the progress meter as it retrieves data.+fileRetriever :: (FilePath -> Key -> MeterUpdate -> Annex ()) -> Retriever+fileRetriever a k m callback = do+	f <- prepTmp k+	a f k m+	callback (FileContent f)++-- A Retriever that generates a lazy ByteString containing the Key's+-- content, and passes it to a callback action which will fully consume it+-- before returning.+byteRetriever :: (Key -> (L.ByteString -> Annex Bool) -> Annex Bool) -> Retriever+byteRetriever a k _m callback = a k (callback . ByteContent)++{- The base Remote that is provided to specialRemote needs to have+ - storeKey, retrieveKeyFile, removeKey, and checkPresent methods,+ - but they are never actually used (since specialRemote replaces them).+ - Here are some dummy ones.+ -}+storeKeyDummy :: Key -> AssociatedFile -> MeterUpdate -> Annex Bool+storeKeyDummy _ _ _ = return False+retreiveKeyFileDummy :: Key -> AssociatedFile -> FilePath -> MeterUpdate -> Annex Bool+retreiveKeyFileDummy _ _ _ _ = return False+removeKeyDummy :: Key -> Annex Bool+removeKeyDummy _ = return False+checkPresentDummy :: Key -> Annex Bool+checkPresentDummy _ = error "missing checkPresent implementation"++type RemoteModifier+	= RemoteConfig+	-> Preparer Storer+	-> Preparer Retriever+	-> Preparer Remover+	-> Preparer CheckPresent+	-> Remote+	-> Remote++data SpecialRemoteCfg = SpecialRemoteCfg+	{ chunkConfig :: ChunkConfig+	, displayProgress :: Bool+	}++specialRemoteCfg :: RemoteConfig -> SpecialRemoteCfg+specialRemoteCfg c = SpecialRemoteCfg (getChunkConfig c) True++-- Modifies a base Remote to support both chunking and encryption,+-- which special remotes typically should support.+specialRemote :: RemoteModifier+specialRemote c = specialRemote' (specialRemoteCfg c) c++specialRemote' :: SpecialRemoteCfg -> RemoteModifier+specialRemote' cfg c preparestorer prepareretriever prepareremover preparecheckpresent baser = encr+  where+	encr = baser+		{ storeKey = \k _f p -> cip >>= storeKeyGen k p+		, retrieveKeyFile = \k _f d p -> cip >>= retrieveKeyFileGen k d p+		, retrieveKeyFileCheap = \k d -> cip >>= maybe+			(retrieveKeyFileCheap baser k d)+			-- retrieval of encrypted keys is never cheap+			(\_ -> return False)+		, removeKey = \k -> cip >>= removeKeyGen k+		, checkPresent = \k -> cip >>= checkPresentGen k+		, cost = maybe+			(cost baser)+			(const $ cost baser + encryptedRemoteCostAdj)+			(extractCipher c)+		}+	cip = cipherKey c+	gpgopts = getGpgEncParams encr++	safely a = catchNonAsync a (\e -> warning (show e) >> return False)++	-- chunk, then encrypt, then feed to the storer+	storeKeyGen k p enc = safely $ preparestorer k $ safely . go+	  where+		go (Just storer) = sendAnnex k rollback $ \src ->+			displayprogress p k $ \p' ->+				storeChunks (uuid baser) chunkconfig k src p'+					(storechunk enc storer)+					(checkPresent baser)+		go Nothing = return False+		rollback = void $ removeKey encr k++	storechunk Nothing storer k content p = storer k content p+	storechunk (Just (cipher, enck)) storer k content p =+		withBytes content $ \b ->+			encrypt gpgopts cipher (feedBytes b) $+				readBytes $ \encb ->+					storer (enck k) (ByteContent encb) p++	-- call retrieve-r to get chunks; decrypt them; stream to dest file+	retrieveKeyFileGen k dest p enc =+		safely $ prepareretriever k $ safely . go+	  where+	  	go (Just retriever) = displayprogress p k $ \p' ->+			retrieveChunks retriever (uuid baser) chunkconfig+				enck k dest p' (sink dest enc)+		go Nothing = return False+		enck = maybe id snd enc++	removeKeyGen k enc = safely $ prepareremover k $ safely . go+	  where+		go (Just remover) = removeChunks remover (uuid baser) chunkconfig enck k+		go Nothing = return False+		enck = maybe id snd enc++	checkPresentGen k enc = preparecheckpresent k go+	  where+	  	go (Just checker) = checkPresentChunks checker (uuid baser) chunkconfig enck k+		go Nothing = cantCheck baser+		enck = maybe id snd enc++	chunkconfig = chunkConfig cfg++	displayprogress p k a+		| displayProgress cfg = metered (Just p) k a+		| otherwise = a p++{- Sink callback for retrieveChunks. Stores the file content into the+ - provided Handle, decrypting it first if necessary.+ - + - If the remote did not store the content using chunks, no Handle+ - will be provided, and it's up to us to open the destination file.+ -+ - Note that when neither chunking nor encryption is used, and the remote+ - provides FileContent, that file only needs to be renamed+ - into place. (And it may even already be in the right place..)+ -}+sink+	:: FilePath+	-> Maybe (Cipher, EncKey)+	-> Maybe Handle+	-> Maybe MeterUpdate+	-> ContentSource+	-> Annex Bool+sink dest enc mh mp content = do+	case (enc, mh, content) of+		(Nothing, Nothing, FileContent f)+			| f == dest -> noop+			| otherwise -> liftIO $ moveFile f dest+		(Just (cipher, _), _, ByteContent b) ->+			decrypt cipher (feedBytes b) $+				readBytes write+		(Just (cipher, _), _, FileContent f) -> do+			withBytes content $ \b ->+				decrypt cipher (feedBytes b) $+					readBytes write+			liftIO $ nukeFile f+		(Nothing, _, FileContent f) -> do+			withBytes content write+			liftIO $ nukeFile f+		(Nothing, _, ByteContent b) -> write b+	return True+  where+	write b = case mh of+		Just h -> liftIO $ b `streamto` h+		Nothing -> liftIO $ bracket opendest hClose (b `streamto`)+	streamto b h = case mp of+		Just p -> meteredWrite p h b+		Nothing -> L.hPut h b+	opendest = openBinaryFile dest WriteMode++withBytes :: ContentSource -> (L.ByteString -> Annex a) -> Annex a+withBytes (ByteContent b) a = a b+withBytes (FileContent f) a = a =<< liftIO (L.readFile f)
Remote/Helper/Ssh.hs view
@@ -69,7 +69,7 @@  - a specified error value. -} onRemote  	:: Git.Repo-	-> (FilePath -> [CommandParam] -> IO a, a)+	-> (FilePath -> [CommandParam] -> IO a, Annex a) 	-> String 	-> [CommandParam] 	-> [(Field, String)]@@ -78,22 +78,22 @@ 	s <- git_annex_shell r command params fields 	case s of 		Just (c, ps) -> liftIO $ with c ps-		Nothing -> return errorval+		Nothing -> errorval  {- Checks if a remote contains a key. -}-inAnnex :: Git.Repo -> Key -> Annex (Either String Bool)+inAnnex :: Git.Repo -> Key -> Annex Bool inAnnex r k = do 	showChecking r 	onRemote r (check, cantCheck r) "inannex" [Param $ key2file k] []   where-	check c p = dispatch <$> safeSystem c p-	dispatch ExitSuccess = Right True-	dispatch (ExitFailure 1) = Right False+	check c p = dispatch =<< safeSystem c p+	dispatch ExitSuccess = return True+	dispatch (ExitFailure 1) = return False 	dispatch _ = cantCheck r  {- Removes a key from a remote. -} dropKey :: Git.Repo -> Key -> Annex Bool-dropKey r key = onRemote r (boolSystem, False) "dropkey"+dropKey r key = onRemote r (boolSystem, return False) "dropkey" 	[ Params "--quiet --force" 	, Param $ key2file key 	]
Remote/Hook.hs view
@@ -7,7 +7,6 @@  module Remote.Hook (remote) where -import qualified Data.ByteString.Lazy as L import qualified Data.Map as M  import Common.Annex@@ -17,12 +16,8 @@ import qualified Git import Config import Config.Cost-import Annex.Content import Annex.UUID import Remote.Helper.Special-import Remote.Helper.Encryptable-import Crypto-import Utility.Metered import Utility.Env  type Action = String@@ -39,19 +34,21 @@ gen :: Git.Repo -> UUID -> RemoteConfig -> RemoteGitConfig -> Annex (Maybe Remote) gen r u c gc = do 	cst <- remoteCost gc expensiveRemoteCost-	return $ Just $ encryptableRemote c-		(storeEncrypted hooktype $ getGpgEncParams (c,gc))-		(retrieveEncrypted hooktype)+	return $ Just $ specialRemote c+		(simplyPrepare $ store hooktype)+		(simplyPrepare $ retrieve hooktype)+		(simplyPrepare $ remove hooktype)+		(simplyPrepare $ checkKey r hooktype) 		Remote { 			uuid = u, 			cost = cst, 			name = Git.repoDescribe r,-			storeKey = store hooktype,-			retrieveKeyFile = retrieve hooktype,+			storeKey = storeKeyDummy,+			retrieveKeyFile = retreiveKeyFileDummy, 			retrieveKeyFileCheap = retrieveCheap hooktype,-			removeKey = remove hooktype,-			hasKey = checkPresent r hooktype,-			hasKeyCheap = False,+			removeKey = removeKeyDummy,+			checkPresent = checkPresentDummy,+			checkPresentCheap = False, 			whereisKey = Nothing, 			remoteFsck = Nothing, 			repairRepo = Nothing,@@ -61,7 +58,9 @@ 			gitconfig = gc, 			readonly = False, 			availability = GloballyAvailable,-			remotetype = remote+			remotetype = remote,+			mkUnavailable = gen r u c $+				gc { remoteAnnexHookType = Just "!dne!" } 		}   where 	hooktype = fromMaybe (error "missing hooktype") $ remoteAnnexHookType gc@@ -118,38 +117,26 @@ 				return False 			) -store :: HookName -> Key -> AssociatedFile -> MeterUpdate -> Annex Bool-store h k _f _p = sendAnnex k (void $ remove h k) $ \src ->+store :: HookName -> Storer+store h = fileStorer $ \k src _p -> 	runHook h "store" k (Just src) $ return True -storeEncrypted :: HookName -> [CommandParam] -> (Cipher, Key) -> Key -> MeterUpdate -> Annex Bool-storeEncrypted h gpgOpts (cipher, enck) k _p = withTmp enck $ \tmp ->-	sendAnnex k (void $ remove h enck) $ \src -> do-		liftIO $ encrypt gpgOpts cipher (feedFile src) $-			readBytes $ L.writeFile tmp-		runHook h "store" enck (Just tmp) $ return True--retrieve :: HookName -> Key -> AssociatedFile -> FilePath -> MeterUpdate -> Annex Bool-retrieve h k _f d _p = runHook h "retrieve" k (Just d) $ return True+retrieve :: HookName -> Retriever+retrieve h = fileRetriever $ \d k _p ->+	unlessM (runHook h "retrieve" k (Just d) $ return True) $+		error "failed to retrieve content"  retrieveCheap :: HookName -> Key -> FilePath -> Annex Bool retrieveCheap _ _ _ = return False -retrieveEncrypted :: HookName -> (Cipher, Key) -> Key -> FilePath -> MeterUpdate -> Annex Bool-retrieveEncrypted h (cipher, enck) _ f _p = withTmp enck $ \tmp ->-	runHook h "retrieve" enck (Just tmp) $ liftIO $ catchBoolIO $ do-		decrypt cipher (feedFile tmp) $-			readBytes $ L.writeFile f-		return True--remove :: HookName -> Key -> Annex Bool+remove :: HookName -> Remover remove h k = runHook h "remove" k Nothing $ return True -checkPresent :: Git.Repo -> HookName -> Key -> Annex (Either String Bool)-checkPresent r h k = do+checkKey :: Git.Repo -> HookName -> CheckPresent+checkKey r h k = do 	showAction $ "checking " ++ Git.repoDescribe r 	v <- lookupHook h action-	liftIO $ catchMsgIO $ check v+	liftIO $ check v   where   	action = "checkpresent" 	findkey s = key2file k `elem` lines s
Remote/Rsync.hs view
@@ -9,10 +9,10 @@  module Remote.Rsync ( 	remote,-	storeEncrypted,-	retrieveEncrypted,+	store,+	retrieve, 	remove,-	checkPresent,+	checkKey, 	withRsyncScratchDir, 	genRsyncOpts, 	RsyncOpts@@ -27,7 +27,6 @@ import Annex.UUID import Annex.Ssh import Remote.Helper.Special-import Remote.Helper.Encryptable import Remote.Rsync.RsyncUrl import Crypto import Utility.Rsync@@ -37,8 +36,8 @@ import Annex.Perms import Logs.Transfer import Types.Creds+import Types.Key (isChunkKey) -import qualified Data.ByteString.Lazy as L import qualified Data.Map as M  remote :: RemoteType@@ -56,19 +55,21 @@ 		fromMaybe (error "missing rsyncurl") $ remoteAnnexRsyncUrl gc 	let o = genRsyncOpts c gc transport url 	let islocal = rsyncUrlIsPath $ rsyncUrl o-	return $ Just $ encryptableRemote c-		(storeEncrypted o $ getGpgEncParams (c,gc))-		(retrieveEncrypted o)+	return $ Just $ specialRemote' specialcfg c+		(simplyPrepare $ fileStorer $ store o)+		(simplyPrepare $ fileRetriever $ retrieve o)+		(simplyPrepare $ remove o)+		(simplyPrepare $ checkKey r o) 		Remote 			{ uuid = u 			, cost = cst 			, name = Git.repoDescribe r-			, storeKey = store o-			, retrieveKeyFile = retrieve o+			, storeKey = storeKeyDummy+			, retrieveKeyFile = retreiveKeyFileDummy 			, retrieveKeyFileCheap = retrieveCheap o-			, removeKey = remove o-			, hasKey = checkPresent r o-			, hasKeyCheap = False+			, removeKey = removeKeyDummy+			, checkPresent = checkPresentDummy+			, checkPresentCheap = False 			, whereisKey = Nothing 			, remoteFsck = Nothing 			, repairRepo = Nothing@@ -81,7 +82,12 @@ 			, readonly = False 			, availability = if islocal then LocallyAvailable else GloballyAvailable 			, remotetype = remote+			, mkUnavailable = return Nothing 			}+  where+	specialcfg = (specialRemoteCfg c)+		-- Rsync displays its own progress.+		{ displayProgress = False }  genRsyncOpts :: RemoteConfig -> RemoteGitConfig -> [CommandParam] -> RsyncUrl -> RsyncOpts genRsyncOpts c gc transport url = RsyncOpts@@ -139,33 +145,51 @@ 	gitConfigSpecialRemote u c' "rsyncurl" url 	return (c', u) -store :: RsyncOpts -> Key -> AssociatedFile -> MeterUpdate -> Annex Bool-store o k _f p = sendAnnex k (void $ remove o k) $ rsyncSend o p k False--storeEncrypted :: RsyncOpts -> [CommandParam] -> (Cipher, Key) -> Key -> MeterUpdate -> Annex Bool-storeEncrypted o gpgOpts (cipher, enck) k p = withTmp enck $ \tmp ->-	sendAnnex k (void $ remove o enck) $ \src -> do-		liftIO $ encrypt gpgOpts cipher (feedFile src) $-			readBytes $ L.writeFile tmp-		rsyncSend o p enck True tmp+{- To send a single key is slightly tricky; need to build up a temporary+ - directory structure to pass to rsync so it can create the hash+ - directories.+ -+ - This would not be necessary if the hash directory structure used locally+ - was always the same as that used on the rsync remote. So if that's ever+ - unified, this gets nicer.+ - (When we have the right hash directory structure, we can just+ - pass --include=X --include=X/Y --include=X/Y/file --exclude=*)+ -}+store :: RsyncOpts -> Key -> FilePath -> MeterUpdate -> Annex Bool+store o k src meterupdate = withRsyncScratchDir $ \tmp -> do+	let dest = tmp </> Prelude.head (keyPaths k)+	liftIO $ createDirectoryIfMissing True $ parentDir dest+	ok <- liftIO $ if canrename+		then do+			rename src dest+			return True+		else createLinkOrCopy src dest+	ps <- sendParams+	if ok+		then showResumable $ rsyncRemote Upload o (Just meterupdate) $ ps +++			[ Param "--recursive"+			, partialParams+			-- tmp/ to send contents of tmp dir+			, File $ addTrailingPathSeparator tmp+			, Param $ rsyncUrl o+			]+		else return False+  where+ 	{- If the key being sent is encrypted or chunked, the file+	 - containing its content is a temp file, and so can be+	 - renamed into place. Otherwise, the file is the annexed+	 - object file, and has to be copied or hard linked into place. -}+	canrename = isEncKey k || isChunkKey k -retrieve :: RsyncOpts -> Key -> AssociatedFile -> FilePath -> MeterUpdate -> Annex Bool-retrieve o k _ f p = rsyncRetrieve o k f (Just p)+retrieve :: RsyncOpts -> FilePath -> Key -> MeterUpdate -> Annex ()+retrieve o f k p = +	unlessM (rsyncRetrieve o k f (Just p)) $+		error "rsync failed"  retrieveCheap :: RsyncOpts -> Key -> FilePath -> Annex Bool retrieveCheap o k f = ifM (preseedTmp k f) ( rsyncRetrieve o k f Nothing , return False ) -retrieveEncrypted :: RsyncOpts -> (Cipher, Key) -> Key -> FilePath -> MeterUpdate -> Annex Bool-retrieveEncrypted o (cipher, enck) _ f p = withTmp enck $ \tmp ->-	ifM (rsyncRetrieve o enck tmp (Just p))-		( liftIO $ catchBoolIO $ do-			decrypt cipher (feedFile tmp) $-				readBytes $ L.writeFile f-			return True-		, return False-		)--remove :: RsyncOpts -> Key -> Annex Bool+remove :: RsyncOpts -> Remover remove o k = do 	ps <- sendParams 	withRsyncScratchDir $ \tmp -> liftIO $ do@@ -193,14 +217,12 @@ 		, dir </> keyFile k </> "***" 		] -checkPresent :: Git.Repo -> RsyncOpts -> Key -> Annex (Either String Bool)-checkPresent r o k = do+checkKey :: Git.Repo -> RsyncOpts -> CheckPresent+checkKey r o k = do 	showAction $ "checking " ++ Git.repoDescribe r 	-- note: Does not currently differentiate between rsync failing 	-- to connect, and the file not being present.-	Right <$> check-  where-	check = untilTrue (rsyncUrls o k) $ \u -> +	untilTrue (rsyncUrls o k) $ \u ->  		liftIO $ catchBoolIO $ do 			withQuietOutput createProcessSuccess $ 				proc "rsync" $ toCommand $@@ -238,8 +260,8 @@ 		removeDirectoryRecursive d  rsyncRetrieve :: RsyncOpts -> Key -> FilePath -> Maybe MeterUpdate -> Annex Bool-rsyncRetrieve o k dest callback =-	showResumable $ untilTrue (rsyncUrls o k) $ \u -> rsyncRemote Download o callback+rsyncRetrieve o k dest meterupdate =+	showResumable $ untilTrue (rsyncUrls o k) $ \u -> rsyncRemote Download o meterupdate 		-- use inplace when retrieving to support resuming 		[ Param "--inplace" 		, Param u@@ -263,33 +285,3 @@ 	opts 		| direction == Download = rsyncDownloadOptions o 		| otherwise = rsyncUploadOptions o--{- To send a single key is slightly tricky; need to build up a temporary- - directory structure to pass to rsync so it can create the hash- - directories.- -- - This would not be necessary if the hash directory structure used locally- - was always the same as that used on the rsync remote. So if that's ever- - unified, this gets nicer.- - (When we have the right hash directory structure, we can just- - pass --include=X --include=X/Y --include=X/Y/file --exclude=*)- -}-rsyncSend :: RsyncOpts -> MeterUpdate -> Key -> Bool -> FilePath -> Annex Bool-rsyncSend o callback k canrename src = withRsyncScratchDir $ \tmp -> do-	let dest = tmp </> Prelude.head (keyPaths k)-	liftIO $ createDirectoryIfMissing True $ parentDir dest-	ok <- liftIO $ if canrename-		then do-			rename src dest-			return True-		else createLinkOrCopy src dest-	ps <- sendParams-	if ok-		then showResumable $ rsyncRemote Upload o (Just callback) $ ps ++-			[ Param "--recursive"-			, partialParams-			-- tmp/ to send contents of tmp dir-			, File $ addTrailingPathSeparator tmp-			, Param $ rsyncUrl o-			]-		else return False
Remote/S3.hs view
@@ -25,12 +25,9 @@ import Config import Config.Cost import Remote.Helper.Special-import Remote.Helper.Encryptable import qualified Remote.Helper.AWS as AWS-import Crypto import Creds import Utility.Metered-import Annex.Content import Annex.UUID import Logs.Web @@ -47,21 +44,23 @@ gen :: Git.Repo -> UUID -> RemoteConfig -> RemoteGitConfig -> Annex (Maybe Remote) gen r u c gc = new <$> remoteCost gc expensiveRemoteCost   where-	new cst = Just $ encryptableRemote c-		(storeEncrypted this)-		(retrieveEncrypted this)+	new cst = Just $ specialRemote c+		(prepareStore this)+		(prepareRetrieve this)+		(simplyPrepare $ remove this c)+		(simplyPrepare $ checkKey this) 		this 	  where 		this = Remote { 			uuid = u, 			cost = cst, 			name = Git.repoDescribe r,-			storeKey = store this,-			retrieveKeyFile = retrieve this,-			retrieveKeyFileCheap = retrieveCheap this,-			removeKey = remove this c,-			hasKey = checkPresent this,-			hasKeyCheap = False,+			storeKey = storeKeyDummy,+			retrieveKeyFile = retreiveKeyFileDummy,+			retrieveKeyFileCheap = retrieveCheap,+			removeKey = removeKeyDummy,+			checkPresent = checkPresentDummy,+			checkPresentCheap = False, 			whereisKey = Nothing, 			remoteFsck = Nothing, 			repairRepo = Nothing,@@ -71,7 +70,8 @@ 			localpath = Nothing, 			readonly = False, 			availability = GloballyAvailable,-			remotetype = remote+			remotetype = remote,+			mkUnavailable = gen r u (M.insert "host" "!dne!" c) gc 		}  s3Setup :: Maybe UUID -> Maybe CredPair -> RemoteConfig -> Annex (RemoteConfig, UUID)@@ -123,71 +123,43 @@ 		writeUUIDFile archiveconfig u 		use archiveconfig -store :: Remote -> Key -> AssociatedFile -> MeterUpdate -> Annex Bool-store r k _f p = s3Action r False $ \(conn, bucket) -> -	sendAnnex k (void $ remove' r k) $ \src -> do-		ok <- s3Bool =<< storeHelper (conn, bucket) r k p src+prepareStore :: Remote -> Preparer Storer+prepareStore r = resourcePrepare (const $ s3Action r False) $ \(conn, bucket) -> +	fileStorer $ \k src p -> do+		ok <- s3Bool =<< liftIO (store (conn, bucket) r k p src)  		-- Store public URL to item in Internet Archive.-		when (ok && isIA (config r)) $+		when (ok && isIA (config r) && not (isChunkKey k)) $ 			setUrlPresent k (iaKeyUrl r k)  		return ok -storeEncrypted :: Remote -> (Cipher, Key) -> Key -> MeterUpdate -> Annex Bool-storeEncrypted r (cipher, enck) k p = s3Action r False $ \(conn, bucket) -> -	-- To get file size of the encrypted content, have to use a temp file.-	-- (An alternative would be chunking to to a constant size.)-	withTmp enck $ \tmp -> sendAnnex k (void $ remove' r enck) $ \src -> do-		liftIO $ encrypt (getGpgEncParams r) cipher (feedFile src) $-			readBytes $ L.writeFile tmp-		s3Bool =<< storeHelper (conn, bucket) r enck p tmp--storeHelper :: (AWSConnection, Bucket) -> Remote -> Key -> MeterUpdate -> FilePath -> Annex (AWSResult ())-storeHelper (conn, bucket) r k p file = do-	size <- maybe getsize (return . fromIntegral) $ keySize k-	meteredBytes (Just p) size $ \meterupdate ->-		liftIO $ withMeteredFile file meterupdate $ \content -> do-			-- size is provided to S3 so the whole content-			-- does not need to be buffered to calculate it-			let object = S3Object-				bucket (bucketFile r k) ""-				(("Content-Length", show size) : getXheaders (config r))-				content-			sendObject conn $-				setStorageClass (getStorageClass $ config r) object-  where-	getsize = liftIO $ fromIntegral . fileSize <$> getFileStatus file--retrieve :: Remote -> Key -> AssociatedFile -> FilePath -> MeterUpdate -> Annex Bool-retrieve r k _f d p = s3Action r False $ \(conn, bucket) ->-	metered (Just p) k $ \meterupdate -> do-		res <- liftIO $ getObject conn $ bucketKey r bucket k-		case res of-			Right o -> do-				liftIO $ meteredWriteFile meterupdate d $-					obj_data o-				return True-			Left e -> s3Warning e+store :: (AWSConnection, Bucket) -> Remote -> Key -> MeterUpdate -> FilePath -> IO (AWSResult ())+store (conn, bucket) r k p file = do+	size <- (fromIntegral . fileSize <$> getFileStatus file) :: IO Integer+	withMeteredFile file p $ \content -> do+		-- size is provided to S3 so the whole content+		-- does not need to be buffered to calculate it+		let object = S3Object+			bucket (bucketFile r k) ""+			(("Content-Length", show size) : getXheaders (config r))+			content+		sendObject conn $+			setStorageClass (getStorageClass $ config r) object -retrieveCheap :: Remote -> Key -> FilePath -> Annex Bool-retrieveCheap _ _ _ = return False+prepareRetrieve :: Remote -> Preparer Retriever+prepareRetrieve r = resourcePrepare (const $ s3Action r False) $ \(conn, bucket) ->+	byteRetriever $ \k sink ->+		liftIO (getObject conn $ bucketKey r bucket k)+			>>= either s3Error (sink . obj_data) -retrieveEncrypted :: Remote -> (Cipher, Key) -> Key -> FilePath -> MeterUpdate -> Annex Bool-retrieveEncrypted r (cipher, enck) k d p = s3Action r False $ \(conn, bucket) ->-	metered (Just p) k $ \meterupdate -> do-		res <- liftIO $ getObject conn $ bucketKey r bucket enck-		case res of-			Right o -> liftIO $ decrypt cipher (\h -> meteredWrite meterupdate h $ obj_data o) $ -				readBytes $ \content -> do-					L.writeFile d content-					return True-			Left e -> s3Warning e+retrieveCheap :: Key -> FilePath -> Annex Bool+retrieveCheap _ _ = return False  {- Internet Archive doesn't easily allow removing content.  - While it may remove the file, there are generally other files  - derived from it that it does not remove. -}-remove :: Remote -> RemoteConfig -> Key -> Annex Bool+remove :: Remote -> RemoteConfig -> Remover remove r c k 	| isIA c = do 		warning "Cannot remove content from the Internet Archive"@@ -198,16 +170,16 @@ remove' r k = s3Action r False $ \(conn, bucket) -> 	s3Bool =<< liftIO (deleteObject conn $ bucketKey r bucket k) -checkPresent :: Remote -> Key -> Annex (Either String Bool)-checkPresent r k = s3Action r noconn $ \(conn, bucket) -> do+checkKey :: Remote -> CheckPresent+checkKey r k = s3Action r noconn $ \(conn, bucket) -> do 	showAction $ "checking " ++ name r 	res <- liftIO $ getObjectInfo conn $ bucketKey r bucket k 	case res of-		Right _ -> return $ Right True-		Left (AWSError _ _) -> return $ Right False-		Left e -> return $ Left (s3Error e)+		Right _ -> return True+		Left (AWSError _ _) -> return False+		Left e -> s3Error e   where-	noconn = Left $ error "S3 not configured"+	noconn = error "S3 not configured" 			 s3Warning :: ReqError -> Annex Bool s3Warning e = do
Remote/Tahoe.hs view
@@ -72,8 +72,8 @@ 		retrieveKeyFile = retrieve u hdl, 		retrieveKeyFileCheap = \_ _ -> return False, 		removeKey = remove,-		hasKey = checkPresent u hdl,-		hasKeyCheap = False,+		checkPresent = checkKey u hdl,+		checkPresentCheap = False, 		whereisKey = Nothing, 		remoteFsck = Nothing, 		repairRepo = Nothing,@@ -83,7 +83,8 @@ 		localpath = Nothing, 		readonly = False, 		availability = GloballyAvailable,-		remotetype = remote+		remotetype = remote,+		mkUnavailable = return Nothing 	}  tahoeSetup :: Maybe UUID -> Maybe CredPair -> RemoteConfig -> Annex (RemoteConfig, UUID)@@ -123,14 +124,16 @@ 	warning "content cannot be removed from tahoe remote" 	return False -checkPresent :: UUID -> TahoeHandle -> Key -> Annex (Either String Bool)-checkPresent u hdl k = go =<< getCapability u k+checkKey :: UUID -> TahoeHandle -> Key -> Annex Bool+checkKey u hdl k = go =<< getCapability u k   where-	go Nothing = return (Right False)-	go (Just cap) = liftIO $ parseCheck <$> readTahoe hdl "check"-		[ Param "--raw"-		, Param cap-		]+	go Nothing = return False+	go (Just cap) = liftIO $ do+		v <- parseCheck <$> readTahoe hdl "check"+			[ Param "--raw"+			, Param cap+			]+		either error return v  defaultTahoeConfigDir :: UUID -> IO TahoeConfigDir defaultTahoeConfigDir u = do
Remote/Web.hs view
@@ -50,8 +50,8 @@ 		retrieveKeyFile = downloadKey, 		retrieveKeyFileCheap = downloadKeyCheap, 		removeKey = dropKey,-		hasKey = checkKey,-		hasKeyCheap = False,+		checkPresent = checkKey,+		checkPresentCheap = False, 		whereisKey = Just getUrls, 		remoteFsck = Nothing, 		repairRepo = Nothing,@@ -61,7 +61,8 @@ 		repo = r, 		readonly = True, 		availability = GloballyAvailable,-		remotetype = remote+		remotetype = remote,+		mkUnavailable = return Nothing 	}  downloadKey :: Key -> AssociatedFile -> FilePath -> MeterUpdate -> Annex Bool@@ -98,12 +99,12 @@ 	mapM_ (setUrlMissing k) =<< getUrls k 	return True -checkKey :: Key -> Annex (Either String Bool)+checkKey :: Key -> Annex Bool checkKey key = do 	us <- getUrls key 	if null us-		then return $ Right False-		else return =<< checkKey' key us+		then return False+		else either error return =<< checkKey' key us checkKey' :: Key -> [URLString] -> Annex (Either String Bool) checkKey' key us = firsthit us (Right False) $ \u -> do 	let (u', downloader) = getDownloader u
Remote/WebDAV.hs view
@@ -5,25 +5,19 @@  - Licensed under the GNU GPL version 3 or higher.  -} -{-# LANGUAGE ScopedTypeVariables, CPP #-}+{-# LANGUAGE ScopedTypeVariables #-}  module Remote.WebDAV (remote, davCreds, configUrl) where  import Network.Protocol.HTTP.DAV import qualified Data.Map as M+import qualified Data.ByteString.Lazy as L import qualified Data.ByteString.UTF8 as B8 import qualified Data.ByteString.Lazy.UTF8 as L8-import qualified Data.ByteString.Lazy as L-import qualified Control.Exception as E-import qualified Control.Exception.Lifted as EL-#if MIN_VERSION_DAV(0,6,0) import Network.HTTP.Client (HttpException(..))-#else-import Network.HTTP.Conduit (HttpException(..))-#endif import Network.HTTP.Types-import System.Log.Logger (debugM) import System.IO.Error+import Control.Monad.Catch  import Common.Annex import Types.Remote@@ -31,17 +25,13 @@ import Config import Config.Cost import Remote.Helper.Special-import Remote.Helper.Encryptable-import Remote.Helper.Chunked-import Crypto+import Remote.Helper.Http+import qualified Remote.Helper.Chunked.Legacy as Legacy import Creds import Utility.Metered-import Annex.Content+import Utility.Url (URLString) import Annex.UUID-import Remote.WebDAV.DavUrl--type DavUser = B8.ByteString-type DavPass = B8.ByteString+import Remote.WebDAV.DavLocation  remote :: RemoteType remote = RemoteType {@@ -54,21 +44,23 @@ gen :: Git.Repo -> UUID -> RemoteConfig -> RemoteGitConfig -> Annex (Maybe Remote) gen r u c gc = new <$> remoteCost gc expensiveRemoteCost   where-	new cst = Just $ encryptableRemote c-		(storeEncrypted this)-		(retrieveEncrypted this)+	new cst = Just $ specialRemote c+		(prepareDAV this $ store chunkconfig)+		(prepareDAV this $ retrieve chunkconfig)+		(prepareDAV this $ remove)+		(prepareDAV this $ checkKey this chunkconfig) 		this 	  where 		this = Remote { 			uuid = u, 			cost = cst, 			name = Git.repoDescribe r,-			storeKey = store this,-			retrieveKeyFile = retrieve this,-			retrieveKeyFileCheap = retrieveCheap this,-			removeKey = remove this,-			hasKey = checkPresent this,-			hasKeyCheap = False,+			storeKey = storeKeyDummy,+			retrieveKeyFile = retreiveKeyFileDummy,+			retrieveKeyFileCheap = retrieveCheap,+			removeKey = removeKeyDummy,+			checkPresent = checkPresentDummy,+			checkPresentCheap = False, 			whereisKey = Nothing, 			remoteFsck = Nothing, 			repairRepo = Nothing,@@ -78,14 +70,17 @@ 			localpath = Nothing, 			readonly = False, 			availability = GloballyAvailable,-			remotetype = remote+			remotetype = remote,+			mkUnavailable = gen r u (M.insert "url" "http://!dne!/" c) gc 		}+		chunkconfig = getChunkConfig c  webdavSetup :: Maybe UUID -> Maybe CredPair -> RemoteConfig -> Annex (RemoteConfig, UUID) webdavSetup mu mcreds c = do 	u <- maybe (liftIO genUUID) return mu-	let url = fromMaybe (error "Specify url=") $-		M.lookup "url" c+	url <- case M.lookup "url" c of+		Nothing -> error "Specify url="+		Just url -> return url 	c' <- encryptionSetup c 	creds <- maybe (getCreds c' u) (return . Just) mcreds 	testDav url creds@@ -93,189 +88,146 @@ 	c'' <- setRemoteCredPair c' (davCreds u) creds 	return (c'', u) -store :: Remote -> Key -> AssociatedFile -> MeterUpdate -> Annex Bool-store r k _f p = metered (Just p) k $ \meterupdate ->-	davAction r False $ \(baseurl, user, pass) -> -		sendAnnex k (void $ remove r k) $ \src ->-			liftIO $ withMeteredFile src meterupdate $-				storeHelper r k baseurl user pass--storeEncrypted :: Remote -> (Cipher, Key) -> Key -> MeterUpdate -> Annex Bool-storeEncrypted r (cipher, enck) k p = metered (Just p) k $ \meterupdate ->-	davAction r False $ \(baseurl, user, pass) ->-		sendAnnex k (void $ remove r enck) $ \src ->-			liftIO $ encrypt (getGpgEncParams r) cipher-				(streamMeteredFile src meterupdate) $-				readBytes $ storeHelper r enck baseurl user pass--storeHelper :: Remote -> Key -> DavUrl -> DavUser -> DavPass -> L.ByteString -> IO Bool-storeHelper r k baseurl user pass b = catchBoolIO $ do-	mkdirRecursiveDAV tmpurl user pass-	storeChunks k tmpurl keyurl chunksize storer recorder finalizer-  where-	tmpurl = tmpLocation baseurl k-	keyurl = davLocation baseurl k-	chunksize = chunkSize $ config r-	storer urls = storeChunked chunksize urls storehttp b-	recorder url s = storehttp url (L8.fromString s)-	finalizer srcurl desturl = do-		void $ tryNonAsync (deleteDAV desturl user pass)-		mkdirRecursiveDAV (urlParent desturl) user pass-		moveDAV srcurl desturl user pass-	storehttp url = putDAV url user pass--retrieveCheap :: Remote -> Key -> FilePath -> Annex Bool-retrieveCheap _ _ _ = return False--retrieve :: Remote -> Key -> AssociatedFile -> FilePath -> MeterUpdate -> Annex Bool-retrieve r k _f d p = metered (Just p) k $ \meterupdate ->-	davAction r False $ \(baseurl, user, pass) -> liftIO $ catchBoolIO $-		withStoredFiles r k baseurl user pass onerr $ \urls -> do-			meteredWriteFileChunks meterupdate d urls $ \url -> do-				mb <- getDAV url user pass-				case mb of-					Nothing -> throwIO "download failed"-					Just b -> return b-			return True-  where-	onerr _ = return False--retrieveEncrypted :: Remote -> (Cipher, Key) -> Key -> FilePath -> MeterUpdate -> Annex Bool-retrieveEncrypted r (cipher, enck) k d p = metered (Just p) k $ \meterupdate ->-	davAction r False $ \(baseurl, user, pass) -> liftIO $ catchBoolIO $-		withStoredFiles r enck baseurl user pass onerr $ \urls -> do-			decrypt cipher (feeder user pass urls) $-				readBytes $ meteredWriteFile meterupdate d-			return True-  where-	onerr _ = return False--	feeder _ _ [] _ = noop-	feeder user pass (url:urls) h = do-		mb <- getDAV url user pass-		case mb of-			Nothing -> throwIO "download failed"-			Just b -> do-				L.hPut h b-				feeder user pass urls h+-- Opens a http connection to the DAV server, which will be reused+-- each time the helper is called.+prepareDAV :: Remote -> (Maybe DavHandle -> helper) -> Preparer helper+prepareDAV = resourcePrepare . const . withDAVHandle -remove :: Remote -> Key -> Annex Bool-remove r k = davAction r False $ \(baseurl, user, pass) -> liftIO $ do-	-- Delete the key's whole directory, including any chunked-	-- files, etc, in a single action.-	let url = davLocation baseurl k-	isJust . eitherToMaybe <$> tryNonAsync (deleteDAV url user pass)+store :: ChunkConfig -> Maybe DavHandle -> Storer+store _ Nothing = byteStorer $ \_k _b _p -> return False+store (LegacyChunks chunksize) (Just dav) = fileStorer $ \k f p -> liftIO $+	withMeteredFile f p $ storeLegacyChunked chunksize k dav+store _  (Just dav) = httpStorer $ \k reqbody -> liftIO $ goDAV dav $ do+	let tmp = keyTmpLocation k+	let dest = keyLocation k+	void $ mkColRecursive tmpDir+	inLocation tmp $+		putContentM' (contentType, reqbody)+	finalizeStore (baseURL dav) tmp dest+	return True -checkPresent :: Remote -> Key -> Annex (Either String Bool)-checkPresent r k = davAction r noconn go-  where-	noconn = Left $ error $ name r ++ " not configured"+finalizeStore :: URLString -> DavLocation -> DavLocation -> DAVT IO ()+finalizeStore baseurl tmp dest = do+	inLocation dest $ void $ safely $ delContentM+	maybe noop (void . mkColRecursive) (locationParent dest)+	moveDAV baseurl tmp dest -	go (baseurl, user, pass) = do-		showAction $ "checking " ++ name r-		liftIO $ withStoredFiles r k baseurl user pass onerr check-	  where-		check [] = return $ Right True-		check (url:urls) = do-			v <- existsDAV url user pass-			if v == Right True-				then check urls-				else return v+retrieveCheap :: Key -> FilePath -> Annex Bool+retrieveCheap _ _ = return False -		{- Failed to read the chunkcount file; see if it's missing,-		 - or if there's a problem accessing it,-		 - or perhaps this was an intermittent error. -}-		onerr url = do-			v <- existsDAV url user pass-			return $ if v == Right True-				then Left $ "failed to read " ++ url-				else v+retrieve :: ChunkConfig -> Maybe DavHandle -> Retriever+retrieve _ Nothing = error "unable to connect"+retrieve (LegacyChunks _) (Just dav) = retrieveLegacyChunked dav+retrieve _ (Just dav) = fileRetriever $ \d k p -> liftIO $+	goDAV dav $+		inLocation (keyLocation k) $+			withContentM $+				httpBodyRetriever d p -withStoredFiles-	:: Remote-	-> Key-	-> DavUrl-	-> DavUser-	-> DavPass-	-> (DavUrl -> IO a)-	-> ([DavUrl] -> IO a)-	-> IO a-withStoredFiles r k baseurl user pass onerr a-	| isJust $ chunkSize $ config r = do-		let chunkcount = keyurl ++ chunkCount-		v <- getDAV chunkcount user pass+remove :: Maybe DavHandle -> Remover+remove Nothing _ = return False+remove (Just dav) k = liftIO $ do+	-- Delete the key's whole directory, including any+	-- legacy chunked files, etc, in a single action.+	let d = keyDir k+	goDAV dav $ do+		v <- safely $ inLocation d delContentM 		case v of-			Just s -> a $ listChunks keyurl $ L8.toString s+			Just _ -> return True 			Nothing -> do-				chunks <- probeChunks keyurl $ \u -> (== Right True) <$> existsDAV u user pass-				if null chunks-					then onerr chunkcount-					else a chunks-	| otherwise = a [keyurl]-  where-	keyurl = davLocation baseurl k ++ keyFile k+				v' <- existsDAV d+				case v' of+					Right False -> return True+					_ -> return False -davAction :: Remote -> a -> ((DavUrl, DavUser, DavPass) -> Annex a) -> Annex a-davAction r unconfigured action = do-	mcreds <- getCreds (config r) (uuid r)-	case (mcreds, configUrl r) of-		(Just (user, pass), Just url) ->-			action (url, toDavUser user, toDavPass pass)-		_ -> return unconfigured+checkKey :: Remote -> ChunkConfig -> Maybe DavHandle -> CheckPresent+checkKey r _ Nothing _ = error $ name r ++ " not configured"+checkKey r chunkconfig (Just dav) k = do+	showAction $ "checking " ++ name r+	case chunkconfig of+		LegacyChunks _ -> checkKeyLegacyChunked dav k+		_ -> do+			v <- liftIO $ goDAV dav $+				existsDAV (keyLocation k)+			either error return v -configUrl :: Remote -> Maybe DavUrl+configUrl :: Remote -> Maybe URLString configUrl r = fixup <$> M.lookup "url" (config r)   where 	-- box.com DAV url changed 	fixup = replace "https://www.box.com/dav/" "https://dav.box.com/dav/" +type DavUser = B8.ByteString+type DavPass = B8.ByteString++baseURL :: DavHandle -> URLString+baseURL (DavHandle _ _ _ u) = u++ toDavUser :: String -> DavUser toDavUser = B8.fromString  toDavPass :: String -> DavPass toDavPass = B8.fromString -{- Creates a directory in WebDAV, if not already present; also creating- - any missing parent directories. -}-mkdirRecursiveDAV :: DavUrl -> DavUser -> DavPass -> IO ()-mkdirRecursiveDAV url user pass = go url-  where-	make u = mkdirDAV u user pass--	go u = do-		r <- E.try (make u) :: IO (Either E.SomeException Bool)-		case r of-			{- Parent directory is missing. Recurse to create-			 - it, and try once more to create the directory. -}-			Right False -> do-				go (urlParent u)-				void $ make u-			{- Directory created successfully -}-			Right True -> return ()-			{- Directory already exists, or some other error-			 - occurred. In the latter case, whatever wanted-			 - to use this directory will fail. -}-			Left _ -> return ()- {- Test if a WebDAV store is usable, by writing to a test file, and then- - deleting the file. Exits with an IO error if not. -}-testDav :: String -> Maybe CredPair -> Annex ()-testDav baseurl (Just (u, p)) = do+ - deleting the file.+ -+ - Also ensures that the path of the url exists, trying to create it if not.+ -+ - Throws an error if store is not usable.+ -}+testDav :: URLString -> Maybe CredPair -> Annex ()+testDav url (Just (u, p)) = do 	showSideAction "testing WebDAV server"-	test "make directory" $ mkdirRecursiveDAV baseurl user pass-	test "write file" $ putDAV testurl user pass L.empty-	test "delete file" $ deleteDAV testurl user pass+	test $ liftIO $ evalDAVT url $ do+		prepDAV user pass+		makeParentDirs+		inLocation tmpDir $ void mkCol+		inLocation (tmpLocation "git-annex-test") $ do+			putContentM (Nothing, L.empty)+			delContentM   where-	test desc a = liftIO $-		either (\e -> throwIO $ "WebDAV failed to " ++ desc ++ ": " ++ show e)+	test a = liftIO $+		either (\e -> throwIO $ "WebDAV test failed: " ++ show e) 			(const noop) 			=<< tryNonAsync a  	user = toDavUser u 	pass = toDavPass p-	testurl = davUrl baseurl "git-annex-test" testDav _ Nothing = error "Need to configure webdav username and password." +{- Tries to make all the parent directories in the WebDAV urls's path,+ - right down to the root.+ -+ - Ignores any failures, which can occur for reasons including the WebDAV+ - server only serving up WebDAV in a subdirectory. -}+makeParentDirs :: DAVT IO ()+makeParentDirs = go+  where+	go = do+		l <- getDAVLocation+		case locationParent l of+			Nothing -> noop+			Just p -> void $ safely $ inDAVLocation (const p) go+		void $ safely mkCol++{- Checks if the directory exists. If not, tries to create its+ - parent directories, all the way down to the root, and finally creates+ - it. -}+mkColRecursive :: DavLocation -> DAVT IO Bool+mkColRecursive d = go =<< existsDAV d+  where+	go (Right True) = return True+	go _ = ifM (inLocation d mkCol)+		( return True+		, do+			case locationParent d of+				Nothing -> makeParentDirs+				Just parent -> void (mkColRecursive parent)+			inLocation d mkCol+		)+ getCreds :: RemoteConfig -> UUID -> Annex (Maybe CredPair) getCreds c u = getRemoteCredPairFor "webdav" c (davCreds u) @@ -293,107 +245,142 @@ throwIO :: String -> IO a throwIO msg = ioError $ mkIOError userErrorType msg Nothing Nothing -debugDAV :: DavUrl -> String -> IO ()-debugDAV msg url = debugM "DAV" $ msg ++ " " ++ url--{---------------------------------------------------------------------- - Low-level DAV operations, using the new DAV monad when available.- ---------------------------------------------------------------------}--putDAV :: DavUrl -> DavUser -> DavPass -> L.ByteString -> IO ()-putDAV url user pass b = do-	debugDAV "PUT" url-#if MIN_VERSION_DAV(0,6,0)-	goDAV url user pass $ putContentM (contentType, b)-#else-	putContent url user pass (contentType, b)-#endif--getDAV :: DavUrl -> DavUser -> DavPass -> IO (Maybe L.ByteString)-getDAV url user pass = do-	debugDAV "GET" url-	eitherToMaybe <$> tryNonAsync go-  where-#if MIN_VERSION_DAV(0,6,0)-	go = goDAV url user pass $ snd <$> getContentM-#else-	go = snd . snd <$> getPropsAndContent url user pass-#endif--deleteDAV :: DavUrl -> DavUser -> DavPass -> IO ()-deleteDAV url user pass = do-	debugDAV "DELETE" url-#if MIN_VERSION_DAV(0,6,0)-	goDAV url user pass delContentM-#else-	deleteContent url user pass-#endif--moveDAV :: DavUrl -> DavUrl -> DavUser -> DavPass -> IO ()-moveDAV url newurl user pass = do-	debugDAV ("MOVE to " ++ newurl ++ " from ") url-#if MIN_VERSION_DAV(0,6,0)-	goDAV url user pass $ moveContentM newurl'-#else-	moveContent url newurl' user pass-#endif+moveDAV :: URLString -> DavLocation -> DavLocation -> DAVT IO ()+moveDAV baseurl src dest = inLocation src $ moveContentM newurl   where-	newurl' = B8.fromString newurl--mkdirDAV :: DavUrl -> DavUser -> DavPass -> IO Bool-mkdirDAV url user pass = do-	debugDAV "MKDIR" url-#if MIN_VERSION_DAV(0,6,0)-	goDAV url user pass mkCol-#else-	makeCollection url user pass-#endif+	newurl = B8.fromString (locationUrl baseurl dest) -existsDAV :: DavUrl -> DavUser -> DavPass -> IO (Either String Bool)-existsDAV url user pass = do-	debugDAV "EXISTS" url-	either (Left . show) id <$> tryNonAsync check+existsDAV :: DavLocation -> DAVT IO (Either String Bool)+existsDAV l = inLocation l check `catchNonAsync` (\e -> return (Left $ show e))   where-	ispresent = return . Right-#if MIN_VERSION_DAV(0,6,0)-	check = goDAV url user pass $ do+	check = do 		setDepth Nothing-		EL.catchJust-			(matchStatusCodeException notFound404)+		catchJust+			(matchStatusCodeException (== notFound404)) 			(getPropsM >> ispresent True) 			(const $ ispresent False)-#else-	check = E.catchJust-		(matchStatusCodeException notFound404)-#if ! MIN_VERSION_DAV(0,4,0)-		(getProps url user pass >> ispresent True)-#else-		(getProps url user pass Nothing >> ispresent True)-#endif-		(const $ ispresent False)-#endif+	ispresent = return . Right -matchStatusCodeException :: Status -> HttpException -> Maybe ()-#if MIN_VERSION_DAV(0,6,0)-matchStatusCodeException want (StatusCodeException s _ _)-#else-matchStatusCodeException want (StatusCodeException s _)-#endif-	| s == want = Just ()+matchStatusCodeException :: (Status -> Bool) -> HttpException -> Maybe HttpException+matchStatusCodeException want e@(StatusCodeException s _ _)+	| want s = Just e 	| otherwise = Nothing matchStatusCodeException _ _ = Nothing -#if MIN_VERSION_DAV(0,6,0)-goDAV :: DavUrl -> DavUser -> DavPass -> DAVT IO a -> IO a-goDAV url user pass a = choke $ evalDAVT url $ do+-- Ignores any exceptions when performing a DAV action.+safely :: DAVT IO a -> DAVT IO (Maybe a)+safely = eitherToMaybe <$$> tryNonAsync++choke :: IO (Either String a) -> IO a+choke f = do+	x <- f+	case x of+		Left e -> error e+		Right r -> return r++data DavHandle = DavHandle DAVContext DavUser DavPass URLString++withDAVHandle :: Remote -> (Maybe DavHandle -> Annex a) -> Annex a+withDAVHandle r a = do+	mcreds <- getCreds (config r) (uuid r)+	case (mcreds, configUrl r) of+		(Just (user, pass), Just baseurl) ->+			withDAVContext baseurl $ \ctx ->+				a (Just (DavHandle ctx (toDavUser user) (toDavPass pass) baseurl))+		_ -> a Nothing++goDAV :: DavHandle -> DAVT IO a -> IO a+goDAV (DavHandle ctx user pass _) a = choke $ run $ prettifyExceptions $ do+	prepDAV user pass+	a+  where+	run = fst <$$> runDAVContext ctx++{- Catch StatusCodeException and trim it to only the statusMessage part,+ - eliminating a lot of noise, which can include the whole request that+ - failed. The rethrown exception is no longer a StatusCodeException. -}+prettifyExceptions :: DAVT IO a -> DAVT IO a+prettifyExceptions a = catchJust (matchStatusCodeException (const True)) a go+  where+	go (StatusCodeException status _ _) = error $ unwords+		[ "DAV failure:"+		, show (statusCode status)+		, show (statusMessage status)+		]+	go e = throwM e++prepDAV :: DavUser -> DavPass -> DAVT IO ()+prepDAV user pass = do 	setResponseTimeout Nothing -- disable default (5 second!) timeout 	setCreds user pass-	a++--+-- Legacy chunking code, to be removed eventually.+--++storeLegacyChunked :: ChunkSize -> Key -> DavHandle -> L.ByteString -> IO Bool+storeLegacyChunked chunksize k dav b =+	Legacy.storeChunks k tmp dest storer recorder finalizer   where-	choke :: IO (Either String a) -> IO a-	choke f = do-		x <- f-		case x of-			Left e -> error e-			Right r -> return r-#endif+	storehttp l b' = void $ goDAV dav $ do+		maybe noop (void . mkColRecursive) (locationParent l)+		inLocation l $ putContentM (contentType, b')+	storer locs = Legacy.storeChunked chunksize locs storehttp b+	recorder l s = storehttp l (L8.fromString s)+	finalizer tmp' dest' = goDAV dav $ +		finalizeStore (baseURL dav) tmp' (fromJust $ locationParent dest')++	tmp = keyTmpLocation k+	dest = keyLocation k++retrieveLegacyChunked :: DavHandle -> Retriever+retrieveLegacyChunked dav = fileRetriever $ \d k p -> liftIO $+	withStoredFilesLegacyChunked k dav onerr $ \locs ->+		Legacy.meteredWriteFileChunks p d locs $ \l ->+			goDAV dav $+				inLocation l $+					snd <$> getContentM+  where+	onerr = error "download failed"++checkKeyLegacyChunked :: DavHandle -> CheckPresent+checkKeyLegacyChunked dav k = liftIO $+	either error id <$> withStoredFilesLegacyChunked k dav onerr check+  where+	check [] = return $ Right True+	check (l:ls) = do+		v <- goDAV dav $ existsDAV l+		if v == Right True+			then check ls+			else return v++	{- Failed to read the chunkcount file; see if it's missing,+	 - or if there's a problem accessing it,+	- or perhaps this was an intermittent error. -}+	onerr f = do+		v <- goDAV dav $ existsDAV f+		return $ if v == Right True+			then Left $ "failed to read " ++ f+			else v++withStoredFilesLegacyChunked+	:: Key+	-> DavHandle+	-> (DavLocation -> IO a)+	-> ([DavLocation] -> IO a)+	-> IO a+withStoredFilesLegacyChunked k dav onerr a = do+	let chunkcount = keyloc ++ Legacy.chunkCount+	v <- goDAV dav $ safely $ +		inLocation chunkcount $+			snd <$> getContentM+	case v of+		Just s -> a $ Legacy.listChunks keyloc $ L8.toString s+		Nothing -> do+			chunks <- Legacy.probeChunks keyloc $ \f ->+				(== Right True) <$> goDAV dav (existsDAV f)+			if null chunks+				then onerr chunkcount+				else a chunks+  where+	keyloc = keyLocation k
+ Remote/WebDAV/DavLocation.hs view
@@ -0,0 +1,62 @@+{- WebDAV locations.+ -+ - Copyright 2014 Joey Hess <joey@kitenet.net>+ -+ - Licensed under the GNU GPL version 3 or higher.+ -}++{-# LANGUAGE CPP #-}+{-# LANGUAGE FlexibleContexts #-}++module Remote.WebDAV.DavLocation where++import Types+import Locations+import Utility.Url (URLString)++import System.FilePath.Posix -- for manipulating url paths+import Network.Protocol.HTTP.DAV (inDAVLocation, DAVT)+import Control.Monad.IO.Class (MonadIO)+#ifdef mingw32_HOST_OS+import Data.String.Utils+#endif++-- Relative to the top of the DAV url.+type DavLocation = String++{- Runs action in subdirectory, relative to the current location. -}+inLocation :: (MonadIO m) => DavLocation -> DAVT m a -> DAVT m a+inLocation d = inDAVLocation (</> d)++{- The directory where files(s) for a key are stored. -}+keyDir :: Key -> DavLocation+keyDir k = addTrailingPathSeparator $ hashdir </> keyFile k+  where+#ifndef mingw32_HOST_OS+	hashdir = hashDirLower k+#else+	hashdir = replace "\\" "/" (hashDirLower k)+#endif++keyLocation :: Key -> DavLocation+keyLocation k = keyDir k ++ keyFile k++{- Where we store temporary data for a key as it's being uploaded. -}+keyTmpLocation :: Key -> DavLocation+keyTmpLocation = addTrailingPathSeparator . tmpLocation . keyFile++tmpLocation :: FilePath -> DavLocation+tmpLocation f = tmpDir </> f++tmpDir :: DavLocation+tmpDir = "tmp"++locationParent :: String -> Maybe String+locationParent loc+	| loc `elem` tops = Nothing+	| otherwise = Just (takeDirectory loc)+  where+	tops = ["/", "", "."]++locationUrl :: URLString -> DavLocation -> URLString+locationUrl baseurl loc = baseurl </> loc
− Remote/WebDAV/DavUrl.hs 
@@ -1,44 +0,0 @@-{- WebDAV urls.- -- - Copyright 2014 Joey Hess <joey@kitenet.net>- -- - Licensed under the GNU GPL version 3 or higher.- -}--{-# LANGUAGE CPP #-}--module Remote.WebDAV.DavUrl where--import Types-import Locations--import Network.URI (normalizePathSegments)-import System.FilePath.Posix-#ifdef mingw32_HOST_OS-import Data.String.Utils-#endif--type DavUrl = String--{- The directory where files(s) for a key are stored. -}-davLocation :: DavUrl -> Key -> DavUrl-davLocation baseurl k = addTrailingPathSeparator $-	davUrl baseurl $ hashdir </> keyFile k-  where-#ifndef mingw32_HOST_OS-	hashdir = hashDirLower k-#else-	hashdir = replace "\\" "/" (hashDirLower k)-#endif--{- Where we store temporary data for a key as it's being uploaded. -}-tmpLocation :: DavUrl -> Key -> DavUrl-tmpLocation baseurl k = addTrailingPathSeparator $-	davUrl baseurl $ "tmp" </> keyFile k--davUrl :: DavUrl -> FilePath -> DavUrl-davUrl baseurl file = baseurl </> file--urlParent :: DavUrl -> DavUrl-urlParent url = dropTrailingPathSeparator $-	normalizePathSegments (dropTrailingPathSeparator url ++ "/..")
RemoteDaemon/Transport/Ssh.hs view
@@ -108,10 +108,10 @@  {- Make connection robustly, with exponentioal backoff on failure. -} robustly :: Int -> IO Status -> IO ()-robustly backoff a = handle =<< catchDefaultIO ConnectionClosed a+robustly backoff a = caught =<< catchDefaultIO ConnectionClosed a   where-	handle Stopping = return ()-	handle ConnectionClosed = do+	caught Stopping = return ()+	caught ConnectionClosed = do 		threadDelaySeconds (Seconds backoff) 		robustly increasedbackoff a
Test.hs view
@@ -20,7 +20,6 @@ #if MIN_VERSION_optparse_applicative(0,8,0) import qualified Options.Applicative.Types as Opt #endif-import Control.Exception.Extensible import qualified Data.Map as M import qualified Text.JSON @@ -1251,7 +1250,7 @@ 	annexed_notpresent annexedfile 	git_annex testenv "copy" [annexedfile, "--from", "foo"] @? "copy --from bup remote failed" 	annexed_present annexedfile-	not <$> git_annex testenv "move" [annexedfile, "--from", "foo"] @? "move --from bup remote failed to fail"+	git_annex testenv "move" [annexedfile, "--from", "foo"] @? "move --from bup remote failed" 	annexed_present annexedfile  -- gpg is not a build dependency, so only test when it's available@@ -1444,7 +1443,7 @@ 		(try a::IO (Either SomeException ())) 	case r of 		Right () -> return ()-		Left e -> throw e+		Left e -> throwM e  setuprepo :: TestEnv -> FilePath -> IO FilePath setuprepo testenv dir = do
Types/Backend.hs view
@@ -15,9 +15,16 @@ data BackendA a = Backend 	{ name :: String 	, getKey :: KeySource -> a (Maybe Key) +	-- Checks the content of a key. 	, fsckKey :: Maybe (Key -> FilePath -> a Bool)+	-- Checks if a key can be upgraded to a better form. 	, canUpgradeKey :: Maybe (Key -> Bool)+	-- Checks if there is a fast way to migrate a key to a different+	-- backend (ie, without re-hashing). 	, fastMigrate :: Maybe (Key -> BackendA a -> Maybe Key)+	-- Checks if a key is known (or assumed) to always refer to the+	-- same data.+	, isStableKey :: Key -> Bool 	}  instance Show (BackendA a) where
Types/Command.hs view
@@ -69,6 +69,7 @@ 	| SectionMetaData 	| SectionUtility 	| SectionPlumbing+	| SectionTesting 	deriving (Eq, Ord, Enum, Bounded)  descSection :: CommandSection -> String@@ -79,3 +80,4 @@ descSection SectionMetaData = "Metadata commands" descSection SectionUtility = "Utility commands" descSection SectionPlumbing = "Plumbing commands"+descSection SectionTesting = "Testing commands"
Types/Key.hs view
@@ -2,7 +2,7 @@  -   - Most things should not need this, using Types instead  -- - Copyright 2011 Joey Hess <joey@kitenet.net>+ - Copyright 2011-2014 Joey Hess <joey@kitenet.net>  -  - Licensed under the GNU GPL version 3 or higher.  -}@@ -13,6 +13,9 @@ 	stubKey, 	key2file, 	file2key,+	nonChunkKey,+	chunkKeyOffset,+	isChunkKey,  	prop_idempotent_key_encode, 	prop_idempotent_key_decode@@ -30,6 +33,8 @@ 	, keyBackendName :: String 	, keySize :: Maybe Integer 	, keyMtime :: Maybe EpochTime+	, keyChunkSize :: Maybe Integer+	, keyChunkNum :: Maybe Integer 	} deriving (Eq, Ord, Read, Show)  {- A filename may be associated with a Key. -}@@ -41,8 +46,26 @@ 	, keyBackendName = "" 	, keySize = Nothing 	, keyMtime = Nothing+	, keyChunkSize = Nothing+	, keyChunkNum = Nothing 	} +-- Gets the parent of a chunk key.+nonChunkKey :: Key -> Key+nonChunkKey k = k+	{ keyChunkSize = Nothing+	, keyChunkNum = Nothing+	}++-- Where a chunk key is offset within its parent.+chunkKeyOffset :: Key -> Maybe Integer+chunkKeyOffset k = (*)+	<$> keyChunkSize k+	<*> (pred <$> keyChunkNum k)++isChunkKey :: Key -> Bool+isChunkKey k = isJust (keyChunkSize k) && isJust (keyChunkNum k)+ fieldSep :: Char fieldSep = '-' @@ -50,13 +73,13 @@  - The name field is always shown last, separated by doubled fieldSeps,  - and is the only field allowed to contain the fieldSep. -} key2file :: Key -> FilePath-key2file Key { keyBackendName = b, keySize = s, keyMtime = m, keyName = n } =-	b +++ ('s' ?: s) +++ ('m' ?: m) +++ (fieldSep : n)+key2file Key { keyBackendName = b, keySize = s, keyMtime = m, keyChunkSize = cs, keyChunkNum = cn, keyName = n } =+	b +++ ('s' ?: s) +++ ('m' ?: m) +++ ('S' ?: cs) +++ ('C' ?: cn) +++ (fieldSep : n)   where 	"" +++ y = y 	x +++ "" = x 	x +++ y = x ++ fieldSep:y-	c ?: (Just v) = c : show v+	f ?: (Just v) = f : show v 	_ ?: _ = ""  file2key :: FilePath -> Maybe Key@@ -84,6 +107,13 @@ 	addfield 'm' k v = do 		mtime <- readish v 		return $ k { keyMtime = Just mtime }+	addfield 'S' k v = do+		chunksize <- readish v+		return $ k { keyChunkSize = Just chunksize }+	addfield 'C' k v = case readish v of+		Just chunknum | chunknum > 0 ->+			return $ k { keyChunkNum = Just chunknum }+		_ -> return k 	addfield _ _ _ = Nothing  instance Arbitrary Key where@@ -92,6 +122,8 @@ 		<*> (listOf1 $ elements ['A'..'Z']) -- BACKEND 		<*> ((abs <$>) <$> arbitrary) -- size cannot be negative 		<*> arbitrary+		<*> ((abs <$>) <$> arbitrary) -- chunksize cannot be negative+		<*> ((succ . abs <$>) <$> arbitrary) -- chunknum cannot be 0 or negative  prop_idempotent_key_encode :: Key -> Bool prop_idempotent_key_encode k = Just k == (file2key . key2file) k@@ -103,6 +135,6 @@   where   	-- file2key will accept the fields in any order, so don't 	-- try the test unless the fields are in the normal order-	normalfieldorder = fields `isPrefixOf` "sm"+	normalfieldorder = fields `isPrefixOf` "smSC" 	fields = map (f !!) $ filter (< length f) $ map succ $ 		elemIndices fieldSep f
Types/Remote.hs view
@@ -56,7 +56,9 @@ 	name :: RemoteName, 	-- Remotes have a use cost; higher is more expensive 	cost :: Cost,-	-- Transfers a key to the remote.+	-- Transfers a key's contents from disk to the remote.+	-- The key should not appear to be present on the remote until+	-- all of its contents have been transferred. 	storeKey :: Key -> AssociatedFile -> MeterUpdate -> a Bool, 	-- Retrieves a key's contents to a file. 	-- (The MeterUpdate does not need to be used if it retrieves@@ -64,14 +66,14 @@ 	retrieveKeyFile :: Key -> AssociatedFile -> FilePath -> MeterUpdate -> a Bool, 	-- retrieves a key's contents to a tmp file, if it can be done cheaply 	retrieveKeyFileCheap :: Key -> FilePath -> a Bool,-	-- removes a key's contents+	-- removes a key's contents (succeeds if the contents are not present) 	removeKey :: Key -> a Bool,-	-- Checks if a key is present in the remote; if the remote-	-- cannot be accessed returns a Left error message.-	hasKey :: Key -> a (Either String Bool),-	-- Some remotes can check hasKey without an expensive network+	-- Checks if a key is present in the remote.+	-- Throws an exception if the remote cannot be accessed.+	checkPresent :: Key -> a Bool,+	-- Some remotes can checkPresent without an expensive network 	-- operation.-	hasKeyCheap :: Bool,+	checkPresentCheap :: Bool, 	-- Some remotes can provide additional details for whereis. 	whereisKey :: Maybe (Key -> a [String]), 	-- Some remotes can run a fsck operation on the remote,@@ -93,7 +95,10 @@ 	-- a Remote can be globally available. (Ie, "in the cloud".) 	availability :: Availability, 	-- the type of the remote-	remotetype :: RemoteTypeA a+	remotetype :: RemoteTypeA a,+	-- For testing, makes a version of this remote that is not+	-- available for use. All its actions should fail.+	mkUnavailable :: a (Maybe (RemoteA a)) }  instance Show (RemoteA a) where
+ Types/StoreRetrieve.hs view
@@ -0,0 +1,43 @@+{- Types for Storer and Retriever actions for remotes.+ -+ - Copyright 2014 Joey Hess <joey@kitenet.net>+ -+ - Licensed under the GNU GPL version 3 or higher.+ -}++module Types.StoreRetrieve where++import Common.Annex+import Utility.Metered++import qualified Data.ByteString.Lazy as L++-- Prepares for and then runs an action that will act on a Key's+-- content, passing it a helper when the preparation is successful.+type Preparer helper = Key -> (Maybe helper -> Annex Bool) -> Annex Bool++-- A source of a Key's content.+data ContentSource+	= FileContent FilePath+	| ByteContent L.ByteString++isByteContent :: ContentSource -> Bool+isByteContent (ByteContent _) = True+isByteContent (FileContent _) = False++-- Action that stores a Key's content on a remote.+-- Can throw exceptions.+type Storer = Key -> ContentSource -> MeterUpdate -> Annex Bool++-- Action that retrieves a Key's content from a remote, passing it to a+-- callback, which will fully consume the content before returning.+-- Throws exception if key is not present, or remote is not accessible.+type Retriever = Key -> MeterUpdate -> (ContentSource -> Annex Bool) -> Annex Bool++-- Action that removes a Key's content from a remote.+-- Succeeds if key is already not present; never throws exceptions.+type Remover = Key -> Annex Bool++-- Checks if a Key's content is present on a remote.+-- Throws an exception if the remote is not accessible.+type CheckPresent = Key -> Annex Bool
Upgrade/V1.hs view
@@ -144,7 +144,7 @@ readKey1 :: String -> Key readKey1 v 	| mixup = fromJust $ file2key $ intercalate ":" $ Prelude.tail bits-	| otherwise = Key+	| otherwise = stubKey 		{ keyName = n 		, keyBackendName = b 		, keySize = s
Utility/Directory.hs view
@@ -11,7 +11,6 @@  import System.IO.Error import System.Directory-import Control.Exception (throw, bracket) import Control.Monad import Control.Monad.IfElse import System.FilePath@@ -114,7 +113,7 @@ 			whenM (isdir dest) rethrow 			viaTmp mv dest undefined 	  where-		rethrow = throw e+		rethrow = throwM e 		mv tmp _ = do 			ok <- boolSystem "mv" [Param "-f", Param src, Param tmp] 			unless ok $ do
Utility/Exception.hs view
@@ -1,59 +1,88 @@ {- Simple IO exception handling (and some more)  -- - Copyright 2011-2012 Joey Hess <joey@kitenet.net>+ - Copyright 2011-2014 Joey Hess <joey@kitenet.net>  -  - License: BSD-2-clause  -}  {-# LANGUAGE ScopedTypeVariables #-} -module Utility.Exception where+module Utility.Exception (+	module X,+	catchBoolIO,+	catchMaybeIO,+	catchDefaultIO,+	catchMsgIO,+	catchIO,+	tryIO,+	bracketIO,+	catchNonAsync,+	tryNonAsync,+	tryWhenExists,+) where -import Control.Exception-import qualified Control.Exception as E-import Control.Applicative+import Control.Monad.Catch as X hiding (Handler)+import qualified Control.Monad.Catch as M+import Control.Exception (IOException, AsyncException) import Control.Monad+import Control.Monad.IO.Class (liftIO, MonadIO) import System.IO.Error (isDoesNotExistError) import Utility.Data  {- Catches IO errors and returns a Bool -}-catchBoolIO :: IO Bool -> IO Bool+catchBoolIO :: MonadCatch m => m Bool -> m Bool catchBoolIO = catchDefaultIO False  {- Catches IO errors and returns a Maybe -}-catchMaybeIO :: IO a -> IO (Maybe a)-catchMaybeIO a = catchDefaultIO Nothing $ Just <$> a+catchMaybeIO :: MonadCatch m => m a -> m (Maybe a)+catchMaybeIO a = do+	catchDefaultIO Nothing $ do+		v <- a+		return (Just v)  {- Catches IO errors and returns a default value. -}-catchDefaultIO :: a -> IO a -> IO a+catchDefaultIO :: MonadCatch m => a -> m a -> m a catchDefaultIO def a = catchIO a (const $ return def)  {- Catches IO errors and returns the error message. -}-catchMsgIO :: IO a -> IO (Either String a)-catchMsgIO a = either (Left . show) Right <$> tryIO a+catchMsgIO :: MonadCatch m => m a -> m (Either String a)+catchMsgIO a = do+	v <- tryIO a+	return $ either (Left . show) Right v  {- catch specialized for IO errors only -}-catchIO :: IO a -> (IOException -> IO a) -> IO a-catchIO = E.catch+catchIO :: MonadCatch m => m a -> (IOException -> m a) -> m a+catchIO = M.catch  {- try specialized for IO errors only -}-tryIO :: IO a -> IO (Either IOException a)-tryIO = try+tryIO :: MonadCatch m => m a -> m (Either IOException a)+tryIO = M.try +{- bracket with setup and cleanup actions lifted to IO.+ -+ - Note that unlike catchIO and tryIO, this catches all exceptions. -}+bracketIO :: (MonadMask m, MonadIO m) => IO v -> (v -> IO b) -> (v -> m a) -> m a+bracketIO setup cleanup = bracket (liftIO setup) (liftIO . cleanup)+ {- Catches all exceptions except for async exceptions.  - This is often better to use than catching them all, so that  - ThreadKilled and UserInterrupt get through.  -}-catchNonAsync :: IO a -> (SomeException -> IO a) -> IO a+catchNonAsync :: MonadCatch m => m a -> (SomeException -> m a) -> m a catchNonAsync a onerr = a `catches`-	[ Handler (\ (e :: AsyncException) -> throw e)-	, Handler (\ (e :: SomeException) -> onerr e)+	[ M.Handler (\ (e :: AsyncException) -> throwM e)+	, M.Handler (\ (e :: SomeException) -> onerr e) 	] -tryNonAsync :: IO a -> IO (Either SomeException a)-tryNonAsync a = (Right <$> a) `catchNonAsync` (return . Left)+tryNonAsync :: MonadCatch m => m a -> m (Either SomeException a)+tryNonAsync a = go `catchNonAsync` (return . Left)+  where+	go = do+		v <- a+		return (Right v)  {- Catches only DoesNotExist exceptions, and lets all others through. -}-tryWhenExists :: IO a -> IO (Maybe a)-tryWhenExists a = eitherToMaybe <$>-	tryJust (guard . isDoesNotExistError) a+tryWhenExists :: MonadCatch m => m a -> m (Maybe a)+tryWhenExists a = do+	v <- tryJust (guard . isDoesNotExistError) a+	return (eitherToMaybe v)
Utility/FileMode.hs view
@@ -11,7 +11,6 @@  import System.IO import Control.Monad-import Control.Exception (bracket) import System.PosixCompat.Types import Utility.PosixFiles #ifndef mingw32_HOST_OS
Utility/Gpg.hs view
@@ -11,6 +11,7 @@  import Control.Applicative import Control.Concurrent+import Control.Monad.IO.Class import qualified Data.Map as M  import Common@@ -18,7 +19,6 @@  #ifndef mingw32_HOST_OS import System.Posix.Types-import Control.Exception (bracket) import System.Path import Utility.Env #else@@ -104,23 +104,23 @@  -  - Note that to avoid deadlock with the cleanup stage,  - the reader must fully consume gpg's input before returning. -}-feedRead :: [CommandParam] -> String -> (Handle -> IO ()) -> (Handle -> IO a) -> IO a+feedRead :: (MonadIO m, MonadMask m) => [CommandParam] -> String -> (Handle -> IO ()) -> (Handle -> m a) -> m a feedRead params passphrase feeder reader = do #ifndef mingw32_HOST_OS 	-- pipe the passphrase into gpg on a fd-	(frompipe, topipe) <- createPipe-	void $ forkIO $ do+	(frompipe, topipe) <- liftIO createPipe+	liftIO $ void $ forkIO $ do 		toh <- fdToHandle topipe 		hPutStrLn toh passphrase 		hClose toh 	let Fd pfd = frompipe 	let passphrasefd = [Param "--passphrase-fd", Param $ show pfd]-	closeFd frompipe `after` go (passphrasefd ++ params)+	liftIO (closeFd frompipe) `after` go (passphrasefd ++ params) #else 	-- store the passphrase in a temp file for gpg 	withTmpFile "gpg" $ \tmpfile h -> do-		hPutStr h passphrase-		hClose h+		liftIO $ hPutStr h passphrase+		liftIO $ hClose h 		let passphrasefile = [Param "--passphrase-file", File tmpfile] 		go $ passphrasefile ++ params #endif@@ -128,15 +128,24 @@ 	go params' = pipeLazy params' feeder reader  {- Like feedRead, but without passphrase. -}-pipeLazy :: [CommandParam] -> (Handle -> IO ()) -> (Handle -> IO a) -> IO a+pipeLazy :: (MonadIO m, MonadMask m) => [CommandParam] -> (Handle -> IO ()) -> (Handle -> m a) -> m a pipeLazy params feeder reader = do-	params' <- stdParams $ Param "--batch" : params-	withBothHandles createProcessSuccess (proc gpgcmd params')-		$ \(to, from) -> do-			void $ forkIO $ do-				feeder to-				hClose to-			reader from+	params' <- liftIO $ stdParams $ Param "--batch" : params+	let p = (proc gpgcmd params')+		{ std_in = CreatePipe+		, std_out = CreatePipe+		, std_err = Inherit+		}+	bracket (setup p) (cleanup p) go+  where+	setup = liftIO . createProcess+	cleanup p (_, _, _, pid) = liftIO $ forceSuccessProcess p pid+	go p = do+		let (to, from) = bothHandles p+		liftIO $ void $ forkIO $ do+			feeder to+			hClose to+		reader from  {- Finds gpg public keys matching some string. (Could be an email address,  - a key id, or a name; See the section 'HOW TO SPECIFY A USER ID' of
Utility/InodeCache.hs view
@@ -40,6 +40,10 @@ import System.PosixCompat.Types import Utility.QuickCheck +#ifdef mingw32_HOST_OS+import Data.Word (Word64)+#endif+ data InodeCachePrim = InodeCachePrim FileID FileOffset EpochTime 	deriving (Show, Eq, Ord) @@ -203,6 +207,11 @@ 			<*> arbitrary 			<*> arbitrary 		in InodeCache <$> prim++#ifdef mingw32_HOST_OS+instance Arbitrary FileID where+	arbitrary = fromIntegral <$> (arbitrary :: Gen Word64)+#endif  prop_read_show_inodecache :: InodeCache -> Bool prop_read_show_inodecache c = case readInodeCache (showInodeCache c) of
Utility/Matcher.hs view
@@ -102,13 +102,13 @@ 	in (Group (reverse g), rest)   where   	go c [] = (c, []) -- not picky about extra Close-	go c (t:ts) = handle t+	go c (t:ts) = dispatch t 	  where-		handle Close = (c, ts)-		handle Open = +		dispatch Close = (c, ts)+		dispatch Open =  			let (c', ts') = go [] ts 			in go (Group (reverse c') : c) ts'-		handle _ = go (One t:c) ts+		dispatch _ = go (One t:c) ts  {- Checks if a Matcher matches, using a supplied function to check  - the value of Operations. -}
Utility/Metered.hs view
@@ -16,6 +16,7 @@ import System.IO.Unsafe import Foreign.Storable (Storable(sizeOf)) import System.Posix.Types+import Data.Int  {- An action that can be run repeatedly, updating it on the bytes processed.  -@@ -23,6 +24,9 @@  - far, *not* an incremental amount since the last call. -} type MeterUpdate = (BytesProcessed -> IO ()) +nullMeterUpdate :: MeterUpdate+nullMeterUpdate _ = return ()+ {- Total number of bytes processed so far. -} newtype BytesProcessed = BytesProcessed Integer 	deriving (Eq, Ord, Show)@@ -31,6 +35,10 @@ 	toBytesProcessed :: a -> BytesProcessed 	fromBytesProcessed :: BytesProcessed -> a +instance AsBytesProcessed BytesProcessed where+	toBytesProcessed = id+	fromBytesProcessed = id+ instance AsBytesProcessed Integer where 	toBytesProcessed i = BytesProcessed i 	fromBytesProcessed (BytesProcessed i) = i@@ -39,6 +47,10 @@ 	toBytesProcessed i = BytesProcessed $ toInteger i 	fromBytesProcessed (BytesProcessed i) = fromInteger i +instance AsBytesProcessed Int64 where+	toBytesProcessed i = BytesProcessed $ toInteger i+	fromBytesProcessed (BytesProcessed i) = fromInteger i+ instance AsBytesProcessed FileOffset where 	toBytesProcessed sz = BytesProcessed $ toInteger sz 	fromBytesProcessed (BytesProcessed sz) = fromInteger sz@@ -76,6 +88,13 @@ meteredWriteFile :: MeterUpdate -> FilePath -> L.ByteString -> IO () meteredWriteFile meterupdate f b = withBinaryFile f WriteMode $ \h -> 	meteredWrite meterupdate h b++{- Applies an offset to a MeterUpdate. This can be useful when+ - performing a sequence of actions, such as multiple meteredWriteFiles,+ - that all update a common meter progressively. Or when resuming.+ -}+offsetMeterUpdate :: MeterUpdate -> BytesProcessed -> MeterUpdate+offsetMeterUpdate base offset = \n -> base (offset `addBytesProcessed` n)  {- This is like L.hGetContents, but after each chunk is read, a meter  - is updated based on the size of the chunk.
Utility/Parallel.hs view
@@ -10,7 +10,6 @@ import Common  import Control.Concurrent-import Control.Exception  {- Runs an action in parallel with a set of values, in a set of threads.  - In order for the actions to truely run in parallel, requires GHC's
Utility/Process.hs view
@@ -31,6 +31,7 @@ 	stdinHandle, 	stdoutHandle, 	stderrHandle,+	bothHandles, 	processHandle, 	devNull, ) where
Utility/Rsync.hs view
@@ -66,14 +66,8 @@  - The params must enable rsync's --progress mode for this to work.  -} rsyncProgress :: MeterUpdate -> [CommandParam] -> IO Bool-rsyncProgress meterupdate params = do-	r <- catchBoolIO $ -		withHandle StdoutHandle createProcessSuccess p (feedprogress 0 [])-	{- For an unknown reason, piping rsync's output like this does-	 - causes it to run a second ssh process, which it neglects to wait-	 - on. Reap the resulting zombie. -}-	reapZombies-	return r+rsyncProgress meterupdate params = catchBoolIO $ +	withHandle StdoutHandle createProcessSuccess p (feedprogress 0 [])   where 	p = proc "rsync" (toCommand $ rsyncParamsFixup params) 	feedprogress prev buf h = do
Utility/Tmp.hs view
@@ -9,11 +9,11 @@  module Utility.Tmp where -import Control.Exception (bracket) import System.IO import System.Directory import Control.Monad.IfElse import System.FilePath+import Control.Monad.IO.Class  import Utility.Exception import Utility.FileSystemEncoding@@ -32,31 +32,31 @@ 	setup = do 		createDirectoryIfMissing True dir 		openTempFile dir template-	cleanup (tmpfile, handle) = do-		_ <- tryIO $ hClose handle+	cleanup (tmpfile, h) = do+		_ <- tryIO $ hClose h 		tryIO $ removeFile tmpfile-	use (tmpfile, handle) = do-		hClose handle+	use (tmpfile, h) = do+		hClose h 		a tmpfile content 		rename tmpfile file  {- Runs an action with a tmp file located in the system's tmp directory  - (or in "." if there is none) then removes the file. -}-withTmpFile :: Template -> (FilePath -> Handle -> IO a) -> IO a+withTmpFile :: (MonadIO m, MonadMask m) => Template -> (FilePath -> Handle -> m a) -> m a withTmpFile template a = do-	tmpdir <- catchDefaultIO "." getTemporaryDirectory+	tmpdir <- liftIO $ catchDefaultIO "." getTemporaryDirectory 	withTmpFileIn tmpdir template a  {- Runs an action with a tmp file located in the specified directory,  - then removes the file. -}-withTmpFileIn :: FilePath -> Template -> (FilePath -> Handle -> IO a) -> IO a+withTmpFileIn :: (MonadIO m, MonadMask m) => FilePath -> Template -> (FilePath -> Handle -> m a) -> m a withTmpFileIn tmpdir template a = bracket create remove use   where-	create = openTempFile tmpdir template-	remove (name, handle) = do-		hClose handle+	create = liftIO $ openTempFile tmpdir template+	remove (name, h) = liftIO $ do+		hClose h 		catchBoolIO (removeFile name >> return True)-	use (name, handle) = a name handle+	use (name, h) = a name h  {- Runs an action with a tmp directory located within the system's tmp  - directory (or within "." if there is none), then removes the tmp
Utility/Url.hs view
@@ -1,16 +1,18 @@ {- Url downloading.  -- - Copyright 2011,2013 Joey Hess <joey@kitenet.net>+ - Copyright 2011-2014 Joey Hess <joey@kitenet.net>  -  - License: BSD-2-clause  -}  {-# LANGUAGE CPP #-}+{-# LANGUAGE OverloadedStrings #-}  module Utility.Url ( 	URLString, 	UserAgent,-	UrlOptions(..),+	UrlOptions,+	mkUrlOptions, 	check, 	checkBoth, 	exists,@@ -21,10 +23,12 @@  import Common import Network.URI-import qualified Network.Browser as Browser-import Network.HTTP-import Data.Either+import Network.HTTP.Conduit+import Network.HTTP.Types import Data.Default+import qualified Data.CaseInsensitive as CI+import qualified Data.ByteString as B+import qualified Data.ByteString.UTF8 as B8  import qualified Build.SysConfig @@ -38,12 +42,36 @@ 	{ userAgent :: Maybe UserAgent 	, reqHeaders :: Headers 	, reqParams :: [CommandParam]+	, applyRequest :: Request -> Request 	}  instance Default UrlOptions   where-	def = UrlOptions Nothing [] []+	def = UrlOptions Nothing [] [] id +mkUrlOptions :: Maybe UserAgent -> Headers -> [CommandParam] -> UrlOptions+mkUrlOptions useragent reqheaders reqparams =+	UrlOptions useragent reqheaders reqparams applyrequest+  where+	applyrequest = \r -> r { requestHeaders = requestHeaders r ++ addedheaders }+	addedheaders = uaheader ++ otherheaders+	uaheader = case useragent of+		Nothing -> []+		Just ua -> [(hUserAgent, B8.fromString ua)]+	otherheaders = map toheader reqheaders+	toheader s =+		let (h, v) = separate (== ':') s+		    h' = CI.mk (B8.fromString h)+		in case v of+			(' ':v') -> (h', B8.fromString v')+			_ -> (h', B8.fromString v)++addUserAgent :: UrlOptions -> [CommandParam] -> [CommandParam]+addUserAgent uo ps = case userAgent uo of+	Nothing -> ps+	-- --user-agent works for both wget and curl commands+	Just ua -> ps ++ [Param "--user-agent", Param ua] + {- Checks that an url exists and could be successfully downloaded,  - also checking that its size, if available, matches a specified size. -} checkBoth :: URLString -> Maybe Integer -> UrlOptions -> IO Bool@@ -51,42 +79,35 @@ 	v <- check url expected_size uo 	return (fst v && snd v) check :: URLString -> Maybe Integer -> UrlOptions -> IO (Bool, Bool)-check url expected_size = handle <$$> exists url+check url expected_size = go <$$> exists url   where-	handle (False, _) = (False, False)-	handle (True, Nothing) = (True, True)-	handle (True, s) = case expected_size of+	go (False, _) = (False, False)+	go (True, Nothing) = (True, True)+	go (True, s) = case expected_size of 		Just _ -> (True, expected_size == s) 		Nothing -> (True, True)  {- Checks that an url exists and could be successfully downloaded,- - also returning its size if available. - -- - For a file: url, check it directly.- -- - Uses curl otherwise, when available, since curl handles https better- - than does Haskell's Network.Browser.- -}+ - also returning its size if available. -} exists :: URLString -> UrlOptions -> IO (Bool, Maybe Integer) exists url uo = case parseURIRelaxed url of-	Just u-		| uriScheme u == "file:" -> do-			s <- catchMaybeIO $ getFileStatus (unEscapeString $ uriPath u)-			case s of-				Just stat -> return (True, Just $ fromIntegral $ fileSize stat)-				Nothing -> dne-		| otherwise -> if Build.SysConfig.curl-			then do+	Just u -> case parseUrl (show u) of+		Just req -> existsconduit req `catchNonAsync` const dne+		-- http-conduit does not support file:, ftp:, etc urls,+		-- so fall back to reading files and using curl.+		Nothing+			| uriScheme u == "file:" -> do+				s <- catchMaybeIO $ getFileStatus (unEscapeString $ uriPath u)+				case s of+					Just stat -> return (True, Just $ fromIntegral $ fileSize stat)+					Nothing -> dne+			| Build.SysConfig.curl -> do 				output <- catchDefaultIO "" $ 					readProcess "curl" $ toCommand curlparams 				case lastMaybe (lines output) of-					Just ('2':_:_) -> return (True, extractsize output)+					Just ('2':_:_) -> return (True, extractlencurl output) 					_ -> dne-			else do-				r <- request u HEAD uo-				case rspCode r of-					(2,_,_) -> return (True, size r)-					_ -> return (False, Nothing)+			| otherwise -> dne 	Nothing -> dne   where 	dne = return (False, Nothing)@@ -98,19 +119,40 @@ 		, Param "-w", Param "%{http_code}" 		] ++ concatMap (\h -> [Param "-H", Param h]) (reqHeaders uo) ++ (reqParams uo) -	extractsize s = case lastMaybe $ filter ("Content-Length:" `isPrefixOf`) (lines s) of+	extractlencurl s = case lastMaybe $ filter ("Content-Length:" `isPrefixOf`) (lines s) of 		Just l -> case lastMaybe $ words l of 			Just sz -> readish sz 			_ -> Nothing 		_ -> Nothing--	size = liftM Prelude.read . lookupHeader HdrContentLength . rspHeaders+	+	extractlen resp = readish . B8.toString =<< headMaybe lenheaders+	  where+		lenheaders = map snd $ +			filter (\(h, _) -> h == hContentLength)+				(responseHeaders resp)+	+	existsconduit req = withManager $ \mgr -> do+			let req' = headRequest (applyRequest uo req)+			resp <- http req' mgr+			-- forces processing the response before the+			-- manager is closed+			ret <- if responseStatus resp == ok200+				then return (True, extractlen resp)+				else liftIO dne+			liftIO $ closeManager mgr+			return ret --- works for both wget and curl commands-addUserAgent :: UrlOptions -> [CommandParam] -> [CommandParam]-addUserAgent uo ps = case userAgent uo of-	Nothing -> ps-	Just ua -> ps ++ [Param "--user-agent", Param ua] +headRequest :: Request -> Request+headRequest r = r+	{ method = methodHead+	-- remove defaut Accept-Encoding header, to get actual,+	-- not gzip compressed size.+	, requestHeaders = (hAcceptEncoding, B.empty) :+		filter (\(h, _) -> h /= hAcceptEncoding)+		(requestHeaders r)+	}+  where+	hAcceptEncoding = "Accept-Encoding"  {- Used to download large files, such as the contents of keys.  -@@ -160,52 +202,6 @@ 	quietopt s 		| quiet = [Param s] 		| otherwise = []--{- Uses Network.Browser to make a http request of an url.- - For example, HEAD can be used to check if the url exists,- - or GET used to get the url content (best for small urls).- -- - This does its own redirect following because Browser's is buggy for HEAD- - requests.- -- - Unfortunately, does not handle https, so should only be used- - when curl is not available.- -}-request :: URI -> RequestMethod -> UrlOptions -> IO (Response String)-request url requesttype uo = go 5 url-  where-	go :: Int -> URI -> IO (Response String)-	go 0 _ = error "Too many redirects "-	go n u = do-		rsp <- Browser.browse $ do-			maybe noop Browser.setUserAgent (userAgent uo)-			Browser.setErrHandler ignore-			Browser.setOutHandler ignore-			Browser.setAllowRedirects False-			let req = mkRequest requesttype u :: Request_String-			snd <$> Browser.request (addheaders req)-		case rspCode rsp of-			(3,0,x) | x /= 5 -> redir (n - 1) u rsp-			_ -> return rsp-	addheaders req = setHeaders req (rqHeaders req ++ userheaders)-	userheaders = rights $ map parseHeader (reqHeaders uo)-	ignore = const noop-	redir n u rsp = case retrieveHeaders HdrLocation rsp of-		[] -> return rsp-		(Header _ newu:_) ->-			case parseURIReference newu of-				Nothing -> return rsp-				Just newURI -> go n $-#if defined VERSION_network-#if ! MIN_VERSION_network(2,4,0)-#define WITH_OLD_URI-#endif-#endif-#ifdef WITH_OLD_URI-					fromMaybe newURI (newURI `relativeTo` u)-#else-					newURI `relativeTo` u-#endif  {- Allows for spaces and other stuff in urls, properly escaping them. -} parseURIRelaxed :: URLString -> Maybe URI
Utility/WebApp.hs view
@@ -38,10 +38,6 @@ #ifdef __ANDROID__ import Data.Endian #endif-#if defined(__ANDROID__) || defined (mingw32_HOST_OS)-#else-import Control.Exception (bracketOnError)-#endif  localhost :: HostName localhost = "localhost"
debian/changelog view
@@ -1,3 +1,48 @@+git-annex (5.20140817) unstable; urgency=medium++  * New chunk= option to chunk files stored in special remotes.+    Supported by: directory, S3, webdav, gcrypt, rsync, and all external+    and hook special remotes.+  * Partially transferred files are automatically resumed when using+    chunked remotes!+  * The old chunksize= option is deprecated. Do not use for new remotes.+  * Legacy code for directory remotes using the old chunksize= option+    will keep them working, but more slowly than before.+  * webapp: Automatically install Konqueror integration scripts+    to get and drop files.+  * repair: Removing bad objects could leave fsck finding no more+    unreachable objects, but some branches no longer accessible.+    Fix this, including support for fixing up repositories that+    were incompletely repaired before.+  * Fix cost calculation for non-encrypted remotes.+  * Display exception message when a transfer fails due to an exception.+  * WebDAV: Sped up by avoiding making multiple http connections+    when storing a file.+  * WebDAV: Avoid buffering whole file in memory when uploading and+    downloading.+  * WebDAV: Dropped support for DAV before 1.0.+  * testremote: New command to test uploads/downloads to a remote.+  * Dropping an object from a bup special remote now deletes the git branch+    for the object, although of course the object's content cannot be deleted+    due to the nature of bup.+  * unlock: Better error handling; continue past files that are not available+    or cannot be unlocked due to disk space, and try all specified files.+  * Windows: Now uses actual inode equivilants in new direct mode+    repositories, for safer detection of eg, renaming of files with the same+    size and mtime.+  * direct: Fix ugly warning messages.+  * WORM backend: When adding a file in a subdirectory, avoid including the+    subdirectory in the key name.+  * S3, Glacier, WebDAV: Fix bug that prevented accessing the creds+    when the repository was configured with encryption=shared embedcreds=yes.+  * direct: Avoid leaving file content in misctemp if interrupted.+  * git-annex-shell sendkey: Don't fail if a remote asks for a key to be sent+    that already has a transfer lock file indicating it's being sent to that+    remote. The remote may have moved between networks, or reconnected.+  * Switched from the old haskell HTTP library to http-conduit.++ -- Joey Hess <joeyh@debian.org>  Sun, 17 Aug 2014 10:30:58 -0400+ git-annex (5.20140717) unstable; urgency=high    * Fix minor FD leak in journal code. Closes: #754608
debian/control view
@@ -14,10 +14,11 @@ 	libghc-dataenc-dev, 	libghc-utf8-string-dev, 	libghc-hs3-dev (>= 0.5.6),-	libghc-dav-dev (>= 0.6.1) [amd64 i386 kfreebsd-amd64 kfreebsd-i386 powerpc],+	libghc-dav-dev (>= 1.0) [amd64 i386 kfreebsd-amd64 kfreebsd-i386 powerpc], 	libghc-quickcheck2-dev, 	libghc-monad-control-dev (>= 0.3), 	libghc-exceptions-dev,+	libghc-transformers-dev, 	libghc-unix-compat-dev, 	libghc-dlist-dev, 	libghc-uuid-dev,@@ -26,7 +27,6 @@ 	libghc-ifelse-dev, 	libghc-bloomfilter-dev, 	libghc-edit-distance-dev,-	libghc-extensible-exceptions-dev, 	libghc-hinotify-dev [linux-any], 	libghc-stm-dev (>= 2.3), 	libghc-dbus-dev (>= 0.10.3) [linux-any],@@ -46,6 +46,7 @@ 	libghc-dns-dev, 	libghc-case-insensitive-dev, 	libghc-http-types-dev,+	libghc-http-conduit-dev, 	libghc-blaze-builder-dev, 	libghc-crypto-api-dev, 	libghc-network-multicast-dev,@@ -55,7 +56,6 @@ 	libghc-gnutls-dev (>= 0.1.4), 	libghc-xml-types-dev, 	libghc-async-dev,-	libghc-http-dev, 	libghc-feed-dev (>= 0.3.9.2), 	libghc-regex-tdfa-dev [!mipsel !s390], 	libghc-regex-compat-dev [mipsel s390],
+ doc/assistant/konquerormenu.png view

binary file changed (absent → 27159 bytes)

+ doc/backends/comment_7_4aa8cfaec1090f79fed530720e4ddad4._comment view
@@ -0,0 +1,18 @@+[[!comment format=mdwn+ username="https://www.google.com/accounts/o8/id?id=AItOawmraN_ldJplGunVGmnjjLN6jL9s9TrVMGE"+ nickname="Ævar Arnfjörð"+ subject="Can annex use existing backends when amending existing files?"+ date="2014-08-05T21:35:34Z"+ content="""+Related to the question posed in http://git-annex.branchable.com/forum/switching_backends/ can git annex be told to use the existing backend for a given file?++The use case for this is that you have an existing repo that started out e.g. with SHA256, but new files are being added with SHA256E since that's the default now.++But I was doing:++    git annex edit .+    rsync /some/old/copy/ .+    git annex add .++And was expecting it to show no changes for existing files, but it did, it would be nice if that was not the case.+"""]]
+ doc/backends/comment_8_c40d2c2c929ad3239ee5d529e307c746._comment view
@@ -0,0 +1,8 @@+[[!comment format=mdwn+ username="http://joeyh.name/"+ ip="209.250.56.7"+ subject="comment 8"+ date="2014-08-12T18:00:46Z"+ content="""+Ævar, you can use `git annex add --backend=SHA256` to temporarily override the backend.+"""]]
+ doc/bugs/Permission_problem_in_second_user_account_on_Android.mdwn view
@@ -0,0 +1,15 @@+I get the following error message upon starting git-annex in a second user account on Android:++    Falling back to hardcoded app location: cannot find expected files in /data/app-lib+    git annex webapp+    lib/lib.runshell.so: line 133: git: Permission denied++    [Terminal session finished]++The same version of git-annex works just fine for the primary user.+(The primary user has root access which unfortunately can't be enabled for other user accounts.)++### What version of git-annex are you using? On what operating system?++  * git-annex: 5.20140710+  * OS: CyanogenMod 10.1.3-p3110
+ doc/bugs/Possible_data-loss_if_WORM_keys_do_not_encode_relative_paths.mdwn view
@@ -0,0 +1,23 @@+This is a follow-up to [this+qbug](http://git-annex.branchable.com/bugs/WORM_keys_differ_depending_on_working_dir_during_add/).+Thank you for your fix there! However, if I understood correctly, you+indicated in your reply that the current fix completely removes the+relative path component from WORM keys. I gave some thought to this+and believe not having the relative path encoded inside WORM keys+makes key collisions (and accordingly data-loss) a very dire problem,+while they are not of practical concern if the relative path is+encoded.++When relative paths are encoded within the key, a collision can only+occur when a file in the same directory is annexed twice within the+resolution of the mtime component inside the key (i.e., one second).+As such, unless one adds files automatically with a period of < 1s,+one can very much be certain that no collisions come up.++Without relative paths, however, one could never be certain that+adding a file will not result in data-loss.++Instead of just using the basename, WORM keys could be kept stable by+using the relative path and anchoring it to the root of the+repository.+
+ doc/bugs/S3_memory_leaks/comment_3_5e9cecb0e2ec7602963406779b6e3c1f._comment view
@@ -0,0 +1,12 @@+[[!comment format=mdwn+ username="http://joeyh.name/"+ ip="209.250.56.112"+ subject="comment 3"+ date="2014-08-02T23:08:44Z"+ content="""+hS3's author seems to have abandoned it and it has other problems. I should try to switch to a different S3 library.++There is now a workaround; S3 special remotes can be configured to use [[chunking]]. A max of one chunk will then be buffered in memory at a time. ++For example, to reconfigure an existing mys3 remote: `enableremote mys3 chunk=1MiB`+"""]]
+ doc/bugs/S3_memory_leaks/comment_4_37e41b518813bd7c349017abf4a0ca0f._comment view
@@ -0,0 +1,8 @@+[[!comment format=mdwn+ username="http://joeyh.name/"+ ip="209.250.56.112"+ subject="comment 4"+ date="2014-08-03T18:40:26Z"+ content="""+Beginning work on a `s3-aws` branch using the aws library instead of hS3.+"""]]
doc/bugs/Truncated_file_transferred_via_S3.mdwn view
@@ -612,3 +612,6 @@  # End of transcript or log. """]]++> Pretty sure this must have been due to Char8 truncation. So,+> [[fixed|done]].
+ doc/bugs/WORM_keys_differ_depending_on_working_dir_during_add.mdwn view
@@ -0,0 +1,68 @@+### Please describe the problem.++While the docs say that WORM keys are a function of a files basename,+when doing «git annex add .», the generated keys will actually contain+the relative path (with slashes escaped). Not sure whether this is by+design or a bug in its own right. I suppose that to minimize the chance+of collisions on WORM, having the path within the key is preferable.++A problem about this, however, is that the path in the key is not+stable, but varies with the working dir when doing the «git annex+add». So, when a file is added from one working dir (say, the repo+base), later unlocked, and readded from another working dir (say,+somewhere below the repo base), this will generate a different key+even when the file has not been touched.++Is there a rationale for this variability, or should «add» canonicalize+the encoded paths to the repo root?+++### What steps will reproduce the problem?+++[[!format sh """++# Init+$ git init /tmp/foo+$ cd /tmp/foo && git annex init++$ mkdir baz+$ touch baz/quux++# Add file with working dir at repo root.+$ git annex add --backend=WORM baz+$ git commit -m "first"++# Key includes relative path.+$ readlink baz/quux+../.git/annex/objects/8x/8V/WORM-s0-m1406981486--baz%quux/WORM-s0-m1406981486--baz%quux++# Unlock and readd with working dir at path below repo root.+$ cd baz+$ git annex unlock quux++$ git annex add quux+$ git com -m "second"++# Relative path is anchored to working dir instead of repo root.+$ readlink quux+../.git/annex/objects/9G/72/WORM-s0-m1406981486--quux/WORM-s0-m1406981486--quux++# End of transcript or log.+"""]]++### What version of git-annex are you using? On what operating system?+Linux 3.15.8++git-annex 5.20140716++> This was a bug. I suspect it got broken a while ago and I didn't noticed+> since I rarely use WORM and when I do it's almost always adding files+> in the current directory. [[fixed|done]] to take the filename only.+> +> I don't think it's a problem to have the subdirectory path in the+> existing WORM keys, other than the problems you note with this meaning+> a later add of the same file will generate a different key. So I have not+> done anything to try to fix up existing keys. (If this became a problem,+> I could add upgrade code to the WORM backend.)+> --[[Joey]]
+ doc/bugs/direct_command_leaves_repository_inconsistent_if_interrupted.mdwn view
@@ -0,0 +1,45 @@+### Please describe the problem.++When `git annex direct` is interrupted (either through a power outage or deliberate `control-c`) it may leave the repository in an inconsistent state.++A typical situation is `git-annex` believing that the repo is in `indirect` mode while the files are not symlinks anymore.++I believe I have described this problem here before, but the bug report was deleted as part of the may 29th purge (222f78e9eadd3d2cc40ec94ab22241823a7d50d9,  [[bugs/git_annex_indirect_can_fail_catastrophically]]).++### What steps will reproduce the problem?++`git annex direct` on a large repository, `control-c` before it finishes.++Observe how a lot of files are now considered to be in the famous [[typechange status|forum/git-status_typechange_in_direct_mode/]] in git.++### What version of git-annex are you using? On what operating system?++5.20140717 on Debian Jessie, ext4 filesystem.++### Please provide any additional information below.++I wish i could resume the `git annex direct` command, but this will do a `git commit -a` and therefore commit all those files to git directly. It still seems to me that `git annex` should never run `git commit -a` for exactly that kind of situations.++I think that's it for now. -- [[anarcat]]++Update: i was able to get rid of the `typechange` situation by running `git annex lock` on the repository, but then all files are found to be missing by `git annex fsck`:++[[!format txt """+fsck films/God Hates Cartoons/VIDEO_TS/VTS_15_0.BUP (fixing location log)+  ** Based on the location log, films/God Hates Cartoons/VIDEO_TS/VTS_15_0.BUP+  ** was expected to be present, but its content is missing.++  Only 1 of 2 trustworthy copies exist of films/God Hates Cartoons/VIDEO_TS/VTS_15_0.BUP+  Back it up with git-annex copy.+"""]]++Oddly enough, the repo still uses hundreds of gigs, because all the files ended up in `.git/annex/misctmp`. Not sure I remember what happened there.++Similar issues and discussions:++* [[bugs/direct_mode_merge_interrupt/]]+* [[forum/Cleaning_up_after_aborted_sync_in_direct_mode/]]+* [[bugs/failure_to_return_to_indirect_mode_on_usb/]]+* [[forum/git-status_typechange_in_direct_mode/]]++[[!meta title="git annex lock --force deletes only copy of content after interrupted switch to direct mode"]
+ doc/bugs/git_annex_import_fails_on_filenames_with_newlines_in_them.mdwn view
@@ -0,0 +1,46 @@+### Please describe the problem.+I am importing a lot of old documents into my annex.  Some of these old files apparently have newlines in their filename.  A run of `git annex import` aborts when it encounters such a file; the file is moved to the annex, but it is left unstaged.++### What steps will reproduce the problem?+[[!format sh """+bram@durian% mkdir annex+bram@durian% cd annex+bram@durian% git init+Initialized empty Git repository in /home/bram/tmp/t/annex/.git/+bram@durian% git annex init+init  ok+(Recording state in git...)+bram@durian% echo foo > ../$'foo\nbar'+bram@durian% ls -lb ..+total 8+drwxr-xr-x 3 bram bram 4096 Jul 26 18:20 annex/+-rw-r--r-- 1 bram bram    4 Jul 26 18:20 foo\nbar+bram@durian% git annex import ../foo$'\n'bar+import foo+bar git-annex: unknown response from git cat-file ("HEAD:./foo missing","HEAD:./foo\nbar")+bram@durian% ls -lb+total 4+-r--r--r-- 2 bram bram 4 Jul 26 18:20 foo\nbar+bram@durian% git status+On branch master++Initial commit++Untracked files:+  (use "git add <file>..." to include in what will be committed)++	"foo\nbar"++nothing added to commit but untracked files present (use "git add" to track)+bram@durian% cat $'foo\nbar'+foo+"""]]+++### What version of git-annex are you using? On what operating system?+    Debian unstable+    git-annex version: 5.20140717+    git version 2.0.1+    Linux durian 3.14-1-amd64 #1 SMP Debian 3.14.9-1 (2014-06-30) x86_64 GNU/Linux++[[!tag confirmed git-bug]]
+ doc/bugs/git_annex_still_deleting_content_when_merging.mdwn view
@@ -0,0 +1,88 @@+**Premise:**++I've had this problem before 5.20140709-gc75193e and when the [ugly bug](http://git-annex.branchable.com/devblog/day_193-194__ugly_bug/) was discovered and fixed, I updated and thought it was gone.+Yet, I'm still experiencing a content removal bug, so it might be something different altogether.+I should also add that I don't know much about git log history and git-annex inner workings. I might need some help with finding the necessary information for debugging.++**Bug description:**++Two local computers, running Ubuntu-14.04 and Fedora-20 respectively, are paired through the assistant and functional with git annex 5.20140709. In direct mode. Most of the time, everything seems to work fine. Sometimes, *Computer A* will modify one file in its repository while *B* is offline. When *B* comes back online both repositories will lose their copy of the modified file (I'm not sure whether this also happens when they're both online when the change happens; it doesn't look like it anyway). The rest of the data in the repository is intact. This does not happen every time and I haven't been able to reproduce it consistently. Since 5.20140709 came out, it happened 2 or 3 times.++Looking at 'git log --stat' in *B*:++    commit d9eb9e94a39+    Author: COMPUTER B+    Date:   Thu Jul 17 18:17:16 2014 +0200+      shared.skg | 1 -+      1 file changed, 1 deletion(-)++    commit 6fa27f08492+    Author: COMPUTER A+    Date:   Thu Jul 17 18:17:14 2014 +0200+      shared.skg | 1 ++      1 file changed, 1 insertion(+)++    commit d25cc793739+    Author: COMPUTER A+    Date:   Thu Jul 17 18:17:12 2014 +0200+      shared.skg | 1 -+      1 file changed, 1 deletion(-)++A change is apparently deleting and rewriting the whole file (maybe that's normal because it's a binary (encrypted) file?). The third most recent deletion is probably the one that shouldn't happen.++Reverting "d9eb9e94a39" will only recover a placeholder, not really the original file. I can get the content back by going through *git annex unused* with *git log -S'key'*, then going to indirect mode, and then using *addunused*. This can only be done in the repository that changed the file in the first place (repo A), as the other repository only has the older version of the file in its unused list. This probably means that the change did not propagate before the file was deleted.++**daemon.log transcript**++[[!format sh """++[2014-07-17 18:13:17 CEST] main: starting assistant version 5.20140709-gc75193e+[2014-07-17 18:13:17 CEST] Cronner: You should enable consistency checking to protect your data. +[2014-07-17 18:13:55 CEST] TransferScanner: Syncing with asus.local_sincro +(scanning...) [2014-07-17 18:13:55 CEST] Watcher: Performing startup scan+p11-kit: couldn't load module: /usr/lib/x86_64-linux-gnu/pkcs11/p11-kit-trust.so: /usr/lib/x86_64-linux-gnu/pkcs11/p11-kit-trust.so: cannot open shared object file: No such file or directory+p11-kit: couldn't load module: /usr/lib/x86_64-linux-gnu/pkcs11/gnome-keyring-pkcs11.so: /usr/lib/x86_64-linux-gnu/pkcs11/gnome-keyring-pkcs11.so: cannot open shared object file: No such file or directory+(started...) p11-kit: couldn't load module: /usr/lib/x86_64-linux-gnu/pkcs11/p11-kit-trust.so: /usr/lib/x86_64-linux-gnu/pkcs11/p11-kit-trust.so: cannot open shared object file: No such file or directory+p11-kit: couldn't load module: /usr/lib/x86_64-linux-gnu/pkcs11/gnome-keyring-pkcs11.so: /usr/lib/x86_64-linux-gnu/pkcs11/gnome-keyring-pkcs11.so: cannot open shared object file: No such file or directory+gpg: Signature made gio 17 lug 2014 18:02:09 CEST using DSA key ID 89C809CB+gpg: /tmp/git-annex-gpg.tmp.0/trustdb.gpg: trustdb created+gpg: Good signature from "git-annex distribution signing key (for Joey Hess) <id@joeyh.name>"+gpg: WARNING: This key is not certified with a trusted signature!+gpg:          There is no indication that the signature belongs to the owner.+Primary key fingerprint: 4005 5C6A FD2D 526B 2961  E78F 5EE1 DBA7 89C8 09CB+[2014-07-17 18:13:58 CEST] Upgrader: An upgrade of git-annex is available.  (version 5.20140716)+Everything up-to-date+git-annex-shell: key is already present in annex+rsync: connection unexpectedly closed (0 bytes received so far) [sender]+rsync error: error in rsync protocol data stream (code 12) at io.c(226) [sender=3.1.0]++########## SYNCING STARTS HERE ###########++[2014-07-17 18:17:12 CEST] RemoteControl: Syncing with asus.local_sincro +From ssh://git-annex-asus.local-USER-A_22_sincro/~/sincro+   51815ea..d25cc79  annex/direct/master -> asus.local_sincro/annex/direct/master+   0391880..49efa5f  git-annex  -> asus.local_sincro/git-annex+   51815ea..d25cc79  master     -> asus.local_sincro/master+   51815ea..d25cc79  synced/master -> asus.local_sincro/synced/master+[2014-07-17 18:17:15 CEST] RemoteControl: Syncing with asus.local_sincro +Automatic merge went well; stopped before committing as requested+Removing shared.skg+From ssh://git-annex-asus.local-USER-A_22_sincro/~/sincro+   d25cc79..6fa27f0  annex/direct/master -> asus.local_sincro/annex/direct/master+   d25cc79..6fa27f0  master     -> asus.local_sincro/master+   d25cc79..6fa27f0  synced/master -> asus.local_sincro/synced/master+[2014-07-17 18:17:16 CEST] Committer: Committing changes to git+[2014-07-17 18:17:16 CEST] Pusher: Syncing with asus.local_sincro +To ssh://USER-A@git-annex-asus.local-USER-A_22_sincro/~/sincro/+   0391880..8d1c927  git-annex -> synced/git-annex+   6fa27f0..d9eb9e9  annex/direct/master -> synced/master+[2014-07-17 18:17:17 CEST] RemoteControl: Syncing with asus.local_sincro +From ssh://git-annex-asus.local-USER-A_22_sincro/~/sincro+   49efa5f..e328661  git-annex  -> asus.local_sincro/git-annex+[2014-07-17 18:17:20 CEST] RemoteControl: Syncing with asus.local_sincro +From ssh://git-annex-asus.local-USER-A_22_sincro/~/sincro+   6fa27f0..d9eb9e9  annex/direct/master -> asus.local_sincro/annex/direct/master+   e328661..32e44ce  git-annex  -> asus.local_sincro/git-annex++# End of transcript or log.+"""]]
+ doc/bugs/googlemail/comment_1_5614fa85029f9f97be03cb74899a7099._comment view
@@ -0,0 +1,19 @@+[[!comment format=mdwn+ username="https://www.google.com/accounts/o8/id?id=AItOawm8BAEUyzYhORZmMuocRTk4M-3IumDm5VU"+ nickname="luciusf0"+ subject="Bug still valid"+ date="2014-07-31T08:35:29Z"+ content="""+The bug is still valid. A lot of german users had to use the @googlemail.com extension as google couldn't get the gmail domain in Germany. +So it might be bothering not just a few people, but a whole country! Now, if that doesn't count ...++	Mac OSX 10.9.4+	Version: 5.20140717-g5a7d4ff +	Build flags: Assistant Webapp Webapp-secure Pairing Testsuite S3 WebDAV FsEvents XMPP DNS Feeds Quvi TDFA CryptoHash++This is the message I get++	Unable to connect to the Jabber server. Maybe you entered the wrong password? (Error message: host xmpp.l.google.com.:5222 failed: AuthenticationFailure (Element {elementName = Name {nameLocalName = \"failure\", nameNamespace = Just \"urn:ietf:params:xml:ns:xmpp-sasl\", namePrefix = Nothing}, elementAttributes = [], elementNodes = [NodeElement (Element {elementName = Name {nameLocalName = \"not-authorized\", nameNamespace = Just \"urn:ietf:params:xml:ns:xmpp-sasl\", namePrefix = Nothing}, elementAttributes = [], elementNodes = []})]}); host alt2.xmpp.l.google.com.:5222 failed: AuthenticationFailure (Element {elementName = Name {nameLocalName = \"failure\", nameNamespace = Just \"urn:ietf:params:xml:ns:xmpp-sasl\", namePrefix = Nothing}, elementAttributes = [], elementNodes = [NodeElement (Element {elementName = Name {nameLocalName = \"not-authorized\", nameNamespace = Just \"urn:ietf:params:xml:ns:xmpp-sasl\", namePrefix = Nothing}, elementAttributes = [], elementNodes = []})]}); host alt1.xmpp.l.google.com.:5222 failed: AuthenticationFailure (Element {elementName = Name {nameLocalName = \"failure\", nameNamespace = Just \"urn:ietf:params:xml:ns:xmpp-sasl\", namePrefix = Nothing}, elementAttributes = [], elementNodes = [NodeElement (Element {elementName = Name {nameLocalName = \"not-authorized\", nameNamespace = Just \"urn:ietf:params:xml:ns:xmpp-sasl\", namePrefix = Nothing}, elementAttributes = [], elementNodes = []})]}); host alt4.xmpp.l.google.com.:5222 failed: AuthenticationFailure (Element {elementName = Name {nameLocalName = \"failure\", nameNamespace = Just \"urn:ietf:params:xml:ns:xmpp-sasl\", namePrefix = Nothing}, elementAttributes = [], elementNodes = [NodeElement (Element {elementName = Name {nameLocalName = \"not-authorized\", nameNamespace = Just \"urn:ietf:params:xml:ns:xmpp-sasl\", namePrefix = Nothing}, elementAttributes = [], elementNodes = []})]}); host alt3.xmpp.l.google.com.:5222 failed: AuthenticationFailure (Element {elementName = Name {nameLocalName = \"failure\", nameNamespace = Just \"urn:ietf:params:xml:ns:xmpp-sasl\", namePrefix = Nothing}, elementAttributes = [], elementNodes = [NodeElement (Element {elementName = Name {nameLocalName = \"not-authorized\", nameNamespace = Just \"urn:ietf:params:xml:ns:xmpp-sasl\", namePrefix = Nothing}, elementAttributes = [], elementNodes = []})]}))+	++"""]]
+ doc/bugs/googlemail/comment_2_bdb2b08346673f850709041d2f41be5c._comment view
@@ -0,0 +1,12 @@+[[!comment format=mdwn+ username="http://joeyh.name/"+ ip="209.250.56.7"+ subject="comment 2"+ date="2014-08-12T17:39:09Z"+ content="""+AFAICS, xmpp.l.google.com is the correct XMPP server; it's what the SRV record for googlemail.com says to use.++Since it fails with an authentication error, I wonder if google's XMPP is rejecting a user@googlemail.com jid and expects the domain to be @gmail.com or something else. Would that be allowed by the XMPP spec? I don't know.+++"""]]
+ doc/bugs/present_files__47__directories_are_dropped_after_a_sync.mdwn view
@@ -0,0 +1,38 @@+### Please describe the problem.++This is a followup from the discussion on https://git-annex.branchable.com/forum/Standard_groups__47__preferred_contents/ where I unfortunately did not get a complete answer.+I don't know if it is really a bug but at least it does not work as I would expect and the documentation provides no clear discussion on that.++Now to the problem:+My annex is in "manual" mode (or equivalently "exclude="*" and present" or an expression which contains "present".+Then I get a file using "git annex get file".+I would expect that this file is now synced because it is "present".+But it is not. When I change the file it is synced to the remotes. This is what it should be.+However, when a remote changes that file, the content is NOT synced, the file is silently dropped.++Similarly, when I get a complete directory tree in manual mode, I would expect that it is synced. That means, when a remote adds a file or changes a file in that directory, it is also synced to the local machine. But it is not. If it is changed, it is silently dropped (as written above). If a file is added, only the metadata is added but the content is not synced.++### What steps will reproduce the problem?++ - Create a file 'file' on the server, git annex add/sync etc.+ - On the client: git annex wanted here 'exclude="*" and present'+ - On the client: git annex get file . The file is now present on the client+ - Change the file on the server, git annex sync+ - git annex sync --content on the client+ - Result: File is dropped again on client++Similarly for directories:++ - Create a (sub-)directory 'subdir' with files and sync everything+ - On the client: git annex get subdir . The subdirectory is now present, all files under it downloaded.+ - On the server create a new file in 'subdir' and git annex add; git annex sync --content+ - git annex sync --content on the client+ - Result: Content of the files is not synced to client++### What version of git-annex are you using? On what operating system?++    git-annex version: 5.20140717-g5a7d4ff+    build flags: Assistant Webapp Webapp-secure Pairing Testsuite S3 WebDAV DNS Feeds Quvi TDFA CryptoHash+    key/value backends: SHA256E SHA1E SHA512E SHA224E SHA384E SKEIN256E SKEIN512E SHA256 SHA1 SHA512 SHA224 SHA384 SKEIN256 SKEIN512 WORM URL+    remote types: git gcrypt S3 bup directory rsync web webdav tahoe glacier ddar hook external+
doc/bugs/protocol_mismatch_after_interrupt.mdwn view
@@ -30,4 +30,4 @@  -- [[anarcat]] -[[!taglink moreinfo]]+> [[fixed|done]] --[[Joey]]
+ doc/bugs/whereis_does_not_work_in_direct_mode.mdwn view
@@ -0,0 +1,86 @@+### Please describe the problem.++`git annex whereis` says that there are no copies of any of the files that have been added in repositories running in direct mode.++In other words, if I add a file from PC1 in direct mode, `whereis` in PC2 will fail. Instead, if I add the same file from PC1 in indirect mode, `whereis` in PC2 will work correctly and will report that the file is present in PC1.++This is the error received in PC2:++    $ git annex whereis+    whereis fileA (0 copies) failed+    whereis fileB (0 copies) failed+    git-annex: whereis: 2 failed++### What steps will reproduce the problem?++The following script (available at <https://gist.github.com/gioele/dde462df89edfe17c5e3>) will reproduce this problem.++[[!format sh """+#!/bin/sh -x+ +set -e ; set -u+export LC_ALL=C+ +direct=true # set to false to make the problem disappear+ +h=${h:-localhost}+dr="/tmp/annex"+ +sync='sync -c annex.alwayscommit=true'+ +chmod a+rwx -R pc1 pc2 || true+rm -Rf pc1 pc2+ +# create central git repo+ssh $h "chmod a+rwx -R ${dr}/Docs.git" || true+ssh $h "rm -Rf ${dr}/Docs.git"+ssh $h "mkdir -p ${dr}/Docs.git"+ssh $h "cd ${dr}/Docs.git ; git init --bare"+ +d=$(pwd)+ +# populate repo in PC1+mkdir -p pc1/Docs+cd pc1/Docs+echo AAA > fileA+echo BBB > fileB+ +git init+git remote add origin $h:$dr/Docs.git+git fetch --all+ +# simulate a host without git-annex+git config remote.origin.annex-ignore true+ +git annex init "pc1"+git annex info+ +$direct && git annex direct+ +git annex add .+git annex $sync origin+ +# re-create repo on PC2+cd $d+mkdir -p pc2+cd pc2+git clone $h:$dr/Docs.git+cd Docs+ +git config remote.origin.annex-ignore true+ +git annex init "pc2"+git annex info+ +git annex whereis || true+echo "I was expecting location info to be available after info (press Enter)" ; read enter+ +git annex $sync origin+ +git annex whereis || true+echo "Why isn't location info available even after sync? (press Enter)"+"""]]++### What version of git-annex are you using? On what operating system?++git-annex version: 5.20140716-g8c14ba8
+ doc/bugs/youtube_web_download_gives_Prelude.undefined_in_webapp.mdwn view
@@ -0,0 +1,27 @@+### Please describe the problem.++I'm downloading a video with 'git annex addurl' from youtube. The webapp shows the transfer, but when I click the 'web' link it takes me to a page that says "internal server error" and "Prelude.undefined"++### What steps will reproduce the problem?++1. start webapp+2. download youtube video+3. click 'web' link on transfer in git-annex++### What version of git-annex are you using? On what operating system?++* Version: 5.20140717+* OS: Debian sid++### Please provide any additional information below.++Not much in the logs, I see this:++[[!format sh """++[2014-07-25 08:40:14 BST] TransferWatcher: transfer starting: Download UUID "00000000-0000-0000-0000-000000000001" URL--quvi:https://www.youtube.com/watch,63v,61Z8_8jNLsZms Nothing+[2014-07-25 08:40:14 BST] TransferWatcher: transfer starting: Download UUID "00000000-0000-0000-0000-000000000001" Chase_Adam_at_Startup_School_NY_2014.mp4 Nothing++"""]]++> [[fixed|done]] --[[Joey]]
+ doc/chunking.mdwn view
@@ -0,0 +1,31 @@+Some [[special_remotes]] have support for breaking large files up into+chunks that are stored on the remote.++This can be useful to work around limitations on the size of files+on the remote.++Chunking also allows for resuming interrupted downloads and uploads.++Note that git-annex has to buffer chunks in memory before they are sent to+a remote. So, using a large chunk size will make it use more memory.++To enable chunking, pass a `chunk=nnMiB` parameter to `git annex+initremote`, specifying the chunk size. ++Good chunk sizes will depend on the remote, but a good starting place+is probably `1MiB`. Very large chunks are problimatic, both because+git-annex needs to buffer one chunk in memory when uploading, and because+a larger chunk will make resuming interrupted transfers less efficient.+On the other hand, when a file is split into a great many chunks,+there can be increased overhead of making many requests to the remote.++To disable chunking of a remote that was using chunking,+pass `chunk=0` to `git annex enableremote`. Any content already stored on+the remote using chunks will continue to be accessed via chunks, this+just prevents using chunks when storing new content.++To change the chunk size, pass a `chunk=nnMiB` parameter to+`git annex enableremote`. This only affects the chunk sized used when+storing new content.++See also: [[design document|design/assistant/chunks]]
doc/design/assistant/chunks.mdwn view
@@ -5,3 +5,267 @@  May also allow for downloading different chunks of a file concurrently from multiple remotes.++Also, can allow resuming of interrupted uploads and downloads.++# legacy chunking++Supported by only the webdav and directory special remotes.++Filenames are used for the chunks that make it easy to see which chunks+belong together, even when encryption is used. There is also a chunkcount+file, that similarly leaks information.++It is not possible to enable chunking on a non-chunked remote.++Problem: Two uploads of the same key from repos with different chunk sizes+could lead to data loss. For example, suppose A is 10 mb chunksize, and B+is 20 mb, and the upload speed is the same. If B starts first, when A will+overwrite the file it is uploading for the 1st chunk. Then A uploads the+second chunk, and once A is done, B finishes the 1st chunk and uploads its+second. We now have [chunk 1(from A), chunk 2(from B)].++# new requirements++Every special remote should support chunking. (It does not make sense+to support it for git remotes, but gcrypt remotes should support it.)++S3 remotes should chunk by default, because the current S3 backend fails+for files past a certian size. See [[bugs/Truncated_file_transferred_via_S3]].++The size of chunks, as well as whether any chunking is done, should be+configurable on the fly without invalidating data already stored in the+remote. This seems important for usability (eg, so users can turn chunking+on in the webapp when configuring an existing remote).++Two concurrent uploaders of the same object to a remote should be safe,+even if they're using different chunk sizes.++The legacy chunk method needs to be supported for back-compat, so+keep the chunksize= setting to enable that mode, and add a new chunk=+setting for the new mode.++# obscuring file sizes++To hide from a remote any information about the sizes of files could be+another goal of chunking. At least two things are needed for this:++1. The filenames used on the remote don't indicate which chunks belong+   together.++2. The final short chunk needs to be padded with random data,+   so that a remote sees only encrypted files with uniform sizes+   and cannot make guesses about the kinds of data being stored.++Note that padding cannot completely hide all information from an attacker+who is logging puts or gets. An attacker could, for example, look at the+times of puts, and guess at when git-annex has moved on to+encrypting/decrypting the next object, and so guess at the approximate+sizes of objects. (Concurrent uploads/downloads or random delays could be+added to prevent these kinds of attacks.)++And, obviously, if someone stores 10 tb of data in a remote, they probably+have around 10 tb of files, so it's probably not a collection of recipes..++Given its inneficiencies and lack of fully obscuring file sizes,+padding may not be worth adding, but is considered in the designs below.++# design 1++Add an optional chunk field to Key. It is only present for chunk+2 and above. Ie, SHA256-s12345--xxxxxxx is the first chunk (or whole+object), while SHA256-s12345-c2--xxxxxxx is the second chunk.++On an encrypted remote, Keys are generated with the chunk field, and then+HMAC enrypted.++Note that only using it for chunks 2+ means that git-annex can start by+requesting the regular key, so an observer sees the same request whether+chunked or not, and does not see eg, a pattern of failed requests for +a non-chunked key, followed by successful requests for the chunked keys.+(Both more efficient and perhaps more secure.)++Problem: This makes putting chunks easy. But there is a problem when getting +an object that has been chunked. If the key size is not known, we+cannot tell when we've gotten the last chunk. (Also, we cannot strip+padding.) Note that `addurl` sometimes generates keys w/o size info+(particularly, it does so by design when using quvi).++Problem: Also, this makes `checkPresent` hard to implement: How can it know if+all the chunks are present, if the key size is not known?++Problem: Also, this makes it difficult to download encrypted keys, because+we only know the decrypted size, not the encrypted size, so we can't+be sure how many chunks to get, and all chunks need to be downloaded before+we can decrypt any of them. (Assuming we encrypt first; chunking first+avoids this problem.)++Problem: Does not solve concurrent uploads with different chunk sizes.++# design 2++When chunking is enabled, always put a chunk number in the Key,+along with the chunk size.+So, SHA256-1048576-c1--xxxxxxx for the first chunk of 1 megabyte.++Before any chunks are stored, write a chunkcount file, eg+SHA256-s12345-c0--xxxxxxx. Note that this key is the same as the original+object's key, except with chunk number set to 0. This file contains both+the number of chunks, and also the chunk size used. `checkPresent` downloads this+file, and then verifies that each chunk is present, looking for keys with+the expected chunk numbers and chunk size.++This avoids problems with multiple writers using different chunk sizes,+since they will be uploading to different files.++Problem: In such a situation, some duplicate data might be stored, not+referenced by the last chunkcount file to be written. It would not be+dropped when the key was removed from the remote.++Note: This design lets an attacker with logs tell the (appoximate) size of+objects, by finding the small files that contain a chunk count, and+correlating when that is written/read and when other files are+written/read. That could be solved by padding the chunkcount key up to the+size of the rest of the keys, but that's very innefficient; `checkPresent` is not+designed to need to download large files.++# design 3++Like design 1, but add an encrypted chunk count prefix to the first object.+This needs to be done in a way that does not let an attacker tell if the+object has an encrypted chunk count prefix or not. ++This seems difficult; attacker could probably tell where the first encrypted+part stops and the next encrypted part starts by looking for gpg headers,+and so tell which files are the first chunks.++Also, `checkPresent` would need to download some or all of the first file.+If all, that's a lot more expensive. If only some is downloaded, an+attacker can guess that the file that was partially downloaded is the+first chunk in a series, and wait for a time when it's fully downloaded to+determine which are the other chunks.++Problem: Two uploads of the same key from repos with different chunk sizes+could lead to data loss. (Same as in design 2.)++# design 4++Use key SHA256-s12345-S1048576-C1--xxxxxxx for the first chunk of 1 megabyte.++Note that keeping the 's'ize field unchanged is necessary because it +disambiguates eg, WORM keys. So a 'S'ize field is used to hold the chunk+size.++Instead of storing the chunk count in the special remote, store it in +the git-annex branch. ++The location log does not record locations of individual chunk keys+(too space-inneficient). Instead, look at a chunk log in the+git-annex branch to get the chunk count and size for a key.++`checkPresent` would check if any of the logged sets of chunks is +present on the remote. It would also check if the non-chunked key is+present, as a fallback.++When dropping a key from the remote, drop all logged chunk sizes.+(Also drop any non-chunked key.)++As long as the location log and the chunk log are committed atomically,+this guarantees that no orphaned chunks end up on a remote+(except any that might be left by interrupted uploads).++This has the best security of the designs so far, because the special +remote doesn't know anything about chunk sizes. It uses a little more+data in the git-annex branch, although with care (using the same timestamp+as the location log), it can compress pretty well.++## chunk log++Stored in the git-annex branch, this provides a mapping `Key -> [[Key]]`.++Note that a given remote uuid might have multiple sets of chunks (with+different sizes) logged, if a key was stored on it twice using different+chunk sizes. Also note that even when the log indicates a key is chunked,+the object may be stored non-chunked on the remote too.++For fixed size chunks, there's no need to store the list of chunk keys,+instead the log only records the number of chunks (needed because the size+of the parent Key may not be known), and the chunk size.++Example:++	1287290776.765152s e605dca6-446a-11e0-8b2a-002170d25c55:10240 9++Later, might want to support other kinds of chunks, for example ones made+using a rsync-style rolling checksum. It would probably not make sense to+store the full [Key] list for such chunks in the log. Instead, it might be+stored in a file on the remote.++To support such future developments, when updating the chunk log, +git-annex should preserve unparsable values (the part after the colon).++## chunk then encrypt++Rather than encrypting the whole object 1st and then chunking, chunk and+then encrypt.++Reasons:++1. If 2 repos are uploading the same key to a remote concurrently,+   this allows some chunks to come from one and some from another,+   and be reassembled without problems.++2. Also allows chunks of the same object to be downloaded from different+   remotes, perhaps concurrently, and again be reassembled without+   problems.++3. Prevents an attacker from re-assembling the chunked file using details+   of the gpg output. Which would expose approximate+   file size even if padding is being used to obscure it.++Note that this means that the chunks won't exactly match the configured+chunk size. gpg does compression, which might make them a+lot smaller. Or gpg overhead could make them slightly larger. So `checkPresent`+cannot check exact file sizes.++If padding is enabled, gpg compression should be disabled, to not leak+clues about how well the files compress and so what kind of file it is.++## chunk key hashing++A chunk key should hash into the same directory structure as its parent+key. This will avoid lots of extra hash directories when using chunking+with non-encrypted keys.++Won't happen when the key is encrypted, but that is good; hashing to the+same bucket then would allow statistical correlation.++## resuming interupted transfers++Resuming interrupted downloads, and uploads are both possible.++Downloads: If the tmp file for a key exists, round it to the chunk size,+and skip forward to the next needed chunk. Easy.++Uploads: Check if the 1st chunk is present. If so, check the second chunk,+etc. Once the first missing chunk is found, start uploading from there.++That adds one extra checkPresent call per upload. Probably a win in most cases.+Can be improved by making special remotes open a persistent+connection that is used for transferring all chunks, as well as for+checking checkPresent.++Note that this is safe to do only as long as the Key being transferred+cannot possibly have 2 different contents in different repos. Notably not+necessarily the case for the URL keys generated for quvi.++Both **done**.++## parallel++If 2 remotes both support chunking, uploading could upload different chunks+to them in parallel. However, the chunk log does not currently allow+representing the state where some chunks are on one remote and others on+another remote.++Parallel downloading of chunks from different remotes is a bit more doable.
doc/design/assistant/deltas.mdwn view
@@ -4,6 +4,24 @@ being transferred, so it can be used as the basis for rsync, or any other similar transfer protocol. -For remotes that don't use rsync, a poor man's version could be had by-chunking each object into multiple parts. Only modified parts need be-transferred. Sort of sub-keys to the main key being stored.+For remotes that don't use rsync, use a rolling checksum based chunker,+such as BuzHash. This will produce [[chunks]], which can be stored on the+remote as regular Keys -- where unlike the fixed size chunk keys, the+SHA256 part of these keys is the checksum of the chunk they contain.++Once that's done, it's easy to avoid uploading chunks that have been sent+to the remote before.++When retriving a new version of a file, there would need to be a way to get+the list of chunk keys that constitute the new version. Probably best to+store this list on the remote. Then there needs to be a way to find which+of those chunks are available in locally present files, so that the locally+available chunks can be extracted, and combined with the chunks that need+to be downloaded, to reconstitute the file.++To find which chucks are locally available, here are 2 ideas:++1. Use a single basis file, eg an old version of the file. Re-chunk it, and+   use its chunks.  Slow, but simple.+2. Some kind of database of locally available chunks. Would need to be kept+   up-to-date as files are added, and as files are downloaded.
doc/design/assistant/polls/Android_default_directory.mdwn view
@@ -4,4 +4,4 @@ want the first time they run it, but to save typing on android, anything that gets enough votes will be included in a list of choices as well. -[[!poll open=yes expandable=yes 67 "/sdcard/annex" 6 "Whole /sdcard" 7 "DCIM directory (photos and videos only)" 2 "Same as for regular git-annex. ~/annex/"]]+[[!poll open=yes expandable=yes 68 "/sdcard/annex" 6 "Whole /sdcard" 7 "DCIM directory (photos and videos only)" 2 "Same as for regular git-annex. ~/annex/"]]
doc/design/assistant/progressbars.mdwn view
@@ -14,7 +14,7 @@   could use inotify. **done** * When easily available, remotes call the MeterUpdate callback as downloads   progress. **done**-* S3 TODO  +* S3: TODO     While it has a download progress bar, `getObject` probably buffers the whole   download in memory before returning. Leaving the progress bar to only   display progress for writing the file out of memory. Fixing this would@@ -32,7 +32,7 @@ * webdav: **done** * S3: **done** * glacier: **done**-* bup: TODO+* bup: **done** * hook: Would require the hook interface to somehow do this, which seems   too complicated. So skipping.
doc/design/external_special_remote_protocol.mdwn view
@@ -101,12 +101,14 @@   Tells the special remote it's time to prepare itself to be used.     Only INITREMOTE can come before this. * `TRANSFER STORE|RETRIEVE Key File`  -  Requests the transfer of a key. For Send, the File is the file to upload;-  for Receive the File is where to store the download.  +  Requests the transfer of a key. For STORE, the File is the file to upload;+  for RETRIEVE the File is where to store the download.     Note that the File should not influence the filename used on the remote.   The filename will not contain any whitespace.  +  Note that it's important that, while a Key is being stored, CHECKPRESENT+  not indicate it's present until all the data has been transferred.     Multiple transfers might be requested by git-annex, but it's fine for the -  program to serialize them and only do one at a time.+  program to serialize them and only do one at a time.   * `CHECKPRESENT Key`     Requests the remote check if a key is present in it. * `REMOVE Key`  @@ -286,7 +288,6 @@   the remote. However, \n and probably \0 need to be escaped somehow in the   file data, which adds complication. * uuid discovery during INITREMOTE.-* Support for splitting files into chunks. * Support for getting and setting the list of urls that can be associated   with a key. * Hook into webapp. Needs a way to provide some kind of prompt to the user
doc/design/roadmap.mdwn view
@@ -14,5 +14,10 @@ * Month 8 [[!traillink git-remote-daemon]] * Month 9 Brazil!, [[!traillink assistant/sshpassword]] * Month 10 polish [[assistant/Windows]] port-* **Month 11 [[!traillink assistant/chunks]], [[!traillink assistant/deltas]], [[!traillink assistant/gpgkeys]] (pick 2?)**-* Month 12 [[!traillink assistant/telehash]]+* Month 11 [[!traillink assistant/chunks]]+* **Month 12** user-driven features and polishing++Deferred until later:++* Month XX [[!traillink assistant/deltas]], [[!traillink assistant/gpgkeys]]+* Month XX [[!traillink assistant/telehash]]
+ doc/devblog/day_200__one_year_along.mdwn view
@@ -0,0 +1,17 @@+Updated the Debian backport. (Also the git-remote-gcrypt backport.)++Made the assistant install a desktop file to integrate with Konqueror.++Improved `git annex repair`, fixing a bug that could cause it to leave+broken branch refs and yet think that the repair was successful.++----++A bit surprised to see that now been a full year since I started doing+development funded by my campaign. Not done yet!++Update on campaign rewards: <https://campaign.joeyh.name/blog/stickers_soon/>++----++Today's work was sponsored by Douglas Butts.
+ doc/devblog/day_201__chunky.mdwn view
@@ -0,0 +1,12 @@+Working on designs for better [[chunking|design/assistant/chunks]]. Having+a hard time finding a way to totally obscure file sizes, but otherwise a+good design seems to be coming together. I particularly like that the new+design puts the chunk count in the Key (which is then encrypted for special+remotes, rather than having it be some special extension.++While thinking through chunking, I realized that the current chunking+method can fail if two repositories have different chunksize settings for+the same special remote and both upload the same key at the same time.+Arn't races fun? The new design will eliminate this problem; in the+meantime updated the docs to recommend never changing a remote's+chunksize setting.
+ doc/devblog/day_202__new_chunk_groundwork.mdwn view
@@ -0,0 +1,6 @@+The design for new style chunks seems done, and I laid the groundwork for it+today. Added chunk metadata to keys, reorganized the legacy chunking code+for directory and webdav so it won't get (too badly) in the way, and+implemented the chunk logs in the git-annex branch.++Today's work was sponsored by LeastAuthority.com.
+ doc/devblog/day_203__in_the_weeds.mdwn view
@@ -0,0 +1,39 @@+A lil bit in the weeds on the chunking rewrite right now. I did succeed in+writing the core chunk generation code, which can be used for every special+remote. It was pretty hairy (needs to stream large files in constant+memory, separating into chunks, and get the progress display right+across operations on chunks, etc). That took most of the day.++Ended up getting stuck in integrating the encryptable remote code, and had+to revert changes that could have led to rewriting (or perhaps+eliminating?) most of the per-remote encryption specific code.++Up till now, this has supported both encrypted and non-encrypted remotes;+it was simply passed encrypted keys for an encrypted remote:++[[!format haskell """+remove :: Key -> Annex Bool+"""]]++But with chunked encrypted keys, it seems it needs to be more complicated:++[[!format haskell """+remove' :: Maybe (Key -> Key) -> ChunkConfig -> Key -> Annex Bool+"""]]++So that when the remote is configured to use chunking, it can look up+the chunk keys, and then encrypt them, in order to remove all the encrypted+chunk keys.++I don't like that complication, so want to find a cleaner+abstraction. Will sleep on it.++----++While I was looking at the encryptable remote generator, I realized+the remote cost was being calculated wrongly for special +remotes that are not encrypted. Fixed that bug.++----++Today's work was sponsored by bak.
+ doc/devblog/day_204__mowing.mdwn view
@@ -0,0 +1,64 @@+Remained frustratingly stuck until 3 pm on the same stuff that puzzled+me yesterday. However, 6 hours later, I have the directory+special remote 100% working with both new chunk= and legacy chunksize=+configuration, both with and without encryption.++----++So, the root of why this is was hard, since I thought about it a lot today+in between beating my head into the wall: git-annex's internal API for remotes+is really, really simple. It basically comes down to:++[[!format haskell """+	Remote+		{ storeKey :: Key -> AssociatedFile -> MeterUpdate -> Annex Bool+		, retrieveKeyFile :: Key -> AssociatedFile -> FilePath -> MeterUpdate -> Annex Bool+		, removeKey :: Key -> Annex Bool+		, hasKey :: Key -> Annex (Either String Bool)+		}+"""]]++This simplicity is a Good Thing, because it maps very well to REST-type+services. And it allows for quite a lot of variety in implementations of+remotes. Ranging from reguar git remotes, that rsync files around without+git-annex ever loading them itself, to remotes like webdav that load+and store files themselves, to remotes like tahoe that intentionally do not+support git-annex's built-in encryption methods.++However, the simplicity of that API means that lots of complicated stuff,+like handling chunking, encryption, etc, has to be handled on a per-remote+basis. Or, more generally, by `Remote -> Remote` transformers that take+a remote and add some useful feature to it.++One problem is that the API is so simple that a remote transformer that adds+encryption is not feasible. In fact, every encryptable remote has+had its own code that loads a file from local disk, encrypts it, and sends+it to the remote. Because there's no way to make a remote transformer that+converts a `storeKey` into an encrypted `storeKey`. (Ditto for retrieving+keys.)++I almost made the API more complicated today. Twice. But both times+I ended up not, and I think that was the right choice, even though+it meant I had to write some quite painful code.++----++In the end, I instead wrote a little module that pulls together supporting+both encryption and chunking. I'm not completely happy because those+two things should be independent, and so separate. But, 120 lines of+code that don't keep them separate is not the end of the world.++That module also contains some more powerful, less general APIs, +that will work well with the kinds of remotes that will use it.++The really nice result, is that the implementation of the directory+special remote melts down from 267 lines of code to just 172! (Plus some+legacy code for the old style chunking, refactored out into a file I can+delete one day.) It's a lot cleaner too.++With all this done, I expect I can pretty easily add the new style chunking+to most git-annex remotes, and remove code from them while doing it!++----++Today's work was sponsored by Mark Hepburn.
+ doc/devblog/day_205__incremental.mdwn view
@@ -0,0 +1,21 @@+Last night, went over the new chunking interface, tightened up exception+handling, and improved the API so that things like WebDAV will be able to+reuse a single connection while all of a key's chunks are being downloaded.+I am pretty happy with the interface now, and except to convert more+special remotes to use it soon.++Just finished adding a killer feature: Automatic resuming of interrupted+downloads from chunked remotes. Sort of a poor man's rsync, that while less+efficient and awesome, is going to work on *every* remote that gets the new+chunking interface, from S3 to WebDAV, to all of Tobias's external special+remotes! Even allows for things like starting a download+from one remote, interrupting, and resuming from another one, and so on.++I had forgotten about resuming while designing the chunking API. Luckily, I+got the design right anyway. Implementation was almost trivial, and only+took about 2 hours! (See [[!commit 9d4a766cd7b8e8b0fc7cd27b08249e4161b5380a]])++I'll later add resuming of interrupted uploads. It's not hard to detect+such uploads with only one extra query of the remote, but in principle,+it should be possible to do it with no extra overhead, since git-annex+already checks if all the chunks are there before starting an upload.
+ doc/devblog/day_206__zap.mdwn view
@@ -0,0 +1,83 @@+Zap! ... My internet gateway was [destroyed by lightning](https://identi.ca/joeyh/note/xogvXTFDR9CZaCPsmKZipA).+Limping along regardless, and replacement ordered.++Got resuming of uploads to chunked remotes working. Easy!++----++Next I want to convert the external special remotes to have these nice+new features. But there is a wrinkle: The new chunking interface works+entirely on ByteStrings containing the content, but the external special+remote interface passes content around in files.++I could just make it write the ByteString to a temp file, and pass the temp+file to the external special remote to store. But then, when chunking is+not being used, it would pointlessly read a file's content, only to write+it back out to a temp file.++Similarly, when retrieving a key, the external special remote saves it to a+file. But we want a ByteString. Except, when not doing chunking or+encryption, letting the external special remote save the content directly+to a file is optimal.++One approach would be to change the protocol for external special+remotes, so that the content is sent over the protocol rather than in temp+files. But I think this would not be ideal for some kinds of external+special remotes, and it would probably be quite a lot slower and more+complicated.++Instead, I am playing around with some type class trickery:++[[!format haskell """+{-# LANGUAGE Rank2Types TypeSynonymInstances FlexibleInstances MultiParamTypeClasses #-}++type Storer p = Key -> p -> MeterUpdate -> IO Bool++-- For Storers that want to be provided with a file to store.+type FileStorer a = Storer (ContentPipe a FilePath)++-- For Storers that want to be provided with a ByteString to store+type ByteStringStorer a = Storer (ContentPipe a L.ByteString)++class ContentPipe src dest where+        contentPipe :: src -> (dest -> IO a) -> IO a++instance ContentPipe L.ByteString L.ByteString where+        contentPipe b a = a b++-- This feels a lot like I could perhaps use pipes or conduit...+instance ContentPipe FilePath FilePath where+        contentPipe f a = a f++instance ContentPipe L.ByteString FilePath where+        contentPipe b a = withTmpFile "tmpXXXXXX" $ \f h -> do+                L.hPut h b+                hClose h+                a f++instance ContentPipe FilePath L.ByteString where+        contentPipe f a = a =<< L.readFile f+"""]]++The external special remote would be a FileStorer, so when a non-chunked,+non-encrypted file is provided, it just runs on the FilePath with no extra+work. While when a ByteString is provided, it's swapped out to a temp file+and the temp file provided. And many other special remotes are ByteStorers,+so they will just pass the provided ByteStream through, or read in the+content of a file.++I think that would work. Thoigh it is not optimal for external special+remotes that are chunked but not encrypted. For that case, it might be worth+extending the special remote protocol with a way to say "store a chunk of+this file from byte N to byte M".++---++Also, talked with ion about what would be involved in using rolling checksum+based chunks. That would allow for rsync or zsync like behavior, where+when a file changed, git-annex uploads only the chunks that changed, and the+unchanged chunks are reused.++I am not ready to work on that yet, but I made some changes to the parsing+of the chunk log, so that additional chunking schemes like this can be added+to git-annex later without breaking backwards compatability.
+ doc/devblog/day_207__at_last.mdwn view
@@ -0,0 +1,34 @@+It took 9 hours, but I finally got to make [[!commit c0dc134cded6078bb2e5fa2d4420b9cc09a292f7]],+which both removes 35 lines of code, and adds chunking support to all+external special remotes!++The groundwork for that commit involved taking the type scheme I sketched+out yesterday, completely failing to make it work with such high-ranked+types, and falling back to a simpler set of types that both I and GHC seem+better at getting our heads around.++Then I also had more fun with types, when it turned out I needed to+run encryption in the Annex monad. So I had to go convert several parts of+the utility libraries to use MonadIO and exception lifting. Yurk.++The final and most fun stumbling block caused git-annex to crash when+retriving a file from an external special remote that had neither+encryption not chunking. Amusingly it was because I had not put in an+optimation (namely, just renaming the file that was retrieved in this case,+rather than unnecessarily reading it in and writing it back out). It's+not often that a lack of an optimisation causes code to crash!++So, fun day, great result, and it should now be very simple to convert+the bup, ddar, gcrypt, glacier, rsync, S3, and WebDAV special remotes+to the new system. Fingers crossed.++But first, I will probably take half a day or so and write a +`git annex testremote` that can be run in a repository and does live+testing of a special remote including uploading and downloading files.+There are quite a lot of cases to test now, and it seems best to get+that in place before I start changing a lot of remotes without a way to+test everything.++----++Today's work was sponsored by Daniel Callahan.
+ doc/devblog/day_208__testremote.mdwn view
@@ -0,0 +1,10 @@+Built `git annex testremote` today. ++That took a little bit longer than expected, because it actually found+several fence post bugs in the chunking code.++It also found a bug in the sample external special remote script.++I am very pleased with this command. Being able to run 640 tests against+any remote, without any possibility of damaging data already stored in the+remote, is awesome. Should have written it a looong time ago!
+ doc/devblog/day_209__mass_conversion.mdwn view
@@ -0,0 +1,32 @@+Have started converting lots of special remotes to the new API. Today, S3+and hook got chunking support. I also converted several remotes to the new+API without supporting chunking: bup, ddar, and glacier (which should+support chunking, but there were complications). ++This removed 110 lines of code while adding features! And,+I seem to be able to convert them faster than `testremote` can test them. :)++Now that S3 supports chunks, they can be used to work around several+problems with S3 remotes, including file size limits, and a memory leak in+the underlying S3 library.++The S3 conversion included caching of the S3 connection when+storing/retrieving chunks. [Update: Actually, it turns out it didn't;+the hS3 library doesn't support persistent connections. Another reason I+need to switch to a better S3 library!] ++But the API doesn't yet support caching+when removing or checking if chunks are present. I should probably expand+the API, but got into some type checker messes when using generic enough+data types to support everything. Should probably switch to `ResourceT`.++Also, I tried, but failed to make `testremote` check that storing a key+is done atomically. The best I could come up with was a test that stored a+key and had another thread repeatedly check if the object was present on+the remote, logging the results and timestamps. It then becomes a+statistical problem -- somewhere toward the end of the log it's ok if the key+has become present -- but too early might indicate that it wasn't stored+atomically. Perhaps it's my poor knowledge of statistics, but I could not+find a way to analize the log that reliably detected non-atomic storage.+If someone would like to try to work on this, see the `atomic-store-test`+branch.
+ doc/devblog/day_210__conversion_and_digression.mdwn view
@@ -0,0 +1,14 @@+Just finished converting both rsync and gcrypt to the new API,+and testing them. Still need to fix 2 test suite failures for gcrypt.+Otherwise, only WebDAV remains unconverted.++Earlier today, I investigated switching from hS3 to+<http://hackage.haskell.org/package/aws>. Learned its API, which seemed a+lot easier to comprehend than the other two times I looked at it. Wrote+some test programs, which are in the `s3-aws` branch. I was able to stream+in large files to S3, without ever buffering them in memory (which hS3's+API precludes). And for chunking, it can reuse an http connection.+This seems very promising. (Also, it might eventually get Glacier support..)++I have uploaded haskell-aws to Debian, and once it gets into testing and+backports, I plan to switch git-annex over to it.
+ doc/devblog/day_211__conversion_complete.mdwn view
@@ -0,0 +1,12 @@+Converted the webdav special remote to the new API. +All done with converting everything now!++I also updated the new API to support doing things like+reusing the same http connection when removing and checking+the presence of chunks.++I've been working on improving the haskell DAV library, in a+number of ways that will let me improve the webdav special remote.+Including making changes that will let me do connection caching, and+improving its API to support streaming content without buffering a whole+file in memory.
+ doc/devblog/day_212__webdav_rewrite.mdwn view
@@ -0,0 +1,18 @@+Today was spent reworking so much of the webdav special remote that it was+essentially rewritten from scratch.++The main improvement is that it now keeps a http connection open and uses+it to perform multiple actions. Before, one connection was made per action.+This is even done for operations on chunks. So, now storing a chunked file+in webdav makes only 2 http connections total. Before, it would take around+10 connections *per chunk*. So a big win for performance, although there is+still room for improvement: It would be possible to reduce that down to+just 1 connection, and indeed keep a persistent connection reused when+acting on multiple files.++Finished up by making uploading a large (non-chunked) file to webdav not+buffer the whole file in memory. ++I still need to make downloading a file from webdav not buffer it, and+test, and then I'll be done with webdav and can move on to making+similar changes to S3.
+ doc/devblog/day_213__newchunks_merged.mdwn view
@@ -0,0 +1,15 @@+Finished up webdav, and after running `testremote` for a long time, I'm+satisfied it's good. The newchunks branch has now been merged into master+completely.++Spent the rest of the day beginning to rework the S3 special remote to use+the aws library. This was pretty fiddly; I want to keep all the+configuration exactly the same, so had to do a lot of mapping from hS3+configuration to aws configuration. Also there is some hairy stuff+involving escaping from the ResourceT monad with responses and http+connection managers intact.++Stopped once `initremote` worked. The rest should be pretty easy, although+Internet Archive support is blocked by+<https://github.com/aristidb/aws/issues/119>. This is in the `s3-aws`+branch until it gets usable.
+ doc/devblog/day_214-215__wrapping_up_recent_work.mdwn view
@@ -0,0 +1,16 @@+Yesterday, finished converting S3 to use the aws library. Very happy with+the result (no memory leaks! connection caching!), but s3-aws is not merged+into master yet. Waiting on a new release of the aws library so as to not+break Internet Archive S3 support.++Today, spent a few hours adding more tests to `testremote`. The new tests+take a remote, and construct a modified version that is intentionally+unavailable. Then they make sure trying to use it fails in appropriate+ways. This was a very good thing to test; two bugs were immediately found+and fixed.++And that wraps up several weeks of hacking on the core of git-annex's+remotes support, which started with reworking chunking and kind of took+on a life of its own. I plan a release of this new stuff in a week. The+next week will be spent catching up on 117 messages of backlog that+accumulated while I was in deep coding mode.
+ doc/devblog/day_216__various_minor_bugs.mdwn view
@@ -0,0 +1,16 @@+Working on getting caught up with backlog. 73 messages remain.++Several minor bugs were fixed today. All edge cases. The most edge case one+of all, I could not fix: git-annex cannot add a file that has a newline+in its filename, because `git cat-file --batch`'s interface does not support such+filenames.++Added a page [[documenting how verify the signatures of git-annex releases|install/verifying_downloads]].++Over the past couple days, all the autobuilders have been updated to new+dependencies needed by the recent work. Except for Windows, which needs to+be updated to the new Haskell Platform first, so hopefully soon.++Turns out that upgrading unix-compat means that inode(like) numbers are+available even on Windows, which will make git-annex more robust there.+Win win. ;)
+ doc/devblog/day_217__autobuilders.mdwn view
@@ -0,0 +1,10 @@+Over the past couple days, got the arm autobuilder working again. It had+been down since June with several problems. cabal install tended to crash;+apparenty this has something to do with threading in user-mode qemu,+because -j1 avoids that. And strange invalid character problems were fixed+by downgrading file-embed. Also, with Yury's help I got the Windows+autobuilder upgraded to the new Haskell Platform and working again.++Today a last few finishing touches, including getting rid of the last+dependency on the old haskell HTTP library, since http-conduit is being+used now. Ready for the release!
doc/encryption.mdwn view
@@ -18,7 +18,7 @@ any data is stored in it. So, `git annex initremote` requires you to specify "encryption=none" when first setting up a remote in order to disable encryption. To use encryption, you run -run `git-annex initremote` in one of these ways:+`git-annex initremote` in one of these ways:  * `git annex initremote newremote type=... encryption=hybrid keyid=KEYID ...` * `git annex initremote newremote type=... encryption=shared`@@ -43,7 +43,7 @@ 	git annex enableremote myremote keyid+=788A3F4C  While a key can later be removed from the list, note that-that will **not** necessarily prevent the owner of the key+it will **not** necessarily prevent the owner of the key from accessing data on the remote (which is by design impossible to prevent, short of deleting the remote). In fact the only sound use of `keyid-=` is probably to replace a revoked key:@@ -74,7 +74,7 @@  	git annex initremote newremote type=.... encryption=pubkey keyid=KEYID ... -A disavantage is that is not easy to later add additional public keys+A disavantage is that it is not easy to later add additional public keys to the special remote. While the `enableremote` parameters `keyid+=` and `keyid-=` can be used, they have **no effect** on files that are already present on the remote. Probably the only use for these parameters is @@ -94,7 +94,7 @@ ## MAC algorithm  The default MAC algorithm to be applied on the filenames is HMACSHA1. A-stronger one, for instance HMACSHA512, one can be chosen upon creation+stronger one, for instance HMACSHA512, can be chosen upon creation of the special remote with the option `mac=HMACSHA512`. The available MAC algorithms are HMACSHA1, HMACSHA224, HMACSHA256, HMACSHA384, and HMACSHA512. Note that it is not possible to change algorithm for a
+ doc/forum/Archive_USB_drive_not_working_as_documented.mdwn view
@@ -0,0 +1,171 @@+I'm hoping to use git-annex in a project to manage large image files and maintain archived copies of them on removable USB drives. But I can't get this to work the way it's described in the walkthrough and in the "git-annex/tips/offline archive drives" example. Here's what I did:++    marshal@home[~]> git-annex version+    git-annex version: 5.20140412ubuntu1+    build flags: Assistant Webapp Webapp-secure Pairing Testsuite S3 WebDAV Inotify DBus DesktopNotify XMPP DNS Feeds Quvi TDFA CryptoHash+    key/value backends: SHA256E SHA1E SHA512E SHA224E SHA384E SKEIN256E SKEIN512E SHA256 SHA1 SHA512 SHA224 SHA384 SKEIN256 SKEIN512 WORM URL+    remote types: git gcrypt S3 bup directory rsync web webdav tahoe glacier hook external++Create the local repo:++    marshal@home[~]> mkdir ~/annex+    marshal@home[~]> cd ~/annex+    marshal@home[~/annex]> git init+    Initialized empty Git repository in /home/marshal/annex/.git/+    marshal@home[~/annex]> git annex init "my laptop"+    init my laptop ok+    (Recording state in git...)++Create the remote repo (assume the warning can be ignored?)++    marshal@home[~/annex]> cd /media/marshal/Sony\ USB/+    marshal@home[/media/marshal/Sony USB]> git clone ~/annex+    Cloning into 'annex'...+    done.+    warning: remote HEAD refers to nonexistent ref, unable to checkout.+    marshal@home[/media/marshal/Sony USB]> cd annex+    marshal@home[/media/marshal/Sony USB/annex]> git annex init "usbdrive"+    init usbdrive ok+    (Recording state in git...)++Make them remotes of each other++    marshal@home[/media/marshal/Sony USB/annex]> git remote add laptop ~/annex+    marshal@home[/media/marshal/Sony USB/annex]> cd ~/annex+    marshal@home[~/annex]> git remote add usbdrive /media/marshal/Sony\ USB/annex/++Add some files into the local repo++    marshal@home[~/annex]> cp ~/Desktop/file* .+    marshal@home[~/annex]> git annex add .+    add file1.m3u ok+    add file2.sh ok+    add file3.pdf ok+    (Recording state in git...)+    marshal@home[~/annex]> git commit -a -m "added files"+    [master (root-commit) 4ea3be7] added files+     3 files changed, 3 insertions(+)+     create mode 120000 file1.m3u+     create mode 120000 file2.sh+     create mode 120000 file3.pdf++Change the preferred content settings++    marshal@home[~/annex]> git annex group usbdrive archive+    group usbdrive ok+    (Recording state in git...)+    marshal@home[~/annex]> git annex wanted usbdrive standard+    wanted usbdrive ok+    (Recording state in git...)++Sync to the usbdrive repo++    marshal@home[~/annex]> git annex sync usbdrive+    commit  ok+    pull usbdrive +    remote: Counting objects: 7, done.+    remote: Compressing objects: 100% (3/3), done.+    remote: Total 5 (delta 1), reused 0 (delta 0)+    Unpacking objects: 100% (5/5), done.+    From /media/marshal/Sony USB/annex+     * [new branch]      git-annex  -> usbdrive/git-annex+    ok+    (merging usbdrive/git-annex into git-annex...)+    (Recording state in git...)+    push usbdrive +    Counting objects: 29, done.+    Delta compression using up to 8 threads.+    Compressing objects: 100% (22/22), done.+    Writing objects: 100% (25/25), 2.44 KiB | 0 bytes/s, done.+    Total 25 (delta 3), reused 0 (delta 0)+    To /media/marshal/Sony USB/annex/+     * [new branch]      git-annex -> synced/git-annex+     * [new branch]      master -> synced/master+    ok++Copy eveything to the usbdrive repo++    marshal@home[~/annex]> git-annex copy --auto --to usbdrive+    copy file1.m3u (to usbdrive...) +    SHA256E-s64061--c388e2c927cb4c88c11b1b5a8e166c4d8080dc528d53954dad1ee6d4933ce3c7.m3u+             64,061 100%   29.84MB/s    0:00:00 (xfr#1, to-chk=0/1)+    ok+    copy file2.sh (to usbdrive...) +    SHA256E-s318--b8729560cc759d2256903feaa4ba65994ccbac94f30515d52a39083ad52e1bad.sh+                318 100%    0.00kB/s    0:00:00 (xfr#1, to-chk=0/1)+    ok+    copy file3.pdf (to usbdrive...) +    SHA256E-s32239--9b051067d5ef9f0cb4a01750901bf6bee3f9348e5b10138c8ef416ac8d51e5df.pdf+             32,239 100%    0.00kB/s    0:00:00 (xfr#1, to-chk=0/1)+    ok+    (Recording state in git...)++Check to see where git-annex "thinks" the files are++    marshal@home[~/annex]> git-annex whereis file1.m3u +    whereis file1.m3u (2 copies) +          	80fa5a68-3843-4e25-b4c9-53a8c51ba9ff -- here (my laptop)+           	d642b276-5f9b-4a5c-a42e-ea29cd9540b5 -- usbdrive+    ok++Check the filesystem results++    marshal@home[~/annex]> ls -la ~/annex+    total 48+    drwxrwxr-x  3 marshal marshal  4096 Jul 19 14:59 .+    drwxr-xr-x 99 marshal marshal 24576 Jul 19 14:55 ..+    lrwxrwxrwx  1 marshal marshal   194 Jul 19 14:59 file1.m3u -> .git/annex/objects/jq/MW/SHA256E-s64061--c388e2c927cb4c88c11b1b5a8e166c4d8080dc528d53954dad1ee6d4933ce3c7.m3u/SHA256E-s64061--c388e2c927cb4c88c11b1b5a8e166c4d8080dc528d53954dad1ee6d4933ce3c7.m3u+    lrwxrwxrwx  1 marshal marshal   188 Jul 19 14:59 file2.sh -> .git/annex/objects/1J/2K/SHA256E-s318--b8729560cc759d2256903feaa4ba65994ccbac94f30515d52a39083ad52e1bad.sh/SHA256E-    s318--b8729560cc759d2256903feaa4ba65994ccbac94f30515d52a39083ad52e1bad.sh+    lrwxrwxrwx  1 marshal marshal   194 Jul 19 14:59 file3.pdf -> .git/annex/objects/77/Wj/SHA256E-s32239--9b051067d5ef9f0cb4a01750901bf6bee3f9348e5b10138c8ef416ac8d51e5df.pdf/SHA256E-s32239--9b051067d5ef9f0cb4a01750901bf6bee3f9348e5b10138c8ef416ac8d51e5df.pdf+    drwxrwxr-x  9 marshal marshal  4096 Jul 19 15:04 .git+    marshal@home[~/annex]> ls -la /media/marshal/Sony\ USB/annex/+    total 4+    drwx------ 1 marshal marshal  144 Jul 19 14:56 .+    drwx------ 1 marshal marshal 4096 Jul 19 14:56 ..+    drwx------ 1 marshal marshal  448 Jul 19 14:57 .git++Why is there nothing in the usbdrive repo? And worse, why is the whereis command saying there are 2 copies?++But if I sync from the usbdrive repo, the files are copied++    marshal@home[~/annex]> cd /media/marshal/Sony\ USB/annex/+    marshal@home[/media/marshal/Sony USB/annex]> git-annex sync laptop+    (merging synced/git-annex origin/git-annex into git-annex...)+    (Recording state in git...)+    commit  ok+    pull laptop +    remote: Counting objects: 23, done.+    remote: Compressing objects: 100% (8/8), done.+    remote: Total 11 (delta 3), reused 0 (delta 0)+    Unpacking objects: 100% (11/11), done.+    From /home/marshal/annex+     * [new branch]      git-annex  -> laptop/git-annex+     * [new branch]      master     -> laptop/master+     * [new branch]      synced/master -> laptop/synced/master+    +    +    Already up-to-date.+    ok+    (merging laptop/git-annex into git-annex...)+    (Recording state in git...)+    push laptop +    Counting objects: 56, done.+    Delta compression using up to 8 threads.+    Compressing objects: 100% (24/24), done.+    Writing objects: 100% (33/33), 2.34 KiB | 0 bytes/s, done.+    Total 33 (delta 15), reused 0 (delta 0)+    To /home/marshal/annex+     * [new branch]      git-annex -> synced/git-annex+    ok+    marshal@home[/media/marshal/Sony USB/annex]> ls -la /media/marshal/Sony\ USB/annex/+    total 6+    drwx------ 1 marshal marshal  456 Jul 19 15:07 .+    drwx------ 1 marshal marshal 4096 Jul 19 14:56 ..+    lrwxrwxrwx 1 marshal marshal  396 Jul 19 15:07 file1.m3u -> .git/annex/objects/jq/MW/SHA256E-s64061--c388e2c927cb4c88c11b1b5a8e166c4d8080dc528d53954dad1ee6d4933ce3c7.m3u/SHA256E-s64061--c388e2c927cb4c88c11b1b5a8e166c4d8080dc528d53954dad1ee6d4933ce3c7.m3u+    lrwxrwxrwx 1 marshal marshal  384 Jul 19 15:07 file2.sh -> .git/annex/objects/1J/2K/SHA256E-s318--b8729560cc759d2256903feaa4ba65994ccbac94f30515d52a39083ad52e1bad.sh/SHA256E-s318--b8729560cc759d2256903feaa4ba65994ccbac94f30515d52a39083ad52e1bad.sh+    lrwxrwxrwx 1 marshal marshal  396 Jul 19 15:07 file3.pdf -> .git/annex/objects/77/Wj/SHA256E-s32239--9b051067d5ef9f0cb4a01750901bf6bee3f9348e5b10138c8ef416ac8d51e5df.pdf/SHA256E-s32239--9b051067d5ef9f0cb4a01750901bf6bee3f9348e5b10138c8ef416ac8d51e5df.pdf+    drwx------ 1 marshal marshal  448 Jul 19 15:07 .git++Why did I have to sync from the usbdrive? I expected the repo setup and the --auto option to copy the files. What am I missing?++Any help much appreciated.
+ doc/forum/Central_git_annex_server_that_always_keeps_one_copy.mdwn view
@@ -0,0 +1,1 @@+Is there a way to configure a central git repository that keeps track of large files with git annex so that multiple users can clone the repository but no repository clone can drop files from the server. Essentially, I'm looking for a way to have one repository that is always populated with at least one copy of each file. Other users shouldn't be able to tell that repository to drop any files (but would be able to add files it). The term "user" in that last sentence really refers to other clones...
+ doc/forum/Corrupted_repository__44___can_not_be_repaired.mdwn view
@@ -0,0 +1,40 @@+Hey, I hope somebody can help me:++I recently moved a bunch of files to another location shortly after I renamed them. The assistant was running (repo: indirect mode) and I guess the assistant was confused about whether to commit the rename changes or to fix the symlinks because of the location move (and to commit these changes). I don't know much about the internal design, but after that my repository was kinda broken. Every git command failed and also "git fsck" gave me some error messages. However, I mounted my external drive (backup repo) and tried a "git annex repair". It took quite a while, but it could fix the repo....somehow. This is the current status:++    ~/private [master●] » git annex info+    repository mode: indirect+    trusted repositories: error: refs/remotes/extern/git-annex does not point to a valid object!+    error: refs/remotes/extern/git-annex does not point to a valid object!+    error: unable to resolve reference refs/heads/git-annex: Datei oder Verzeichnis nicht gefunden // (english: No such file or directory)+    fatal: Cannot lock the ref 'refs/heads/git-annex'.+    git-annex: git [Param "update-ref",Param "refs/heads/git-annex",Param "ea4d4b5e09bfd10c714c24ca76ab5af0625bb6a7"] failed++    ~/private [master●] » git fsck+    Checking object directories: 100% (256/256), done.+    Checking objects: 100% (654755/654755), done.+    error: refs/remotes/extern/git-annex does not point to a valid object!+    error: bad ref for refs/heads/git-annex+    Checking connectivity: 654760, done.+    dangling blob cb2a012e65b15baf0bc51cb8ac6ab05c4ac4e543+    dangling blob 6a48216d54be6fbf0539c86501ce9e4567ebf678+    dangling blob 3f8f21304c6dcfc6ace92093425d7f057138b5e8+    dangling blob 4943840264ad7c06071f510261151c28b4fb5168+    dangling blob d67e845b06b17c3ba5b44a454d3128dea6ebe8cc+    dangling blob 38b7e4ce06a84c03b9a0f7f3a84872b2ed202421+    dangling blob ca0a65e010c69e02953d63f33c5f2030f793c8ff+    dangling blob aeba65035f566ec9f18ad2ba71b155b0efd2193a+    dangling blob d3cea542db4c2904f5c8c6dd98ca3868074e6d36+    dangling commit fe1026edee5dcc6306f04ebe1a7762b86678db8a+    [... some more dangling objects ...]++However, git annex repair does not want to repair my repo a second time:++    ~/private [master●] » git annex repair+    Running git fsck ...+    No problems found.+    ok+My directory seems to be fine, also the data (symlinks) I renamed & moved are also fine. Just the "git-annex" branch seems to be broken now and I don't know how to fix that.++Cheers,+Stephan
+ doc/forum/Duplicate_entries_in_location_tracking_logs.mdwn view
@@ -0,0 +1,25 @@+I’ve noticed something odd when inspecting the history of the+git-annex branch today. Apparently, the branch had some merge+conflicts during sync that involved two alternative location tracking+entries that both were for one and the same remote. Both entries only+differed in their timestamps, and the union merge kept both, so that I+now have .log files in the annex branch that contain duplicate parts+like this.++<pre>+1404838274.151066s 1 a2401cfd-1f58-4441-a2b3-d9bef06220ad+1406978406.24838s 1 a2401cfd-1f58-4441-a2b3-d9bef06220ad+</pre>++The UUID here is my local repository.++The duplication also occurred in the uuid.log:++<pre>+4316c3dc-5b6d-46eb-b780-948c717b7be5 server timestamp=1404839228.113473s+4316c3dc-5b6d-46eb-b780-948c717b7be5 server timestamp=1404847241.863051s+</pre>++Is this something to be concerned about? The situation somehow arose+in relation to unannexing a bunch of files and rebasing the master+branch.
+ doc/forum/How_to_get_detailed_information_on_special_remotes__63__.mdwn view
@@ -0,0 +1,1 @@+How can I get information on already-configured special remotes in a repository?  I'd like to find out what type a given special remote is, and which URL/bucket, encryption mode, etc. was used to set it up.
@@ -0,0 +1,3 @@+Firefox has the nasty habit that it will force-dereference symlinks when locally opening files (i. e., opening an annexed document will cause it to be opened in .git/annex/objects/…). Since this will break relative links within HTML files, this would make Firefox pretty useless when working with a git annex containing HTML files. (Apparently this behavior is [desired](https://bugzilla.mozilla.org/show_bug.cgi?id=803999) upstream and might not be fixed.)++Seems I’m not the only one who would like to work with annexed HTML files, though. On the [Debian bugtracker](https://bugs.debian.org/cgi-bin/bugreport.cgi?bug=691099), another user shared a handy shim which can be used in LD_PRELOAD and which will force Firefox to open symlinks in-place. Thought I’d share this here in case it’s of use to anyone.
+ doc/forum/Reloading_.git__47__config_mid-sync.mdwn view
@@ -0,0 +1,1 @@+There are some settings (rsync bandwidth settings are my use case) I'd like to reload after assistant starts, possibly mid-sync. Does assistant support SIGHUP, etc? What's the correct way to change bandwidth settings?
+ doc/forum/__34__Lost__34___data__63___Maybe_a_bug__63__.mdwn view
@@ -0,0 +1,14 @@+Hey,++I lost some symlinks to my data and I do not know how to recover them. I was in view mode  with some tag folders already there. I added _new_ files from outside annex into some folder and 'git annex add' those files.++What I expected: Git-Annex should add those files to the annex, move the symlinks to the root of the annex (because there is no other way to tell where to put them) and tag them with the specific tag. That is the way I would like to work, first tag, then organize in folder structure.++Now that seems not to be a scenario which has been respected? Because I don't see my files... anywhere. Not in master branch nor in the view branch (I already did 'git annex vpop'). If that is not supported and never will be git-annex should not accept data from the outside world if it is currently in view mode.++Now, how do I get my symlinks back? I guess the content is still there, but the links are missing and I don't find any reference or history log to revert that. 'git annex unused' does not show them either.++I hope somebody can help me :)++Cheers,+Stephan
+ doc/forum/armhf_binary.mdwn view
@@ -0,0 +1,3 @@+Does a armhf binary tarball exist anywhere? I'm running Ubuntu trusty on a armhf platform (beagleboard), and the repository package is out of date. I might try to get the standalone armel binary working using multiarch, but that seems only slightly less painful than compiling from scratch.++Or am I better off changing to a debian boot image, and be done with it?
+ doc/forum/armhf_binary/comment_1_9ca7ff6cb1f5dfc1e5ce8527e7e0a45f._comment view
@@ -0,0 +1,8 @@+[[!comment format=mdwn+ username="http://joeyh.name/"+ ip="209.250.56.7"+ subject="comment 1"+ date="2014-08-15T15:58:02Z"+ content="""+The standalone armel build should work fine on armhf, assuming that the kernel supports EABI, which I'm pretty sure it does (or multiarch armel would not work).+"""]]
+ doc/forum/drop__47__whereis_not_showing_gcrypted_special_ssh_remote.mdwn view
@@ -0,0 +1,11 @@+I have my laptop, my server and my usb drive. My server is a gcrypted remote via ssh. My laptop is just a repo that's referenced as a remote with a filepath.++I do git annex copy --to server, and let it copy stuff. I repeat the same thing for the usb drive. ++I run git annex sync and it does the whole sync dance successfully. it pushes stuff to both the usb drive and the server.++Afterwards, I do git annex whereis, and I only get 2 copies showing - my laptop and my usb drive. Likewise, since I set numcopies to 2, it won't let me drop anything at all, because it doesn't know there's a copy on my server.++Anything I can do about this? (What further info do you need?) ++I should probably add that my server is a ubuntu machine, and so it runs version 5.20140412ubuntu1. My laptop runs a more recent 5.20140717-g5a7d4ff.
+ doc/forum/gcrypt_os_x_app_vs_brew.mdwn view
@@ -0,0 +1,18 @@+Gcrypt remotes work when using the git-annex command bundled in the git-annex.app. But gcrypt doesn't work when git-annex is installed via home-brew (brew install git-annex).++The initial push will work, any subsequent commands (push/pull) will fail with:++    gpg: anonymous recipient; trying secret key...+    gpg: anonymous recipient; trying secret key...+    gpg: anonymous recipient; trying secret key...+    gpg: anonymous recipient; trying secret key...+    gpg: decryption failed: No secret key+    gcrypt: Failed to decrypt manifest!++In both cases (app/brew) it tries the same keys. The app version will use its own version of gpg, which will trigger password prompts. With the brew version gpgtools is used, so I won't get any prompts. (Keychain)++I tried "echo i | gpg -e -R XX -R XX | gpg -d" with the same recipients as the repo. It works well. ++Has anybody hints or ideas what to try next?++Best, Jean-Louis
+ doc/forum/local_subtree_and_broken_symlinks.mdwn view
@@ -0,0 +1,21 @@+Here's a simple example on a repository with three branches, where we'll be adding images-annex as a subtree into master.++    $ git branch+        git-annex+        images-annex+      * master+    $ git subtree add --squash --prefix=images/ images-annex+      Added dir 'images'+    $ ls+      FILE_A        FILE_B        images/++...checkout images-annex, make changes, commit...++    $ git checkout master+    $ git subtree pull --squash --prefix=images/ . images-annex+      From .+      * branch images-annex -> FETCH_HEAD+      Merge made by the 'recursive' strategy.+      ...(files created/modified/etc)++I have tried a few different methods for merging the subtree in and so far have not been able to keep git-annex links up to date. Running `git-annex fix .` does what it's supposed to but then git sees everything as modified. Is this entirely the expected behavior because of the --prefix? I have not used subtrees much before but the model appears to be very helpful for what I'm trying to do.
doc/git-annex.mdwn view
@@ -949,19 +949,44 @@   Merge conflicts between two files that are not annexed will not be   automatically resolved. +* `remotedaemon`++  Detects when network remotes have received git pushes and fetches from them.++* `xmppgit`++  This command is used internally to perform git pulls over XMPP.++# TESTING COMMANDS+ * `test`    This runs git-annex's built-in test suite.    There are several parameters, provided by Haskell's tasty test framework.+  Pass --help for details. -* `remotedaemon`+* `testremote remote` -  Detects when network remotes have received git pushes and fetches from them.+  This tests a remote by generating some random objects and sending them to+  the remote, then redownloading them, removing them from the remote, etc. -* `xmppgit`+  It's safe to run in an existing repository (the repository contents are+  not altered), although it may perform expensive data transfers. -  This command is used internally to perform git pulls over XMPP.+  To perform a smaller set of tests, use --fast.++  The --size option can be used to tune the size of the generated objects.++  Testing a single remote will use the remote's configuration,+  automatically varying the chunk sizes, and with simple shared encryption+  enabled and disabled.++* `fuzztest`++  Generates random changes to files in the current repository,+  for use in testing the assistant. This is dangerous, so it will not+  do anything unless --forced.  # OPTIONS
doc/install.mdwn view
@@ -3,7 +3,7 @@ [[!table format=dsv header=yes data=""" detailed instructions             | quick install [[OSX]]                           | [download git-annex.app](http://downloads.kitenet.net/git-annex/OSX/current/)-&nbsp;&nbsp;[[Homebrew]]            | `brew install git-annex`+&nbsp;&nbsp;[[OSX/Homebrew]]      | `brew install git-annex` [[Android]]                       | [download git-annex.apk](http://downloads.kitenet.net/git-annex/android/current/) **beta** [[Linux|linux_standalone]]        | [download prebuilt linux tarball](http://downloads.kitenet.net/git-annex/linux/current/) &nbsp;&nbsp;[[Debian]]            | `apt-get install git-annex`@@ -16,8 +16,11 @@ &nbsp;&nbsp;[[ScientificLinux5]]  | &nbsp;&nbsp;[[openSUSE]]          |  &nbsp;&nbsp;[[Docker]]            | -[[Windows]]                       | [download installer](http://downloads.kitenet.net/git-annex/windows/current/) **alpha**+[[Windows]]                       | [download installer](http://downloads.kitenet.net/git-annex/windows/current/) **beta** """]]++All the downloads above use https for security. For added security, see+[[verifying_downloads]].  ## Using cabal
− doc/install/Homebrew.mdwn 
@@ -1,21 +0,0 @@-[Homebrew](http://brew.sh/) has [a formula](https://github.com/Homebrew/homebrew/commits/master/Library/Formula/git-annex.rb) for git-annex.--Homebrew users can simply run `brew install git-annex` to install git-annex.--## buiding git-annex from sources--This is the old recipe for building git-annex from source, using-packages from homebrew. Useful if you want a newer version than the version-in homebrew.--<pre>-brew install haskell-platform git ossp-uuid md5sha1sum coreutils gnutls libidn gsasl pkg-config libxml2-brew link libxml2 --force-cabal update-mkdir $HOME/bin-PATH=$HOME/bin:$PATH-PATH=$HOME/.cabal/bin:$PATH-cabal install c2hs --bindir=$HOME/bin-cabal install gnuidn-cabal install git-annex --bindir=$HOME/bin-</pre>
doc/install/Linux_standalone.mdwn view
@@ -5,9 +5,9 @@ This tarball should work on most Linux systems. It has basically no dependencies and is self-contained. -* i386: [download tarball](https://downloads.kitenet.net/git-annex/linux/current/git-annex-standalone-i386.tar.gz)-* amd64: [download tarball](https://downloads.kitenet.net/git-annex/linux/current/git-annex-standalone-amd64.tar.gz)-* armel: [download tarball](https://downloads.kitenet.net/git-annex/linux/current/git-annex-standalone-armel.tar.gz)+* x86-32: [download tarball](https://downloads.kitenet.net/git-annex/linux/current/git-annex-standalone-i386.tar.gz)+* x86-64: [download tarball](https://downloads.kitenet.net/git-annex/linux/current/git-annex-standalone-amd64.tar.gz)+* arm: [download tarball](https://downloads.kitenet.net/git-annex/linux/current/git-annex-standalone-armel.tar.gz)  To use, just unpack the tarball, `cd git-annex.linux` and run `./runshell` -- this sets up an environment where you can use `git annex`, as well@@ -18,7 +18,7 @@ PATH. This lets you use `git annex`, without overriding your system's own versions of git, etc. -The armel version can be installed on NAS devices and other embedded ARM+The arm version can be installed on NAS devices and other embedded ARM linux systems.  * [[tips/Synology_NAS_and_git_annex]]@@ -29,6 +29,6 @@ A daily build is also available, thanks to Mesar Hameed and the University of Bath CS department. -* i386: [download tarball](https://downloads.kitenet.net/git-annex/autobuild/i386/git-annex-standalone-i386.tar.gz) ([build logs](https://downloads.kitenet.net/git-annex/autobuild/i386/))-* amd64: [download tarball](https://downloads.kitenet.net/git-annex/autobuild/amd64/git-annex-standalone-amd64.tar.gz) ([build logs](https://downloads.kitenet.net/git-annex/autobuild/amd64/))-* armel: [download tarball](https://downloads.kitenet.net/git-annex/autobuild/armel/git-annex-standalone-armel.tar.gz) ([build logs](https://downloads.kitenet.net/git-annex/autobuild/armel/))+* x86-32: [download tarball](https://downloads.kitenet.net/git-annex/autobuild/i386/git-annex-standalone-i386.tar.gz) ([build logs](https://downloads.kitenet.net/git-annex/autobuild/i386/))+* x86-64: [download tarball](https://downloads.kitenet.net/git-annex/autobuild/amd64/git-annex-standalone-amd64.tar.gz) ([build logs](https://downloads.kitenet.net/git-annex/autobuild/amd64/))+* arm: [download tarball](https://downloads.kitenet.net/git-annex/autobuild/armel/git-annex-standalone-armel.tar.gz) ([build logs](https://downloads.kitenet.net/git-annex/autobuild/armel/))
doc/install/OSX.mdwn view
@@ -31,25 +31,9 @@  ## using MacPorts -Install the Haskell Platform from [[http://hackage.haskell.org/platform/mac.html]].-The version provided by Macports is too old to work with current versions of git-annex.-Then execute--<pre>-sudo port install git-core ossp-uuid md5sha1sum coreutils gnutls libxml2 libgsasl pkgconfig-sudo cabal update-PATH=$HOME/bin:$PATH-cabal install c2hs git-annex --bindir=$HOME/bin-</pre>--## PATH setup--Do not forget to add to your PATH variable your ~/bin folder. In your .bashrc, for example:-<pre>-PATH=$HOME/bin:$PATH-</pre>+git-annex is not available in MacPorts, but can be built from source using+MacPorts tools. See [[MacPorts]]. -See also:+## building it yourself -* [[forum/OSX__39__s_haskell-platform_statically_links_things]]-* [[forum/OSX__39__s_default_sshd_behaviour_has_limited_paths_set]]+See [[porting]].
+ doc/install/OSX/Homebrew.mdwn view
@@ -0,0 +1,21 @@+[Homebrew](http://brew.sh/) has [a formula](https://github.com/Homebrew/homebrew/commits/master/Library/Formula/git-annex.rb) for git-annex.++Homebrew users can simply run `brew install git-annex` to install git-annex.++## buiding git-annex from sources++This is the old recipe for building git-annex from source, using+packages from homebrew. Useful if you want a newer version than the version+in homebrew.++<pre>+brew install haskell-platform git ossp-uuid md5sha1sum coreutils gnutls libidn gsasl pkg-config libxml2+brew link libxml2 --force+cabal update+mkdir $HOME/bin+PATH=$HOME/bin:$PATH+PATH=$HOME/.cabal/bin:$PATH+cabal install c2hs --bindir=$HOME/bin+cabal install gnuidn+cabal install git-annex --bindir=$HOME/bin+</pre>
+ doc/install/OSX/MacPorts.mdwn view
@@ -0,0 +1,27 @@+This is not a recommended way to install git-annex. Use [[HomeBrew]] or the+prebuilt app bundle instead.++But if you really want to use MacPorts:++Install the Haskell Platform from [[http://hackage.haskell.org/platform/mac.html]].+The version provided by Macports is too old to work with current versions of git-annex.+Then execute++<pre>+sudo port install git-core ossp-uuid md5sha1sum coreutils gnutls libxml2 libgsasl pkgconfig+sudo cabal update+PATH=$HOME/bin:$PATH+cabal install c2hs git-annex --bindir=$HOME/bin+</pre>++## PATH setup++Do not forget to add to your PATH variable your ~/bin folder. In your .bashrc, for example:+<pre>+PATH=$HOME/bin:$PATH+</pre>++See also:++* [[forum/OSX__39__s_haskell-platform_statically_links_things]]+* [[forum/OSX__39__s_default_sshd_behaviour_has_limited_paths_set]]
+ doc/install/OSX/MacPorts/comment_3_47a77a03040fe628109bd54f82f9ad7a._comment view
@@ -0,0 +1,17 @@+[[!comment format=mdwn+ username="https://www.google.com/accounts/o8/id?id=AItOawlDDW-g2WLLsLpcnCm4LykAquFY_nwbIrU"+ nickname="Daniel"+ subject="comment 3"+ date="2013-01-15T15:22:43Z"+ content="""+Installing via the MacPorts method. I ran into this error.++    \"_locale_charset\", referenced from: _localeEncoding in libHSbase-4.5.1.0.a(PrelIOUtils.o) +    ld: symbol(s) not found for architecture x86_64++I was able to solve and get git-annex to build buy providing the --extra-lib-dirs parameter++    cabal install c2hs git-annex --bindir=$HOME/bin --extra-lib-dirs=/usr/lib++Cheers, [Daniel Wozniak](http://woz.io)+"""]]
− doc/install/OSX/comment_10_cd2120552ef894a37933b328136fa4cc._comment 
@@ -1,8 +0,0 @@-[[!comment format=mdwn- username="https://www.google.com/accounts/o8/id?id=AItOawnaYy6kTuKAHmsa4BtGls2oqa42Jo2w2v0"- nickname="Pere"- subject="Segmentation Fault"- date="2013-01-19T16:10:08Z"- content="""-I guess my adventure ends here. :'(-"""]]
− doc/install/OSX/comment_11_740fa80e2e54e6fb570f820ff1f56440._comment 
@@ -1,8 +0,0 @@-[[!comment format=mdwn- username="https://www.google.com/accounts/o8/id?id=AItOawmyFvkaewo432ELwtCoecUGou4v3jCP0Pc"- nickname="Eric"- subject="Updating to latest build"- date="2013-01-25T06:05:35Z"- content="""-What is the appropriate way to update to the latest build of git-annex using cabal?-"""]]
− doc/install/OSX/comment_12_a84028080578a8b60115b6c4ef823627._comment 
@@ -1,8 +0,0 @@-[[!comment format=mdwn- username="https://www.google.com/accounts/o8/id?id=AItOawnaYy6kTuKAHmsa4BtGls2oqa42Jo2w2v0"- nickname="Pere"- subject="git annex on Snow Leopard"- date="2013-01-25T14:36:52Z"- content="""-Is there any way I can try to solve or by-pass the Segmentation Fault I commeted before? -"""]]
− doc/install/OSX/comment_13_d6f1db401858ffea23c123db49f5b296._comment 
@@ -1,8 +0,0 @@-[[!comment format=mdwn- username="http://joeyh.name/"- ip="4.154.3.125"- subject="comment 13"- date="2013-02-05T19:46:29Z"- content="""-@eric `cabal update && cabal upgrade git-annex`-"""]]
− doc/install/OSX/comment_14_035f856923276b0edad879e196e94097._comment 
@@ -1,9 +0,0 @@-[[!comment format=mdwn- username="https://www.google.com/accounts/o8/id?id=AItOawmCmNS-oUgYfNg85-LPuxzTZJUp0sIgprM"- nickname="Jonas"- subject="more homebrew"- date="2013-02-16T19:46:47Z"- content="""-i had macports installed. then i installed brew, instaled haskell via brew. i needed to set -    PATH=$HOME/bin:/usr/local/bin:$PATH-"""]]
− doc/install/OSX/comment_15_336e0acb00e84943715e69917643a69e._comment 
@@ -1,35 +0,0 @@-[[!comment format=mdwn- username="https://launchpad.net/~wincus"- nickname="Juan Moyano"- subject="git annex on Snow Leopard"- date="2013-03-26T16:02:54Z"- content="""-I'm having the same issue as @Pere, with a newer version of DAV :(--cabal: Error: some packages failed to install:-DAV-0.3.1 failed during the building phase. The exception was:-ExitFailure 11-git-annex-4.20130323 depends on shakespeare-css-1.0.3 which failed to install.-persistent-1.1.5.1 failed during the building phase. The exception was:-ExitFailure 11-persistent-template-1.1.3.1 depends on persistent-1.1.5.1 which failed to-install.-shakespeare-css-1.0.3 failed during the building phase. The exception was:-ExitFailure 11-yesod-1.1.9.2 depends on shakespeare-css-1.0.3 which failed to install.-yesod-auth-1.1.5.3 depends on shakespeare-css-1.0.3 which failed to install.-yesod-core-1.1.8.2 depends on shakespeare-css-1.0.3 which failed to install.-yesod-default-1.1.3.2 depends on shakespeare-css-1.0.3 which failed to-install.-yesod-form-1.2.1.3 depends on shakespeare-css-1.0.3 which failed to install.-yesod-json-1.1.2.2 depends on shakespeare-css-1.0.3 which failed to install.-yesod-persistent-1.1.0.1 depends on shakespeare-css-1.0.3 which failed to-install.-yesod-static-1.1.2.2 depends on shakespeare-css-1.0.3 which failed to install.----*Any ideas?*---"""]]
− doc/install/OSX/comment_16_1befafa862b7d07b1f6e57c0182497cf._comment 
@@ -1,36 +0,0 @@-[[!comment format=mdwn- username="https://www.google.com/accounts/o8/id?id=AItOawkurjhi0CRJvgm7QNaZDWS9hitBtavqIpc"- nickname="Bret"- subject="Snow Leopard Issues"- date="2013-04-14T20:17:17Z"- content="""-I was able to build snow leopard completely for the first time over last night (it took a very long time to build all the tools and dependancies).  Woohoo!--The way I was able to fully build on a 32-bit 10.6 machine was this--1. Delete ~/.ghc and ~/.cabal.  They were full of random things and were causing problems.-2. `brew uninstall ghc and haskell-platform`-3. `brew update`-4. `brew install git ossp-uuid md5sha1sum coreutils libgsasl gnutls libidn libgsasl pkg-config libxml2`-5. `brew upgrade git ossp-uuid md5sha1sum coreutils libgsasl gnutls libidn libgsasl pkg-config libxml2` (Some of these were already installed/up to date.-6. `brew link libxml2`-7. `brew install haskell-platform`  (This takes a long, long time).-8. `cabal update` (assuming you have added `~/.cabal/bin` to your path-9. `cabal install cablal-install`-10. `cabal install c2hs`-11. `cabal install git-annex`---It also appears to be running fairly smoothly than it had in the past on a 32-bit SL system.  Thats also neat.  --The problem is that it seems to not really work as git annex though, probably due to the error relating you get when you start up the webapp:-Running-`git annex webapp` -The browser starts up, and I get 3 of these errors:-`Watcher crashed: Need at least OSX 10.7.0 for file-level FSEvents`--Pairing with a local computer appears to work to systems running 10.7, but when you complete the process, they never show up in the repository list.---Also on a side note, when running `git annex webapp` it triggers the opening of an html file in whatever the default html file handler is.  I edit a lot of html, so for me that is usually a text editor.  I had to change the file handler to open html files with my web browser for the `git annex webapp` to actually work.  Is there a way to change that so that `git annex webapp` uses the default web browser for the system rather than the default html file handler?-"""]]
− doc/install/OSX/comment_17_19c08b2c6c2c5cd88bf96d2bcbbd9055._comment 
@@ -1,10 +0,0 @@-[[!comment format=mdwn- username="http://joeyh.name/"- nickname="joey"- subject="comment 17"- date="2013-04-16T20:31:10Z"- content="""-@Bret, the assistant relies on FSEvents pretty heavily. It seems to me your best bet is to upgrade OSX to a version that supports FSEvents.--You can certainly use the rest of git-annex on Snow Leopard without FSEvents.-"""]]
− doc/install/OSX/comment_18_537fad5d8854e765499d47602d1ab398._comment 
@@ -1,8 +0,0 @@-[[!comment format=mdwn- username="https://www.google.com/accounts/o8/id?id=AItOawkurjhi0CRJvgm7QNaZDWS9hitBtavqIpc"- nickname="Bret"- subject="Can't update"- date="2013-04-18T00:58:19Z"- content="""-The laptop is one of the first macbook pro's with a 32 bit chip, which apple dropped support for in 10.7, so the furthest it can update to is 10.6.x. :(-"""]]
− doc/install/OSX/comment_19_18d4377f4ded5604d395d73783ba82c9._comment 
@@ -1,8 +0,0 @@-[[!comment format=mdwn- username="http://edheil.wordpress.com/"- ip="99.54.57.201"- subject="comment 19"- date="2013-04-18T02:05:34Z"- content="""-sounds like a prime candidate for a nice lightweight linux distro ;)-"""]]
− doc/install/OSX/comment_21_987f1302f56107c926b6daf83e124654._comment 
@@ -1,11 +0,0 @@-[[!comment format=mdwn- username="https://www.google.com/accounts/o8/id?id=AItOawmJdzisfT6DhorwRz0kKJ_9-zQbccCopu4"- nickname="Alejandro"- subject="Macports _iconv"- date="2013-07-18T14:23:02Z"- content="""-If you get an error like `undefined symbol _iconv for x86_64`, you're most likely using libiconv installed by macports. You can fix this by running--    cabal install c2hs git-annex --bindir=$HOME/bin --extra-lib-dirs=/usr/lib--"""]]
− doc/install/OSX/comment_22_6b5f44a98f9d37a1c6ecfe19a60fe6c5._comment 
@@ -1,12 +0,0 @@-[[!comment format=mdwn- username="https://www.google.com/accounts/o8/id?id=AItOawmRFKwny4rArBaz-36xTcsJYqKIgdDaw5Q"- nickname="Andrew"- subject="comment 22"- date="2013-07-25T02:19:53Z"- content="""-Rather than specifying --bindir on the command line for cabal, I edited my ~/.cabal/config to add this line:--    symlink-bindir: /usr/local/bin--This installs the binaries to ~/.cabal/bin but symlinks them into /usr/local/bin alongside the links that homebrew installs. Additionally, I symlinked /usr/local/bin/git-annex-shell to /usr/local/bin/git-annex which made things work great from remote hosts via ssh.-"""]]
− doc/install/OSX/comment_23_3d82a270dd4b0159f4aab5675166e1e3._comment 
@@ -1,30 +0,0 @@-[[!comment format=mdwn- username="https://www.google.com/accounts/o8/id?id=AItOawmL8pteP2jbYJUn1M3CbeLDvz2SWAA1wtg"- nickname="Kristian"- subject="Build failure using Haskel Platform"- date="2013-09-15T18:49:01Z"- content="""-I get this error when I try to build git-annex using \"cabal install git-annex\"--    [ 34 of 347] Compiling Utility.Misc     ( Utility/Misc.hs, dist/build/git-annex/git-annex-tmp/Utility/Misc.o )-    [ 35 of 347] Compiling Utility.Process  ( Utility/Process.hs, dist/build/git-annex/git-annex-tmp/Utility/Process.o )-    [ 36 of 347] Compiling Utility.Network  ( Utility/Network.hs, dist/build/git-annex/git-annex-tmp/Utility/Network.o )-    [ 37 of 347] Compiling Utility.SRV      ( Utility/SRV.hs, dist/build/git-annex/git-annex-tmp/Utility/SRV.o )-    -    Utility/SRV.hs:70:54:-        Couldn't match expected type `Maybe-                                        [(Int, Int, Integer, B8.ByteString)]'-                    with actual type `Either-                                        dns-1.0.0:Network.DNS.Internal.DNSError-                                        [(Int, Int, Int, dns-1.0.0:Network.DNS.Internal.Domain)]'-        In the third argument of `maybe', namely `r'-        In the second argument of `($)', namely-          `maybe [] (orderHosts . map tohosts) r'-        In a stmt of a 'do' block:-          return $ maybe [] (orderHosts . map tohosts) r-    Failed to install git-annex-4.20130909-    cabal: Error: some packages failed to install:-    git-annex-4.20130909 failed during the building phase. The exception was:-    ExitFailure 1--"""]]
− doc/install/OSX/comment_24_b9d3563a2cc3d769f27876e028dc344d._comment 
@@ -1,12 +0,0 @@-[[!comment format=mdwn- username="http://joeyh.name/"- ip="4.152.108.128"- subject="comment 24"- date="2013-09-17T15:56:17Z"- content="""-@Kristian, a new version of the DNS library has caused this. A workaround is to pass `-f-DNS` to the cabal command.--I am in the process of adding support for the new DNS library version in git now.--By the way, please [[file_a_bug|bugs]] if you have a big ugly looking build failure like that, so as to not clutter up this page.-"""]]
− doc/install/OSX/comment_27_2a60108a440231ba83f5a54b6bcc5488._comment 
@@ -1,14 +0,0 @@-[[!comment format=mdwn- username="https://www.google.com/accounts/o8/id?id=AItOawnZEanlyzay_QlEAL0CWpyZcRTyN7vay8U"- nickname="Carlo"- subject="comment 27"- date="2013-10-16T09:40:23Z"- content="""-The [FSevents framework itself has been around since leopard](http://arstechnica.com/apple/2007/10/mac-os-x-10-5/7/).--[This fsevents wrapper project](https://github.com/rastersize/CDEvents) supports snow leopard and even leopard, maybe it will provide some clues on how it was done.--I'm guessing it would be worth it, [snow leopard is still the most popular OSX as of April](http://www.patentlyapple.com/patently-apple/2013/04/snow-leopard-remains-the-most-popular-version-of-os-x.html). From my own experience, snow leopard is a huge life extender for 2+ year old hardware. Lion just makes them sluggishly painful to use.--Maybe someone could volunteer an SL machine for remote development? Sorry, mine are tied down :(-"""]]
− doc/install/OSX/comment_27_d453510b9bb62072a4c663206c12c8a4._comment 
@@ -1,8 +0,0 @@-[[!comment format=mdwn- username="http://joeyh.name/"- ip="64.134.31.139"- subject="comment 27"- date="2013-10-16T15:14:53Z"- content="""-The git-annex assistant uses **file level** FSevents to detect which files have been changed. Would it be possible to make it work with older versions that don't provide file-level events? Probably. The code for BSD kqueue deals with similar limitations in needing to scan the directory to find the files that actually changed. If someone cares about old versions of OSX and wants to do that work I'll happily support you.-"""]]
− doc/install/OSX/comment_28_0970bfd63137ea48701dff6aea1b4bcb._comment 
@@ -1,18 +0,0 @@-[[!comment format=mdwn- username="http://alan.petitepomme.net/"- nickname="Alan Schmitt"- subject="dbus support?"- date="2013-10-18T08:24:11Z"- content="""-Hello,--I just compiled git-annex using cabal on OS X, and I see there is no dbus support:--    Assistant/Threads/NetWatcher.hs:26:0:-         warning: #warning Building without dbus support; will poll for network connection changes-    -    Assistant/Threads/MountWatcher.hs:33:0:-         warning: #warning Building without dbus support; will use mtab polling--Is this problematic? I see I can install dbus using homebrew. If I do so, will I have dbus support (after recompiling git-annex)?-"""]]
− doc/install/OSX/comment_29_8622ed56c6a8034c20fb311418d94003._comment 
@@ -1,8 +0,0 @@-[[!comment format=mdwn- username="https://www.google.com/accounts/o8/id?id=AItOawnZEanlyzay_QlEAL0CWpyZcRTyN7vay8U"- nickname="Carlo"- subject="comment 29"- date="2013-10-18T15:58:59Z"- content="""-I think I dragged you out of dev mode for commenting unnecessarily, sorry about that. Apparently, [Lion](http://www.redmondpie.com/os-x-lion-vs-os-x-snow-leopard-head-to-head-performance-showdown/) and [Mountain Lion are fine on older hardware](http://apple.stackexchange.com/questions/58453/will-mountain-lion-make-an-older-computer-run-faster-or-slower). For a while [a daemon cause Lion slowdowns for a day after upgrade](https://discussions.apple.com/message/15719036) for a while, which was enough to cause a reputation.-"""]]
− doc/install/OSX/comment_30_ce58633ef5b2f8f4caa7e626358f33be._comment 
@@ -1,8 +0,0 @@-[[!comment format=mdwn- username="http://joeyh.name/"- ip="64.134.31.139"- subject="comment 30"- date="2013-10-19T15:31:45Z"- content="""-@Alan you don't need to install dbus on OSX. The polling code will work. On the other hand if you'd like to experiment with installing dbus and report back, perhaps it's worth a try. It's nice when the git-annex assistant can instantly detect when drives are plugged in, and then the network connection changes and react to it. On Linux, dbus gives it that capability.-"""]]
− doc/install/OSX/comment_31_09084a7b3cf06bfa3add0f4991476ffe._comment 
@@ -1,10 +0,0 @@-[[!comment format=mdwn- username="http://alan.petitepomme.net/"- nickname="Alan Schmitt"- subject="dbus and homebrew"- date="2013-10-20T17:25:04Z"- content="""-I'm trying to build git-annex with dbus support, and even though I installed dbus (through homebrew), at the end of compilation I get the warning about \"building without dbus\". Is there something special I need to do for git-annex to see I have installed dbus?--(Also, it tells me at the beginning that I don't have gcrypt, but libgcrypt is installed.)-"""]]
− doc/install/OSX/comment_32_a46d8e3e7795b9afb1e1c2be943d12af._comment 
@@ -1,10 +0,0 @@-[[!comment format=mdwn- username="http://joeyh.name/"- ip="64.134.31.139"- subject="comment 32"- date="2013-10-21T22:47:14Z"- content="""-You probably need to install libdbus dev stuff, and then the haskell dbus library. But it's certainly going to need code changes to make git-annex use dbus in any way on OSX, assuming there are even useful dbus events generated for network connections and drives being mounted on OSX.--It was saying \"gcrypt\" when it meant \"git-remote-gcrypt\".-"""]]
− doc/install/OSX/comment_33_203a36322b3c453c05c8906c64e62e06._comment 
@@ -1,8 +0,0 @@-[[!comment format=mdwn- username="http://alan.petitepomme.net/"- nickname="Alan Schmitt"- subject="comment 33"- date="2013-10-23T11:39:51Z"- content="""-I installed the haskell DBus library, but it's still not picking it up. Is there some additional option to pass to cabal, or is it supposed to find it automatically?-"""]]
− doc/install/OSX/comment_34_874ff01f27911baf6ef0f559d5d5f5a0._comment 
@@ -1,27 +0,0 @@-[[!comment format=mdwn- username="https://www.google.com/accounts/o8/id?id=AItOawn3rK4VDzxyhmrIc18z7F5OuXvEbUsgUac"- nickname="Srinath"- subject="build issue with brew technique on Darwin Kernel Version 13.0.0"- date="2014-02-15T02:17:16Z"- content="""-Following the Mac OS X brew instructions from the top of the board, I got the following error:--[5 of 5] Compiling Yesod            ( Yesod.hs, dist/build/Yesod.o )-In-place registering yesod-1.2.5...-Installing library in /Users/srinathv/.cabal/lib/yesod-1.2.5/ghc-7.6.3-Registering yesod-1.2.5...-Installed yesod-1.2.5-cabal: Error: some packages failed to install:-git-annex-5.20140210 depends on libxml-sax-0.7.4 which failed to install.-libxml-sax-0.7.4 failed during the configure step. The exception was:-ExitFailure 1-network-protocol-xmpp-0.4.5 depends on libxml-sax-0.7.4 which failed to-install.---Then I perused the comments and did:-$brew link libmxl2 --force-$cabal install git-annex --bindir=$HOME/bin--with success.  -"""]]
− doc/install/OSX/comment_3_47a77a03040fe628109bd54f82f9ad7a._comment 
@@ -1,17 +0,0 @@-[[!comment format=mdwn- username="https://www.google.com/accounts/o8/id?id=AItOawlDDW-g2WLLsLpcnCm4LykAquFY_nwbIrU"- nickname="Daniel"- subject="comment 3"- date="2013-01-15T15:22:43Z"- content="""-Installing via the MacPorts method. I ran into this error.--    \"_locale_charset\", referenced from: _localeEncoding in libHSbase-4.5.1.0.a(PrelIOUtils.o) -    ld: symbol(s) not found for architecture x86_64--I was able to solve and get git-annex to build buy providing the --extra-lib-dirs parameter--    cabal install c2hs git-annex --bindir=$HOME/bin --extra-lib-dirs=/usr/lib--Cheers, [Daniel Wozniak](http://woz.io)-"""]]
− doc/install/OSX/comment_4_bbe99673033e4c48c8bb3db24ee419f9._comment 
@@ -1,8 +0,0 @@-[[!comment format=mdwn- username="https://www.google.com/accounts/o8/id?id=AItOawkSq2FDpK2n66QRUxtqqdbyDuwgbQmUWus"- nickname="Jimmy"- subject="comment 4"- date="2012-12-10T17:00:43Z"- content="""-For those that care, I've updated my autobuilder to the latest version of haskell-platform 2012.4.0.0 and it appears to be building correctly.-"""]]
− doc/install/OSX/comment_8_38d9c2eea1090674de2361274eab5b0e._comment 
@@ -1,29 +0,0 @@-[[!comment format=mdwn- username="https://www.google.com/accounts/o8/id?id=AItOawnaYy6kTuKAHmsa4BtGls2oqa42Jo2w2v0"- nickname="Pere"- subject="I couldn't install it on Snow Leopard"- date="2013-01-19T15:04:27Z"- content="""-Bad news, it looks like I'm not able to install git-annex to my machine: When I run--    sudo cabal install c2hs git-annex --bindir=$HOME/bin--I get the following error:--    cabal: Error: some packages failed to install:-    DAV-0.3 failed during the building phase. The exception was:-    ExitFailure 11-    git-annex-3.20130114 depends on yesod-core-1.1.7.1 which failed to install.-    yesod-1.1.7.2 depends on yesod-core-1.1.7.1 which failed to install.-    yesod-auth-1.1.3 depends on yesod-core-1.1.7.1 which failed to install.-    yesod-core-1.1.7.1 failed during the building phase. The exception was:-    ExitFailure 11-    yesod-default-1.1.3 depends on yesod-core-1.1.7.1 which failed to install.-    yesod-form-1.2.0.2 depends on yesod-core-1.1.7.1 which failed to install.-    yesod-json-1.1.2 depends on yesod-core-1.1.7.1 which failed to install.-    yesod-persistent-1.1.0.1 depends on yesod-core-1.1.7.1 which failed to-    install.-    yesod-static-1.1.1.2 depends on yesod-core-1.1.7.1 which failed to install.--What does *ExitFailure 11* mean?-"""]]
+ doc/install/OSX/comment_8_b94193a0583605920effa7179a6164d9._comment view
@@ -0,0 +1,10 @@+[[!comment format=mdwn+ username="http://joeyh.name/"+ ip="209.250.56.7"+ subject="comment 8"+ date="2014-08-15T19:26:07Z"+ content="""+@David, the bundle contains the man page since a while.++@Michael, the best way to get a git-annex that does not use those bundled programs is probably to instead install it using homebrew.+"""]]
− doc/install/OSX/comment_9_35bf3812db6f3ef25da9b3bc84f147c5._comment 
@@ -1,8 +0,0 @@-[[!comment format=mdwn- username="http://joeyh.name/"- ip="4.154.3.194"- subject="comment 9"- date="2013-01-19T16:02:35Z"- content="""-sig11 is a Segmentation Fault, probably from a C library used by DAV for HTTP in this case.-"""]]
+ doc/install/OSX/porting.mdwn view
@@ -0,0 +1,6 @@+If you cannot get a OSX build of git-annex suitable for your computer,+from eg [[HomeBrew]] or the regular [[OSX]] prebuilt app, you+can try building git-annex from source on OSX, using haskell's cabal package+manager.++For general instructions for using cabal, see [[this page|/install/cabal]].
+ doc/install/OSX/porting/comment_10_cd2120552ef894a37933b328136fa4cc._comment view
@@ -0,0 +1,8 @@+[[!comment format=mdwn+ username="https://www.google.com/accounts/o8/id?id=AItOawnaYy6kTuKAHmsa4BtGls2oqa42Jo2w2v0"+ nickname="Pere"+ subject="Segmentation Fault"+ date="2013-01-19T16:10:08Z"+ content="""+I guess my adventure ends here. :'(+"""]]
+ doc/install/OSX/porting/comment_11_740fa80e2e54e6fb570f820ff1f56440._comment view
@@ -0,0 +1,8 @@+[[!comment format=mdwn+ username="https://www.google.com/accounts/o8/id?id=AItOawmyFvkaewo432ELwtCoecUGou4v3jCP0Pc"+ nickname="Eric"+ subject="Updating to latest build"+ date="2013-01-25T06:05:35Z"+ content="""+What is the appropriate way to update to the latest build of git-annex using cabal?+"""]]
+ doc/install/OSX/porting/comment_12_a84028080578a8b60115b6c4ef823627._comment view
@@ -0,0 +1,8 @@+[[!comment format=mdwn+ username="https://www.google.com/accounts/o8/id?id=AItOawnaYy6kTuKAHmsa4BtGls2oqa42Jo2w2v0"+ nickname="Pere"+ subject="git annex on Snow Leopard"+ date="2013-01-25T14:36:52Z"+ content="""+Is there any way I can try to solve or by-pass the Segmentation Fault I commeted before? +"""]]
+ doc/install/OSX/porting/comment_13_d6f1db401858ffea23c123db49f5b296._comment view
@@ -0,0 +1,8 @@+[[!comment format=mdwn+ username="http://joeyh.name/"+ ip="4.154.3.125"+ subject="comment 13"+ date="2013-02-05T19:46:29Z"+ content="""+@eric `cabal update && cabal upgrade git-annex`+"""]]
+ doc/install/OSX/porting/comment_14_035f856923276b0edad879e196e94097._comment view
@@ -0,0 +1,9 @@+[[!comment format=mdwn+ username="https://www.google.com/accounts/o8/id?id=AItOawmCmNS-oUgYfNg85-LPuxzTZJUp0sIgprM"+ nickname="Jonas"+ subject="more homebrew"+ date="2013-02-16T19:46:47Z"+ content="""+i had macports installed. then i installed brew, instaled haskell via brew. i needed to set +    PATH=$HOME/bin:/usr/local/bin:$PATH+"""]]
+ doc/install/OSX/porting/comment_15_336e0acb00e84943715e69917643a69e._comment view
@@ -0,0 +1,35 @@+[[!comment format=mdwn+ username="https://launchpad.net/~wincus"+ nickname="Juan Moyano"+ subject="git annex on Snow Leopard"+ date="2013-03-26T16:02:54Z"+ content="""+I'm having the same issue as @Pere, with a newer version of DAV :(++cabal: Error: some packages failed to install:+DAV-0.3.1 failed during the building phase. The exception was:+ExitFailure 11+git-annex-4.20130323 depends on shakespeare-css-1.0.3 which failed to install.+persistent-1.1.5.1 failed during the building phase. The exception was:+ExitFailure 11+persistent-template-1.1.3.1 depends on persistent-1.1.5.1 which failed to+install.+shakespeare-css-1.0.3 failed during the building phase. The exception was:+ExitFailure 11+yesod-1.1.9.2 depends on shakespeare-css-1.0.3 which failed to install.+yesod-auth-1.1.5.3 depends on shakespeare-css-1.0.3 which failed to install.+yesod-core-1.1.8.2 depends on shakespeare-css-1.0.3 which failed to install.+yesod-default-1.1.3.2 depends on shakespeare-css-1.0.3 which failed to+install.+yesod-form-1.2.1.3 depends on shakespeare-css-1.0.3 which failed to install.+yesod-json-1.1.2.2 depends on shakespeare-css-1.0.3 which failed to install.+yesod-persistent-1.1.0.1 depends on shakespeare-css-1.0.3 which failed to+install.+yesod-static-1.1.2.2 depends on shakespeare-css-1.0.3 which failed to install.++++*Any ideas?*+++"""]]
+ doc/install/OSX/porting/comment_16_1befafa862b7d07b1f6e57c0182497cf._comment view
@@ -0,0 +1,36 @@+[[!comment format=mdwn+ username="https://www.google.com/accounts/o8/id?id=AItOawkurjhi0CRJvgm7QNaZDWS9hitBtavqIpc"+ nickname="Bret"+ subject="Snow Leopard Issues"+ date="2013-04-14T20:17:17Z"+ content="""+I was able to build snow leopard completely for the first time over last night (it took a very long time to build all the tools and dependancies).  Woohoo!++The way I was able to fully build on a 32-bit 10.6 machine was this++1. Delete ~/.ghc and ~/.cabal.  They were full of random things and were causing problems.+2. `brew uninstall ghc and haskell-platform`+3. `brew update`+4. `brew install git ossp-uuid md5sha1sum coreutils libgsasl gnutls libidn libgsasl pkg-config libxml2`+5. `brew upgrade git ossp-uuid md5sha1sum coreutils libgsasl gnutls libidn libgsasl pkg-config libxml2` (Some of these were already installed/up to date.+6. `brew link libxml2`+7. `brew install haskell-platform`  (This takes a long, long time).+8. `cabal update` (assuming you have added `~/.cabal/bin` to your path+9. `cabal install cablal-install`+10. `cabal install c2hs`+11. `cabal install git-annex`+++It also appears to be running fairly smoothly than it had in the past on a 32-bit SL system.  Thats also neat.  ++The problem is that it seems to not really work as git annex though, probably due to the error relating you get when you start up the webapp:+Running+`git annex webapp` +The browser starts up, and I get 3 of these errors:+`Watcher crashed: Need at least OSX 10.7.0 for file-level FSEvents`++Pairing with a local computer appears to work to systems running 10.7, but when you complete the process, they never show up in the repository list.+++Also on a side note, when running `git annex webapp` it triggers the opening of an html file in whatever the default html file handler is.  I edit a lot of html, so for me that is usually a text editor.  I had to change the file handler to open html files with my web browser for the `git annex webapp` to actually work.  Is there a way to change that so that `git annex webapp` uses the default web browser for the system rather than the default html file handler?+"""]]
+ doc/install/OSX/porting/comment_17_19c08b2c6c2c5cd88bf96d2bcbbd9055._comment view
@@ -0,0 +1,10 @@+[[!comment format=mdwn+ username="http://joeyh.name/"+ nickname="joey"+ subject="comment 17"+ date="2013-04-16T20:31:10Z"+ content="""+@Bret, the assistant relies on FSEvents pretty heavily. It seems to me your best bet is to upgrade OSX to a version that supports FSEvents.++You can certainly use the rest of git-annex on Snow Leopard without FSEvents.+"""]]
+ doc/install/OSX/porting/comment_18_537fad5d8854e765499d47602d1ab398._comment view
@@ -0,0 +1,8 @@+[[!comment format=mdwn+ username="https://www.google.com/accounts/o8/id?id=AItOawkurjhi0CRJvgm7QNaZDWS9hitBtavqIpc"+ nickname="Bret"+ subject="Can't update"+ date="2013-04-18T00:58:19Z"+ content="""+The laptop is one of the first macbook pro's with a 32 bit chip, which apple dropped support for in 10.7, so the furthest it can update to is 10.6.x. :(+"""]]
+ doc/install/OSX/porting/comment_19_18d4377f4ded5604d395d73783ba82c9._comment view
@@ -0,0 +1,8 @@+[[!comment format=mdwn+ username="http://edheil.wordpress.com/"+ ip="99.54.57.201"+ subject="comment 19"+ date="2013-04-18T02:05:34Z"+ content="""+sounds like a prime candidate for a nice lightweight linux distro ;)+"""]]
+ doc/install/OSX/porting/comment_22_6b5f44a98f9d37a1c6ecfe19a60fe6c5._comment view
@@ -0,0 +1,12 @@+[[!comment format=mdwn+ username="https://www.google.com/accounts/o8/id?id=AItOawmRFKwny4rArBaz-36xTcsJYqKIgdDaw5Q"+ nickname="Andrew"+ subject="comment 22"+ date="2013-07-25T02:19:53Z"+ content="""+Rather than specifying --bindir on the command line for cabal, I edited my ~/.cabal/config to add this line:++    symlink-bindir: /usr/local/bin++This installs the binaries to ~/.cabal/bin but symlinks them into /usr/local/bin alongside the links that homebrew installs. Additionally, I symlinked /usr/local/bin/git-annex-shell to /usr/local/bin/git-annex which made things work great from remote hosts via ssh.+"""]]
+ doc/install/OSX/porting/comment_23_3d82a270dd4b0159f4aab5675166e1e3._comment view
@@ -0,0 +1,30 @@+[[!comment format=mdwn+ username="https://www.google.com/accounts/o8/id?id=AItOawmL8pteP2jbYJUn1M3CbeLDvz2SWAA1wtg"+ nickname="Kristian"+ subject="Build failure using Haskel Platform"+ date="2013-09-15T18:49:01Z"+ content="""+I get this error when I try to build git-annex using \"cabal install git-annex\"++    [ 34 of 347] Compiling Utility.Misc     ( Utility/Misc.hs, dist/build/git-annex/git-annex-tmp/Utility/Misc.o )+    [ 35 of 347] Compiling Utility.Process  ( Utility/Process.hs, dist/build/git-annex/git-annex-tmp/Utility/Process.o )+    [ 36 of 347] Compiling Utility.Network  ( Utility/Network.hs, dist/build/git-annex/git-annex-tmp/Utility/Network.o )+    [ 37 of 347] Compiling Utility.SRV      ( Utility/SRV.hs, dist/build/git-annex/git-annex-tmp/Utility/SRV.o )+    +    Utility/SRV.hs:70:54:+        Couldn't match expected type `Maybe+                                        [(Int, Int, Integer, B8.ByteString)]'+                    with actual type `Either+                                        dns-1.0.0:Network.DNS.Internal.DNSError+                                        [(Int, Int, Int, dns-1.0.0:Network.DNS.Internal.Domain)]'+        In the third argument of `maybe', namely `r'+        In the second argument of `($)', namely+          `maybe [] (orderHosts . map tohosts) r'+        In a stmt of a 'do' block:+          return $ maybe [] (orderHosts . map tohosts) r+    Failed to install git-annex-4.20130909+    cabal: Error: some packages failed to install:+    git-annex-4.20130909 failed during the building phase. The exception was:+    ExitFailure 1++"""]]
+ doc/install/OSX/porting/comment_24_b9d3563a2cc3d769f27876e028dc344d._comment view
@@ -0,0 +1,12 @@+[[!comment format=mdwn+ username="http://joeyh.name/"+ ip="4.152.108.128"+ subject="comment 24"+ date="2013-09-17T15:56:17Z"+ content="""+@Kristian, a new version of the DNS library has caused this. A workaround is to pass `-f-DNS` to the cabal command.++I am in the process of adding support for the new DNS library version in git now.++By the way, please [[file_a_bug|bugs]] if you have a big ugly looking build failure like that, so as to not clutter up this page.+"""]]
+ doc/install/OSX/porting/comment_27_2a60108a440231ba83f5a54b6bcc5488._comment view
@@ -0,0 +1,14 @@+[[!comment format=mdwn+ username="https://www.google.com/accounts/o8/id?id=AItOawnZEanlyzay_QlEAL0CWpyZcRTyN7vay8U"+ nickname="Carlo"+ subject="comment 27"+ date="2013-10-16T09:40:23Z"+ content="""+The [FSevents framework itself has been around since leopard](http://arstechnica.com/apple/2007/10/mac-os-x-10-5/7/).++[This fsevents wrapper project](https://github.com/rastersize/CDEvents) supports snow leopard and even leopard, maybe it will provide some clues on how it was done.++I'm guessing it would be worth it, [snow leopard is still the most popular OSX as of April](http://www.patentlyapple.com/patently-apple/2013/04/snow-leopard-remains-the-most-popular-version-of-os-x.html). From my own experience, snow leopard is a huge life extender for 2+ year old hardware. Lion just makes them sluggishly painful to use.++Maybe someone could volunteer an SL machine for remote development? Sorry, mine are tied down :(+"""]]
+ doc/install/OSX/porting/comment_27_d453510b9bb62072a4c663206c12c8a4._comment view
@@ -0,0 +1,8 @@+[[!comment format=mdwn+ username="http://joeyh.name/"+ ip="64.134.31.139"+ subject="comment 27"+ date="2013-10-16T15:14:53Z"+ content="""+The git-annex assistant uses **file level** FSevents to detect which files have been changed. Would it be possible to make it work with older versions that don't provide file-level events? Probably. The code for BSD kqueue deals with similar limitations in needing to scan the directory to find the files that actually changed. If someone cares about old versions of OSX and wants to do that work I'll happily support you.+"""]]
+ doc/install/OSX/porting/comment_28_0970bfd63137ea48701dff6aea1b4bcb._comment view
@@ -0,0 +1,18 @@+[[!comment format=mdwn+ username="http://alan.petitepomme.net/"+ nickname="Alan Schmitt"+ subject="dbus support?"+ date="2013-10-18T08:24:11Z"+ content="""+Hello,++I just compiled git-annex using cabal on OS X, and I see there is no dbus support:++    Assistant/Threads/NetWatcher.hs:26:0:+         warning: #warning Building without dbus support; will poll for network connection changes+    +    Assistant/Threads/MountWatcher.hs:33:0:+         warning: #warning Building without dbus support; will use mtab polling++Is this problematic? I see I can install dbus using homebrew. If I do so, will I have dbus support (after recompiling git-annex)?+"""]]
+ doc/install/OSX/porting/comment_29_8622ed56c6a8034c20fb311418d94003._comment view
@@ -0,0 +1,8 @@+[[!comment format=mdwn+ username="https://www.google.com/accounts/o8/id?id=AItOawnZEanlyzay_QlEAL0CWpyZcRTyN7vay8U"+ nickname="Carlo"+ subject="comment 29"+ date="2013-10-18T15:58:59Z"+ content="""+I think I dragged you out of dev mode for commenting unnecessarily, sorry about that. Apparently, [Lion](http://www.redmondpie.com/os-x-lion-vs-os-x-snow-leopard-head-to-head-performance-showdown/) and [Mountain Lion are fine on older hardware](http://apple.stackexchange.com/questions/58453/will-mountain-lion-make-an-older-computer-run-faster-or-slower). For a while [a daemon cause Lion slowdowns for a day after upgrade](https://discussions.apple.com/message/15719036) for a while, which was enough to cause a reputation.+"""]]
+ doc/install/OSX/porting/comment_30_ce58633ef5b2f8f4caa7e626358f33be._comment view
@@ -0,0 +1,8 @@+[[!comment format=mdwn+ username="http://joeyh.name/"+ ip="64.134.31.139"+ subject="comment 30"+ date="2013-10-19T15:31:45Z"+ content="""+@Alan you don't need to install dbus on OSX. The polling code will work. On the other hand if you'd like to experiment with installing dbus and report back, perhaps it's worth a try. It's nice when the git-annex assistant can instantly detect when drives are plugged in, and then the network connection changes and react to it. On Linux, dbus gives it that capability.+"""]]
+ doc/install/OSX/porting/comment_31_09084a7b3cf06bfa3add0f4991476ffe._comment view
@@ -0,0 +1,10 @@+[[!comment format=mdwn+ username="http://alan.petitepomme.net/"+ nickname="Alan Schmitt"+ subject="dbus and homebrew"+ date="2013-10-20T17:25:04Z"+ content="""+I'm trying to build git-annex with dbus support, and even though I installed dbus (through homebrew), at the end of compilation I get the warning about \"building without dbus\". Is there something special I need to do for git-annex to see I have installed dbus?++(Also, it tells me at the beginning that I don't have gcrypt, but libgcrypt is installed.)+"""]]
+ doc/install/OSX/porting/comment_32_a46d8e3e7795b9afb1e1c2be943d12af._comment view
@@ -0,0 +1,10 @@+[[!comment format=mdwn+ username="http://joeyh.name/"+ ip="64.134.31.139"+ subject="comment 32"+ date="2013-10-21T22:47:14Z"+ content="""+You probably need to install libdbus dev stuff, and then the haskell dbus library. But it's certainly going to need code changes to make git-annex use dbus in any way on OSX, assuming there are even useful dbus events generated for network connections and drives being mounted on OSX.++It was saying \"gcrypt\" when it meant \"git-remote-gcrypt\".+"""]]
+ doc/install/OSX/porting/comment_33_203a36322b3c453c05c8906c64e62e06._comment view
@@ -0,0 +1,8 @@+[[!comment format=mdwn+ username="http://alan.petitepomme.net/"+ nickname="Alan Schmitt"+ subject="comment 33"+ date="2013-10-23T11:39:51Z"+ content="""+I installed the haskell DBus library, but it's still not picking it up. Is there some additional option to pass to cabal, or is it supposed to find it automatically?+"""]]
+ doc/install/OSX/porting/comment_34_874ff01f27911baf6ef0f559d5d5f5a0._comment view
@@ -0,0 +1,27 @@+[[!comment format=mdwn+ username="https://www.google.com/accounts/o8/id?id=AItOawn3rK4VDzxyhmrIc18z7F5OuXvEbUsgUac"+ nickname="Srinath"+ subject="build issue with brew technique on Darwin Kernel Version 13.0.0"+ date="2014-02-15T02:17:16Z"+ content="""+Following the Mac OS X brew instructions from the top of the board, I got the following error:++[5 of 5] Compiling Yesod            ( Yesod.hs, dist/build/Yesod.o )+In-place registering yesod-1.2.5...+Installing library in /Users/srinathv/.cabal/lib/yesod-1.2.5/ghc-7.6.3+Registering yesod-1.2.5...+Installed yesod-1.2.5+cabal: Error: some packages failed to install:+git-annex-5.20140210 depends on libxml-sax-0.7.4 which failed to install.+libxml-sax-0.7.4 failed during the configure step. The exception was:+ExitFailure 1+network-protocol-xmpp-0.4.5 depends on libxml-sax-0.7.4 which failed to+install.+++Then I perused the comments and did:+$brew link libmxl2 --force+$cabal install git-annex --bindir=$HOME/bin++with success.  +"""]]
+ doc/install/OSX/porting/comment_8_38d9c2eea1090674de2361274eab5b0e._comment view
@@ -0,0 +1,29 @@+[[!comment format=mdwn+ username="https://www.google.com/accounts/o8/id?id=AItOawnaYy6kTuKAHmsa4BtGls2oqa42Jo2w2v0"+ nickname="Pere"+ subject="I couldn't install it on Snow Leopard"+ date="2013-01-19T15:04:27Z"+ content="""+Bad news, it looks like I'm not able to install git-annex to my machine: When I run++    sudo cabal install c2hs git-annex --bindir=$HOME/bin++I get the following error:++    cabal: Error: some packages failed to install:+    DAV-0.3 failed during the building phase. The exception was:+    ExitFailure 11+    git-annex-3.20130114 depends on yesod-core-1.1.7.1 which failed to install.+    yesod-1.1.7.2 depends on yesod-core-1.1.7.1 which failed to install.+    yesod-auth-1.1.3 depends on yesod-core-1.1.7.1 which failed to install.+    yesod-core-1.1.7.1 failed during the building phase. The exception was:+    ExitFailure 11+    yesod-default-1.1.3 depends on yesod-core-1.1.7.1 which failed to install.+    yesod-form-1.2.0.2 depends on yesod-core-1.1.7.1 which failed to install.+    yesod-json-1.1.2 depends on yesod-core-1.1.7.1 which failed to install.+    yesod-persistent-1.1.0.1 depends on yesod-core-1.1.7.1 which failed to+    install.+    yesod-static-1.1.1.2 depends on yesod-core-1.1.7.1 which failed to install.++What does *ExitFailure 11* mean?+"""]]
+ doc/install/OSX/porting/comment_9_35bf3812db6f3ef25da9b3bc84f147c5._comment view
@@ -0,0 +1,8 @@+[[!comment format=mdwn+ username="http://joeyh.name/"+ ip="4.154.3.194"+ subject="comment 9"+ date="2013-01-19T16:02:35Z"+ content="""+sig11 is a Segmentation Fault, probably from a C library used by DAV for HTTP in this case.+"""]]
+ doc/install/verifying_downloads.mdwn view
@@ -0,0 +1,31 @@+When you download a git-annex package from downloads.kitenet.net,+as listed in [[install]], you should use a https connection. That provides+some security, but here's some more.++The downloaded package's integrity can be verified by checking that+it was signed using the right GPG key, specifically the git-annex+distribution signing key. To do this, you need to download the .sig+file accompanying your package. Just append .sig to the url. ++For example, on Linux:++	$ wget http://downloads.kitenet.net/git-annex/linux/current/git-annex-standalone-amd64.tar.gz+	$ wget http://downloads.kitenet.net/git-annex/linux/current/git-annex-standalone-amd64.tar.gz.sig++You can then download the public key, and check that the package is signed+with it.++	$ wget https://downloads.kitenet.net/git-annex/gpg-pubkey.asc+	$ gpg --import gpg-pubey.asc+	$ gpg --verify git-annex-standalone-*.tar.gz.sig++(The git-annex assistant can automatically upgrade git-annex, and when it+does, it always checks the signature like that.)++But, how do you know that the gpg-pubkey.asc you downloaded+is the right key? The answer is the GPG web of trust. ++* Joey Hess generates these git-annex packages,+  and has a GPG key, [C910D9222512E3C Joey Hess <id@joeyh.name>](http://pgp.cs.uu.nl/stats/2512E3C7.html), which has+  been verified and signed by many people.+* Joey's GPG key has signed the git-annex distribution signing key.
doc/internals.mdwn view
@@ -219,6 +219,19 @@ (including \r or \r), it will be base64 encoded. Base64 encoded values are indicated by prefixing them with "!"  +## `aaa/bbb/*.log.cnk`++These log files are used when objects are stored in chunked form on+remotes. They record the size(s) of the chunks, and the number of chunks.++For example, this logs that a remote has an object stored using both+9 chunks of 1 mb size, and 1 chunk of 10 mb size.++	1287290776.765152s e605dca6-446a-11e0-8b2a-002170d25c55:10240 9+	1287290776.765153s e605dca6-446a-11e0-8b2a-002170d25c55:102400 1++(When those chunks are removed from the remote, the 9 is changed to 0.)+ ## `schedule.log`  Used to record scheduled events, such as periodic fscks.
doc/internals/hashing.mdwn view
@@ -36,3 +36,8 @@ 0-9a-f, this instead uses the 32 characters "0123456789zqjxkmvwgpfZQJXKMVWGPF". The first 2 letters of the resulting string are the first directory, and the second 2 are the second directory.++## chunk keys++The same hash directory is used for a chunk key as would be used for the+key that it's a chunk of.
doc/internals/key_format.mdwn view
@@ -1,6 +1,6 @@ A git-annex key has this format: -	BACKEND-sNNNN-mNNNN--NAME+	BACKEND[-sNNNN][-mNNNN][-SNNNN-CNNNN]--NAME  For example: @@ -10,14 +10,20 @@   are always upper-cased. * The name field at the end has a format dependent on the backend. It is   always the last field, and is prefixed with "--". Unlike other fields,-  it may contain "-" in its content. It should not contain newline characters;-  otherwise nearly anything goes.+  it may contain "-" in its content. It should not contain newline+  characters or "/"; otherwise nearly anything goes.  * The "-s" field is optional, and is the size of the content in bytes. * The "-m" field is optional, and is the mtime of the file when it was   added to git-annex, expressed as seconds from the epoch.   This is currently only used by the WORM backend.+* The "-S" and "-C" fields are only used for keys that are chunks+  of some other key. "-S" is the size of the chunk, and "-c" is the chunk+  number (starting at 1). * Other fields could be added in the future, if needed.-* Fields may appear, in any order (though always before the name field).++git-annex always puts the fields in the order shown above when serializing+a key. It can parse keys with the fields in other orders (although the name+field must always come last).  The `git annex examinekey` command can be used to extract information from a key.
− doc/news/version_5.20140606.mdwn 
@@ -1,14 +0,0 @@-git-annex 5.20140606 released with [[!toggle text="these changes"]]-[[!toggleable text="""-   * webapp: When adding a new local repository, fix bug that caused its-     group and preferred content to be set in the current repository,-     even when not combining.-   * webapp: Avoid stomping on existing description, group and-     preferred content settings when enabling or combining with-     an already existing remote.-   * assistant: Make sanity checker tmp dir cleanup code more robust.-   * unused: Avoid checking view branches for unused files.-   * webapp: Include ssh port in mangled hostname.-   * Windows: Fix bug introduced in last release that caused files-     in the git-annex branch to have lines teminated with \r.-   * Windows: Fix retrieving of files from local bare git repositories."""]]
+ doc/news/version_5.20140817.mdwn view
@@ -0,0 +1,42 @@+git-annex 5.20140817 released with [[!toggle text="these changes"]]+[[!toggleable text="""+   * New chunk= option to chunk files stored in special remotes.+     Supported by: directory, S3, webdav, gcrypt, rsync, and all external+     and hook special remotes.+   * Partially transferred files are automatically resumed when using+     chunked remotes!+   * The old chunksize= option is deprecated. Do not use for new remotes.+   * Legacy code for directory remotes using the old chunksize= option+     will keep them working, but more slowly than before.+   * webapp: Automatically install Konqueror integration scripts+     to get and drop files.+   * repair: Removing bad objects could leave fsck finding no more+     unreachable objects, but some branches no longer accessible.+     Fix this, including support for fixing up repositories that+     were incompletely repaired before.+   * Fix cost calculation for non-encrypted remotes.+   * Display exception message when a transfer fails due to an exception.+   * WebDAV: Sped up by avoiding making multiple http connections+     when storing a file.+   * WebDAV: Avoid buffering whole file in memory when uploading and+     downloading.+   * WebDAV: Dropped support for DAV before 1.0.+   * testremote: New command to test uploads/downloads to a remote.+   * Dropping an object from a bup special remote now deletes the git branch+     for the object, although of course the object's content cannot be deleted+     due to the nature of bup.+   * unlock: Better error handling; continue past files that are not available+     or cannot be unlocked due to disk space, and try all specified files.+   * Windows: Now uses actual inode equivilants in new direct mode+     repositories, for safer detection of eg, renaming of files with the same+     size and mtime.+   * direct: Fix ugly warning messages.+   * WORM backend: When adding a file in a subdirectory, avoid including the+     subdirectory in the key name.+   * S3, Glacier, WebDAV: Fix bug that prevented accessing the creds+     when the repository was configured with encryption=shared embedcreds=yes.+   * direct: Avoid leaving file content in misctemp if interrupted.+   * git-annex-shell sendkey: Don't fail if a remote asks for a key to be sent+     that already has a transfer lock file indicating it's being sent to that+     remote. The remote may have moved between networks, or reconnected.+   * Switched from the old haskell HTTP library to http-conduit."""]]
doc/special_remotes.mdwn view
@@ -81,3 +81,21 @@ 	  (To remove unwanted data: git-annex dropunused --from mys3 NUMBER) 	$ git annex dropunused --from mys3 1 	dropunused 12948 (from mys3...) ok++## Testing special remotes++To make sure that a special remote is working correctly, you can use the+`git annex testremote` command. This expects you to have set up the remote+as usual, and it then runs a lot of tests, using random data. It's+particularly useful to test new implementations of special remotes.++By default it will upload and download files of around 1MiB to the remote+it tests; the `--size` parameter can adjust it test using smaller files.++It's safe to use this command even when you're already storing data in a+remote; it won't touch your existing files stored on the remote.++For most remotes, it also won't bloat the remote with any data, since+it cleans up the stuff it uploads. However, the bup, ddar, and tahoe+special remotes don't support removal of uploaded files, so be careful+with those.
doc/special_remotes/S3.mdwn view
@@ -18,6 +18,9 @@ * `encryption` - One of "none", "hybrid", "shared", or "pubkey".   See [[encryption]]. +* `chunk` - Enables [[chunking]] when storing large files.+  `chunk=1MiB` is a good starting point for chunking.+ * `keyid` - Specifies the gpg key to use for [[encryption]].  * `embedcreds` - Optional. Set to "yes" embed the login credentials inside
doc/special_remotes/bup.mdwn view
@@ -19,15 +19,16 @@  These parameters can be passed to `git annex initremote` to configure bup: -* `encryption` - One of "none", "hybrid", "shared", or "pubkey".-  See [[encryption]].--* `keyid` - Specifies the gpg key to use for [[encryption]].- * `buprepo` - Required. This is passed to `bup` as the `--remote`   to use to store data. To create the repository,`bup init` will be run.   Example: "buprepo=example.com:/big/mybup" or "buprepo=/big/mybup"   (To use the default `~/.bup` repository on the local host, specify "buprepo=")++* `encryption` - One of "none", "hybrid", "shared", or "pubkey".+  See [[encryption]]. Note that using encryption will prevent+  de-duplication of content stored in the buprepo.++* `keyid` - Specifies the gpg key to use for [[encryption]].  Options to pass to `bup split` when sending content to bup can also be specified, by using `git config annex.bup-split-options`. This
− doc/special_remotes/comment_21_5c11e69c28b9ed4cbe238a36c0839a47._comment 
@@ -1,15 +0,0 @@-[[!comment format=mdwn- username="http://joeyh.name/"- ip="209.250.56.64"- subject="comment 21"- date="2013-11-24T15:58:30Z"- content="""-@Bence the closest I have is some tests of particular special remotes inside Test.hs. The shell equivilant of that code is:--[[!format sh \"\"\"-set -e-git annex copy file --to remote # tests store-git annex drop file # tests checkpresent when remote has file-git annex move file --from remote # tests retrieve and remove-\"\"\"]]-"""]]
doc/special_remotes/directory.mdwn view
@@ -25,13 +25,11 @@  * `keyid` - Specifies the gpg key to use for [[encryption]]. -* `chunksize` - Avoid storing files larger than the specified size in the-  directory. For use on directories on mount points that have file size-  limitations. The default is to never chunk files.  -  The value can use specified using any commonly used units.-  Example: `chunksize=100 megabytes`  -  Note that enabling chunking on an existing remote with non-chunked-  files is not recommended.+* `chunk` - Enables [[chunking]] when storing large files.++* `chunksize` - Deprecated version of chunk parameter above.  +  Do not use for new remotes. It is not safe to change the chunksize+  setting of an existing remote.  Setup example:
doc/special_remotes/external/example.sh view
@@ -128,14 +128,25 @@ 				STORE) 					# Store the file to a location 					# based on the key.-					# XXX when possible, send PROGRESS+					# XXX when at all possible, send PROGRESS 					calclocation "$key" 					mkdir -p "$(dirname "$LOC")"-					if runcmd cp "$file" "$LOC"; then+					# Store in temp file first, so that+					# CHECKPRESENT does not see it+					# until it is all stored.+					mkdir -p "$mydirectory/tmp"+					tmp="$mydirectory/tmp/$key"+					if runcmd cp "$file" "$tmp" \+					   && runcmd mv -f "$tmp" "$LOC"; then 						echo TRANSFER-SUCCESS STORE "$key" 					else 						echo TRANSFER-FAILURE STORE "$key" 					fi++					mkdir -p "$(dirname "$LOC")"+					# The file may already exist, so+					# make sure we can overwrite it.+					chmod 644 "$LOC" 2>/dev/null || true 				;; 				RETRIEVE) 					# Retrieve from a location based on
doc/special_remotes/gcrypt.mdwn view
@@ -13,7 +13,7 @@ gcrypt:  * `encryption` - One of "none", "hybrid", "shared", or "pubkey".-  See [[encryption]].+  Required. See [[encryption]].  * `keyid` - Specifies the gpg key to use for encryption of both the files   git-annex stores in the repository, as well as to encrypt the git@@ -24,6 +24,8 @@   for gcrypt to use. This repository should be either empty, or an existing   gcrypt repositry. +* `chunk` - Enables [[chunking]] when storing large files.+ * `shellescape` - See [[rsync]] for the details of this option.  ## notes@@ -44,7 +46,7 @@ be decrypted by the added keys. Probably this can be done by setting `GCRYPT_FULL_REPACK` and doing a forced push of branches. -Recent versions of git-annex configure gcrypt-publish-participants when+Recent versions of git-annex configure `remote.<name>`gcrypt-publish-participants` when setting up a gcrypt repository. This is done to avoid unncessary gpg passphrase prompts, but it does publish the gpg keyids that can decrypt the repository. Unset it if you need to obscure that.
doc/special_remotes/hook.mdwn view
@@ -36,6 +36,8 @@  * `keyid` - Specifies the gpg key to use for [[encryption]]. +* `chunk` - Enables [[chunking]] when storing large files.+ ## hooks  Each type of hook remote is specified by a collection of hook commands.
doc/special_remotes/rsync.mdwn view
@@ -14,14 +14,14 @@  These parameters can be passed to `git annex initremote` to configure rsync: +* `rsyncurl` - Required. This is the url or `hostname:/directory` to +  pass to rsync to tell it where to store content.+ * `encryption` - One of "none", "hybrid", "shared", or "pubkey".   See [[encryption]].  * `keyid` - Specifies the gpg key to use for [[encryption]]. -* `rsyncurl` - Required. This is the url or `hostname:/directory` to -  pass to rsync to tell it where to store content.- * `shellescape` - Optional. Set to "no" to avoid shell escaping normally   done when using rsync over ssh. That escaping is needed with typical   setups, but not with some hosting providers that do not expose rsynced@@ -29,6 +29,10 @@   from the special remote fails with an error message containing a single   quote (`'`) character. If that happens, you can run enableremote   setting shellescape=no.++* `chunk` - Enables [[chunking]] when storing large files.  +  This is typically not a win for rsync, so no need to enable it.+  But, it makes this interoperate with the [[directory]] special remote.  The `annex-rsync-options` git configuration setting can be used to pass parameters to rsync.
doc/special_remotes/webdav.mdwn view
@@ -29,14 +29,12 @@   be created as needed. Use of a https URL is strongly   encouraged, since HTTP basic authentication is used. -* `chunksize` - Avoid storing files larger than the specified size in-  WebDAV. For use when the WebDAV server has file size-  limitations. The default is to never chunk files.  -  The value can use specified using any commonly used units.-  Example: `chunksize=75 megabytes`  -  Note that enabling chunking on an existing remote with non-chunked-  files is not recommended.+* `chunk` - Enables [[chunking]] when storing large files. +* `chunksize` - Deprecated version of chunk parameter above.  +  Do not use for new remotes. It is not safe to change the chunksize+  setting of an existing remote.+ Setup example: -	# WEBDAV_USERNAME=joey@kitenet.net WEBDAV_PASSWORD=xxxxxxx git annex initremote box.com type=webdav url=https://dav.box.com/dav/git-annex chunksize=75mb keyid=joey@kitenet.net+	# WEBDAV_USERNAME=joey@kitenet.net WEBDAV_PASSWORD=xxxxxxx git annex initremote box.com type=webdav url=https://dav.box.com/dav/git-annex chunk=10mb keyid=joey@kitenet.net
doc/thanks.mdwn view
@@ -71,7 +71,7 @@ Berthomier, Chad Horohoe, Lois DeFiore, Lieven Baes, Patrick Wheeler, James Kim, Carlos Trijueque Albarran, Ritesh Nadhani, chesty, Andre Pereira, Eskild Hustvedt, David Wagner, Maximiliano Curia, András Széll, Allan-Holman, Thomas Langewouters, Anonymous, Yannick Leyendecker, Peter+Holman, Thomas Langewouters, Anonymous, Peter Daengeli, Josh Taylor, Abhishek Dasgupta, Maarten Aertsen, Mark Sheppard, Daengeli, Josh Taylor, Abhishek Dasgupta, Maarten Aertsen, Mark Sheppard, Markus Engström, Samuel Tardieu, Geog Wechslberger, Abdó Roig, Dmitry Markushevich, Sergio Rubio, Jim Paris, Vivek Gani, Brock Spratlen, Nathan
+ doc/tips/Bup_repositories_in_git-annex.mdwn view
@@ -0,0 +1,51 @@+I'd like to share my setup for keeping [bup](https://github.com/bup/bup/) repositories in git-annex.¹+I'm not sure if this is a *good* tip, so comments are welcome.++The purpose of this setup is to (kind of) bring encryption to bup,+and make it easy to keep bup backups in untrusted storage by making use of the encryption modes and backends provided by git-annex.+This approach can be used to make encrypted *backups of bup repositories*;+it can not replace encrypted filesystems such as EncFS or S3QL+which wouldn't necessarily require local bup repositories but also can't be combined with storage like Amazon Glacier.++To add a bup repository to git-annex, initialize a regular indirect git-annex repository,+and make the bup repository a subdirectory of it.²+Then `git annex add $BUP_REPO/objects/packs`, i.e. the location of the large data files (.pack & .par2).+The rest of the bup repository should be tracked by Git (`git add $BUP_REPO`).³+This way the repository stays fully functional.++After a bup-save the following steps will synchronize all remotes:⁴++    git annex add $BUP_REPO/objects/pack+    git add $BUP_REPO+    git commit -m "Backup on $(date)"+	git annex sync --content++In my current setup, the git-annex repositories are located on a local file server.+Various clients use bup to create backups on the server.+This server also makes backups of other servers.+Afterwards, it uploads the annexed data to Glacier+(via an [encrypted S3 special remote](/special_remotes/S3/)),+and pushes the small Git repositories to an S3QL filesystem and another off-site server.+Using these repositories (and my GPG key) the bup repositories could be recovered.++It may be important to note that in order to be able to *access* a bup repository,+*all* files have to be available locally.+Bup will not function if any pack files are missing (maybe this can be improved?).++-----++¹) Not to be confused with git-annex's [bup special remote](/special_remotes/bup/).++²) You can't initialize git-annex repositories directly inside bup repositories+because git-annex will (rightfully) identify them as bare git repositories and set itself up accordingly.++³) I've come up with these .gitignore rules to exclude potentially large files not needed for recovery:++    /bup_repo/bupindex*+    /bup_repo/objects/pack/bup.bloom+    /bup_repo/objects/pack/midx*midx+    /bup_repo/objects/tmp*.pack+    /bup_repo/index-cache/++⁴) `git annex sync` might not be the safest command to use because it would merge changes from the remotes.+However, assuming normal bup usage, external changes to the bup repository are not to be expected.
+ doc/tips/dumb_metadata_extraction_from_xbmc.mdwn view
@@ -0,0 +1,29 @@+I wanted to get the list of movies I haven't seen yet in XBMC, and i'm lazy. So I'll use [[metadata]] to be able to extract those movies only, for the road for example.++First I fiddled around with shell scripts to extract the list of those films, which in XBMC-speak means that have a `NULL playCount`. Since there are two ways that XMBC can represent those files (in a `stack://` if there is multiple files for the movie or not), there are two scripts. For "stacked" movies:++    echo 'SELECT files.strFileName FROM movie JOIN files ON files.idFile=movie.idFile JOIN path ON path.idPath=files.idPath WHERE playCount IS NULL AND files.strFileName LIKE "stack://%";' | sqlite3 /home/video/.xbmc/userdata/Database/MyVideos75.db | sed "s#stack://##;s/, /\n/g" | sed "s#/home/media/video/##"++And the rest:++    echo 'SELECT path.strPath || files.strFileName FROM movie JOIN files ON files.idFile=movie.idFile JOIN path ON path.idPath=files.idPath WHERE playCount IS NULL AND files.strFileName NOT LIKE "stack://%";' | sqlite3 /home/video/.xbmc/userdata/Database/MyVideos75.db | sed "s#/home/media/video/##"++Also notice how I remove the absolute prefix for the annex so that i can refer to files as a relative path.++So this quick and dirty hack could have been used to mark files as "new". Unfortunately, this won't unmark them when the playcount increases. So instead I think this should be a field, and we need to extract the playcount. Play around with shell scripting enough to get sick, get back into bad perl habits and you'll end up with this nasty script: [[git-annex-xbmc-playcount.pl]].++After the script is ran, you can sort the files by play count with:++    git annex view "playCount=*"++Or just show the files that haven't been played yet:++    git annex view playCount=0++Use `git checkout master` to reset the view. Note that the above will flatten the tree hierarchy, which you may not way. Try this in that case:++    git annex view playCount=0 films/=*++For more information, see [[tips/metadata_driven_views/]].++-- [[anarcat]]
+ doc/tips/dumb_metadata_extraction_from_xbmc/git-annex-xbmc-playcount.pl view
@@ -0,0 +1,28 @@+#! /usr/bin/perl -w++my $dbpath="/home/video/.xbmc/userdata/Database/MyVideos75.db";+my $prefix="/home/media/video/";++my @lines = `echo 'SELECT playCount, path.strPath, files.strFileName FROM movie JOIN files ON files.idFile=movie.idFile JOIN path ON path.idPath=files.idPath;' | sqlite3 $dbpath`;+for (@lines) {+    my ($count, $dir, $file) = split /\|/;+    chomp $file;+    # empty or non-numeric count is zero+    if ($count !~ /[0-9]/) {+        $count = 0;+    }+    $dir =~ s/$prefix//;+    if ($file =~ s#stack://##) {+        for (split /,/, $file) {+            s/$prefix//;+            s/^ //;+            s/ $//;+            my @cmd = (qw(git annex metadata --set), "playCount=$count", $_);+            system(@cmd);+        }+    }+    else {+        my @cmd = (qw(git annex metadata --set), "playCount=$count", "$dir$file");+        system(@cmd);+    }+}
doc/tips/file_manager_integration.mdwn view
@@ -5,39 +5,23 @@  ## GNOME (nautilus) -Recent git-annex comes with built-in nautilus integration. Just pick the-action from the menu.+Recent git-annex comes with built-in integration for Nautilus.  [[!img assistant/nautilusmenu.png]]  [[!img assistant/downloadnotification.png]] -This is set up by making simple scripts in+This is set up by git-annex creating simple scripts in `~/.local/share/nautilus/scripts`, with names like "git-annex get"  ## KDE (Dolphin/Konqueror) -Create a file `~/.kde4/share/kde4/services/ServiceMenus/git-annex.desktop` with the following contents:--        [Desktop Entry]-        Type=Service-        ServiceTypes=all/allfiles-        MimeType=all/all;-        Actions=GitAnnexGet;GitAnnexDrop;-        X-KDE-Priority=TopLevel-        X-KDE-Submenu=Git-Annex-        X-KDE-Icon=git-annex-        X-KDE-ServiceTypes=KonqPopupMenu/Plugin+Even more recent git-annex comes with built-in integration with Konqueror. -        [Desktop Action GitAnnexGet]-        Name=Get-        Icon=git-annex-        Exec=git-annex get --notify-start --notify-finish -- %U+[[!img assistant/konquerormenu.png]] -        [Desktop Action GitAnnexDrop]-        Name=Drop-        Icon=git-annex-        Exec=git-annex drop --notify-start --notify-finish -- %U+This is set up by git-annex creating a +`~/.kde/share/kde4/services/ServiceMenus/git-annex.desktop file.  ## XFCE (Thunar)
+ doc/tips/flickrannex/comment_15_2dd75800e4db58761fcbbd1954a36f1f._comment view
@@ -0,0 +1,11 @@+[[!comment format=mdwn+ username="https://www.google.com/accounts/o8/id?id=AItOawmvzzyDA8uXFz8yokeCrepbh8PwWe_WrjE"+ nickname="Michael"+ subject="current status?"+ date="2014-08-08T16:00:18Z"+ content="""+Hi, just wondering what the current status of this plugin is.+The repo at TobiasTheViking looks a little odd - it has a few large commits from January with an unknown author, and the last one appears to completely remove the main script.++What's going on? does it need a fork?+"""]]
+ doc/tips/flickrannex/comment_16_2f65093ec9f6d67d2cfe5b5fae201123._comment view
@@ -0,0 +1,10 @@+[[!comment format=mdwn+ username="https://www.google.com/accounts/o8/id?id=AItOawmvzzyDA8uXFz8yokeCrepbh8PwWe_WrjE"+ nickname="Michael"+ subject="a more recent fork"+ date="2014-08-08T16:03:24Z"+ content="""+Just a note that I poked around on github and saw a more recent cleaned up version in this fork: https://github.com/magthe/flickrannex/tree/devo+++"""]]
+ doc/tips/megaannex/comment_1_eec701662debd2a78c48243dbcebf59a._comment view
@@ -0,0 +1,8 @@+[[!comment format=mdwn+ username="http://joeyh.name/"+ ip="108.236.230.124"+ subject="comment 1"+ date="2014-07-21T19:56:13Z"+ content="""+Note that there has apparently been an API break, so this special remote may not work anymore. See: <http://git-annex.branchable.com/forum/MegaAnnex_not_working./>+"""]]
doc/tips/metadata_driven_views.mdwn view
@@ -6,7 +6,7 @@  One nice way to use the metadata is through **views**. You can ask git-annex to create a view of files in the currently checked out branch-that have certian metadata. Once you're in a view, you can move and copy+that have certain metadata. Once you're in a view, you can move and copy files to adjust their metadata further. Rather than the traditional hierarchical directory structure, views are dynamic; you can easily refine or reorder a view.
doc/tips/using_Amazon_S3.mdwn view
@@ -14,7 +14,7 @@  Next, create the S3 remote, and describe it.  -	# git annex initremote cloud type=S3 keyid=2512E3C7+	# git annex initremote cloud type=S3 chunk=1MiB keyid=2512E3C7 	initremote cloud (encryption setup with gpg key C910D9222512E3C7) (checking bucket) (creating bucket in US) (gpg) ok 	# git annex describe cloud "at Amazon's US datacenter" 	describe cloud ok
doc/tips/using_box.com_as_a_special_remote.mdwn view
@@ -5,9 +5,9 @@ git-annex can use Box as a [[special remote|special_remotes]]. Recent versions of git-annex make this very easy to set up: -	WEBDAV_USERNAME=you@example.com WEBDAV_PASSWORD=xxxxxxx git annex initremote box.com type=webdav url=https://dav.box.com/dav/git-annex chunksize=75mb encryption=shared+	WEBDAV_USERNAME=you@example.com WEBDAV_PASSWORD=xxxxxxx git annex initremote box.com type=webdav url=https://dav.box.com/dav/git-annex chunk=50mb encryption=shared -Note the use of chunksize; Box has a 100 mb maximum file size, and this+Note the use of [[chunking]]; Box has a 100 mb maximum file size, and this breaks up large files into chunks before that limit is reached.  # old davfs2 method@@ -58,7 +58,7 @@ ** This example is non-encrypted; fill in your gpg key ID for a securely encrypted special remote! ** -	git annex initremote box.com type=directory directory=/media/box.com chunksize=2mb encryption=none+	git annex initremote box.com type=directory directory=/media/box.com chunk=2mb encryption=none  Now git-annex can copy files to box.com, get files from it, etc, just like with any other special remote.
+ doc/todo/Deduplicate_archive___40__i.e._zip__41___files.mdwn view
@@ -0,0 +1,9 @@+I've just come across this issue and I'm not sure if git-annex is the right place to put it, but in case it is easy enough to do.. may as well ask!++In this scenario, an online service (Bandcamp), automatically creates the archive file when downloading an album each and every time you download it. This results in identical files inside a zip, but different hashes due to the slightly different timestamps on the archive itself.++Would it be possible for git-annex to be able to detect this scenario (in a manner similar to zipcmp) and redirect an add/import to the already existing copy?++I've found this due to trying to decommission an old annex by `git annex import --clean-duplicates ~/annex_old/.git/annex/objects` and finding these files being left.++[[done]] --[[Joey]]
+ doc/todo/Speed_up___39__import_--clean-duplicates__39__.mdwn view
@@ -0,0 +1,7 @@+I'm currently in the process of gutting old (some broken) git-annex's and cleaning out download directories from before I started using git-annex.++To do this, I am running `git annex import --clean--duplicates $PATH` on the directories I want to clear out but sometimes, this takes a unnecessarily long time.++For example, git-annex will calculate the digest for a huge file (30GB+) in $TARGET, even though there are no files in the annex of that size.++It's a common shortcut to check for duplicate sizes first to eliminate definite non-matches really quickly. Can this be added to git-annex's `import` in some way or is this a no-go due to the constant memory constraint?
doc/walkthrough/renaming_files.mdwn view
@@ -11,3 +11,8 @@ the symlink will break when the file is moved into a subdirectory. But, git-annex will fix this up for you when you commit -- it has a pre-commit hook that watches for and corrects broken symlinks.++(Note that if a repository is in direct mode, you can't run normal git+commands in it. Instead, just move the files using non-git commands, and+`git annex add` and `git annex sync`. This walkthrough does not make a+direct mode repository.)
git-annex.1 view
@@ -874,16 +874,39 @@ Merge conflicts between two files that are not annexed will not be automatically resolved. .IP+.IP "\fBremotedaemon\fP"+Detects when network remotes have received git pushes and fetches from them.+.IP+.IP "\fBxmppgit\fP"+This command is used internally to perform git pulls over XMPP.+.IP+.SH TESTING COMMANDS .IP "\fBtest\fP"+.IP This runs git\-annex's built\-in test suite. .IP There are several parameters, provided by Haskell's tasty test framework.+Pass \-\-help for details. .IP-.IP "\fBremotedaemon\fP"-Detects when network remotes have received git pushes and fetches from them.+.IP "\fBtestremote remote\fP"+This tests a remote by generating some random objects and sending them to+the remote, then redownloading them, removing them from the remote, etc. .IP-.IP "\fBxmppgit\fP"-This command is used internally to perform git pulls over XMPP.+It's safe to run in an existing repository (the repository contents are+not altered), although it may perform expensive data transfers.+.IP+To perform a smaller set of tests, use \-\-fast.+.IP+The \-\-size option can be used to tune the size of the generated objects.+.IP+Testing a single remote will use the remote's configuration,+automatically varying the chunk sizes, and with simple shared encryption+enabled and disabled.+.IP+.IP "\fBfuzztest\fP"+Generates random changes to files in the current repository,+for use in testing the assistant. This is dangerous, so it will not+do anything unless \-\-forced. .IP .SH OPTIONS .IP "\fB\-\-force\fP"
git-annex.cabal view
@@ -1,5 +1,5 @@ Name: git-annex-Version: 5.20140717+Version: 5.20140817 Cabal-Version: >= 1.8 License: GPL-3 Maintainer: Joey Hess <joey@kitenet.net>@@ -96,12 +96,11 @@   Main-Is: git-annex.hs   Build-Depends: MissingH, hslogger, directory, filepath,    containers, utf8-string, network (>= 2.0), mtl (>= 2),-   bytestring, old-locale, time, HTTP,-   extensible-exceptions, dataenc, SHA, process, json,-   base (>= 4.5 && < 4.9), monad-control, exceptions (>= 0.5),+   bytestring, old-locale, time, dataenc, SHA, process, json,+   base (>= 4.5 && < 4.9), monad-control, exceptions (>= 0.5), transformers,    IfElse, text, QuickCheck >= 2.1, bloomfilter, edit-distance, process,    SafeSemaphore, uuid, random, dlist, unix-compat, async, stm (>= 2.3),-   data-default, case-insensitive+   data-default, case-insensitive, http-conduit, http-types   CC-Options: -Wall   GHC-Options: -Wall   Extensions: PackageImports@@ -112,7 +111,7 @@     GHC-Options: -O2    if (os(windows))-    Build-Depends: Win32, Win32-extras+    Build-Depends: Win32, Win32-extras, unix-compat (>= 0.4.1.3)     C-Sources: Utility/winprocess.c   else     Build-Depends: unix@@ -124,7 +123,7 @@    if flag(TestSuite)     Build-Depends: tasty (>= 0.7), tasty-hunit, tasty-quickcheck, tasty-rerun,-     optparse-applicative+     optparse-applicative, crypto-api     CPP-Options: -DWITH_TESTSUITE    if flag(TDFA)@@ -142,8 +141,7 @@     CPP-Options: -DWITH_S3    if flag(WebDAV)-    Build-Depends: DAV ((>= 0.3 && < 0.6) || > 0.6),-     http-client, http-conduit, http-types, lifted-base+    Build-Depends: DAV (>= 1.0), http-client     CPP-Options: -DWITH_WEBDAV    if flag(Assistant) && ! os(solaris)@@ -189,7 +187,7 @@   if flag(Webapp)     Build-Depends:      yesod, yesod-default, yesod-static, yesod-form, yesod-core,-     http-types, transformers, wai, wai-extra, warp, warp-tls,+     wai, wai-extra, warp, warp-tls,      blaze-builder, crypto-api, hamlet, clientsession,      template-haskell, data-default, aeson, path-pieces,      shakespeare
standalone/android/Makefile view
@@ -116,7 +116,7 @@ 	 $(GIT_ANNEX_ANDROID_SOURCETREE)/git/build-stamp: git.patch 	cat git.patch | (cd $(GIT_ANNEX_ANDROID_SOURCETREE)/git && git am)-	cd $(GIT_ANNEX_ANDROID_SOURCETREE)/git && $(MAKE) install NO_OPENSSL=1 NO_GETTEXT=1 NO_GECOS_IN_PWENT=1 NO_GETPASS=1 NO_NSEC=1 NO_MKDTEMP=1 NO_PTHREADS=1 NO_PERL=1 NO_CURL=1 NO_EXPAT=1 NO_TCLTK=1 NO_ICONV=1 prefix= DESTDIR=installed-tree+	cd $(GIT_ANNEX_ANDROID_SOURCETREE)/git && $(MAKE) install NO_OPENSSL=1 NO_GETTEXT=1 NO_GECOS_IN_PWENT=1 NO_GETPASS=1 NO_NSEC=1 NO_MKDTEMP=1 NO_PTHREADS=1 NO_PERL=1 NO_CURL=1 NO_EXPAT=1 NO_TCLTK=1 NO_ICONV=1 HAVE_CLOCK_GETTIME= prefix= DESTDIR=installed-tree 	touch $@  $(GIT_ANNEX_ANDROID_SOURCETREE)/rsync/build-stamp: rsync.patch
standalone/android/git.patch view
@@ -1,54 +1,47 @@-From ec690f617cab405ec2c6420bde53e9d9ed984e5c Mon Sep 17 00:00:00 2001+From 6134cc328f513e32895462e884487513b28029ba Mon Sep 17 00:00:00 2001 From: Joey Hess <joey@kitenet.net>-Date: Thu, 3 Jul 2014 15:55:17 -0400-Subject: [PATCH] Revert "config: preserve config file permissions on edits"--This reverts commit daa22c6f8da466bd7a438f1bc27375fd737ffcf3.+Date: Wed, 13 Aug 2014 13:50:56 -0400+Subject: [PATCH] avoid using of chmod on android when changing config  This breaks on Android's /sdcard, which has a variety of FUSE implentations, all total shite.+---+ config.c | 4 +++++ 1 file changed, 4 insertions(+)  diff --git a/config.c b/config.c-index a1aef1c..7f3303d 100644+index 058505c..16854b2 100644 --- a/config.c +++ b/config.c-@@ -1637,13 +1637,6 @@ int git_config_set_multivar_in_file(const char *config_filename,+@@ -1634,12 +1634,14 @@ int git_config_set_multivar_in_file(const char *config_filename,  			MAP_PRIVATE, in_fd, 0);  		close(in_fd);  --		if (fchmod(fd, st.st_mode & 07777) < 0) {--			error("fchmod on %s failed: %s",--				lock->filename, strerror(errno));--			ret = CONFIG_NO_WRITE;--			goto out_free;--		}--++		/* not on android+ 		if (chmod(lock->filename, st.st_mode & 07777) < 0) {+ 			error("chmod on %s failed: %s",+ 				lock->filename, strerror(errno));+ 			ret = CONFIG_NO_WRITE;+ 			goto out_free;+ 		}++		*/+   		if (store.seen == 0)  			store.seen = 1;+@@ -1813,11 +1815,13 @@ int git_config_rename_section_in_file(const char *config_filename,  -@@ -1792,7 +1785,6 @@ int git_config_rename_section_in_file(const char *config_filename,- 	int out_fd;- 	char buf[1024];- 	FILE *config_file;--	struct stat st;+ 	fstat(fileno(config_file), &st);  - 	if (new_name && !section_name_is_ok(new_name)) {- 		ret = error("invalid section name: %s", new_name);-@@ -1814,14 +1806,6 @@ int git_config_rename_section_in_file(const char *config_filename,- 		goto unlock_and_out;++	/* not on android+ 	if (chmod(lock->filename, st.st_mode & 07777) < 0) {+ 		ret = error("chmod on %s failed: %s",+ 				lock->filename, strerror(errno));+ 		goto out;  	}++	*/  --	fstat(fileno(config_file), &st);----	if (fchmod(out_fd, st.st_mode & 07777) < 0) {--		ret = error("fchmod on %s failed: %s",--				lock->filename, strerror(errno));--		goto out;--	}--  	while (fgets(buf, sizeof(buf), config_file)) {  		int i;- 		int length; -- -2.0.1+2.1.0.rc1
standalone/android/install-haskell-packages view
@@ -4,7 +4,7 @@ # # You should install ghc-android first. #-# Note that the newest version of packages is installed. +# Note that the newest version of packages are installed.  # It attempts to reuse patches for older versions, but  # new versions of packages often break cross-compilation by adding TH,  # etc
standalone/linux/install-haskell-packages view
@@ -3,7 +3,7 @@ # to all the necessary haskell packages being installed, with the # necessary patches to work on architectures that lack template haskell. #-# Note that the newest version of packages is installed. +# Note that the newest version of packages are installed.  # It attempts to reuse patches for older versions, but  # new versions of packages often break cross-compilation by adding TH,  # etc@@ -20,14 +20,15 @@ cabalopts="$@"  cabalinstall () {-	echo cabal install "$@" "$cabalopts"-	eval cabal install "$@" "$cabalopts"+	echo cabal install -j1 "$@" "$cabalopts"+	eval cabal install -j1 "$@" "$cabalopts" }  patched () { 	pkg=$1 	shift 1-	cabal unpack $pkg+	cabal unpack $pkg$1+	shift 1 	cd $pkg* 	git init 	git config user.name dummy@@ -74,7 +75,11 @@ 	patched yesod-core 	patched persistent 	patched persistent-template-	patched file-embed+	# Newer versions of file-embed cause ghc -ddump-splices+	# to output invalid character codes.+	# Note that the system generating the splices should also+	# use this version of file-embed.+	patched file-embed -0.0.6 	patched process-conduit 	patched yesod-static 	patched yesod-persistent
standalone/no-th/haskell-patches/DAV_build-without-TH.patch view
@@ -10,61 +10,60 @@  3 files changed, 307 insertions(+), 45 deletions(-)  diff --git a/DAV.cabal b/DAV.cabal-index bf54f44..04f375a 100644+index 5d50e39..f2abf89 100644 --- a/DAV.cabal +++ b/DAV.cabal-@@ -42,29 +42,7 @@ library-                      , transformers-base+@@ -43,30 +43,7 @@ library+                      , utf8-string                       , xml-conduit >= 1.0          && < 1.3-                      , xml-hamlet >= 0.4           && <= 0.5+                      , xml-hamlet >= 0.4           && < 0.5 -executable hdav -  main-is:           hdav.hs -  ghc-options:       -Wall--  build-depends:       base >= 4.5                 && <= 5+-  build-depends:       base >= 4.5                 && < 5 -                     , bytestring -                     , bytestring -                     , case-insensitive >= 0.4 -                     , containers+-                     , data-default -                     , either >= 4.1 -                     , errors+-                     , exceptions -                     , http-client >= 0.2 -                     , http-client-tls >= 0.2 -                     , http-types >= 0.7 -                     , lens >= 3.0--                     , lifted-base >= 0.1--                     , monad-control >= 0.3.2 -                     , mtl >= 2.1 -                     , network >= 2.3 -                     , optparse-applicative >= 0.5.0 -                     , transformers >= 0.3 -                     , transformers-base+-                     , utf8-string -                     , xml-conduit >= 1.0          && < 1.3--                     , xml-hamlet >= 0.4           && <= 0.5+-                     , xml-hamlet >= 0.4           && < 0.5 +                     , text    source-repository head    type:     git diff --git a/Network/Protocol/HTTP/DAV.hs b/Network/Protocol/HTTP/DAV.hs-index 94d21bc..c48618f 100644+index 4c6d68f..55979b6 100644 --- a/Network/Protocol/HTTP/DAV.hs +++ b/Network/Protocol/HTTP/DAV.hs-@@ -78,7 +78,7 @@ import Network.HTTP.Types (hContentType, Method, Status, RequestHeaders, unautho- +@@ -82,6 +82,7 @@ import Network.HTTP.Types (hContentType, Method, Status, RequestHeaders, unautho  import qualified Text.XML as XML  import Text.XML.Cursor (($/), (&/), element, node, fromDocument, checkName)--import Text.Hamlet.XML (xml)+ import Text.Hamlet.XML (xml) +import qualified Data.Text    import Data.CaseInsensitive (mk)  -@@ -336,28 +336,84 @@ makeCollection url username password = choke $ evalDAVT url $ do+@@ -330,31 +331,88 @@ withLockIfPossibleForDelete nocreate f = do  propname :: XML.Document  propname = XML.Document (XML.Prologue [] Nothing []) root []      where -        root = XML.Element "D:propfind" (Map.fromList [("xmlns:D", "DAV:")]) [xml| -<D:allprop> -|]-- +        root = XML.Element "D:propfind" (Map.fromList [("xmlns:D", "DAV:")])  $         concat +          [[XML.NodeElement +              (XML.Element@@ -72,9 +71,11 @@ +                    (Data.Text.pack "D:allprop") Nothing Nothing) +                 Map.empty +                 (concat []))]]+++   locky :: XML.Document  locky = XML.Document (XML.Prologue [] Nothing []) root []--    where+     where -        root = XML.Element "D:lockinfo" (Map.fromList [("xmlns:D", "DAV:")]) [xml| -<D:lockscope> -  <D:exclusive>@@ -82,38 +83,37 @@ -  <D:write> -<D:owner>Haskell DAV user -|]-+ where-+  root = XML.Element "D:lockinfo" (Map.fromList [("xmlns:D", "DAV:")])  $ concat-+   [[XML.NodeElement-+       (XML.Element-+          (XML.Name-+             (Data.Text.pack "D:lockscope") Nothing Nothing)-+          Map.empty-+          (concat-+             [[XML.NodeElement-+                 (XML.Element-+                    (XML.Name-+                       (Data.Text.pack "D:exclusive") Nothing Nothing)-+                    Map.empty-+                    (concat []))]]))],-+    [XML.NodeElement-+       (XML.Element-+          (XML.Name-+             (Data.Text.pack "D:locktype") Nothing Nothing)-+          Map.empty-+          (concat-+             [[XML.NodeElement-+                 (XML.Element-+                    (XML.Name (Data.Text.pack "D:write") Nothing Nothing)-+                    Map.empty-+                    (concat []))]]))],-+    [XML.NodeElement-+       (XML.Element-+          (XML.Name (Data.Text.pack "D:owner") Nothing Nothing)-+          Map.empty-+          (concat-+             [[XML.NodeContent-+                 (Data.Text.pack "Haskell DAV user")]]))]]++        root = XML.Element "D:lockinfo" (Map.fromList [("xmlns:D", "DAV:")])  $         concat++          [[XML.NodeElement++              (XML.Element++                 (XML.Name++                    (Data.Text.pack "D:lockscope") Nothing Nothing)++                 Map.empty++                 (concat++                    [[XML.NodeElement++                        (XML.Element++                           (XML.Name++                              (Data.Text.pack "D:exclusive") Nothing Nothing)++                           Map.empty++                           (concat []))]]))],++           [XML.NodeElement++              (XML.Element++                 (XML.Name++                    (Data.Text.pack "D:locktype") Nothing Nothing)++                 Map.empty++                 (concat++                    [[XML.NodeElement++                        (XML.Element++                           (XML.Name (Data.Text.pack "D:write") Nothing Nothing)++                           Map.empty++                           (concat []))]]))],++           [XML.NodeElement++              (XML.Element++                 (XML.Name (Data.Text.pack "D:owner") Nothing Nothing)++                 Map.empty++                 (concat++                    [[XML.NodeContent++                        (Data.Text.pack "Haskell DAV user")]]))]] +    calendarquery :: XML.Document@@ -146,8 +146,7 @@ +                           (concat []))]]))], +           [XML.NodeElement +              (XML.Element-+                 (XML.Name-+                    (Data.Text.pack "C:filter") Nothing Nothing)++                 (XML.Name (Data.Text.pack "C:filter") Nothing Nothing) +                 Map.empty +                 (concat +                    [[XML.NodeElement@@ -161,8 +160,11 @@ +                              Map.empty) +                           (concat []))]]))]] ++ + -- | Normally, DAVT actions act on the url that is provided to eg, evalDAVT.+ -- Sometimes, it's useful to adjust the url that is acted on, while diff --git a/Network/Protocol/HTTP/DAV/TH.hs b/Network/Protocol/HTTP/DAV/TH.hs-index b072116..5a01bf9 100644+index 0ecd476..1653bf6 100644 --- a/Network/Protocol/HTTP/DAV/TH.hs +++ b/Network/Protocol/HTTP/DAV/TH.hs @@ -20,9 +20,11 @@@@ -173,8 +175,8 @@ +import Control.Lens  import qualified Data.ByteString as B  import Network.HTTP.Client (Manager, Request)-+import qualified Control.Lens.Type +import qualified Data.Functor++import qualified Control.Lens.Type    data Depth = Depth0 | Depth1 | DepthInfinity  instance Read Depth where@@ -185,231 +187,228 @@ -makeLenses ''DAVContext +allowedMethods :: Control.Lens.Type.Lens' DAVContext [B.ByteString] +allowedMethods-+  _f_a2PF-+  (DAVContext __allowedMethods'_a2PG-+              __baseRequest_a2PI-+              __basicusername_a2PJ-+              __basicpassword_a2PK-+              __complianceClasses_a2PL-+              __depth_a2PM-+              __httpManager_a2PN-+              __lockToken_a2PO-+              __userAgent_a2PP)-+  = ((\ __allowedMethods_a2PH++  _f_a3iH++  (DAVContext __allowedMethods'_a3iI++              __baseRequest_a3iK++              __basicusername_a3iL++              __basicpassword_a3iM++              __complianceClasses_a3iN++              __depth_a3iO++              __httpManager_a3iP++              __lockToken_a3iQ++              __userAgent_a3iR)++  = ((\ __allowedMethods_a3iJ +        -> DAVContext-+             __allowedMethods_a2PH-+             __baseRequest_a2PI-+             __basicusername_a2PJ-+             __basicpassword_a2PK-+             __complianceClasses_a2PL-+             __depth_a2PM-+             __httpManager_a2PN-+             __lockToken_a2PO-+             __userAgent_a2PP)-+     Data.Functor.<$> (_f_a2PF __allowedMethods'_a2PG))++             __allowedMethods_a3iJ++             __baseRequest_a3iK++             __basicusername_a3iL++             __basicpassword_a3iM++             __complianceClasses_a3iN++             __depth_a3iO++             __httpManager_a3iP++             __lockToken_a3iQ++             __userAgent_a3iR)++     Data.Functor.<$> (_f_a3iH __allowedMethods'_a3iI)) +{-# INLINE allowedMethods #-} +baseRequest :: Control.Lens.Type.Lens' DAVContext Request +baseRequest-+  _f_a2PQ-+  (DAVContext __allowedMethods_a2PR-+              __baseRequest'_a2PS-+              __basicusername_a2PU-+              __basicpassword_a2PV-+              __complianceClasses_a2PW-+              __depth_a2PX-+              __httpManager_a2PY-+              __lockToken_a2PZ-+              __userAgent_a2Q0)-+  = ((\ __baseRequest_a2PT++  _f_a3iS++  (DAVContext __allowedMethods_a3iT++              __baseRequest'_a3iU++              __basicusername_a3iW++              __basicpassword_a3iX++              __complianceClasses_a3iY++              __depth_a3iZ++              __httpManager_a3j0++              __lockToken_a3j1++              __userAgent_a3j2)++  = ((\ __baseRequest_a3iV +        -> DAVContext-+             __allowedMethods_a2PR-+             __baseRequest_a2PT-+             __basicusername_a2PU-+             __basicpassword_a2PV-+             __complianceClasses_a2PW-+             __depth_a2PX-+             __httpManager_a2PY-+             __lockToken_a2PZ-+             __userAgent_a2Q0)-+     Data.Functor.<$> (_f_a2PQ __baseRequest'_a2PS))++             __allowedMethods_a3iT++             __baseRequest_a3iV++             __basicusername_a3iW++             __basicpassword_a3iX++             __complianceClasses_a3iY++             __depth_a3iZ++             __httpManager_a3j0++             __lockToken_a3j1++             __userAgent_a3j2)++     Data.Functor.<$> (_f_a3iS __baseRequest'_a3iU)) +{-# INLINE baseRequest #-} +basicpassword :: Control.Lens.Type.Lens' DAVContext B.ByteString +basicpassword-+  _f_a2Q1-+  (DAVContext __allowedMethods_a2Q2-+              __baseRequest_a2Q3-+              __basicusername_a2Q4-+              __basicpassword'_a2Q5-+              __complianceClasses_a2Q7-+              __depth_a2Q8-+              __httpManager_a2Q9-+              __lockToken_a2Qa-+              __userAgent_a2Qb)-+  = ((\ __basicpassword_a2Q6++  _f_a3j3++  (DAVContext __allowedMethods_a3j4++              __baseRequest_a3j5++              __basicusername_a3j6++              __basicpassword'_a3j7++              __complianceClasses_a3j9++              __depth_a3ja++              __httpManager_a3jb++              __lockToken_a3jc++              __userAgent_a3jd)++  = ((\ __basicpassword_a3j8 +        -> DAVContext-+             __allowedMethods_a2Q2-+             __baseRequest_a2Q3-+             __basicusername_a2Q4-+             __basicpassword_a2Q6-+             __complianceClasses_a2Q7-+             __depth_a2Q8-+             __httpManager_a2Q9-+             __lockToken_a2Qa-+             __userAgent_a2Qb)-+     Data.Functor.<$> (_f_a2Q1 __basicpassword'_a2Q5))++             __allowedMethods_a3j4++             __baseRequest_a3j5++             __basicusername_a3j6++             __basicpassword_a3j8++             __complianceClasses_a3j9++             __depth_a3ja++             __httpManager_a3jb++             __lockToken_a3jc++             __userAgent_a3jd)++     Data.Functor.<$> (_f_a3j3 __basicpassword'_a3j7)) +{-# INLINE basicpassword #-} +basicusername :: Control.Lens.Type.Lens' DAVContext B.ByteString +basicusername-+  _f_a2Qc-+  (DAVContext __allowedMethods_a2Qd-+              __baseRequest_a2Qe-+              __basicusername'_a2Qf-+              __basicpassword_a2Qh-+              __complianceClasses_a2Qi-+              __depth_a2Qj-+              __httpManager_a2Qk-+              __lockToken_a2Ql-+              __userAgent_a2Qm)-+  = ((\ __basicusername_a2Qg++  _f_a3je++  (DAVContext __allowedMethods_a3jf++              __baseRequest_a3jg++              __basicusername'_a3jh++              __basicpassword_a3jj++              __complianceClasses_a3jk++              __depth_a3jl++              __httpManager_a3jm++              __lockToken_a3jn++              __userAgent_a3jo)++  = ((\ __basicusername_a3ji +        -> DAVContext-+             __allowedMethods_a2Qd-+             __baseRequest_a2Qe-+             __basicusername_a2Qg-+             __basicpassword_a2Qh-+             __complianceClasses_a2Qi-+             __depth_a2Qj-+             __httpManager_a2Qk-+             __lockToken_a2Ql-+             __userAgent_a2Qm)-+     Data.Functor.<$> (_f_a2Qc __basicusername'_a2Qf))++             __allowedMethods_a3jf++             __baseRequest_a3jg++             __basicusername_a3ji++             __basicpassword_a3jj++             __complianceClasses_a3jk++             __depth_a3jl++             __httpManager_a3jm++             __lockToken_a3jn++             __userAgent_a3jo)++     Data.Functor.<$> (_f_a3je __basicusername'_a3jh)) +{-# INLINE basicusername #-} +complianceClasses :: +  Control.Lens.Type.Lens' DAVContext [B.ByteString] +complianceClasses-+  _f_a2Qn-+  (DAVContext __allowedMethods_a2Qo-+              __baseRequest_a2Qp-+              __basicusername_a2Qq-+              __basicpassword_a2Qr-+              __complianceClasses'_a2Qs-+              __depth_a2Qu-+              __httpManager_a2Qv-+              __lockToken_a2Qw-+              __userAgent_a2Qx)-+  = ((\ __complianceClasses_a2Qt++  _f_a3jp++  (DAVContext __allowedMethods_a3jq++              __baseRequest_a3jr++              __basicusername_a3js++              __basicpassword_a3jt++              __complianceClasses'_a3ju++              __depth_a3jw++              __httpManager_a3jx++              __lockToken_a3jy++              __userAgent_a3jz)++  = ((\ __complianceClasses_a3jv +        -> DAVContext-+             __allowedMethods_a2Qo-+             __baseRequest_a2Qp-+             __basicusername_a2Qq-+             __basicpassword_a2Qr-+             __complianceClasses_a2Qt-+             __depth_a2Qu-+             __httpManager_a2Qv-+             __lockToken_a2Qw-+             __userAgent_a2Qx)-+     Data.Functor.<$> (_f_a2Qn __complianceClasses'_a2Qs))++             __allowedMethods_a3jq++             __baseRequest_a3jr++             __basicusername_a3js++             __basicpassword_a3jt++             __complianceClasses_a3jv++             __depth_a3jw++             __httpManager_a3jx++             __lockToken_a3jy++             __userAgent_a3jz)++     Data.Functor.<$> (_f_a3jp __complianceClasses'_a3ju)) +{-# INLINE complianceClasses #-} +depth :: Control.Lens.Type.Lens' DAVContext (Maybe Depth) +depth-+  _f_a2Qy-+  (DAVContext __allowedMethods_a2Qz-+              __baseRequest_a2QA-+              __basicusername_a2QB-+              __basicpassword_a2QC-+              __complianceClasses_a2QD-+              __depth'_a2QE-+              __httpManager_a2QG-+              __lockToken_a2QH-+              __userAgent_a2QI)-+  = ((\ __depth_a2QF++  _f_a3jA++  (DAVContext __allowedMethods_a3jB++              __baseRequest_a3jC++              __basicusername_a3jD++              __basicpassword_a3jE++              __complianceClasses_a3jF++              __depth'_a3jG++              __httpManager_a3jI++              __lockToken_a3jJ++              __userAgent_a3jK)++  = ((\ __depth_a3jH +        -> DAVContext-+             __allowedMethods_a2Qz-+             __baseRequest_a2QA-+             __basicusername_a2QB-+             __basicpassword_a2QC-+             __complianceClasses_a2QD-+             __depth_a2QF-+             __httpManager_a2QG-+             __lockToken_a2QH-+             __userAgent_a2QI)-+     Data.Functor.<$> (_f_a2Qy __depth'_a2QE))++             __allowedMethods_a3jB++             __baseRequest_a3jC++             __basicusername_a3jD++             __basicpassword_a3jE++             __complianceClasses_a3jF++             __depth_a3jH++             __httpManager_a3jI++             __lockToken_a3jJ++             __userAgent_a3jK)++     Data.Functor.<$> (_f_a3jA __depth'_a3jG)) +{-# INLINE depth #-}-+httpManager :: Control.Lens.Type.Lens' DAVContext Manager++httpManager :: Control.Lens.Type.Lens' DAVContext (Maybe Manager) +httpManager-+  _f_a2QJ-+  (DAVContext __allowedMethods_a2QK-+              __baseRequest_a2QL-+              __basicusername_a2QM-+              __basicpassword_a2QN-+              __complianceClasses_a2QO-+              __depth_a2QP-+              __httpManager'_a2QQ-+              __lockToken_a2QS-+              __userAgent_a2QT)-+  = ((\ __httpManager_a2QR++  _f_a3jL++  (DAVContext __allowedMethods_a3jM++              __baseRequest_a3jN++              __basicusername_a3jO++              __basicpassword_a3jP++              __complianceClasses_a3jQ++              __depth_a3jR++              __httpManager'_a3jS++              __lockToken_a3jU++              __userAgent_a3jV)++  = ((\ __httpManager_a3jT +        -> DAVContext-+             __allowedMethods_a2QK-+             __baseRequest_a2QL-+             __basicusername_a2QM-+             __basicpassword_a2QN-+             __complianceClasses_a2QO-+             __depth_a2QP-+             __httpManager_a2QR-+             __lockToken_a2QS-+             __userAgent_a2QT)-+     Data.Functor.<$> (_f_a2QJ __httpManager'_a2QQ))++             __allowedMethods_a3jM++             __baseRequest_a3jN++             __basicusername_a3jO++             __basicpassword_a3jP++             __complianceClasses_a3jQ++             __depth_a3jR++             __httpManager_a3jT++             __lockToken_a3jU++             __userAgent_a3jV)++     Data.Functor.<$> (_f_a3jL __httpManager'_a3jS)) +{-# INLINE httpManager #-} +lockToken :: +  Control.Lens.Type.Lens' DAVContext (Maybe B.ByteString) +lockToken-+  _f_a2QU-+  (DAVContext __allowedMethods_a2QV-+              __baseRequest_a2QW-+              __basicusername_a2QX-+              __basicpassword_a2QY-+              __complianceClasses_a2QZ-+              __depth_a2R0-+              __httpManager_a2R1-+              __lockToken'_a2R2-+              __userAgent_a2R4)-+  = ((\ __lockToken_a2R3++  _f_a3jW++  (DAVContext __allowedMethods_a3jX++              __baseRequest_a3jY++              __basicusername_a3jZ++              __basicpassword_a3k0++              __complianceClasses_a3k1++              __depth_a3k2++              __httpManager_a3k3++              __lockToken'_a3k4++              __userAgent_a3k6)++  = ((\ __lockToken_a3k5 +        -> DAVContext-+             __allowedMethods_a2QV-+             __baseRequest_a2QW-+             __basicusername_a2QX-+             __basicpassword_a2QY-+             __complianceClasses_a2QZ-+             __depth_a2R0-+             __httpManager_a2R1-+             __lockToken_a2R3-+             __userAgent_a2R4)-+     Data.Functor.<$> (_f_a2QU __lockToken'_a2R2))++             __allowedMethods_a3jX++             __baseRequest_a3jY++             __basicusername_a3jZ++             __basicpassword_a3k0++             __complianceClasses_a3k1++             __depth_a3k2++             __httpManager_a3k3++             __lockToken_a3k5++             __userAgent_a3k6)++     Data.Functor.<$> (_f_a3jW __lockToken'_a3k4)) +{-# INLINE lockToken #-} +userAgent :: Control.Lens.Type.Lens' DAVContext B.ByteString +userAgent-+  _f_a2R5-+  (DAVContext __allowedMethods_a2R6-+              __baseRequest_a2R7-+              __basicusername_a2R8-+              __basicpassword_a2R9-+              __complianceClasses_a2Ra-+              __depth_a2Rb-+              __httpManager_a2Rc-+              __lockToken_a2Rd-+              __userAgent'_a2Re)-+  = ((\ __userAgent_a2Rf++  _f_a3k7++  (DAVContext __allowedMethods_a3k8++              __baseRequest_a3k9++              __basicusername_a3ka++              __basicpassword_a3kb++              __complianceClasses_a3kc++              __depth_a3kd++              __httpManager_a3ke++              __lockToken_a3kf++              __userAgent'_a3kg)++  = ((\ __userAgent_a3kh +        -> DAVContext-+             __allowedMethods_a2R6-+             __baseRequest_a2R7-+             __basicusername_a2R8-+             __basicpassword_a2R9-+             __complianceClasses_a2Ra-+             __depth_a2Rb-+             __httpManager_a2Rc-+             __lockToken_a2Rd-+             __userAgent_a2Rf)-+     Data.Functor.<$> (_f_a2R5 __userAgent'_a2Re))++             __allowedMethods_a3k8++             __baseRequest_a3k9++             __basicusername_a3ka++             __basicpassword_a3kb++             __complianceClasses_a3kc++             __depth_a3kd++             __httpManager_a3ke++             __lockToken_a3kf++             __userAgent_a3kh)++     Data.Functor.<$> (_f_a3k7 __userAgent'_a3kg)) +{-# INLINE userAgent #-}--- -1.7.10.4-
standalone/windows/build.sh view
@@ -7,9 +7,9 @@ set -e  # Path to the Haskell Platform.-HP="/c/Program Files (x86)/Haskell Platform/2013.2.0.0"+#HP="/c/haskell/2014.2.0.0" # now in the default PATH -PATH="$HP/bin:$HP/lib/extralibs/bin:/c/Program Files (x86)/NSIS:/c/msysgit/cmd:/c/msysgit/bin:$PATH"+PATH="/c/Program Files (x86)/NSIS:/c/msysgit/cmd:$PATH"  # Run a command with the cygwin environment available. # However, programs not from cygwin are preferred.@@ -35,6 +35,10 @@ # for haskell libraries to link them with the cygwin library. cabal update || true +# This workaround is still needed, it seems.+#cabal install transformers-compat -fthree+#cabal install DAV-1.0+ cabal install --only-dependencies || true  # Detect when the last build was an incremental build and failed, @@ -64,11 +68,13 @@  rm -f last-incremental-failed +rm -f dist/build-version+ghc --make Build/BuildVersion.hs+Build/BuildVersion > dist/build-version+ # Test git-annex # (doesn't currently work well on autobuilder, reason unknown) rm -rf .t+PATH="$(pwd)/dist/build/git-annex/:$PATH"+export PATH withcyg dist/build/git-annex/git-annex.exe test || true--rm -f dist/build-version-ghc --make Build/BuildVersion.hs-Build/BuildVersion > dist/build-version
+ templates/configurators/edit/webrepository.hamlet view
@@ -0,0 +1,8 @@+<div .col-sm-9>+  <div .content-box>+    <h2>+      The world wide web+    <p>+      git-annex can download files from the web.+    <p>+      This is not a normal repository, and cannot be configured.