packages feed

git-annex 3.20130124 → 3.20130207

raw patch · 96 files changed

+1152/−312 lines, 96 filesdep +asyncbinary-added

Dependencies added: async

Files

.gitignore view
@@ -22,3 +22,4 @@ # OSX related .DS_Store .virthualenv+tags
Annex/Content.hs view
@@ -27,9 +27,8 @@ 	preseedTmp, 	freezeContent, 	thawContent,-	freezeContentDir,-	createContentDir, 	replaceFile,+	cleanObjectLoc, ) where  import System.IO.Unsafe (unsafeInterleaveIO)@@ -249,8 +248,18 @@ 				freezeContent dest 				freezeContentDir dest 			)-	storedirect [] = storeobject =<< inRepo (gitAnnexLocation key)-	storedirect (dest:fs) = do+	storedirect fs = storedirect' =<< liftIO (filterM validsymlink fs)++	validsymlink f = do+		tl <- tryIO $ readSymbolicLink f+		return $ case tl of+			Right l+				| isLinkToAnnex l ->+					Just key == fileKey (takeFileName l)+			_ -> False++	storedirect' [] = storeobject =<< inRepo (gitAnnexLocation key)+	storedirect' (dest:fs) = do 		updateCache key src 		thawContent src 		liftIO $ replaceFile dest $ moveFile src@@ -326,7 +335,12 @@ cleanObjectLoc :: Key -> Annex () cleanObjectLoc key = do 	file <- inRepo $ gitAnnexLocation key-	liftIO $ removeparents file (3 :: Int)+	liftIO $ do+		let dir = parentDir file+		void $ catchMaybeIO $ do+			allowWrite dir+			removeDirectoryRecursive dir+		removeparents dir (2 :: Int)   where 	removeparents _ 0 = noop 	removeparents file n = do@@ -347,9 +361,10 @@ 			removeFile file 		cleanObjectLoc key 	removedirect fs = do-		removeCache key-		mapM_ resetfile fs-	resetfile f = do+		cache <- recordedCache key+		mapM_ (resetfile cache) fs+		cleanObjectLoc key+	resetfile cache f = whenM (compareCache f cache) $ do 		l <- calcGitLink f key 		top <- fromRepo Git.repoPath 		cwd <- liftIO getCurrentDirectory@@ -414,7 +429,7 @@ {- Downloads content from any of a list of urls. -} downloadUrl :: [Url.URLString] -> FilePath -> Annex Bool downloadUrl urls file = do-	o <- map Param . words <$> getConfig (annexConfig "web-options") ""+	o <- map Param . annexWebOptions <$> Annex.getGitConfig 	headers <- getHttpHeaders 	liftIO $ anyM (\u -> Url.download u headers o file) urls @@ -457,27 +472,3 @@ 	go GroupShared = groupWriteRead file 	go AllShared = groupWriteRead file 	go _ = allowWrite file--{- Blocks writing to the directory an annexed file is in, to prevent the- - file accidentially being deleted. However, if core.sharedRepository- - is set, this is not done, since the group must be allowed to delete the- - file.- -}-freezeContentDir :: FilePath -> Annex ()-freezeContentDir file = liftIO . go =<< fromRepo getSharedRepository-  where-	dir = parentDir file-	go GroupShared = groupWriteRead dir-	go AllShared = groupWriteRead dir-	go _ = preventWrite dir--{- Makes the directory tree to store an annexed file's content,- - with appropriate permissions on each level. -}-createContentDir :: FilePath -> Annex ()-createContentDir dest = do-	unlessM (liftIO $ doesDirectoryExist dir) $-		createAnnexDirectory dir -	-- might have already existed with restricted perms-	liftIO $ allowWrite dir-  where-	dir = parentDir dest
Annex/Content/Direct.hs view
@@ -15,7 +15,6 @@ 	recordedCache, 	compareCache, 	writeCache,-	removeCache, 	genCache, 	toCache, 	Cache(..),@@ -23,6 +22,7 @@ ) where  import Common.Annex+import Annex.Perms import qualified Git import Utility.TempFile import Logs.Location@@ -53,7 +53,8 @@ 	mapping <- inRepo $ gitAnnexMapping key 	files <- associatedFilesRelative key 	let files' = transform files-	when (files /= files') $+	when (files /= files') $ do+		createContentDir mapping 		liftIO $ viaTmp write mapping $ unlines files' 	top <- fromRepo Git.repoPath 	return $ map (top </>) files'@@ -109,7 +110,7 @@ {- Gets the recorded cache for a key. -} recordedCache :: Key -> Annex (Maybe Cache) recordedCache key = withCacheFile key $ \cachefile ->-	catchDefaultIO Nothing $ readCache <$> readFile cachefile+	liftIO $ catchDefaultIO Nothing $ readCache <$> readFile cachefile  {- Compares a cache with the current cache for a file. -} compareCache :: FilePath -> Maybe Cache -> Annex Bool@@ -124,12 +125,8 @@ {- Writes a cache for a key. -} writeCache :: Key -> Cache -> Annex () writeCache key cache = withCacheFile key $ \cachefile -> do-	createDirectoryIfMissing True (parentDir cachefile)-	writeFile cachefile $ showCache cache--{- Removes a cache. -}-removeCache :: Key -> Annex ()-removeCache key = withCacheFile key nukeFile+	createContentDir cachefile+	liftIO $ writeFile cachefile $ showCache cache  {- Cache a file's inode, size, and modification time to determine if it's  - been changed. -}@@ -166,5 +163,5 @@ 		(modificationTime s) 	| otherwise = Nothing -withCacheFile :: Key -> (FilePath -> IO a) -> Annex a-withCacheFile key a = liftIO . a =<< inRepo (gitAnnexCache key)+withCacheFile :: Key -> (FilePath -> Annex a) -> Annex a+withCacheFile key a = a =<< inRepo (gitAnnexCache key)
Annex/Direct.hs view
@@ -171,7 +171,6 @@ toDirectGen :: Key -> FilePath -> Annex (Maybe (Annex ())) toDirectGen k f = do 	loc <- inRepo $ gitAnnexLocation k-	createContentDir loc -- thaws directory too 	absf <- liftIO $ absPath f 	locs <- filter (/= absf) <$> addAssociatedFile k f 	case locs of
Annex/Perms.hs view
@@ -10,6 +10,8 @@ 	annexFileMode, 	createAnnexDirectory, 	noUmask,+	createContentDir,+	freezeContentDir, ) where  import Common.Annex@@ -68,3 +70,27 @@ 		done = forM_ below $ \p -> do 			liftIO $ createDirectory p 			setAnnexPerm p++{- Blocks writing to the directory an annexed file is in, to prevent the+ - file accidentially being deleted. However, if core.sharedRepository+ - is set, this is not done, since the group must be allowed to delete the+ - file.+ -}+freezeContentDir :: FilePath -> Annex ()+freezeContentDir file = liftIO . go =<< fromRepo getSharedRepository+  where+	dir = parentDir file+	go GroupShared = groupWriteRead dir+	go AllShared = groupWriteRead dir+	go _ = preventWrite dir++{- Makes the directory tree to store an annexed file's content,+ - with appropriate permissions on each level. -}+createContentDir :: FilePath -> Annex ()+createContentDir dest = do+	unlessM (liftIO $ doesDirectoryExist dir) $+		createAnnexDirectory dir +	-- might have already existed with restricted perms+	liftIO $ allowWrite dir+  where+	dir = parentDir dest
Assistant.hs view
@@ -156,10 +156,6 @@ import Utility.LogFile import Utility.ThreadScheduler -import Control.Concurrent--type NamedThread = IO () -> IO (String, IO ())- stopDaemon :: Annex () stopDaemon = liftIO . Utility.Daemon.stopDaemon =<< fromRepo gitAnnexPidFile @@ -197,11 +193,13 @@ 				=<< newAssistantData st dstatus  	go webappwaiter = do-		d <- getAssistant id #ifdef WITH_WEBAPP+		d <- getAssistant id 		urlrenderer <- liftIO newUrlRenderer+		mapM_ (startthread $ Just urlrenderer)+#else+		mapM_ (startthread Nothing) #endif-		mapM_ (startthread d) 			[ watch $ commitThread #ifdef WITH_WEBAPP 			, assist $ webAppThread d urlrenderer False Nothing webappwaiter@@ -233,7 +231,6 @@  	watch a = (True, a) 	assist a = (False, a)-	startthread d (watcher, t)-		| watcher || assistant = void $ liftIO $ forkIO $-			runAssistant d $ runNamedThread t+	startthread urlrenderer (watcher, t)+		| watcher || assistant = startNamedThread urlrenderer t 		| otherwise = noop
Assistant/Monad.hs view
@@ -19,10 +19,14 @@ 	asIO, 	asIO1, 	asIO2,+	ThreadName,+	debug,+	notice ) where  import "mtl" Control.Monad.Reader import Control.Monad.Base (liftBase, MonadBase)+import System.Log.Logger  import Common.Annex import Assistant.Types.ThreadedMonad@@ -36,6 +40,7 @@ import Assistant.Types.Changes import Assistant.Types.Buddies import Assistant.Types.NetMessager+import Assistant.Types.ThreadName  newtype Assistant a = Assistant { mkAssistant :: ReaderT AssistantData IO a } 	deriving (@@ -50,7 +55,7 @@ 	liftBase = Assistant . liftBase  data AssistantData = AssistantData-	{ threadName :: String+	{ threadName :: ThreadName 	, threadState :: ThreadState 	, daemonStatusHandle :: DaemonStatusHandle 	, scanRemoteMap :: ScanRemoteMap@@ -66,7 +71,7 @@  newAssistantData :: ThreadState -> DaemonStatusHandle -> IO AssistantData newAssistantData st dstatus = AssistantData-	<$> pure "main"+	<$> pure (ThreadName "main") 	<*> pure st 	<*> pure dstatus 	<*> newScanRemoteMap@@ -118,3 +123,14 @@ {- Runs an IO action on a selected field of the AssistantData. -} (<<~) :: (a -> IO b) -> (AssistantData -> a) -> Assistant b io <<~ v = reader v >>= liftIO . io++debug :: [String] -> Assistant ()+debug = logaction debugM++notice :: [String] -> Assistant ()+notice = logaction noticeM++logaction :: (String -> String -> IO ()) -> [String] -> Assistant ()+logaction a ws = do+	ThreadName name <- getAssistant threadName+	liftIO $ a name $ unwords $ (name ++ ":") : ws
Assistant/NamedThread.hs view
@@ -5,26 +5,98 @@  - Licensed under the GNU GPL version 3 or higher.  -} +{-# LANGUAGE CPP #-}+ module Assistant.NamedThread where -import Assistant.Common+import Common.Annex+import Assistant.Types.NamedThread+import Assistant.Types.ThreadName+import Assistant.Types.DaemonStatus import Assistant.DaemonStatus-import Assistant.Alert+import Assistant.Monad +import Control.Concurrent+import Control.Concurrent.Async+import qualified Data.Map as M import qualified Control.Exception as E -runNamedThread :: NamedThread -> Assistant ()-runNamedThread (NamedThread name a) = do-	d <- getAssistant id-	liftIO . go $ d { threadName = name }+#ifdef WITH_WEBAPP+import Assistant.WebApp+import Assistant.WebApp.Types+import Assistant.Alert+import qualified Data.Text as T+#endif++{- Starts a named thread, if it's not already running.+ -+ - Named threads are run by a management thread, so if they crash+ - an alert is displayed, allowing the thread to be restarted. -}+#ifdef WITH_WEBAPP+startNamedThread :: Maybe UrlRenderer -> NamedThread -> Assistant ()+startNamedThread urlrenderer namedthread@(NamedThread name a) = do+#else+startNamedThread :: Maybe Bool -> NamedThread -> Assistant ()+startNamedThread urlrenderer namedthread@(NamedThread name a) = do+#endif+	m <- startedThreads <$> getDaemonStatus+	case M.lookup name m of+		Nothing -> start+		Just (aid, _) -> do+			r <- liftIO (E.try (poll aid) :: IO (Either E.SomeException (Maybe (Either E.SomeException ()))))+			case r of+				Right Nothing -> noop+				_ -> start   where-	go d = do-		r <- E.try (runAssistant d a) :: IO (Either E.SomeException ())+	start = do+		d <- getAssistant id+		aid <- liftIO $ runmanaged $ d { threadName = name }+		restart <- asIO $ startNamedThread urlrenderer namedthread+		modifyDaemonStatus_ $ \s -> s+			{ startedThreads = M.insertWith' const name (aid, restart) (startedThreads s) }+	runmanaged d = do+		aid <- async $ runAssistant d a+		void $ forkIO $ manager d aid+		return aid+	manager d aid = do+		r <- E.try (wait aid) :: IO (Either E.SomeException ()) 		case r of 			Right _ -> noop 			Left e -> do-				let msg = unwords [name, "crashed:", show e]+				let msg = unwords+					[ fromThreadName $ threadName d+					, "crashed:", show e+					] 				hPutStrLn stderr msg-				-- TODO click to restart+#ifdef WITH_WEBAPP+				button <- runAssistant d $+					case urlrenderer of+						Nothing -> return Nothing+						Just renderer -> do+							close <- asIO1 removeAlert+							url <- liftIO $ renderUrl renderer (RestartThreadR name) []+							return $ Just $ AlertButton+								{ buttonLabel = T.pack "Restart Thread"+								, buttonUrl = url+								, buttonAction = Just close+								} 				runAssistant d $ void $-					addAlert $ warningAlert name msg+					addAlert $ (warningAlert (fromThreadName name) msg)+						{ alertButton = button }+#endif++namedThreadId :: NamedThread -> Assistant (Maybe ThreadId)+namedThreadId (NamedThread name _) = do+	m <- startedThreads <$> getDaemonStatus+	return $ asyncThreadId . fst <$> M.lookup name m++{- Waits for all named threads that have been started to finish.+ -+ - Note that if a named thread crashes, it will probably+ - cause this to crash as well. Also, named threads that are started+ - after this is called will not be waited on. -}+waitNamedThreads :: Assistant ()+waitNamedThreads = do+	m <- startedThreads <$> getDaemonStatus+	liftIO $ mapM_ (wait . fst) $ M.elems m+
Assistant/Threads/Committer.hs view
@@ -18,6 +18,7 @@ import Assistant.Threads.Watcher import Assistant.TransferQueue import Logs.Transfer+import Logs.Location import qualified Annex.Queue import qualified Git.Command import qualified Git.HashObject@@ -41,7 +42,7 @@  {- This thread makes git commits at appropriate times. -} commitThread :: NamedThread-commitThread = NamedThread "Committer" $ do+commitThread = namedThread "Committer" $ do 	delayadd <- liftAnnex $ 		maybe delayaddDefault (return . Just . Seconds) 			=<< annexDelayAdd <$> Annex.getGitConfig@@ -81,12 +82,16 @@ 	case v of 		Left _ -> return False 		Right _ -> do-			void $ inRepo $ Git.Command.runBool "commit" $ nomessage-				[ Param "--quiet"-				{- Avoid running the usual git-annex pre-commit hook;-				 - watch does the same symlink fixing, and we don't want-				 - to deal with unlocked files in these commits. -}-				, Param "--no-verify"+			direct <- isDirect+			void $ inRepo $ Git.Command.runBool "commit" $ nomessage $+				catMaybes+				[ Just $ Param "--quiet"+				{- In indirect mode, avoid running the+				 - usual git-annex pre-commit hook;+				 - watch does the same symlink fixing,+				 - and we don't want to deal with unlocked+				 - files in these commits. -}+				, if direct then Nothing else Just $ Param "--no-verify" 				] 			{- Empty commits may be made if tree changes cancel 			 - each other out, etc. Git returns nonzero on those,@@ -204,15 +209,17 @@ 		liftAnnex showEndFail 		return Nothing 	done change file (Just key) = do-		link <- liftAnnex $ ifM isDirect-			( calcGitLink file key-			, Command.Add.link file key True-			)-		liftAnnex $ whenM (pure DirWatcher.eventsCoalesce <||> isDirect) $ do-			sha <- inRepo $-				Git.HashObject.hashObject BlobObject link-			stageSymlink file sha-			showEndOk+		liftAnnex $ do+			logStatus key InfoPresent+			link <- ifM isDirect+				( calcGitLink file key+				, Command.Add.link file key True+				)+			whenM (pure DirWatcher.eventsCoalesce <||> isDirect) $ do+				sha <- inRepo $+					Git.HashObject.hashObject BlobObject link+				stageSymlink file sha+				showEndOk 		queueTransfers Next key (Just file) Upload 		return $ Just change 
Assistant/Threads/ConfigMonitor.hs view
@@ -23,9 +23,6 @@  import qualified Data.Set as S -thisThread :: ThreadName-thisThread = "ConfigMonitor"- {- This thread detects when configuration changes have been made to the  - git-annex branch and reloads cached configuration.  -@@ -35,7 +32,7 @@  - be detected immediately.  -} configMonitorThread :: NamedThread-configMonitorThread = NamedThread "ConfigMonitor" $ loop =<< getConfigs+configMonitorThread = namedThread "ConfigMonitor" $ loop =<< getConfigs   where 	loop old = do 		waitBranchChange
Assistant/Threads/DaemonStatus.hs view
@@ -16,7 +16,7 @@  - frequently than once every ten minutes.  -} daemonStatusThread :: NamedThread-daemonStatusThread = NamedThread "DaemonStatus" $ do+daemonStatusThread = namedThread "DaemonStatus" $ do 	notifier <- liftIO . newNotificationHandle 		=<< changeNotifier <$> getDaemonStatus 	checkpoint
Assistant/Threads/Glacier.hs view
@@ -24,7 +24,7 @@  - downloads. If so, runs glacier-cli to check if the files are now  - available, and queues the downloads. -} glacierThread :: NamedThread-glacierThread = NamedThread "Glacier" $ runEvery (Seconds 3600) <~> go+glacierThread = namedThread "Glacier" $ runEvery (Seconds 3600) <~> go   where 	isglacier r = Remote.remotetype r == Glacier.remote 	go = do
Assistant/Threads/Merger.hs view
@@ -17,13 +17,10 @@ import qualified Git.Branch import qualified Command.Sync -thisThread :: ThreadName-thisThread = "Merger"- {- This thread watches for changes to .git/refs/, and handles incoming  - pushes. -} mergeThread :: NamedThread-mergeThread = NamedThread "Merger" $ do+mergeThread = namedThread "Merger" $ do 	g <- liftAnnex gitRepo 	let dir = Git.localGitDir g </> "refs" 	liftIO $ createDirectoryIfMissing True dir
Assistant/Threads/MountWatcher.hs view
@@ -33,11 +33,8 @@ #warning Building without dbus support; will use mtab polling #endif -thisThread :: ThreadName-thisThread = "MountWatcher"- mountWatcherThread :: NamedThread-mountWatcherThread = NamedThread "MountWatcher" $+mountWatcherThread = namedThread "MountWatcher" $ #if WITH_DBUS 	dbusThread #else
Assistant/Threads/NetWatcher.hs view
@@ -33,7 +33,7 @@ netWatcherThread = thread noop #endif   where-	thread = NamedThread "NetWatcher"+	thread = namedThread "NetWatcher"  {- This is a fallback for when dbus cannot be used to detect  - network connection changes, but it also ensures that@@ -41,7 +41,7 @@  - while (despite the local network staying up), are synced with  - periodically. -} netWatcherFallbackThread :: NamedThread-netWatcherFallbackThread = NamedThread "NetWatcherFallback" $+netWatcherFallbackThread = namedThread "NetWatcherFallback" $ 	runEvery (Seconds 3600) <~> handleConnection  #if WITH_DBUS
Assistant/Threads/PairListener.hs view
@@ -23,11 +23,8 @@ import qualified Data.Text as T import Data.Char -thisThread :: ThreadName-thisThread = "PairListener"- pairListenerThread :: UrlRenderer -> NamedThread-pairListenerThread urlrenderer = NamedThread "PairListener" $ do+pairListenerThread urlrenderer = namedThread "PairListener" $ do 	listener <- asIO1 $ go [] [] 	liftIO $ withSocketsDo $ 		runEvery (Seconds 1) $ void $ tryIO $ 
Assistant/Threads/Pusher.hs view
@@ -19,12 +19,9 @@  import Data.Time.Clock -thisThread :: ThreadName-thisThread = "Pusher"- {- This thread retries pushes that failed before. -} pushRetryThread :: NamedThread-pushRetryThread = NamedThread "PushRetrier" $ runEvery (Seconds halfhour) <~> do+pushRetryThread = namedThread "PushRetrier" $ runEvery (Seconds halfhour) <~> do 	-- We already waited half an hour, now wait until there are failed 	-- pushes to retry. 	topush <- getFailedPushesBefore (fromIntegral halfhour)@@ -38,7 +35,7 @@  {- This thread pushes git commits out to remotes soon after they are made. -} pushThread :: NamedThread-pushThread = NamedThread "Pusher" $ runEvery (Seconds 2) <~> do+pushThread = namedThread "Pusher" $ runEvery (Seconds 2) <~> do 	-- We already waited two seconds as a simple rate limiter. 	-- Next, wait until at least one commit has been made 	commits <- getCommits
Assistant/Threads/SanityChecker.hs view
@@ -20,7 +20,7 @@  {- This thread wakes up occasionally to make sure the tree is in good shape. -} sanityCheckerThread :: NamedThread-sanityCheckerThread = NamedThread "SanityChecker" $ forever $ do+sanityCheckerThread = namedThread "SanityChecker" $ forever $ do 	waitForNextCheck  	debug ["starting sanity check"]
Assistant/Threads/TransferPoller.hs view
@@ -19,7 +19,7 @@ {- This thread polls the status of ongoing transfers, determining how much  - of each transfer is complete. -} transferPollerThread :: NamedThread-transferPollerThread = NamedThread "TransferPoller" $ do+transferPollerThread = namedThread "TransferPoller" $ do 	g <- liftAnnex gitRepo 	tn <- liftIO . newNotificationHandle =<< 		transferNotifier <$> getDaemonStatus
Assistant/Threads/TransferScanner.hs view
@@ -31,7 +31,7 @@  - that need to be made, to keep data in sync.  -} transferScannerThread :: NamedThread-transferScannerThread = NamedThread "TransferScanner" $ do+transferScannerThread = namedThread "TransferScanner" $ do 	startupScan 	go S.empty   where
Assistant/Threads/TransferWatcher.hs view
@@ -22,7 +22,7 @@ {- This thread watches for changes to the gitAnnexTransferDir,  - and updates the DaemonStatus's map of ongoing transfers. -} transferWatcherThread :: NamedThread-transferWatcherThread = NamedThread "TransferWatcher" $ do+transferWatcherThread = namedThread "TransferWatcher" $ do 	dir <- liftAnnex $ gitAnnexTransferDir <$> gitRepo 	liftIO $ createDirectoryIfMissing True dir 	let hook a = Just <$> asIO2 (runHandler a)
Assistant/Threads/Transferrer.hs view
@@ -25,7 +25,7 @@  {- Dispatches transfers from the queue. -} transfererThread :: NamedThread-transfererThread = NamedThread "Transferr" $ do+transfererThread = namedThread "Transferrer" $ do 	program <- liftIO readProgramFile 	forever $ inTransferSlot $ 		maybe (return Nothing) (uncurry $ startTransfer program)
Assistant/Threads/Watcher.hs view
@@ -5,8 +5,11 @@  - Licensed under the GNU GPL version 3 or higher.  -} +{-# LANGUAGE DeriveDataTypeable, CPP #-}+ module Assistant.Threads.Watcher ( 	watchThread,+	WatcherException(..), 	checkCanWatch, 	needLsof, 	stageSymlink,@@ -38,9 +41,12 @@ import Annex.CatFile import Git.Types import Config+import Utility.ThreadScheduler  import Data.Bits.Utils+import Data.Typeable import qualified Data.ByteString.Lazy as L+import qualified Control.Exception as E  checkCanWatch :: Annex () checkCanWatch@@ -58,8 +64,21 @@ 	, "Be warned: This can corrupt data in the annex, and make fsck complain." 	] +{- A special exception that can be thrown to pause or resume the watcher. -}+data WatcherException = PauseWatcher | ResumeWatcher+        deriving (Show, Eq, Typeable)++instance E.Exception WatcherException+ watchThread :: NamedThread-watchThread = NamedThread "Watcher" $ do+watchThread = namedThread "Watcher" $+	ifM (liftAnnex $ annexAutoCommit <$> Annex.getGitConfig)+		( runWatcher+		, waitFor ResumeWatcher runWatcher+		)++runWatcher :: Assistant ()+runWatcher = do 	startup <- asIO1 startupScan 	direct <- liftAnnex isDirect 	addhook <- hook $ if direct then onAddDirect else onAdd@@ -74,11 +93,29 @@ 		, delDirHook = deldirhook 		, errHook = errhook 		}-	void $ liftIO $ watchDir "." ignored hooks startup+	handle <- liftIO $ watchDir "." ignored 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+		waitFor ResumeWatcher runWatcher   where 	hook a = Just <$> asIO2 (runHandler a) +waitFor :: WatcherException -> Assistant () -> Assistant ()+waitFor sig next = do+	r <- liftIO $ (E.try pause :: IO (Either E.SomeException ()))+	case r of+		Left e -> case E.fromException e of+			Just s+				| s == sig -> next+			_ -> noop+		_ -> noop+  where+	pause = runEvery (Seconds 86400) noop+ {- Initial scartup scan. The action should return once the scan is complete. -} startupScan :: IO a -> Assistant a startupScan scanner = do@@ -109,6 +146,9 @@ 	ig ".git" = True 	ig ".gitignore" = True 	ig ".gitattributes" = True+#ifdef darwin_HOST_OS+	ig ".DS_Store" = True+#endif 	ig _ = False  type Handler = FilePath -> Maybe FileStatus -> Assistant (Maybe Change)
Assistant/Threads/WebApp.hs view
@@ -38,9 +38,6 @@ import Network.Socket (SockAddr) import Data.Text (pack, unpack) -thisThread :: String-thisThread = "WebApp"- mkYesodDispatch "WebApp" $(parseRoutesFile "Assistant/WebApp/routes")  type Url = String@@ -76,7 +73,7 @@ 			urlfile <- runThreadState st $ fromRepo gitAnnexUrlFile 			go addr webapp htmlshim (Just urlfile)   where-	thread = NamedThread thisThread+	thread = namedThread "WebApp" 	getreldir 		| noannex = return Nothing 		| otherwise = Just <$>
Assistant/Threads/XMPPClient.hs view
@@ -34,7 +34,7 @@ import Data.Time.Clock  xmppClientThread :: UrlRenderer -> NamedThread-xmppClientThread urlrenderer = NamedThread "XMPPClient" $+xmppClientThread urlrenderer = namedThread "XMPPClient" $ 	restartableClient . xmppClient urlrenderer =<< getAssistant id  {- Runs the client, handing restart events. -}
Assistant/Types/DaemonStatus.hs view
@@ -14,14 +14,19 @@ import Assistant.Pairing import Utility.NotificationBroadcaster import Logs.Transfer+import Assistant.Types.ThreadName  import Control.Concurrent.STM+import Control.Concurrent.Async import Data.Time.Clock.POSIX import qualified Data.Map as M  data DaemonStatus = DaemonStatus+	-- All the named threads that comprise the daemon,+	-- and actions to run to restart them.+	{ startedThreads :: M.Map ThreadName (Async (), IO ()) 	-- False when the daemon is performing its startup scan-	{ scanComplete :: Bool+	, scanComplete :: Bool 	-- Time when a previous process of the daemon was running ok 	, lastRunning :: Maybe POSIXTime 	-- True when the sanity checker is running@@ -58,7 +63,8 @@  newDaemonStatus :: IO DaemonStatus newDaemonStatus = DaemonStatus-	<$> pure False+	<$> pure M.empty+	<*> pure False 	<*> pure Nothing 	<*> pure False 	<*> pure Nothing
Assistant/Types/NamedThread.hs view
@@ -1,32 +1,17 @@-{- git-annex assistant named threads.+{- named threads  -  - Copyright 2012 Joey Hess <joey@kitenet.net>  -  - Licensed under the GNU GPL version 3 or higher.  -} -module Assistant.Types.NamedThread (-	ThreadName,-	NamedThread(..),-	debug,-	notice,-) where+module Assistant.Types.NamedThread where -import Common.Annex import Assistant.Monad--import System.Log.Logger+import Assistant.Types.ThreadName -type ThreadName = String+{- Information about a named thread that can be run. -} data NamedThread = NamedThread ThreadName (Assistant ()) -debug :: [String] -> Assistant ()-debug = logaction debugM--notice :: [String] -> Assistant ()-notice = logaction noticeM--logaction :: (String -> String -> IO ()) -> [String] -> Assistant ()-logaction a ws = do-	name <- getAssistant threadName-	liftIO $ a name $ unwords $ (name ++ ":") : ws+namedThread :: String -> Assistant () -> NamedThread+namedThread name a = NamedThread (ThreadName name) a
+ Assistant/Types/ThreadName.hs view
@@ -0,0 +1,14 @@+{- name of a thread+ -+ - Copyright 2012 Joey Hess <joey@kitenet.net>+ -+ - Licensed under the GNU GPL version 3 or higher.+ -}++module Assistant.Types.ThreadName where++newtype ThreadName = ThreadName String+	deriving (Eq, Read, Show, Ord)++fromThreadName :: ThreadName -> String+fromThreadName (ThreadName n) = n
Assistant/WebApp/Configurators.hs view
@@ -14,6 +14,7 @@ import Assistant.WebApp.Notifications import Assistant.WebApp.Utility import Assistant.WebApp.Configurators.Local+import qualified Annex import qualified Remote import qualified Types.Remote as Remote import Annex.UUID (getUUID)@@ -136,10 +137,18 @@ 		rs <- filter wantedrepo . syncRemotes 			<$> liftAssistant getDaemonStatus 		runAnnex [] $ do-			u <- getUUID-			let l = map Remote.uuid rs-			let l' = if includeHere reposelector then u : l else l-			return $ zip l' $ map mkSyncingRepoActions l'+			let us = map Remote.uuid rs+			let l = zip us $ map mkSyncingRepoActions us+			if includeHere reposelector+				then do+					u <- getUUID+					autocommit <- annexAutoCommit <$> Annex.getGitConfig+					let hereactions = if autocommit+						then mkSyncingRepoActions u+						else mkNotSyncingRepoActions u+					let here = (u, hereactions)+					return $ here : l+				else return l 	rest = runAnnex [] $ do 		m <- readRemoteLog 		unconfigured <- map snd . catMaybes . filter wantedremote 
Assistant/WebApp/Control.hs view
@@ -12,9 +12,11 @@ import Assistant.WebApp.Common import Locations.UserConfig import Utility.LogFile+import Assistant.DaemonStatus  import Control.Concurrent import System.Posix (getProcessID, signalProcess, sigTERM)+import qualified Data.Map as M  getShutdownR :: Handler RepHtml getShutdownR = page "Shutdown" Nothing $@@ -41,6 +43,12 @@   where 	restartcommand program = program ++ " assistant --stop; " ++ 		program ++ " webapp"++getRestartThreadR :: ThreadName -> Handler ()+getRestartThreadR name = do+	m <- liftAssistant $ startedThreads <$> getDaemonStatus+	liftIO $ maybe noop snd $ M.lookup name m+	redirectBack  getLogR :: Handler RepHtml getLogR = page "Logs" Nothing $ do
Assistant/WebApp/Types.hs view
@@ -131,3 +131,7 @@ instance PathPiece RepoSelector where 	toPathPiece = pack . show 	fromPathPiece = readish . unpack++instance PathPiece ThreadName where+	toPathPiece = pack . show+	fromPathPiece = readish . unpack
Assistant/WebApp/Utility.hs view
@@ -22,15 +22,27 @@ import Logs.Transfer import Locations.UserConfig import qualified Config+import Git.Config+import Assistant.Threads.Watcher+import Assistant.NamedThread  import qualified Data.Map as M import Control.Concurrent import System.Posix.Signals (signalProcessGroup, sigTERM, sigKILL) import System.Posix.Process (getProcessGroupIDOf) -{- Use Nothing to change global sync setting. -}+{- Use Nothing to change autocommit setting; or a remote to change+ - its sync setting. -} changeSyncable :: (Maybe Remote) -> Bool -> Handler ()-changeSyncable Nothing _ = noop -- TODO+changeSyncable Nothing enable = liftAssistant $ do+	liftAnnex $ Config.setConfig key (boolConfig enable)+	liftIO . maybe noop (`throwTo` signal)+		=<< namedThreadId watchThread+  where+	key = Config.annexConfig "autocommit"+	signal+		| enable = ResumeWatcher+		| otherwise = PauseWatcher changeSyncable (Just r) True = do 	changeSyncFlag r True 	syncRemote r@@ -48,13 +60,10 @@  changeSyncFlag :: Remote -> Bool -> Handler () changeSyncFlag r enabled = runAnnex undefined $ do-	Config.setConfig key value+	Config.setConfig key (boolConfig enabled) 	void $ Remote.remoteListRefresh   where 	key = Config.remoteConfig (Remote.repo r) "sync"-	value-		| enabled = "true"-		| otherwise = "false"  {- Start syncing remote, using a background thread. -} syncRemote :: Remote -> Handler ()
Assistant/WebApp/routes view
@@ -8,6 +8,7 @@ /shutdown ShutdownR GET /shutdown/confirm ShutdownConfirmedR GET /restart RestartR GET+/restart/thread/#ThreadName RestartThreadR GET /log LogR GET  /config ConfigurationR GET
CHANGELOG view
@@ -1,3 +1,24 @@+git-annex (3.20130207) unstable; urgency=low++  * webapp: Now allows restarting any threads that crash.+  * Adjust debian package to only build-depend on DAV on architectures+    where it is available.+  * addurl --fast: Use curl, rather than haskell HTTP library, to support https.+  * annex.autocommit: New setting, can be used to disable autocommit+    of changed files by the assistant, while it still does data syncing+    and other tasks.+  * assistant: Ignore .DS_Store on OSX.+  * assistant: Fix location log when adding new file in direct mode.+  * Deal with stale mappings for deleted file in direct mode.+  * pre-commit: Update direct mode mappings. +  * uninit, unannex --fast: If hard link creation fails, fall back to slow+    mode.+  * Clean up direct mode cache and mapping info when dropping keys.+  * dropunused: Clean up stale direct mode cache and mapping info not+    removed before.++ -- Joey Hess <joeyh@debian.org>  Thu, 07 Feb 2013 12:45:25 -0400+ git-annex (3.20130124) unstable; urgency=low    * Added source repository group, that only retains files until they've
Command/Add.hs view
@@ -142,8 +142,6 @@ 	liftIO $ createSymbolicLink l file  	when hascontent $ do-		logStatus key InfoPresent-	 		-- touch the symlink to have the same mtime as the 		-- file it points to 		liftIO $ do@@ -155,21 +153,21 @@ {- Note: Several other commands call this, and expect it to   - create the symlink and add it. -} cleanup :: FilePath -> Key -> Bool -> CommandCleanup-cleanup file key hascontent = ifM (isDirect <&&> pure hascontent)-	( do-		l <- calcGitLink file key-		sha <- inRepo $ Git.HashObject.hashObject BlobObject l-		Annex.Queue.addUpdateIndex =<<-			inRepo (Git.UpdateIndex.stageSymlink file sha)-		when hascontent $-			logStatus key InfoPresent-		return True-	, do-		_ <- link file key hascontent-		params <- ifM (Annex.getState Annex.force)-			( return [Param "-f"]-			, return []-			)-		Annex.Queue.addCommand "add" (params++[Param "--"]) [file]-		return True-	)+cleanup file key hascontent = do+	when hascontent $+		logStatus key InfoPresent+	ifM (isDirect <&&> pure hascontent)+		( do+			l <- calcGitLink file key+			sha <- inRepo $ Git.HashObject.hashObject BlobObject l+			Annex.Queue.addUpdateIndex =<<+				inRepo (Git.UpdateIndex.stageSymlink file sha)+		, do+			_ <- link file key hascontent+			params <- ifM (Annex.getState Annex.force)+				( return [Param "-f"]+				, return []+				)+			Annex.Queue.addCommand "add" (params++[Param "--"]) [file]+		)+	return True
Command/Drop.hs view
@@ -60,7 +60,10 @@ 	untrusteduuids <- trustGet UnTrusted 	let tocheck = Remote.remotesWithoutUUID remotes (trusteduuids'++untrusteduuids) 	stopUnless (canDropKey key numcopies trusteduuids' tocheck []) $ do-		whenM (inAnnex key) $ removeAnnex key+		whenM (inAnnex key) $+			removeAnnex key+		{- Clean up stale direct mode files that may exist. -}+		cleanObjectLoc key 		next $ cleanupLocal key  performRemote :: Key -> Maybe Int -> Remote -> CommandPerform
Command/PreCommit.hs view
@@ -1,6 +1,6 @@ {- git-annex command  -- - Copyright 2010 Joey Hess <joey@kitenet.net>+ - Copyright 2010, 2013 Joey Hess <joey@kitenet.net>  -  - Licensed under the GNU GPL version 3 or higher.  -}@@ -11,22 +11,42 @@ import Command import qualified Command.Add import qualified Command.Fix+import qualified Git.DiffTree+import Annex.CatFile+import Annex.Content.Direct+import Git.Sha  def :: [Command] def = [command "pre-commit" paramPaths seek "run by git pre-commit hook"] -{- The pre-commit hook needs to fix symlinks to all files being committed.- - And, it needs to inject unlocked files into the annex. -} seek :: [CommandSeek] seek =+	-- fix symlinks to files being committed 	[ whenNotDirect $ withFilesToBeCommitted $ whenAnnexed $ Command.Fix.start-	, whenNotDirect $ withFilesUnlockedToBeCommitted start]--start :: FilePath -> CommandStart-start file = next $ perform file+	-- inject unlocked files into the annex+	, whenNotDirect $ withFilesUnlockedToBeCommitted startIndirect+	-- update direct mode mappings for committed files+	, whenDirect $ withWords startDirect+	] -perform :: FilePath -> CommandPerform-perform file = do+startIndirect :: FilePath -> CommandStart+startIndirect file = next $ do 	unlessM (doCommand $ Command.Add.start file) $ 		error $ "failed to add " ++ file ++ "; canceling commit" 	next $ return True++startDirect :: [String] -> CommandStart+startDirect _ = next $ do+	(diffs, clean) <- inRepo $ Git.DiffTree.diffIndex+	forM_ diffs go+	next $ liftIO clean+  where+	go diff = do+		withkey (Git.DiffTree.srcsha diff) removeAssociatedFile+		withkey (Git.DiffTree.dstsha diff) addAssociatedFile+	  where+		withkey sha a = when (sha /= nullSha) $ do+			k <- catKey sha+			case k of+				Nothing -> noop+				Just key -> void $ a key (Git.DiffTree.file diff)
Command/Sync.hs view
@@ -226,7 +226,8 @@ 	void $ liftIO cleanup  	(deleted, cleanup2) <- inRepo (LsFiles.deleted [top])-	Annex.Queue.addCommand "rm" [Params "--quiet -f --"] deleted+	unless (null deleted) $+		Annex.Queue.addCommand "rm" [Params "--quiet -f --"] deleted 	void $ liftIO cleanup2 	 	when merged $ do
Command/Unannex.hs view
@@ -49,14 +49,20 @@ 	void $ liftIO clean  	ifM (Annex.getState Annex.fast)-		( do-			-- fast mode: hard link to content in annex-			src <- inRepo $ gitAnnexLocation key-			liftIO $ createLink src file-			thawContent file-		, do-			fromAnnex key file-			logStatus key InfoMissing+		( goFast+		, go 		)  	return True+  where+	goFast = do+		-- fast mode: hard link to content in annex+		src <- inRepo $ gitAnnexLocation key+		-- creating a hard link could fall; fall back to non fast mode+		ifM (liftIO $ catchBoolIO $ createLink src file >> return True)+			( thawContent file+			, go+			)+	go = do+		fromAnnex key file+		logStatus key InfoMissing
Command/WebApp.hs view
@@ -109,10 +109,12 @@ 	urlrenderer <- newUrlRenderer 	v <- newEmptyMVar 	let callback a = Just $ a v-	void $ runAssistant d $ runNamedThread $-		webAppThread d urlrenderer True -			(callback signaler)-			(callback mainthread)+	runAssistant d $ do+		startNamedThread (Just urlrenderer) $+			webAppThread d urlrenderer True +				(callback signaler)+				(callback mainthread)+		waitNamedThreads   where 	signaler v = do 		putMVar v ""
Config.hs view
@@ -83,7 +83,7 @@  setDirect :: Bool -> Annex () setDirect b = do-	setConfig (annexConfig "direct") $ if b then "true" else "false"+	setConfig (annexConfig "direct") (Git.Config.boolConfig b) 	Annex.changeGitConfig $ \c -> c { annexDirect = b }  {- Gets the http headers to use. -}
Git/Config.hs view
@@ -147,5 +147,9 @@   where 	s' = map toLower s +boolConfig :: Bool -> String+boolConfig True = "true"+boolConfig False = "false"+ isBare :: Repo -> Bool isBare r = fromMaybe False $ isTrue =<< getMaybe "core.bare" r
Git/DiffTree.hs view
@@ -9,7 +9,7 @@ 	DiffTreeItem(..), 	diffTree, 	diffTreeRecursive,-	parseDiffTree+	diffIndex, ) where  import Numeric@@ -20,6 +20,7 @@ import Git.Sha import Git.Command import qualified Git.Filename+import qualified Git.Ref  data DiffTreeItem = DiffTreeItem 	{ srcmode :: FileMode@@ -32,19 +33,29 @@  {- Diffs two tree Refs. -} diffTree :: Ref -> Ref -> Repo -> IO ([DiffTreeItem], IO Bool)-diffTree = diffTree' []+diffTree src dst = getdiff (Param "diff-tree")+	[Param (show src), Param (show dst)]  {- Diffs two tree Refs, recursing into sub-trees -} diffTreeRecursive :: Ref -> Ref -> Repo -> IO ([DiffTreeItem], IO Bool)-diffTreeRecursive = diffTree' [Param "-r"]+diffTreeRecursive src dst = getdiff (Param "diff-tree")+	[Param "-r", Param (show src), Param (show dst)] -diffTree' :: [CommandParam] -> Ref -> Ref -> Repo -> IO ([DiffTreeItem], IO Bool)-diffTree' params src dst repo = do+{- Diffs between the repository and index. Does nothing if there is not+ - yet a commit in the repository. -}+diffIndex :: Repo -> IO ([DiffTreeItem], IO Bool)+diffIndex repo = do+	ifM (Git.Ref.headExists repo)+		( getdiff (Param "diff-index") [Param "--cached", Param "HEAD"] repo+		, return ([], return True)+		)++getdiff :: CommandParam -> [CommandParam] -> Repo -> IO ([DiffTreeItem], IO Bool)+getdiff command params repo = do 	(diff, cleanup) <- pipeNullSplit ps repo 	return (parseDiffTree diff, cleanup)   where-	ps = Params "diff-tree -z --raw --no-renames -l0" : params ++-		[Param (show src), Param (show dst)]+	ps = command : Params "-z --raw --no-renames -l0" : params  {- Parses diff-tree output. -} parseDiffTree :: [String] -> [DiffTreeItem]
Git/Ref.hs view
@@ -37,6 +37,13 @@ exists ref = runBool "show-ref"  	[Param "--verify", Param "-q", Param $ show ref] +{- Checks if HEAD exists. It generally will, except for in a repository+ - that was just created. -}+headExists :: Repo -> IO Bool+headExists repo = do+	ls <- lines <$> pipeReadStrict [Param "show-ref", Param "--head"] repo+	return $ any (" HEAD" `isSuffixOf`) ls+ {- Get the sha of a fully qualified git ref, if it exists. -} sha :: Branch -> Repo -> IO (Maybe Sha) sha branch repo = process <$> showref repo
Makefile view
@@ -6,7 +6,6 @@ # you can turn off some of these features. # # If you're using an old version of yesod, enable -DWITH_OLD_YESOD-# Or with an old version of the uri library, enable -DWITH_OLD_URI FEATURES?=$(GIT_ANNEX_LOCAL_FEATURES) -DWITH_ASSISTANT -DWITH_S3 -DWITH_WEBDAV -DWITH_WEBAPP -DWITH_PAIRING -DWITH_XMPP -DWITH_DNS  bins=git-annex@@ -121,6 +120,10 @@ 	@hpc markup test --exclude=Main --exclude=QC --destdir=.hpc >/dev/null 	@echo "(See .hpc/ for test coverage details.)" +# hothasktags chokes on some tempolate haskell etc, so ignore errors+tags:+	find . | grep -v /.git/ | grep -v /doc/ | egrep '\.hs$$' | xargs hothasktags > tags 2>&1+ # If ikiwiki is available, build static html docs suitable for being # shipped in the software package. ifeq ($(shell which ikiwiki),)@@ -140,7 +143,7 @@  clean: 	rm -rf $(GIT_ANNEX_TMP_BUILD_DIR) $(bins) $(mans) test configure  *.tix .hpc $(sources) \-		doc/.ikiwiki html dist $(clibs) build-stamp+		doc/.ikiwiki html dist $(clibs) build-stamp tags  sdist: clean $(mans) 	./Build/make-sdist.sh@@ -217,4 +220,4 @@ getflags: 	@echo $(ALLFLAGS) $(clibs) -.PHONY: $(bins) test install+.PHONY: $(bins) test install tags
Seek.hs view
@@ -28,7 +28,7 @@ 		runSegmentPaths (\fs -> Git.Command.leaveZombie <$> a fs g) params 	{- Show warnings only for files/directories that do not exist. -} 	forM_ (map fst $ filter (null . snd) $ zip params ll) $ \p ->-		unlessM (liftIO $ doesFileExist p <||> doesDirectoryExist p) $+		unlessM (isJust <$> (liftIO $ catchMaybeIO $ getSymbolicLinkStatus p)) $ 			fileNotFound p 	return $ concat ll @@ -127,3 +127,6 @@  whenNotDirect :: CommandSeek -> CommandSeek whenNotDirect a params = ifM isDirect ( return [] , a params )++whenDirect :: CommandSeek -> CommandSeek+whenDirect a params = ifM isDirect ( a params, return [] )
Types/GitConfig.hs view
@@ -33,6 +33,8 @@ 	, annexDelayAdd :: Maybe Int 	, annexHttpHeaders :: [String] 	, annexHttpHeadersCommand :: Maybe String+	, annexAutoCommit :: Bool+	, annexWebOptions :: [String] 	}  extractGitConfig :: Git.Repo -> GitConfig@@ -42,7 +44,7 @@ 	, annexDiskReserve = fromMaybe onemegabyte $ 		readSize dataUnits =<< getmaybe "diskreserve" 	, annexDirect = getbool "direct" False-	, annexBackends = fromMaybe [] $ words <$> getmaybe "backends"+	, annexBackends = getwords "backends" 	, annexQueueSize = getmayberead "queuesize" 	, annexBloomCapacity = getmayberead "bloomcapacity" 	, annexBloomAccuracy = getmayberead "bloomaccuracy"@@ -51,6 +53,8 @@ 	, annexDelayAdd = getmayberead "delayadd" 	, annexHttpHeaders = getlist "http-headers" 	, annexHttpHeadersCommand = getmaybe "http-headers-command"+	, annexAutoCommit = getbool "autocommit" True+	, annexWebOptions = getwords "web-options" 	}   where 	get k def = fromMaybe def $ getmayberead k@@ -59,6 +63,7 @@ 	getmayberead k = readish =<< getmaybe k 	getmaybe k = Git.Config.getMaybe (key k) r 	getlist k = Git.Config.getList (key k) r+	getwords k = fromMaybe [] $ words <$> getmaybe k  	key k = "annex." ++ k 			
Utility/Url.hs view
@@ -16,10 +16,7 @@ ) where  import Common-import qualified Network.Browser as Browser-import Network.HTTP import Network.URI-import Data.Either  type URLString = String @@ -38,21 +35,35 @@  - also returning its size if available. -} exists :: URLString -> Headers -> IO (Bool, Maybe Integer) exists url headers = case parseURI url of-	Nothing -> return (False, Nothing) 	Just u 		| uriScheme u == "file:" -> do 			s <- catchMaybeIO $ getFileStatus (uriPath u)-			return $ case s of-				Nothing -> (False, Nothing)-				Just stat -> (True, Just $ fromIntegral $ fileSize stat)+			case s of+				Just stat -> return (True, Just $ fromIntegral $ fileSize stat)+				Nothing -> dne 		| otherwise -> do-			r <- request u headers HEAD-			case rspCode r of-				(2,_,_) -> return (True, size r)-				_ -> return (False, Nothing)+			output <- readProcess "curl" curlparams+			case lastMaybe (lines output) of+				Just ('2':_:_) -> return (True, extractsize output)+				_ -> dne+	Nothing -> dne   where-	size = liftM Prelude.read . lookupHeader HdrContentLength . rspHeaders+	dne = return (False, Nothing) +	curlparams = +		[ "-s"+		, "--head"+		, "-L"+		, url+		, "-w", "%{http_code}"+		] ++ concatMap (\h -> ["-H", h]) headers++	extractsize s = case lastMaybe $ filter ("Content-Length:" `isPrefixOf`) (lines s) of+		Just l -> case lastMaybe $ words l of+			Just sz -> readish sz+			_ -> Nothing+		_ -> Nothing+ {- Used to download large files, such as the contents of keys.  -  - Uses wget or curl program for its progress bar. (Wget has a better one,@@ -80,54 +91,5 @@  {- Downloads a small file. -} get :: URLString -> Headers -> IO String-get url headers =-	case parseURI url of-		Nothing -> error "url parse error"-		Just u -> do-			r <- request u headers GET-			case rspCode r of-				(2,_,_) -> return $ rspBody r-				_ -> error $ rspReason r--{- Makes 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.- -}-request :: URI -> Headers -> RequestMethod -> IO (Response String)-request url headers requesttype = go 5 url-  where-	go :: Int -> URI -> IO (Response String)-	go 0 _ = error "Too many redirects "-	go n u = do-		rsp <- Browser.browse $ do-			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-	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 newURI_abs-				  where-#if defined VERSION_network-#if ! MIN_VERSION_network(2,4,0)-#define WITH_OLD_URI-#endif-#endif-#ifdef WITH_OLD_URI-					newURI_abs = fromMaybe newURI (newURI `relativeTo` u)-#else-					newURI_abs = newURI `relativeTo` u-#endif-	addheaders req = setHeaders req (rqHeaders req ++ userheaders)-	userheaders = rights $ map parseHeader headers+get url headers = readProcess "curl" $+	["-s", "-L", url] ++ concatMap (\h -> ["-H", h]) headers
debian/changelog view
@@ -1,3 +1,24 @@+git-annex (3.20130207) unstable; urgency=low++  * webapp: Now allows restarting any threads that crash.+  * Adjust debian package to only build-depend on DAV on architectures+    where it is available.+  * addurl --fast: Use curl, rather than haskell HTTP library, to support https.+  * annex.autocommit: New setting, can be used to disable autocommit+    of changed files by the assistant, while it still does data syncing+    and other tasks.+  * assistant: Ignore .DS_Store on OSX.+  * assistant: Fix location log when adding new file in direct mode.+  * Deal with stale mappings for deleted file in direct mode.+  * pre-commit: Update direct mode mappings. +  * uninit, unannex --fast: If hard link creation fails, fall back to slow+    mode.+  * Clean up direct mode cache and mapping info when dropping keys.+  * dropunused: Clean up stale direct mode cache and mapping info not+    removed before.++ -- Joey Hess <joeyh@debian.org>  Thu, 07 Feb 2013 12:45:25 -0400+ git-annex (3.20130124) unstable; urgency=low    * Added source repository group, that only retains files until they've
debian/control view
@@ -10,10 +10,9 @@ 	libghc-pcre-light-dev, 	libghc-sha-dev, 	libghc-dataenc-dev,-	libghc-http-dev, 	libghc-utf8-string-dev, 	libghc-hs3-dev (>= 0.5.6),-	libghc-dav-dev (>= 0.3),+	libghc-dav-dev (>= 0.3) [amd64 i386 kfreebsd-amd64 kfreebsd-i386 sparc], 	libghc-testpack-dev, 	libghc-quickcheck2-dev, 	libghc-monad-control-dev (>= 0.3),@@ -44,6 +43,7 @@ 	libghc-network-protocol-xmpp-dev (>= 0.4.3-1+b1), 	libghc-gnutls-dev (>= 0.1.4), 	libghc-xml-types-dev,+	libghc-async-dev, 	ikiwiki, 	perlmagick, 	git,@@ -62,7 +62,8 @@ 	git (>= 1:1.7.7.6), 	uuid, 	rsync,-	wget | curl,+	wget,+	curl, 	openssh-client (>= 1:5.6p1) Recommends: lsof, gnupg, bind9-host Suggests: graphviz, bup, libnss-mdns
debian/rules view
@@ -1,10 +1,12 @@ #!/usr/bin/make -f -ARCH = $(shell dpkg-architecture -qDEB_BUILD_ARCH) ifeq (install ok installed,$(shell dpkg-query -W -f '$${Status}' libghc-yesod-dev 2>/dev/null))-export FEATURES=-DWITH_ASSISTANT -DWITH_S3 -DWITH_WEBDAV -DWITH_HOST -DWITH_OLD_URI -DWITH_PAIRING -DWITH_XMPP -DWITH_WEBAPP -DWITH_OLD_YESOD+export FEATURES=-DWITH_ASSISTANT -DWITH_S3 -DWITH_HOST -DWITH_PAIRING -DWITH_XMPP -DWITH_WEBAPP -DWITH_OLD_YESOD else-export FEATURES=-DWITH_ASSISTANT -DWITH_S3 -DWITH_WEBDAV -DWITH_HOST -DWITH_OLD_URI -DWITH_PAIRING -DWITH_XMPP+export FEATURES=-DWITH_ASSISTANT -DWITH_S3 -DWITH_HOST -DWITH_PAIRING -DWITH_XMPP+endif+ifeq (install ok installed,$(shell dpkg-query -W -f '$${Status}' libghc-dav-dev 2>/dev/null))+export FEATURES:=${FEATURES} -DWITH_WEBDAV endif  %:
+ doc/assistant/crashrecovery.png view

binary file changed (absent → 6594 bytes)

+ doc/bugs/DS__95__Store_not_gitignored.mdwn view
@@ -0,0 +1,26 @@+What steps will reproduce the problem?++Create a new git repo on OS X.  create a .gitignore file containing the line ".DS_Store".  Check it into git.  do "git annex init" to make the directory into a git annex repo.  do "git annex direct" to put it in direct mode.  do "git annex assistant" to start the assistant and watch it with "git annex webapp".++Open the directory in the finder.  Drag in some files and watch the assistant as it checks them in.  Play with your window's viewing preferences, maybe view things as "icons" so that the finder is forced to store metadata about where you dragged the icons in the window in the .DS_Store file.  As you do this, watch the webapp.  .DS_Store will start to be checked into git annex, and rechecked in frequently as it is updated.  Git annex assistant is not respecting the .gitignore file.  Is there some other way to tell git annex assistant that certain files should be ignored than .gitignore?+++What is the expected output? What do you see instead?++.DS_Store files are ignored by the assistant.+++What version of git-annex are you using? On what operating system?++git-annex version: 3.20130124++OS X Lion++Please provide any additional information below.++> Assistant does not support .gitignore yet. Requires an efficient query+> interface for ignores, which git does not provide.+>+> However, I've added a special case, OSX only ignore for .DS_Store files.+> [[done]] --[[Joey]] +
doc/bugs/Error_creating_remote_repository_using_ssh_on_OSX.mdwn view
@@ -32,4 +32,5 @@  > After a little research it seems that OSX does not have a ssh-askpass -+[[!tag /design/assistant/OSX]]+[[!meta title="ssh-askpass not available on OSX"]]
+ doc/bugs/OSX_app_issues/comment_12_f3bc5a4e4895ac9351786f0bdd8005ba._comment view
@@ -0,0 +1,11 @@+[[!comment format=mdwn+ username="https://www.google.com/accounts/o8/id?id=AItOawmYiJgOvC4IDYkr2KIjMlfVD9r_1Sij_jY"+ nickname="Douglas"+ subject="Error creating remote repository using ssh on OSX"+ date="2013-01-25T13:18:40Z"+ content="""+There is an issue with creating remote repositories using ssh (the problem may require using a different account name.) I filed the following bug:+++<http://git-annex.branchable.com/bugs/Error_creating_remote_repository_using_ssh_on_OSX/>+"""]]
+ doc/bugs/assistant_ignore_.gitignore.mdwn view
@@ -0,0 +1,27 @@+What steps will reproduce the problem?++1. have an existing directory with a bunch of files+2. create a `.gitignore` file that matches some files (*.log *.aux *~ etc.)+3. `git init .`+4. `git annex init work`+5. `git remote add server server:Blabla`+6. `ssh server`+7. `@server $ mkdir Blabla`+8. `@server $ cd Blabla`+9. `@server $ git init .`+10. `@server $ git annex init server`+11. `@server $ exit`+12. `git annex webapp`++What is the expected output? What do you see instead?++I expect that ingored files stay ignored,+I see instead that all the files (including the ignored) are transfered to the server++What version of git-annex are you using? On what operating system?++3.20130124, debian sid (on both machines)++> As noted in [[design/assistant/inotify]]'s TODO list, this+> needs an efficient gitignore query interface in git (DNE) +> or a gitignore parser. --[[Joey]] 
+ doc/bugs/creating_a_remote_server_repository.mdwn view
@@ -0,0 +1,24 @@+What steps will reproduce the problem?++I was trying to add a remote server repository. Unfortunately, this didn't work. Enter Host name, user name, directory, port+(left most of them at their default), but there is no way, to specify a password.) Clicking check this server failed:++ Failed to ssh to the server. Transcript: Permission denied, please try again. Permission denied, please try again. Permission denied (publickey,password). ++(Problem was, I could never enter a password. Interestingly, on the konsole, I get a prompt for a password, but I can't enter anything there).+++What is the expected output? What do you see instead?++Successfully create a connection and use the remote server.+++What version of git-annex are you using? On what operating system?+Version: 3.20130124++++Please provide any additional information below.++[[!tag /design/assistant]]+[[!meta title="ssh password prompting"]]
+ doc/bugs/direct_mode_renames.mdwn view
@@ -0,0 +1,15 @@+When in direct mode, renaming a file with `git mv` does not update the+direct mode mapping to use the new filename. --[[Joey]]++Consistency checks now prevent anything bad happening when the mapping file+contains old filenames. Still, missing the new filename will prevent that+file working properly in direct mode.++Perhaps the pre-commit hook needs to update the mapping for files that were+deleted or added.++This also affects moves of files when the assistant is being used.+In this case, the assistant updates the mapping to add the new name,+but does not delete the old name from the mapping.++> [[done]]; the pre-commit hook now updates the mappings. --[[Joey]]
+ doc/bugs/dropunused_doesn__39__t_work_in_my_case__63__.mdwn view
@@ -0,0 +1,61 @@+What steps will reproduce the problem?++I am unable to create a minimal setup to reproduce this unfortunately. But my case is the following:++* Two synced repos, I have switched between direct and indirect in both, currently they are indirect+* I have two submodules in the repos (not related to the unuesd files)++* I used "git rm -r" to remove a bunch of files along with "git mv" to move some+* I have three commits of actions like this++* In one repo, the one where I did the deletions, I have 172 unused files, and all seem to come from the first of the three commits+* In the second repo, to which I synced, I have 188 unused files, which includes a couple of files from the third commit as well++* If I try to dropunused either a single file or the whole range of the files, from either repo, I get git-annex telling me "ok, recording state" but when I run unused again the files are still there. And looking into .git/objects/annex/ the file is still present++This is the debug from the drop command:++    dropunused 9 [2013-02-07 12:47:24 CET] read: git ["--git-dir=/home/arand/.git","--work-tree=/home/arand","show-ref","git-annex"]+    [2013-02-07 12:47:24 CET] read: git ["--git-dir=/home/arand/.git","--work-tree=/home/arand","show-ref","--hash","refs/heads/git-annex"]+    [2013-02-07 12:47:24 CET] read: git ["--git-dir=/home/arand/.git","--work-tree=/home/arand","log","refs/heads/git-annex..5f3fc9db5c7badb5fb25c3159c20584f11dadaf9","--oneline","-n1"]+    [2013-02-07 12:47:24 CET] read: git ["--git-dir=/home/arand/.git","--work-tree=/home/arand","log","refs/heads/git-annex..8e5674078706864f2eade86d8aa43027e05afc1d","--oneline","-n1"]+    [2013-02-07 12:47:24 CET] read: git ["--git-dir=/home/arand/.git","--work-tree=/home/arand","log","refs/heads/git-annex..cbe492cfa79728698f5d891d7f716fbcd9fc29e2","--oneline","-n1"]+    [2013-02-07 12:47:24 CET] read: git ["--git-dir=/home/arand/.git","--work-tree=/home/arand","log","refs/heads/git-annex..48a1bdf98a10ad9a81c0587f8909e94c1c0dccc4","--oneline","-n1"]+    [2013-02-07 12:47:24 CET] chat: git ["--git-dir=/home/arand/.git","--work-tree=/home/arand","cat-file","--batch"]+    [2013-02-07 12:47:24 CET] read: git ["config","--null","--list"]+    [2013-02-07 12:47:24 CET] chat: git ["--git-dir=/home/arand/.git","--work-tree=/home/arand","hash-object","-w","--stdin-paths"]+    [2013-02-07 12:47:24 CET] feed: git ["--git-dir=/home/arand/.git","--work-tree=/home/arand","update-index","-z","--index-info"]+    [2013-02-07 12:47:24 CET] read: git ["--git-dir=/home/arand/.git","--work-tree=/home/arand","show-ref","--hash","refs/heads/git-annex"]+    [2013-02-07 12:47:24 CET] read: git ["--git-dir=/home/arand/.git","--work-tree=/home/arand","write-tree"]+    [2013-02-07 12:47:24 CET] chat: git ["--git-dir=/home/arand/.git","--work-tree=/home/arand","commit-tree","76f5041bc6e8a109e0309a09b5f36cd0da8b204a","-p","refs/heads/git-annex"]+    [2013-02-07 12:47:24 CET] call: git ["--git-dir=/home/arand/.git","--work-tree=/home/arand","update-ref","refs/heads/git-annex","96de755475bdd8f0f948dd6421c3956803a63e66"]+    ok+    (Recording state in git...)++If I run it again, I get:++    dropunused 9 [2013-02-07 12:47:47 CET] read: git ["--git-dir=/home/arand/.git","--work-tree=/home/arand","show-ref","git-annex"]+    [2013-02-07 12:47:47 CET] read: git ["--git-dir=/home/arand/.git","--work-tree=/home/arand","show-ref","--hash","refs/heads/git-annex"]+    [2013-02-07 12:47:47 CET] read: git ["--git-dir=/home/arand/.git","--work-tree=/home/arand","log","refs/heads/git-annex..96de755475bdd8f0f948dd6421c3956803a63e66","--oneline","-n1"]+    [2013-02-07 12:47:48 CET] read: git ["--git-dir=/home/arand/.git","--work-tree=/home/arand","log","refs/heads/git-annex..8e5674078706864f2eade86d8aa43027e05afc1d","--oneline","-n1"]+    [2013-02-07 12:47:48 CET] read: git ["--git-dir=/home/arand/.git","--work-tree=/home/arand","log","refs/heads/git-annex..cbe492cfa79728698f5d891d7f716fbcd9fc29e2","--oneline","-n1"]+    [2013-02-07 12:47:48 CET] read: git ["--git-dir=/home/arand/.git","--work-tree=/home/arand","log","refs/heads/git-annex..48a1bdf98a10ad9a81c0587f8909e94c1c0dccc4","--oneline","-n1"]+    [2013-02-07 12:47:48 CET] chat: git ["--git-dir=/home/arand/.git","--work-tree=/home/arand","cat-file","--batch"]+    [2013-02-07 12:47:48 CET] read: git ["config","--null","--list"]+    [2013-02-07 12:47:48 CET] chat: git ["--git-dir=/home/arand/.git","--work-tree=/home/arand","hash-object","-w","--stdin-paths"]+    [2013-02-07 12:47:48 CET] feed: git ["--git-dir=/home/arand/.git","--work-tree=/home/arand","update-index","-z","--index-info"]+    [2013-02-07 12:47:48 CET] read: git ["--git-dir=/home/arand/.git","--work-tree=/home/arand","show-ref","--hash","refs/heads/git-annex"]+    [2013-02-07 12:47:48 CET] read: git ["--git-dir=/home/arand/.git","--work-tree=/home/arand","write-tree"]+    [2013-02-07 12:47:48 CET] chat: git ["--git-dir=/home/arand/.git","--work-tree=/home/arand","commit-tree","e40d82db10c60519f6a3a72055e9577850972fdf","-p","refs/heads/git-annex"]+    [2013-02-07 12:47:48 CET] call: git ["--git-dir=/home/arand/.git","--work-tree=/home/arand","update-ref","refs/heads/git-annex","6cf49f629251f9b39fa8b457cf6590c71c1d509b"]+    ok+    (Recording state in git...)+++What version of git-annex are you using? On what operating system?++git-annex: 3.20130124+Debian: sid 2013-02-01++> unused being confused by stale data left when switching from direct mode.+> I've made this be cleaned up. [[done]] --[[Joey]]
doc/bugs/internal_server_error_creating_repo_on_ssh_server.mdwn view
@@ -22,3 +22,5 @@ Internal Server Error user error (gpg ["--quiet","--trust-model","always","--gen-random","--armor","1","512"] exited 127) git-annex version 3.20121212++> [[done]], see comments --[[Joey]] 
+ doc/bugs/javascript_functions_qouting_issue.mdwn view
@@ -0,0 +1,44 @@+**What is the expected output? What do you see instead?**++SyntaxError: missing ( before formal parameters++function longpoll_"sidebar"() {++reposi...c5e0ead (строка 5, столбец 18)+	++**Please provide any additional information below.**++functions have illegal characters in their names: *function longpoll_"sidebar"*++    <script>function longpoll_"sidebar"() {+    	longpoll(longpoll_"sidebar"_url, '"sidebar"'+    		, function() { setTimeout(longpoll_"sidebar", "10"); }+    		, function() { webapp_disconnected(); }+    	);+    }+    $(function() {+    	$.get("/notifier/sidebar?auth=bd717e7499f2c42363719c833d3df2d25b77cf42184aacbcd0f969895911a0208ba17fd4f468c4b97274d5e3f7f419260e5df7d83d2e7642524a89325c5e0ead", function(url){+    		longpoll_"sidebar"_url = url;+    		setTimeout(longpoll_"sidebar", "10");+    	});+    });+    function longpoll_"repolist"() {+    	longpoll(longpoll_"repolist"_url, '"repolist"'+    		, function() { setTimeout(longpoll_"repolist", "10"); }+    		, function() { webapp_disconnected(); }+    	);+    }+    $(function() {+    	$.get("/notifier/repolist/RepoSelector%20%7BonlyCloud%20=%20False,%20onlyConfigured%20=%20False,%20includeHere%20=%20True%7D?auth=bd717e7499f2c42363719c833d3df2d25b77cf42184aacbcd0f969895911a0208ba17fd4f468c4b97274d5e3f7f419260e5df7d83d2e7642524a89325c5e0ead", function(url){+    		longpoll_"repolist"_url = url;+    		setTimeout(longpoll_"repolist", "10");+    	});+    });++> This is already fixed in the 3.20130124 release. [[done]]+> +> (Standalone builds of that release are not yet available for Mountian+> Lion.+> +> --[[Joey]] 
+ doc/bugs/long_running_assistant_causes_resource_starvation_on_OSX.mdwn view
@@ -0,0 +1,24 @@+What steps will reproduce the problem?++leave the assistant running for multiple days++What is the expected output? ++Glorious git-annex enlightenment++What do you see instead?++After ~2-3 days, there are hundreds of zombied git processes and the system is unable to fork new processes. This has occurred on 3 differently hardware configured mac's (macbooks and imacs) all running Mountain Lion 10.8.2 Build 12C3006+In each case, once the system gets to this point, the only solution is forcing a reboot by holding down the power button as not even kill can spin up it's process.++What version of git-annex are you using?++    git-annex version: 3.20130122++On what operating system?++Mac OSX 10.8.2 Mountain Lion Build 12C3006++Please provide any additional information below.++I'm really not sure what to look for next. Happy to take suggestions.
@@ -38,4 +38,10 @@  git-annex should probably not be used on a file system where hard links are disabled. -However, if Bob is not aware that he's using git-annex on such a filesystem, he will accidently deletes his annexed files by issuing a `git annex uninit` command.+However, if the user is not aware that he's using git-annex on such a filesystem, he will accidently delete his annexed files by issuing a `git annex uninit` command.++> git-annex needs a POSIX filesystem, which includes the ability to create+> hard links. The `git annex add` in the example above will fail+> trying to create a hard link with current versions.+> +> I've made uninit fall back to a non-hard link mode. [[done]] --[[Joey]]
doc/design/assistant/android.mdwn view
@@ -30,6 +30,8 @@ but also Android. Need to get in touch with them. <http://ipwnstudios.com/> +Update: This looks likely: <https://github.com/neurocyte/ghc-android>+ ### Android specific features  The app should be aware of power status, and avoid expensive background
+ doc/design/assistant/blog/day_176__thread_management.mdwn view
@@ -0,0 +1,13 @@+Got back to hacking today, and did something I've wanted to do for some+time. Made all the assistant's threads be managed by a thread manager. This+allows restarting threads if they crash, by clicking a button in the+webapp. It also will allow for other features later, like stopping and+starting the watcher thread, to pause the assistant adding local files.++[[!img /assistant/crashrecovery.png]]++I added the haskell async library as a dependency, which made this pretty+easy to implement. The only hitch is that async's documentation is not+clear about how it handles asyncronous exceptions. It took me quite a while+to work out why the errors I'd inserted into threads to test were crashing+the whole program rather than being caught!
+ doc/design/assistant/blog/day_178__bus_hacking.mdwn view
@@ -0,0 +1,10 @@+Hacking on a bus to Canberra for [LCA2013](https://lca2013.linux.org.au/),+I made the webapp's UI for pausing syncing to a repository also work for+the local repository. This pauses the watcher thread. (There's also an+annex.autocommit config setting for this.)++Ironically, this didn't turn out to the use the thread manager I built+yesterday. I am not sure that a ThreadKilled exception would never be+masked in the watcher thread. (There is some overly broad exception+handling in git-annex that dates to back before I quite understood haskell+exceptions.)
+ doc/design/assistant/blog/day_179__brief_updates.mdwn view
@@ -0,0 +1,19 @@+Not doing significant coding here at LCA2013, but stuff is still happening:++* I'll be giving a talk and demo of git-annex and the assistant tomorrow.+  Right after a keynote by Tim Berners-Lee! There's no streaming, but+  a recording will be available later.+* I've met numerous git-annex users and git-annex curious folk from down+  under.+* I had a suggestion that direct mode rename the `.git` directory to+  something else, to prevent foot-shooting git commands being used.+  A wrapper around git could be used to run git commands, and limit+  to safe ones. Under consideration.+* I finally updated the OSX 10.8.2 build to last week's release.+  Been having some problems with the autobuilder, but it finally spat out+  a build. Hopefully this build is good, and it should fix the javascript+  issues with Safari and the webapp.+* Ulrik Sverdrup has written <https://github.com/blake2-ppc/git-remote-gcrypt>,+  which allows using gpg encrypted ssh remotes with git. The same idea+  could be expanded to other types of remotes, like S3. I'm excited+  about adding encrypted git remote support to the assistant!
+ doc/design/assistant/blog/day_180__back.mdwn view
@@ -0,0 +1,7 @@+Back from Australia. Either later today or tomorrow I'll dig into the+messages I was not able to get to while traveling, and then the plan is to+get into the Android port.++Video of my LCA2013 [git-annex talk](http://mirror.linux.org.au/linux.conf.au/2013/mp4/gitannex.mp4)+is now available. I have not watched it yet, hope it turned out ok despite+some technical difficulties!
+ doc/design/assistant/blog/day_181__triage.mdwn view
@@ -0,0 +1,23 @@+Got fairly far along in my triage of my backlog, looking through everything+that happened after January 23rd. Still 39 or so items to look at.++There have been several reports of problems with ssh password prompts.+I'm beginning to think the assistant may need to prompt for the password+when setting up a ssh remote. This should be handled by `ssh-askpass` or+similar, but some Linux users probably don't have it installed, and there+seems to be no widely used OSX equivalent.++---++Fixed several bugs today, all involving (gasp) direct mode.++The tricky one involved renaming or deleting files in direct mode.+Currently nothing removes the old filename from the direct mode+mapping, and this could result in the renamed or deleted file+unexpectedly being put back into the tree when content is downloaded.++To deal with this, it now assumes that direct mode mappings may be out of+date compared to the tree, and does additional checks to catch+inconsistencies. While that works well enough for the assistant,+I'd also like to make the `pre-commit` hook update the mappings for files+that are changed. That's needed to handle things like `git mv`.
+ doc/design/assistant/blog/day_182__it_begins.mdwn view
@@ -0,0 +1,50 @@+I need an Android development environment. I briefly looked into rooting+the Asus Transformer so I could put a Debian chroot on it and build+git-annex in there, but this quickly devolved to the typical maze of+forum posts all containing poor instructions and dead links. Not worth it.++Instead, I'm doing builds on my Sheevaplug, and once I have a static armel+binary, will see what I need to do to get it running on Android.++Fixed building with the webapp disabled, was broken by recent improvements.+I'll be building without the webapp on arm initially, because ghci/template+haskell on arm is still getting sorted out. (I tried ghc 7.6.2 and ghci is+available, but doesn't quite work.)++From there, I got a binary built pretty quickly (well, it's arm, so not *too*+quickly). Then tried to make it static by appending +`-optl-static -optl-pthread` to the ghc command line.+This failed with a bunch of errors:++<pre>+/usr/lib/gcc/arm-linux-gnueabi/4.6/../../../arm-linux-gnueabi/libxml2.a(nanohttp.o): In function `xmlNanoHTTPMethodRedir': (.text+0x2128): undefined reference to `inflateInit2_'+/usr/lib/gcc/arm-linux-gnueabi/4.6/../../../arm-linux-gnueabi/libxml2.a(xzlib.o): In function `xz_decomp': (.text+0x36c): undefined reference to `lzma_code'+...+</pre>++Disabling DBUS and (temporarily) XMPP got around that.++Result!++<pre>+joey@leech:~/git-annex>ldd tmp/git-annex +        not a dynamic executable+joey@leech:~/git-annex>ls -lha tmp/git-annex +-rwxr-xr-x 1 joey joey 18M Feb  6 16:23 tmp/git-annex*+</pre>++Next: Copy binary to Android device, and watch it fail in some interesting way.  +Repeat.++---++Also more bug triage this morning...++Got the pre-commit hook to update direct mode mappings.+Uses `git diff-index HEAD` to find out what's changed. The only+tricky part was detecting when `HEAD` doesn't exist yet. Git's+plumbing is deficient in this area. Anyway, the mappings get updated+much better now.++Fixed a wacky bug where `git annex uninit` behaved badly on a filesystem+that does not support hardlinks.
doc/design/assistant/cloud.mdwn view
@@ -40,3 +40,6 @@ Another option is to not store the git repo in the cloud, but push/pull peer-to-peer. When peers cannot directly talk to one-another, this could be bounced through something like XMPP. This is **done** for [[xmpp]]!++Another option: Use <https://github.com/blake2-ppc/git-remote-gcrypt> to store+git repo encrypted on cloud storage.
doc/design/assistant/desymlink.mdwn view
@@ -58,9 +58,9 @@   This allows just cloning one of these repositories normally, and then   as the files are synced in, they become real files. * Maintain a local mapping from keys to files in the tree. This is needed-  when sending/receiving keys to know what file to access. Note that a key-  can map to multiple files. And that when a file is deleted or moved, the-  mapping needs to be updated.+  when sending/receiving/dropping keys to know what file to access.+  Note that a key can map to multiple files. And that when a file is+  deleted or moved, the mapping needs to be updated. * May need a reverse mapping, from files in the tree to keys? TBD   (Currently, getting by looking up symlinks using `git cat-file`)   (Needed to make things like `git annex drop` that want to map from the
doc/design/assistant/polls/prioritizing_special_remotes.mdwn view
@@ -6,7 +6,7 @@ Help me prioritize my work: What special remote would you most like to use with the git-annex assistant? -[[!poll open=yes 15 "Amazon S3 (done)" 12 "Amazon Glacier (done)" 9 "Box.com (done)" 67 "My phone (or MP3 player)" 18 "Tahoe-LAFS" 6 "OpenStack SWIFT" 25 "Google Drive"]]+[[!poll open=yes 15 "Amazon S3 (done)" 12 "Amazon Glacier (done)" 9 "Box.com (done)" 68 "My phone (or MP3 player)" 18 "Tahoe-LAFS" 6 "OpenStack SWIFT" 25 "Google Drive"]]  This poll is ordered with the options I consider easiest to build listed first. Mostly because git-annex already supports them and they
+ doc/forum/Let_watch_selectively_annex_files.mdwn view
@@ -0,0 +1,27 @@+Hello,++First of all, thanks to Joey for developing git-annex, good job!++I have a small feature request: when running git annex watch, new files are automatically added to the annex. It would be nice to let this depend on an attribute: add a file to annex if an attribute is set, otherwise do a regular git add.++My use-case is the following: I have a repository containing documents I'm working on (mostly LaTeX), which I'd like to be regular files in git (no annex), and a bunch of extra documentation (pdfs) and images, which I'd like to go to the annex. I currently set a git-attribute (addtoannex), and use a shell script to selectively add files to annex as follows:++Content of .gitattributes:++    *.png addtoannex+    *.jpg addtoannex++Snippet of add script:++    git check-attr addtoannex "$FILE" | grep -q ": set$"+    if [ $? -eq 0 ]; then+        git annex add "$FILE"+    else+        git add "$FILE"+    fi++It would be great if the watcher could honour an attribute.++best regards,++Tom
+ doc/forum/Watch__47__assistant__47__webapp_documentation.mdwn view
@@ -0,0 +1,12 @@+Hello,++I'm not sure about the differences and interactions between watch / assistant / webapp / direct mode. I think I figured the following out, can someone confirm this, and perhaps a few words to the documentation / man page?++- git annex watch uses inotify to find new files, and runs git annex add on them (it does not do regular git add)+- git annex assistant does the same as watch, but also runs git annex sync for each new file (does it also enable direct mode?)+- git annex webapp does the same as assistant, and also starts a webapp (in my case it immediately started sending files to origin, without asking for confirmation, which was surprising, I guess this is because I have * annex.numcopies=2 set, and there was only one copy. Still I interpreted the documentation as if it would only show me an interface, not start doing things right away.)++Do these commands do anything else than what I described above?++best regards,+Tom
+ doc/forum/archaeology_of_deleted_files.mdwn view
@@ -0,0 +1,36 @@+Earlier this week, I somehow lost a ton of files from my annex -- by switching on the command line from indirect to direct mode while the assistant was running, I think. I'm not sure.++Anyway, by "lost" I mean "lost the symlinks to," because git-annex defaults to keeping content around till you tell it otherwise.  So I still had the content in the repos on my two backup drives.  All I needed was the symlinks back.++But how to figure out exactly what I lost and get it back?++I found that out here:++http://stackoverflow.com/questions/953481/restore-a-deleted-file-in-a-git-repo++Here's a magical formula you can use to find every single file deletion in the history of your repo:++    git log --diff-filter=D --summary ++That will give you every commit that deleted things, and what was deleted.++To bring back all the files deleted in a given commit, where COMMITHASH is the commit hash, use this command:++    git checkout COMMITHASH^1 -- .++to bring back only a specific file:++    git checkout COMMITHASH^1 -- path/to/file.txt++to bring back only a subdirectory:++    git checkout COMMITHASH^1 -- sub/directory++that will bring them back into the staging area.  You can see which ones just reappeared by typing:++    git status++then you can actually make the restore permanent by typing: ++    git commit -m "I just resurrected some files"+
+ doc/forum/question_about_assistant_and___47__archive__47__.mdwn view
@@ -0,0 +1,22 @@+I have a git-annex repository located at ~/annex which has been set up using git-annex assistant.++This repository is configured as "client".++My other repository is a huge USB drive configured as "full archive".++Now everything seems to work fine except there is one thing I don't understand:++    alip@client:~/annex> git-annex whereis ./archive/kus.png+    whereis archive/kus.png (1 copy) +        e79a4cf6-4c48-4833-93de-98ba6eb625d6 -- deniz+    ok++Fine, there is only one copy according to git-annex but the file is still present+in **this** client repository:++    alip@client:> du -hs ~/annex/archive+    20G	/home/alip/annex/archive/++How do I free this space? Am I supposed to call git-annex drop manually?++git-annex version: 3.20130124
+ doc/forum/recovering_from_repo_corruption.mdwn view
@@ -0,0 +1,11 @@+In my current annex config, I have 4 computers with "traditional" git annexes as well as an external drive that is a git annex, an rsync'd backup annex, and a glacier archive.  Today, one of the computers got a corrupted git repo. It was complaining that a pack file was invalid. In my attempts to fix it, a commit was logged that deleted every file in the annex. I didn't find this out until I did 'git annex sync' and watched git delete everything, then send all those commits to my other 3 systems and the external drive. *facepalm*++Fortunately, I had one of those other systems in direct mode and I copied everything from the annex as a backup. Now, when I try to re-add files to the annex, I'm running into some errors. These appear to be "collisions" within the annex part of the .git folder:++    %  › git annex add House.netspd +    add House.netspd (checksum...) +    git-annex: /Users/akraut/Desktop/annex/.git/annex/objects/31/Gw/SHA256E-s167433--41e68ea0adb5a4086a0b7b39d0556b9b86523ffb6b498d58f12f96460da315e9/SHA256E-s167433--41e68ea0adb5a4086a0b7b39d0556b9b86523ffb6b498d58f12f96460da315e9.map.tmp62699: openFile: permission denied (Permission denied)+    failed+    git-annex: add: 1 failed++Any ideas on what's going on here? Perhaps how to get things added back in or recovered? It seems all the actual file contents are here, but annex doesn't seem to know they're there anymore.
+ doc/forum/something_really_good_happened_with_3.20130124.mdwn view
@@ -0,0 +1,5 @@+The web app used to be unresponsive without manual refreshes.  Now it's all snappy and responsive and quickly reflects what the assistant is doing.++It used to be a complete crapshoot whether the assistant actually shut down when you told it to (either on the command line or through the webapp).  I used to have to manually kill leftover assistants and child processes routinely.  Now... you want it gone, and it's gone instantly, every time.++Something really good happened with this last version, thank you joey!
+ doc/forum/switching_backends.mdwn view
@@ -0,0 +1,12 @@+so git annex migrate can switch a file from using one backend to the other.++I've done that with a bunch of files.++The old files should become "unused" right?  But they don't seem to be.  "git annex unused" still shows me only 2 unused files, and I've just migrated dozens of files from SHA256 to SHA256E.  ++Is it possible they're still "used" by other repos?  I have two other repos, one reached by SSH and one on a USB drive.  Neither one of them is "bare."  So maybe those files are still used by the "master" branches there, I thought... I went over and did "git annex sync" on each.  Still my newly migrated files are not showing up as "unused."  ++I'm worried that my repo is going to bloat with unused files with the SHA256 backend, which mysteriously do not show up as "unused" in git annex unused, if I migrate any more.++any ideas what piece of the puzzle I could be missing here?+
+ doc/forum/use_existing_ssh_keys__63__.mdwn view
@@ -0,0 +1,5 @@+Hi, a new user trying out git-annex 3.20130124 here. So far looks really promising, thanks.++I setup a local annex using the assistant webapp. I then created a rsync cloud repo over ssh to my shell box in a nearby data center for it. Works ok. I already have ssh key setup inclding ssh-agent for quick logins to the server. It would be great if you could configure the assistant to use these existing keys instead of creating a new set of keys. Maybe keep the defaults as is, but provide the config for this hidden behind "trust me, I know what I'm doing" check box or something.++Thanks again, I keep researching.
doc/git-annex.mdwn view
@@ -802,6 +802,11 @@   are accessed directly, rather than through symlinks. Note that many git   and git-annex commands will not work with such a repository. +* `annex.autocommit`++  Set to false to prevent the git-annex assistant from automatically+  committing changes to files in the repository.+ * `remote.<name>.annex-cost`    When determining which repository to
+ doc/install/OSX/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/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/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/fromscratch.mdwn view
@@ -13,7 +13,6 @@   * [lifted-base](http://hackage.haskell.org/package/lifted-base)   * [TestPack](http://hackage.haskell.org/cgi-bin/hackage-scripts/package/testpack)   * [QuickCheck 2](http://hackage.haskell.org/package/QuickCheck)-  * [HTTP](http://hackage.haskell.org/package/HTTP)   * [json](http://hackage.haskell.org/package/json)   * [IfElse](http://hackage.haskell.org/package/IfElse)   * [bloomfilter](http://hackage.haskell.org/package/bloomfilter)@@ -46,13 +45,15 @@   * [network-protocol-xmpp](http://hackage.haskell.org/package/network-protocol-xmpp)   * [dns](http://hackage.haskell.org/package/dns)   * [xml-types](http://hackage.haskell.org/package/xml-types)+  * [async](http://hackage.haskell.org/package/async) * Shell commands   * [git](http://git-scm.com/)   * [uuid](http://www.ossp.org/pkg/lib/uuid/)     (or `uuidgen` from util-linux)   * [xargs](http://savannah.gnu.org/projects/findutils/)   * [rsync](http://rsync.samba.org/)-  * [wget](http://www.gnu.org/software/wget/) or [curl](http://http://curl.haxx.se/) (optional, but recommended)+  * [curl](http://http://curl.haxx.se/) (optional, but recommended)+  * [wget](http://www.gnu.org/software/wget/) (optional)   * [sha1sum](ftp://ftp.gnu.org/gnu/coreutils/) (optional, but recommended;     a sha1 command will also do)   * [gpg](http://gnupg.org/) (optional; needed for encryption)
− doc/news/version_3.20130102.mdwn
@@ -1,25 +0,0 @@-git-annex 3.20130102 released with [[!toggle text="these changes"]]-[[!toggleable text="""-   * direct, indirect: New commands, that switch a repository to and from-     direct mode. In direct mode, files are accessed directly, rather than-     via symlinks. Note that direct mode is currently experimental. Many-     git-annex commands do not work in direct mode. Some git commands can-     cause data loss when used in direct mode repositories.-   * assistant: Now uses direct mode by default when setting up a new-     local repository.-   * OSX assistant: Uses the FSEvents API to detect file changes.-     This avoids issues with running out of file descriptors on large trees,-     as well as allowing detection of modification of files in direct mode.-     Other BSD systems still use kqueue.-   * kqueue: Fix bug that made broken symlinks not be noticed.-   * vicfg: Quote filename. Closes: #[696193](http://bugs.debian.org/696193)-   * Bugfix: Fixed bug parsing transfer info files, where the newline after-     the filename was included in it. This was generally benign, but in-     the assistant, it caused unexpected dropping of preferred content.-   * Bugfix: Remove leading \ from checksums output by sha*sum commands,-     when the filename contains \ or a newline. Closes: #[696384](http://bugs.debian.org/696384)-   * fsck: Still accept checksums with a leading \ as valid, now that-     above bug is fixed.-   * SHA*E backends: Exclude non-alphanumeric characters from extensions.-   * migrate: Remove leading \ in SHA* checksums, and non-alphanumerics-     from extensions of SHA*E keys."""]]
+ doc/news/version_3.20130207.mdwn view
@@ -0,0 +1,18 @@+git-annex 3.20130207 released with [[!toggle text="these changes"]]+[[!toggleable text="""+   * webapp: Now allows restarting any threads that crash.+   * Adjust debian package to only build-depend on DAV on architectures+     where it is available.+   * addurl --fast: Use curl, rather than haskell HTTP library, to support https.+   * annex.autocommit: New setting, can be used to disable autocommit+     of changed files by the assistant, while it still does data syncing+     and other tasks.+   * assistant: Ignore .DS\_Store on OSX.+   * assistant: Fix location log when adding new file in direct mode.+   * Deal with stale mappings for deleted file in direct mode.+   * pre-commit: Update direct mode mappings.+   * uninit, unannex --fast: If hard link creation fails, fall back to slow+     mode.+   * Clean up direct mode cache and mapping info when dropping keys.+   * dropunused: Clean up stale direct mode cache and mapping info not+     removed before."""]]
+ doc/not/comment_7_581e23cca0219711f8a4500a8d5d20fc._comment view
@@ -0,0 +1,16 @@+[[!comment format=mdwn+ username="l3iggs"+ ip="24.130.145.126"+ subject="comment 7"+ date="2013-02-03T03:57:05Z"+ content="""+hi joey,++i'm excited by your project here but also confused by its direction. the kickstarter page has the header: \"git-annex assistant: Like DropBox, but with your own cloud.\" this page says \"git-annex is not a ... DropBox clone.\" these seem to be in direct opposition.++i'm looking for what is described by the header on your kickstarter page. i assume your backers are looking for the the same thing (a self hosted DropBox). for my use, dropbox is perfect, except for the fact that i have to pay a monthly fee to store my data on someone else's server when i would like to buy my own storage medium and run some open source dropbox clone on my own server.++can you explain more clearly what dropbox features your project lacks (/will lack)? and why where is a difference between your fundraising page and this one?++maybe i'm just confused by the difference between git-annex and git-annex assistant. does git-annex assistant truely aim to be a dropbox clone?+"""]]
+ doc/not/comment_8_5c61457f117de38ef487e5cc2780d554._comment view
@@ -0,0 +1,24 @@+[[!comment format=mdwn+ username="http://edheil.wordpress.com/"+ ip="99.54.57.201"+ subject="comment 8"+ date="2013-02-04T03:17:06Z"+ content="""+It's pretty much exactly what he said:++> git-annex is not a filesystem or DropBox clone. However, the git-annex assistant is addressing some of the same needs in its own unique ways. ++The git-annex assistant is not exactly like DropBox; it's not a drop-in replacement that works exactly the way dropbox works.  But as it stands, right now, it can (like Dropbox) run in the background and make sure that all of your files in a special directory are mirrored to another place (a USB drive, or a server to which you have SSH access, or another computer on your home network, or another computer somewhere else which has access to the same USB drive from time to time, or has accesss to the same SSH server or S3 repository or....++It works as is but is still under heavy development and features are being added rapidly.  For example, up until a month or two ago, the files in your annex were replaced with softlinks whose content resided in a hidden directory. This caused some problems esp. on OS X where native programs don't handle softlinked files very gracefully. So Joey added an entirely new way of operating called \"direct mode\" which uses ordinary files, much like Dropbox does.++So -- what you should expect from git-annex assistant is a program which solves many of the same problems Dropbox does (keeping a set of files magically in sync across computers) but does it in its own way, which won't be *exactly* like Dropbox; it will be more flexible but might require a little learning to figure out exactly how to use it the way you want.  It's possible to get a very Dropbox-like system out of the box, especially now that you don't need to use softlinks, if you've got a place on the network you can use as a central remote repository for your files, or if you only want to synchronize two or more computers on the same local network.++\"git-annex\" itself is the plumbing used by git-annex assistant, or to put it another way, the engine that the assistant has under the hood.  Git-annex itself is extremely simple and stable but should only be used by people already familiar with the command line, perhaps even people already familiar with git.++That's my point of view as an enthusiastic user.  Joey may have his own perspective to share. :)+++++"""]]
+ doc/special_remotes/comment_6_5d2bd7c1e1493d3c3784708a9b0bc001._comment view
@@ -0,0 +1,8 @@+[[!comment format=mdwn+ username="https://www.google.com/accounts/o8/id?id=AItOawlBia1J9-PoXgZYj2LASf7Bs__IqK3T8qQ"+ nickname="Greg"+ subject="Rackspace US/UK"+ date="2013-01-30T11:33:12Z"+ content="""+It'd be awesome to be able to use Rackspace as remote storage as an alternative to S3, I would submit a patch, but know 0 Haskell :D+"""]]
+ doc/special_remotes/comment_7_af01ee5ce31b1490af565cb087d65277._comment view
@@ -0,0 +1,10 @@+[[!comment format=mdwn+ username="https://www.google.com/accounts/o8/id?id=AItOawn-UoTjMBsVh6q4HNViGwJi-5FNaCVQB7E"+ nickname="Nico"+ subject="Rapidshare"+ date="2013-02-02T16:49:58Z"+ content="""+Would it be possible to support Rapidshare as a new special remote?+They offer unlimited storage for 6-10€ per month. It would be great for larger backups.+Their API can be found here: http://images.rapidshare.com/apidoc.txt+"""]]
+ doc/tips/using_Google_Cloud_Storage.mdwn view
@@ -0,0 +1,9 @@+[Google Cloud Storage](https://cloud.google.com/products/cloud-storage)+supports the same API as Amazon S3, so the+[[S3 special remote|special_remotes/S3]] can be used with it.+Here is a configuration example:++	git annex initremote cloud type=S3 encryption=none host=storage.googleapis.com port=80++Thanks to jterrance for the [original tip](https://gist.github.com/4576324).+--[[Joey]] 
+ doc/todo/wishlist:_addurl_https:.mdwn view
@@ -0,0 +1,11 @@+It would be nice if "git annex addurl" allowed https: urls, rather than just http:.+To give an example, here is a PDF file:++ https://www.fbo.gov/utils/view?id=59ba4c8aa59101a09827ab7b9a787b05++If you switch the https: to http: it redirects you back to https:.++As more sites provide https: for non-secret traffic, this becomes more of an issue.++> I've gotten rid of the use of the HTTP library, now it just uses curl.+> [[done]] --[[Joey]]
git-annex.1 view
@@ -705,6 +705,10 @@ are accessed directly, rather than through symlinks. Note that many git and git\-annex commands will not work with such a repository. .IP+.IP "annex.autocommit"+Set to false to prevent the git\-annex assistant from automatically+committing changes to files in the repository.+.IP .IP "remote.<name>.annex\-cost" When determining which repository to transfer annexed files from or to, ones with lower costs are preferred.
git-annex.cabal view
@@ -1,5 +1,5 @@ Name: git-annex-Version: 3.20130124+Version: 3.20130207 Cabal-Version: >= 1.8 License: GPL Maintainer: Joey Hess <joey@kitenet.net>@@ -75,6 +75,9 @@   if flag(WebDAV)     Build-Depends: DAV (>= 0.3), http-conduit, xml-conduit, http-types     CPP-Options: -DWITH_WEBDAV+  +  if flag(Assistant)+    Build-Depends: async    if flag(Assistant) && ! os(windows) && ! os(solaris)     Build-Depends: stm >= 2.3