git-annex 3.20121009 → 3.20121010

raw patch · 81 files changed

+896/−316 lines, 81 filesdep ~networkbinary-added

Dependency ranges changed: network

Files

Annex/Branch.hs +3/−1
Assistant/DaemonStatus.hs +5/−2
Assistant/MakeRemote.hs +3/−3
Assistant/Sync.hs +2/−2
Assistant/Threads/Merger.hs +1/−1
Assistant/Threads/PairListener.hs +9/−3
Assistant/Threads/SanityChecker.hs +1/−1
Assistant/Threads/TransferPoller.hs +1/−1
Assistant/Threads/TransferScanner.hs +1/−1
Assistant/Threads/TransferWatcher.hs +1/−1
Assistant/WebApp/Configurators.hs +71/−32
Assistant/WebApp/Configurators/Edit.hs +70/−14
Assistant/WebApp/Configurators/Local.hs +13/−22
Assistant/WebApp/Configurators/S3.hs +4/−4
Assistant/WebApp/Configurators/Ssh.hs +4/−4
Assistant/WebApp/DashBoard.hs +1/−78
Assistant/WebApp/Utility.hs +144/−0
Assistant/WebApp/routes +3/−0
CHANGELOG +22/−0
Command/Dead.hs +4/−0
Command/Sync.hs +3/−1
Command/WebApp.hs +16/−5
Config.hs +5/−0
Git/Command.hs +1/−1
Git/UnionMerge.hs +1/−1
GitAnnex.hs +1/−1
INSTALL +14/−15
Limit.hs +5/−5
Logs/Group.hs +8/−0
Logs/PreferredContent.hs +32/−8
Logs/UUIDBased.hs +8/−4
Makefile +8/−4
Remote.hs +13/−0
Remote/Git.hs +20/−3
Types/StandardGroups.hs +37/−0
Utility/Applicative.o binary
Utility/CoProcess.o binary
Utility/Directory.o binary
Utility/Exception.o binary
Utility/FileMode.o binary
Utility/FileSystemEncoding.o binary
Utility/Misc.o binary
Utility/Monad.o binary
Utility/PartialPrelude.o binary
Utility/Path.o binary
Utility/Process.hs +11/−5
Utility/Process.o binary
Utility/SafeCommand.o binary
Utility/TempFile.o binary
Utility/Url.hs +6/−0
debian/changelog +22/−0
doc/assistant/errata.mdwn +33/−0
doc/assistant/repogroups.png binary
doc/assistant/thanks.mdwn +6/−3
doc/bugs/error_when_using_repositories_with_non-ASCII_characters.mdwn +3/−0
doc/bugs/fatal:_empty_ident_name.mdwn +3/−0
doc/design/assistant/blog/.day_101__transfer_control_done.mdwn.swp binary
doc/design/assistant/blog/day_101__transfer_control_done.mdwn +0/−12
doc/design/assistant/blog/day_102__very_high_level_programming.mdwn +37/−0
doc/design/assistant/blog/day_103__bugfix_day.mdwn +25/−0
doc/design/assistant/blog/day_104__foo.mdwn +15/−0
doc/design/assistant/polls/prioritizing_special_remotes.mdwn +1/−1
doc/design/assistant/webapp.mdwn +5/−0
doc/forum/Can__39__t_get_pairing_to_work.mdwn +5/−0
doc/forum/Pushing_git_repo_to_AWS_S3_from_behind_proxy.mdwn +9/−0
doc/git-annex.mdwn +7/−2
doc/install.mdwn +14/−15
doc/install/Fedora.mdwn +7/−5
doc/install/OSX/comment_4_d68c36432c7be3f4a76f4f0d7300bac9._comment +20/−0
doc/install/OSX/comment_5_626a4b4bf302d4ae750174f860402f70._comment +8/−0
doc/news/version_3.20120807.mdwn +0/−7
doc/news/version_3.20121010.mdwn +19/−0
doc/preferred_content.mdwn +44/−2
git-annex.1 +6/−2
git-annex.cabal +4/−2
standalone/osx/git-annex.app/Contents/MacOS/runshell +11/−9
templates/configurators/editrepository.hamlet +16/−1
templates/configurators/intro.hamlet +3/−7
templates/configurators/repositories.hamlet +14/−9
templates/documentation/about.hamlet +1/−1
test.hs +6/−15

Annex/Branch.hs view

@@ -22,6 +22,7 @@ ) where  import qualified Data.ByteString.Lazy.Char8 as L+import System.Environment  import Common.Annex import Annex.BranchState@@ -292,7 +293,8 @@ withIndex' bootstrapping a = do 	f <- fromRepo gitAnnexIndex 	g <- gitRepo-	let g' = g { gitEnv = Just [("GIT_INDEX_FILE", f)] }+	e <- liftIO getEnvironment+	let g' = g { gitEnv = Just $ ("GIT_INDEX_FILE", f):e }  	Annex.changeState $ \s -> s { Annex.repo = g' } 	checkIndexOnce $ unlessM (liftIO $ doesFileExist f) $ do

Assistant/DaemonStatus.hs view

@@ -17,6 +17,8 @@ import Logs.Transfer import Logs.Trust import qualified Remote+import qualified Types.Remote as Remote+import Config  import Control.Concurrent.STM import System.Posix.Types@@ -86,10 +88,11 @@ 	sendNotification $ changeNotifier s 	return b -{- Remotes ordered by cost, with dead ones thrown out. -}+{- Syncable remotes ordered by cost. -} calcKnownRemotes :: Annex [Remote] calcKnownRemotes = do-	rs <- concat . Remote.byCost <$> Remote.enabledRemoteList+	rs <- filterM (repoSyncable . Remote.repo) =<<+		concat . Remote.byCost <$> Remote.enabledRemoteList 	alive <- snd <$> trustPartition DeadTrusted (map Remote.uuid rs) 	let good r = Remote.uuid r `elem` alive 	return $ filter good rs

Assistant/MakeRemote.hs view

@@ -90,10 +90,10 @@  - Returns the name of the remote. -} makeRemote :: String -> String -> (String -> Annex ()) -> Annex String makeRemote basename location a = do-	r <- fromRepo id-	if not (any samelocation $ Git.remotes r)+	g <- gitRepo+	if not (any samelocation $ Git.remotes g) 		then do-			let name = uniqueRemoteName basename 0 r+			let name = uniqueRemoteName basename 0 g 			a name 			return name 		else return basename

Assistant/Sync.hs view

@@ -84,7 +84,7 @@ pushToRemotes :: ThreadName -> UTCTime -> ThreadState -> Maybe FailedPushMap -> [Remote] -> IO Bool pushToRemotes threadname now st mpushmap remotes = do 	(g, branch, u) <- runThreadState st $ (,,)-		<$> fromRepo id+		<$> gitRepo 		<*> inRepo Git.Branch.current 		<*> getUUID 	go True branch g u remotes@@ -145,7 +145,7 @@ {- Manually pull from remotes and merge their branches. -} manualPull :: ThreadState -> Maybe Git.Ref -> [Remote] -> IO Bool manualPull st currentbranch remotes = do-	g <- runThreadState st $ fromRepo id+	g <- runThreadState st gitRepo 	forM_ remotes $ \r -> 		Git.Command.runBool "fetch" [Param $ Remote.name r] g 	haddiverged <- runThreadState st Annex.Branch.forceUpdate

Assistant/Threads/Merger.hs view

@@ -25,7 +25,7 @@  - pushes. -} mergeThread :: ThreadState -> DaemonStatusHandle -> TransferQueue -> NamedThread mergeThread st dstatus transferqueue = thread $ do-	g <- runThreadState st $ fromRepo id+	g <- runThreadState st gitRepo 	let dir = Git.localGitDir g </> "refs" 	createDirectoryIfMissing True dir 	let hook a = Just $ runHandler st dstatus transferqueue a

Assistant/Threads/PairListener.hs view

@@ -17,6 +17,7 @@ import Assistant.WebApp import Assistant.WebApp.Types import Assistant.Alert+import Utility.ThreadScheduler  import Network.Multicast import Network.Socket@@ -27,11 +28,16 @@ thisThread = "PairListener"  pairListenerThread :: ThreadState -> DaemonStatusHandle -> ScanRemoteMap -> UrlRenderer -> NamedThread-pairListenerThread st dstatus scanremotes urlrenderer = thread $ withSocketsDo $ do-	sock <- multicastReceiver (multicastAddress $ IPv4Addr undefined) pairingPort-	go sock [] []+pairListenerThread st dstatus scanremotes urlrenderer = thread $ withSocketsDo $+	runEvery (Seconds 1) $ void $ tryIO $ do+		sock <- getsock+		go sock [] [] 	where 		thread = NamedThread thisThread+		+		{- Note this can crash if there's no network interface,+		 - or only one like lo that doesn't support multicast. -}+		getsock = multicastReceiver (multicastAddress $ IPv4Addr undefined) pairingPort 		 		go sock reqs cache = getmsg sock [] >>= \msg -> case readish msg of 			Nothing -> go sock reqs cache

Assistant/Threads/SanityChecker.hs view

@@ -74,7 +74,7 @@  - will block the watcher. -} check :: ThreadState -> DaemonStatusHandle -> TransferQueue -> ChangeChan -> IO Bool check st dstatus transferqueue changechan = do-	g <- runThreadState st $ fromRepo id+	g <- runThreadState st gitRepo 	-- Find old unstaged symlinks, and add them to git. 	(unstaged, cleanup) <- Git.LsFiles.notInRepo False ["."] g 	now <- getPOSIXTime

Assistant/Threads/TransferPoller.hs view

@@ -24,7 +24,7 @@  - of each transfer is complete. -} transferPollerThread :: ThreadState -> DaemonStatusHandle -> NamedThread transferPollerThread st dstatus = thread $ do-	g <- runThreadState st $ fromRepo id+	g <- runThreadState st gitRepo 	tn <- newNotificationHandle =<< 		transferNotifier <$> getDaemonStatus dstatus 	forever $ do

Assistant/Threads/TransferScanner.hs view

@@ -94,7 +94,7 @@ expensiveScan st dstatus transferqueue rs = unless onlyweb $ do 	liftIO $ debug thisThread ["starting scan of", show visiblers] 	void $ alertWhile dstatus (scanAlert visiblers) $ do-		g <- runThreadState st $ fromRepo id+		g <- runThreadState st gitRepo 		(files, cleanup) <- LsFiles.inRepo [] g 		go files 		void cleanup

Assistant/Threads/TransferWatcher.hs view

@@ -24,7 +24,7 @@  - and updates the DaemonStatus's map of ongoing transfers. -} transferWatcherThread :: ThreadState -> DaemonStatusHandle -> TransferQueue -> NamedThread transferWatcherThread st dstatus transferqueue = thread $ do-	g <- runThreadState st $ fromRepo id+	g <- runThreadState st gitRepo 	let dir = gitAnnexTransferDir g 	createDirectoryIfMissing True dir 	let hook a = Just $ runHandler st dstatus transferqueue a

Assistant/WebApp/Configurators.hs view

@@ -13,14 +13,16 @@ import Assistant.WebApp import Assistant.WebApp.Types import Assistant.WebApp.SideBar-import Assistant.DaemonStatus+import Assistant.WebApp.Utility import Assistant.WebApp.Configurators.Local+import Assistant.DaemonStatus import Utility.Yesod import qualified Remote import qualified Types.Remote as Remote import Annex.UUID (getUUID) import Logs.Remote import Logs.Trust+import Config  import Yesod import Data.Text (Text)@@ -36,42 +38,82 @@ 		$(widgetFile "configurators/main") 	) +{- An intro message, list of repositories, and nudge to make more. -}+introDisplay :: Text -> Widget+introDisplay ident = do+	webapp <- lift getYesod+	repolist <- lift $ repoList True False+	let n = length repolist+	let numrepos = show n+	let notenough = n < enough+	$(widgetFile "configurators/intro")+	lift $ modifyWebAppState $ \s -> s { showIntro = False }+	where+		enough = 2+ {- Lists known repositories, followed by options to add more. -} getRepositoriesR :: Handler RepHtml getRepositoriesR = bootstrap (Just Config) $ do 	sideBarDisplay 	setTitle "Repositories"-	repolist <- lift $ repoList False+	repolist <- lift $ repoList False True 	$(widgetFile "configurators/repositories") -data SetupRepo = EnableRepo (Route WebApp) | EditRepo (Route WebApp)+data Actions+	= DisabledRepoActions+		{ setupRepoLink :: Route WebApp }+	| SyncingRepoActions+		{ setupRepoLink :: Route WebApp+		, syncToggleLink :: Route WebApp+		}+	| NotSyncingRepoActions+		{ setupRepoLink :: Route WebApp+		, syncToggleLink :: Route WebApp+		} -needsEnabled :: SetupRepo -> Bool-needsEnabled (EnableRepo _) = True+mkSyncingRepoActions :: UUID -> Actions+mkSyncingRepoActions u = SyncingRepoActions+	{ setupRepoLink = EditRepositoryR u+	, syncToggleLink = DisableSyncR u+	}++mkNotSyncingRepoActions :: UUID -> Actions+mkNotSyncingRepoActions u = NotSyncingRepoActions+	{ setupRepoLink = EditRepositoryR u+	, syncToggleLink = EnableSyncR u+	}++needsEnabled :: Actions -> Bool+needsEnabled (DisabledRepoActions _) = True needsEnabled _ = False -setupRepoLink :: SetupRepo -> Route WebApp-setupRepoLink (EnableRepo r) = r-setupRepoLink (EditRepo r) = r+notSyncing :: Actions -> Bool+notSyncing (SyncingRepoActions _ _) = False+notSyncing _ = True -{- A numbered list of known repositories, including the current one. -}-repoList :: Bool -> Handler [(String, String, SetupRepo)]-repoList onlyconfigured+{- A numbered list of known repositories,+ - with actions that can be taken on them. -}+repoList :: Bool -> Bool -> Handler [(String, String, Actions)]+repoList onlyconfigured includehere 	| onlyconfigured = list =<< configured-	| otherwise = list =<< (++) <$> configured <*> unconfigured+	| otherwise = list =<< (++) <$> configured <*> rest 	where 		configured = do 			rs <- filter (not . Remote.readonly) . knownRemotes <$> 				(liftIO . getDaemonStatus =<< daemonStatus <$> getYesod) 			runAnnex [] $ do 				u <- getUUID-				let l = u : map Remote.uuid rs-				return $ zip l (map editlink l)-		editlink = EditRepo . EditRepositoryR-		unconfigured = runAnnex [] $ do+				let l = map Remote.uuid rs+				let l' = if includehere then u : l else l+				return $ zip l' $ map mkSyncingRepoActions l'+		rest = runAnnex [] $ do 			m <- readRemoteLog-			catMaybes . map (findtype m) . snd+			unconfigured <- catMaybes . map (findtype m) . snd 				<$> (trustPartition DeadTrusted $ M.keys m)+			unsyncable <- map Remote.uuid <$>+				(filterM (\r -> not <$> repoSyncable (Remote.repo r))+					=<< Remote.enabledRemoteList)+			return $ zip unsyncable (map mkNotSyncingRepoActions unsyncable) ++ unconfigured 		findtype m u = case M.lookup u m of 			Nothing -> Nothing 			Just c -> case M.lookup "type" c of@@ -79,7 +121,7 @@ 				Just "directory" -> u `enableswith` EnableDirectoryR 				Just "S3" -> u `enableswith` EnableS3R 				_ -> Nothing-		u `enableswith` r = Just (u, EnableRepo $ r u)+		u `enableswith` r = Just (u, DisabledRepoActions $ r u) 		list l = runAnnex [] $ do 			let l' = nubBy (\x y -> fst x == fst y) l 			zip3@@ -88,17 +130,14 @@ 				<*> pure (map snd l') 		counter = map show ([1..] :: [Int]) -{- An intro message, list of repositories, and nudge to make more. -}-introDisplay :: Text -> Widget-introDisplay ident = do-	webapp <- lift getYesod-	repolist <- lift $ repoList True-	let n = length repolist-	let numrepos = show n-	let notenough = n < enough-	let barelyenough = n == enough-	let morethanenough = n > enough-	$(widgetFile "configurators/intro")-	lift $ modifyWebAppState $ \s -> s { showIntro = False }-	where-		enough = 2+getEnableSyncR :: UUID -> Handler ()+getEnableSyncR = flipSync True++getDisableSyncR :: UUID -> Handler ()+getDisableSyncR = flipSync False++flipSync :: Bool -> UUID -> Handler ()+flipSync enable uuid = do+	mremote <- runAnnex undefined $ snd <$> Remote.repoFromUUID uuid+	changeSyncable mremote enable+	redirect RepositoriesR

Assistant/WebApp/Configurators/Edit.hs view

@@ -13,44 +13,100 @@ import Assistant.WebApp import Assistant.WebApp.Types import Assistant.WebApp.SideBar+import Assistant.WebApp.Utility import Utility.Yesod import qualified Remote import Logs.UUID+import Logs.Group+import Logs.PreferredContent+import Types.StandardGroups+import qualified Config+import Annex.UUID+import qualified Git  import Yesod import Data.Text (Text) import qualified Data.Text as T import qualified Data.Map as M+import qualified Data.Set as S +data RepoGroup = RepoGroupCustom String | RepoGroupStandard StandardGroup+	deriving (Show, Eq)+ data RepoConfig = RepoConfig 	{ repoDescription :: Text+	, repoGroup :: RepoGroup+	, repoSyncable :: Bool 	} 	deriving (Show) +getRepoConfig :: UUID -> Git.Repo -> Annex RepoConfig+getRepoConfig uuid r = RepoConfig+	<$> (T.pack . fromMaybe "" . M.lookup uuid <$> uuidMap)+	<*> getrepogroup+	<*> Config.repoSyncable r+	where+		getrepogroup = do+			groups <- lookupGroups uuid+			return $ +				maybe (RepoGroupCustom $ unwords $ S.toList groups) RepoGroupStandard+					(getStandardGroup groups)++{- Returns Just False if syncing should be disabled, Just True when enabled;+ - Nothing when it is not changed. -}+setRepoConfig :: UUID -> Git.Repo -> RepoConfig -> Annex (Maybe Bool)+setRepoConfig uuid r c = do+	describeUUID uuid $ T.unpack $ repoDescription c+	case repoGroup c of+		RepoGroupStandard g -> setStandardGroup uuid g+		RepoGroupCustom s -> groupSet uuid $ S.fromList $ words s+	ifM ((==) uuid <$> getUUID)+		( return Nothing+		, do+			syncable <- Config.repoSyncable r+			return $ if (syncable /= repoSyncable c)+				then Just $ repoSyncable c+				else Nothing+		)+ editRepositoryAForm :: RepoConfig -> AForm WebApp WebApp RepoConfig editRepositoryAForm def = RepoConfig 	<$> areq textField "Description" (Just $ repoDescription def)--getRepoConfig :: UUID -> Annex RepoConfig-getRepoConfig uuid = RepoConfig-	<$> (T.pack . fromMaybe "" . M.lookup uuid <$> uuidMap)+	<*> areq (selectFieldList $ customgroups++standardgroups) "Repository group" (Just $ repoGroup def)+	<*> areq checkBoxField "Syncing enabled" (Just $ repoSyncable def)+	where+		standardgroups :: [(Text, RepoGroup)]+		standardgroups = map (\g -> (T.pack $ descStandardGroup g , RepoGroupStandard g))+			[minBound :: StandardGroup .. maxBound :: StandardGroup]+		customgroups :: [(Text, RepoGroup)]+		customgroups = case repoGroup def of+			RepoGroupCustom s -> [(T.pack s, RepoGroupCustom s)]+			_ -> []  getEditRepositoryR :: UUID -> Handler RepHtml-getEditRepositoryR uuid = bootstrap (Just Config) $ do+getEditRepositoryR = editForm False++getEditNewRepositoryR :: UUID -> Handler RepHtml+getEditNewRepositoryR = editForm True++editForm :: Bool -> UUID -> Handler RepHtml+editForm new uuid = bootstrap (Just Config) $ do 	sideBarDisplay 	setTitle "Configure repository"-	-	curr <- lift $ runAnnex undefined $ getRepoConfig uuid++	(repo, mremote) <- lift $ runAnnex undefined $ Remote.repoFromUUID uuid+	curr <- lift $ runAnnex undefined $ getRepoConfig uuid repo 	((result, form), enctype) <- lift $ 		runFormGet $ renderBootstrap $ editRepositoryAForm curr 	case result of-		FormSuccess input -> do-			error (show input)-		_ -> showform form enctype+		FormSuccess input -> lift $ do+			syncchanged <- runAnnex undefined $+				setRepoConfig uuid repo input+			maybe noop (changeSyncable mremote) syncchanged+			redirect RepositoriesR+		_ -> showform form enctype curr 	where-		showform form enctype = do+		showform form enctype curr = do+			let istransfer = repoGroup curr == RepoGroupStandard TransferGroup 			let authtoken = webAppFormAuthToken-			description <- lift $-				runAnnex T.empty $  T.pack . concat <$>-					Remote.prettyListUUIDs [uuid] 			$(widgetFile "configurators/editrepository")

Assistant/WebApp/Configurators/Local.hs view

@@ -13,7 +13,7 @@ import Assistant.WebApp import Assistant.WebApp.Types import Assistant.WebApp.SideBar-import Assistant.Sync+import Assistant.WebApp.Utility import Assistant.MakeRemote import Utility.Yesod import Init@@ -28,13 +28,13 @@ import Utility.DataUnits import Utility.Network import Remote (prettyListUUIDs)-import Logs.Group import Annex.UUID+import Types.StandardGroups+import Logs.PreferredContent  import Yesod import Data.Text (Text) import qualified Data.Text as T-import qualified Data.Set as S import Data.Char import System.Posix.Directory import qualified Control.Exception as E@@ -147,7 +147,7 @@ 			let path = T.unpack p 			liftIO $ makeRepo path False 			u <- liftIO $ initRepo path Nothing-			runAnnex () $ groupSet u (S.singleton "clients")+			runAnnex () $ setStandardGroup u ClientGroup 			liftIO $ addAutoStart path 			redirect $ SwitchToRepositoryR path 		_ -> $(widgetFile "configurators/newrepository")@@ -185,19 +185,19 @@ 	((res, form), enctype) <- lift $ runFormGet $ 		selectDriveForm (sort writabledrives) Nothing 	case res of-		FormSuccess (RemovableDrive { mountPoint = d }) -> lift $ do-			go $ T.unpack d-			redirect RepositoriesR+		FormSuccess (RemovableDrive { mountPoint = d }) -> lift $+			make (T.unpack d) >>= redirect . EditNewRepositoryR 		_ -> do 			let authtoken = webAppFormAuthToken 			$(widgetFile "configurators/adddrive") 	where-		go mountpoint = do+		make mountpoint = do 			liftIO $ makerepo dir 			u <- liftIO $ initRepo dir $ Just remotename 			r <- addremote dir remotename-			runAnnex () $ groupSet u (S.singleton "drives")+			runAnnex () $ setStandardGroup u TransferGroup 			syncRemote r+			return u 			where 				dir = mountpoint </> gitAnnexAssistantDefaultDir 				remotename = takeFileName mountpoint@@ -227,16 +227,6 @@ 		T.pack . concat <$> prettyListUUIDs [uuid] 	$(widgetFile "configurators/enabledirectory") -{- Start syncing a newly added remote, using a background thread. -}-syncRemote :: Remote -> Handler ()-syncRemote remote = do-	webapp <- getYesod-	liftIO $ syncNewRemote-		(fromJust $ threadState webapp)-		(daemonStatus webapp)-		(scanRemotes webapp)-		remote- {- List of removable drives. -} driveList :: IO [RemovableDrive] driveList = mapM (gen . mnt_dir) =<< filter sane <$> getMounts@@ -264,10 +254,11 @@ startFullAssistant :: FilePath -> Handler () startFullAssistant path = do 	webapp <- getYesod-	liftIO $ makeRepo path False-	u <- liftIO $ initRepo path Nothing-	runAnnex () $ groupSet u (S.singleton "clients") 	url <- liftIO $ do+		makeRepo path False+		u <- initRepo path Nothing+		inDir path $ +			setStandardGroup u ClientGroup 		addAutoStart path 		changeWorkingDirectory path 		fromJust $ postFirstRun webapp

Assistant/WebApp/Configurators/S3.hs view

@@ -21,12 +21,12 @@ import Logs.Remote import qualified Remote import Types.Remote (RemoteConfig)-import Logs.Group+import Types.StandardGroups+import Logs.PreferredContent  import Yesod import Data.Text (Text) import qualified Data.Text as T-import qualified Data.Set as S import qualified Data.Map as M  s3Configurator :: Widget -> Handler RepHtml@@ -94,7 +94,7 @@ 			let authtoken = webAppFormAuthToken 			$(widgetFile "configurators/adds3") 		setgroup r = runAnnex () $-			groupSet (Remote.uuid r) (S.singleton "servers")+			setStandardGroup (Remote.uuid r) TransferGroup  getEnableS3R :: UUID -> Handler RepHtml getEnableS3R uuid = s3Configurator $ do@@ -125,4 +125,4 @@ 		return remotename 	setup r 	liftIO $ syncNewRemote st (daemonStatus webapp) (scanRemotes webapp) r-	redirect RepositoriesR+	redirect $ EditNewRepositoryR $ Remote.uuid r

Assistant/WebApp/Configurators/Ssh.hs view

@@ -19,13 +19,13 @@ import Utility.Rsync (rsyncUrlIsShell) import Logs.Remote import Remote-import Logs.Group+import Logs.PreferredContent+import Types.StandardGroups  import Yesod import Data.Text (Text) import qualified Data.Text as T import qualified Data.Map as M-import qualified Data.Set as S import Network.Socket import System.Posix.User @@ -291,7 +291,7 @@ 		(scanRemotes webapp) 		forcersync sshdata 	setup r-	redirect RepositoriesR+	redirect $ EditRepositoryR $ Remote.uuid r  getAddRsyncNetR :: Handler RepHtml getAddRsyncNetR = do@@ -348,4 +348,4 @@ isRsyncNet (Just host) = ".rsync.net" `T.isSuffixOf` T.toLower host  setupGroup :: Remote -> Handler ()-setupGroup r = runAnnex () $ groupSet (Remote.uuid r) (S.singleton "server")+setupGroup r = runAnnex () $ setStandardGroup (Remote.uuid r) TransferGroup

Assistant/WebApp/DashBoard.hs view

@@ -12,13 +12,12 @@ import Assistant.Common import Assistant.WebApp import Assistant.WebApp.Types+import Assistant.WebApp.Utility import Assistant.WebApp.SideBar import Assistant.WebApp.Notifications import Assistant.WebApp.Configurators import Assistant.DaemonStatus import Assistant.TransferQueue-import Assistant.TransferSlots-import qualified Assistant.Threads.Transferrer as Transferrer import Utility.NotificationBroadcaster import Utility.Yesod import Logs.Transfer@@ -27,14 +26,11 @@ import Types.Key import qualified Remote import qualified Git-import Locations.UserConfig  import Yesod import Text.Hamlet import qualified Data.Map as M import Control.Concurrent-import System.Posix.Signals (signalProcessGroup, sigTERM, sigKILL)-import System.Posix.Process (getProcessGroupIDOf)  {- A display of currently running and queued transfers.  -@@ -162,76 +158,3 @@ getCancelTransferR t = cancelTransfer False t >> redirectBack postCancelTransferR :: Transfer -> Handler () postCancelTransferR t = cancelTransfer False t--pauseTransfer :: Transfer -> Handler ()-pauseTransfer = cancelTransfer True--cancelTransfer :: Bool -> Transfer-> Handler ()-cancelTransfer pause t = do-	webapp <- getYesod-	let dstatus = daemonStatus webapp-	m <- getCurrentTransfers-	liftIO $ do-		unless pause $-			{- remove queued transfer -}-			void $ dequeueTransfers (transferQueue webapp) dstatus $-				equivilantTransfer t-		{- stop running transfer -}-		maybe noop (stop dstatus) (M.lookup t m)-	where-		stop dstatus info = do-			{- When there's a thread associated with the-			 - transfer, it's signaled first, to avoid it-			 - displaying any alert about the transfer having-			 - failed when the transfer process is killed. -}-			maybe noop signalthread $ transferTid info-			maybe noop killproc $ transferPid info-			if pause-				then void $-					alterTransferInfo dstatus t $ \i -> i-						{ transferPaused = True }-				else void $-					removeTransfer dstatus t-		signalthread tid-			| pause = throwTo tid PauseTransfer-			| otherwise = killThread tid-		{- In order to stop helper processes like rsync,-		 - kill the whole process group of the process running the -		 - transfer. -}-		killproc pid = do-			g <- getProcessGroupIDOf pid-			void $ tryIO $ signalProcessGroup sigTERM g-			threadDelay 50000 -- 0.05 second grace period-			void $ tryIO $ signalProcessGroup sigKILL g--startTransfer :: Transfer -> Handler ()-startTransfer t = do-	m <- getCurrentTransfers-	maybe startqueued go (M.lookup t m)-	where-		go info = maybe (start info) resume $ transferTid info-		startqueued = do-			webapp <- getYesod-			let dstatus = daemonStatus webapp-			let q = transferQueue webapp-			is <- liftIO $ map snd <$> getMatchingTransfers q dstatus (== t)-			maybe noop start $ headMaybe is-		resume tid = do-			webapp <- getYesod-			let dstatus = daemonStatus webapp-			liftIO $ do-				alterTransferInfo dstatus t $ \i -> i-					{ transferPaused = False }-				throwTo tid ResumeTransfer-		start info = do-			webapp <- getYesod-			let st = fromJust $ threadState webapp-			let dstatus = daemonStatus webapp-			let slots = transferSlots webapp-			liftIO $ inImmediateTransferSlot dstatus slots $ do-				program <- readProgramFile-				Transferrer.startTransfer st dstatus program t info--getCurrentTransfers :: Handler TransferMap-getCurrentTransfers = currentTransfers-	<$> (liftIO . getDaemonStatus =<< daemonStatus <$> getYesod)

+ Assistant/WebApp/Utility.hs view

@@ -0,0 +1,144 @@+{- git-annex assistant webapp utilities+ -+ - Copyright 2012 Joey Hess <joey@kitenet.net>+ -+ - Licensed under the GNU AGPL version 3 or higher.+ -}++module Assistant.WebApp.Utility where++import Assistant.Common+import Assistant.WebApp+import Assistant.WebApp.Types+import Assistant.DaemonStatus+import Assistant.ThreadedMonad+import Assistant.TransferQueue+import Assistant.TransferSlots+import Assistant.Sync+import qualified Remote+import qualified Types.Remote as Remote+import qualified Remote.List as Remote+import qualified Assistant.Threads.Transferrer as Transferrer+import Logs.Transfer+import Locations.UserConfig+import qualified Config++import Yesod+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. -}+changeSyncable :: (Maybe Remote) -> Bool -> Handler ()+changeSyncable Nothing _ = noop -- TODO+changeSyncable (Just r) True = do+	changeSyncFlag r True+	syncRemote r+changeSyncable (Just r) False = do+	changeSyncFlag r False+	webapp <- getYesod+	let dstatus = daemonStatus webapp+	let st = fromJust $ threadState webapp+	liftIO $ runThreadState st $ updateKnownRemotes dstatus+	{- Stop all transfers to or from this remote.+	 - XXX Can't stop any ongoing scan, or git syncs. -}+	void $ liftIO $ dequeueTransfers (transferQueue webapp) dstatus tofrom+	mapM_ (cancelTransfer False) =<<+		filter tofrom . M.keys <$>+			liftIO (currentTransfers <$> getDaemonStatus dstatus)+	where+		tofrom t = transferUUID t == Remote.uuid r++changeSyncFlag :: Remote -> Bool -> Handler ()+changeSyncFlag r enabled = runAnnex undefined $ do+	Config.setConfig key value+	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 ()+syncRemote remote = do+	webapp <- getYesod+	liftIO $ syncNewRemote+		(fromJust $ threadState webapp)+		(daemonStatus webapp)+		(scanRemotes webapp)+		remote++pauseTransfer :: Transfer -> Handler ()+pauseTransfer = cancelTransfer True++cancelTransfer :: Bool -> Transfer -> Handler ()+cancelTransfer pause t = do+	webapp <- getYesod+	let dstatus = daemonStatus webapp+	m <- getCurrentTransfers+	liftIO $ do+		unless pause $+			{- remove queued transfer -}+			void $ dequeueTransfers (transferQueue webapp) dstatus $+				equivilantTransfer t+		{- stop running transfer -}+		maybe noop (stop dstatus) (M.lookup t m)+	where+		stop dstatus info = do+			{- When there's a thread associated with the+			 - transfer, it's signaled first, to avoid it+			 - displaying any alert about the transfer having+			 - failed when the transfer process is killed. -}+			maybe noop signalthread $ transferTid info+			maybe noop killproc $ transferPid info+			if pause+				then void $+					alterTransferInfo dstatus t $ \i -> i+						{ transferPaused = True }+				else void $+					removeTransfer dstatus t+		signalthread tid+			| pause = throwTo tid PauseTransfer+			| otherwise = killThread tid+		{- In order to stop helper processes like rsync,+		 - kill the whole process group of the process running the +		 - transfer. -}+		killproc pid = do+			g <- getProcessGroupIDOf pid+			void $ tryIO $ signalProcessGroup sigTERM g+			threadDelay 50000 -- 0.05 second grace period+			void $ tryIO $ signalProcessGroup sigKILL g++startTransfer :: Transfer -> Handler ()+startTransfer t = do+	m <- getCurrentTransfers+	maybe startqueued go (M.lookup t m)+	where+		go info = maybe (start info) resume $ transferTid info+		startqueued = do+			webapp <- getYesod+			let dstatus = daemonStatus webapp+			let q = transferQueue webapp+			is <- liftIO $ map snd <$> getMatchingTransfers q dstatus (== t)+			maybe noop start $ headMaybe is+		resume tid = do+			webapp <- getYesod+			let dstatus = daemonStatus webapp+			liftIO $ do+				alterTransferInfo dstatus t $ \i -> i+					{ transferPaused = False }+				throwTo tid ResumeTransfer+		start info = do+			webapp <- getYesod+			let st = fromJust $ threadState webapp+			let dstatus = daemonStatus webapp+			let slots = transferSlots webapp+			liftIO $ inImmediateTransferSlot dstatus slots $ do+				program <- readProgramFile+				Transferrer.startTransfer st dstatus program t info++getCurrentTransfers :: Handler TransferMap+getCurrentTransfers = currentTransfers+	<$> (liftIO . getDaemonStatus =<< daemonStatus <$> getYesod)

Assistant/WebApp/routes view

@@ -11,6 +11,9 @@ /config/repository/new NewRepositoryR GET /config/repository/switchto/#FilePath SwitchToRepositoryR GET /config/repository/edit/#UUID EditRepositoryR GET+/config/repository/edit/new/#UUID EditNewRepositoryR GET+/config/repository/sync/disable/#UUID DisableSyncR GET+/config/repository/sync/enable/#UUID EnableSyncR GET  /config/repository/add/drive AddDriveR GET /config/repository/add/ssh AddSshR GET

CHANGELOG view

@@ -1,3 +1,25 @@+git-annex (3.20121010) unstable; urgency=low++  * Renamed --ingroup to --inallgroup.+  * Standard groups changed to client, transfer, archive, and backup.+    Each of these has its own standard preferred content setting.+  * dead: Remove dead repository from all groups.+  * Avoid unsetting HOME when running certian git commands. Closes: #690193+  * test: Fix threaded runtime hang.+  * Makefile: Avoid building with -threaded if the ghc threaded runtime does+    not exist.+  * webapp: Improve wording of intro display. Closes: #689848+  * webapp: Repositories can now be configured, to change their description,+    their group, or even to disable syncing to them.+  * git config remote.name.annex-sync can be used to control whether+    a remote gets synced.+  * Fix a crash when merging files in the git-annex branch that contain+    invalid utf8.+  * Automatically detect when a ssh remote does not have git-annex-shell+    installed, and set annex-ignore.++ -- Joey Hess <joeyh@debian.org>  Fri, 12 Oct 2012 13:45:21 -0400+ git-annex (3.20121009) unstable; urgency=low    * watch, assistant: It's now safe to git annex unlock files while

Command/Dead.hs view

@@ -11,7 +11,10 @@ import Command import qualified Remote import Logs.Trust+import Logs.Group +import qualified Data.Set as S+ def :: [Command] def = [command "dead" (paramRepeating paramRemote) seek 	"hide a lost repository"]@@ -29,4 +32,5 @@ perform :: UUID -> CommandPerform perform uuid = do 	trustSet uuid DeadTrusted+	groupSet uuid S.empty 	next $ return True

Command/Sync.hs view

@@ -26,6 +26,7 @@ import qualified Types.Remote import qualified Remote.Git import Types.Key+import Config  import qualified Data.ByteString.Lazy as L import Data.Hash.MD5@@ -71,7 +72,8 @@ 					unwords (map Types.Remote.name s) 			return l 		available = filter (not . Remote.specialRemote)-			<$> Remote.enabledRemoteList+			<$> (filterM (repoSyncable . Types.Remote.repo)+				=<< Remote.enabledRemoteList) 		good = filterM $ Remote.Git.repoAvail . Types.Remote.repo 		fastest = fromMaybe [] . headMaybe . Remote.byCost

Command/WebApp.hs view

@@ -39,9 +39,12 @@ seek = [withNothing start]  start :: CommandStart-start = notBareRepo $ do+start = start' True++start' :: Bool -> CommandStart+start' allowauto = notBareRepo $ do 	liftIO $ ensureInstalled-	ifM isInitialized ( go , liftIO startNoRepo )+	ifM isInitialized ( go , auto ) 	stop 	where 		go = do@@ -52,6 +55,11 @@ 				, startDaemon True True $ Just $ 					const $ openBrowser browser 				)+		auto+			| allowauto = liftIO startNoRepo+			| otherwise = do+				d <- liftIO getCurrentDirectory+				error $ "no git repository in " ++ d 		checkpid = do 			pidfile <- fromRepo gitAnnexPidFile 			liftIO $ isJust <$> checkDaemon pidfile@@ -74,7 +82,7 @@ 		(d:_) -> do 			changeWorkingDirectory d 			state <- Annex.new =<< Git.CurrentRepo.get-			void $ Annex.eval state $ doCommand start+			void $ Annex.eval state $ doCommand $ start' False  {- Run the webapp without a repository, which prompts the user, makes one,  - changes to it, starts the regular assistant, and redirects the@@ -125,8 +133,11 @@ openBrowser cmd htmlshim = go $ maybe runBrowser runCustomBrowser cmd 	where 		url = fileUrl htmlshim-		go a = unlessM (a url) $-			error $ "failed to start web browser on url " ++ url+		go a = do+			putStrLn ""+			putStrLn $ "Launching web browser on " ++ url+			unlessM (a url) $+				error $ "failed to start web browser" 		runCustomBrowser c u = boolSystem c [Param u]  {- web.browser is a generic git config setting for a web browser program -}

Config.hs view

@@ -86,6 +86,11 @@ repoNotIgnored r = not . fromMaybe False . Git.Config.isTrue 	<$> getRemoteConfig r "ignore" "" +{- Checks if a repo should be synced. -}+repoSyncable :: Git.Repo -> Annex Bool+repoSyncable r = fromMaybe True . Git.Config.isTrue+	<$> getRemoteConfig r "sync" ""+ {- If a value is specified, it is used; otherwise the default is looked up  - in git config. forcenumcopies overrides everything. -} getNumCopies :: Maybe Int -> Annex Int

Git/Command.hs view

@@ -73,7 +73,7 @@ pipeWriteRead :: [CommandParam] -> String -> Repo -> IO String pipeWriteRead params s repo = assertLocal repo $ 	writeReadProcessEnv "git" (toCommand $ gitCommandLine params repo) -		(gitEnv repo) s+		(gitEnv repo) s (Just fileEncoding)  {- Runs a git subcommand, feeding it input on a handle with an action. -} pipeWrite :: [CommandParam] -> Repo -> (Handle -> IO ()) -> IO ()

Git/UnionMerge.hs view

@@ -86,7 +86,7 @@ 		-- split it into lines to union merge. Using the 		-- FileSystemEncoding for this is a hack, but ensures there 		-- are no decoding errors. Note that this works because-		-- streamUpdateIndex sets fileEncoding on its write handle.+		-- hashObject sets fileEncoding on its write handle. 		getcontents s = lines . encodeW8 . L.unpack <$> catObject h s  {- Calculates a union merge between a list of refs, with contents.

GitAnnex.hs view

@@ -147,7 +147,7 @@ 		"skip files with fewer copies" 	, Option ['B'] ["inbackend"] (ReqArg Limit.addInBackend paramName) 		"skip files not using a key-value backend"-	, Option [] ["ingroup"] (ReqArg Limit.addInGroup paramGroup)+	, Option [] ["inallgroup"] (ReqArg Limit.addInAllGroup paramGroup) 		"skip files not present in all remotes in a group" 	, Option [] ["largerthan"] (ReqArg Limit.addLargerThan paramSize) 		"skip files larger than a size"

INSTALL view

@@ -1,21 +1,20 @@ ## Pick your OS -Quick commands given where possible, but see the individual pages for-details.--[[!table format=dsv header=no data="""-[[OSX]]              | [download git-annex.app](http://downloads.kitenet.net/git-annex/OSX/git-annex.dmg.bz2) **beta**+[[!table format=dsv header=yes data="""+detailed instructions | quick install+[[OSX]]               | [download git-annex.app](http://downloads.kitenet.net/git-annex/OSX/git-annex.dmg.bz2) **beta** [[Linux|linux_standalone]] | [download prebuilt linux tarball](http://downloads.kitenet.net/git-annex/linux/)-[[Debian]]           | `apt-get install git-annex`-[[Ubuntu]]           | `apt-get install git-annex`-[[FreeBSD]]          | `pkg_add -r hs-git-annex`-[[ArchLinux]]        | `yaourt -Sy git-annex`-[[NixOS]]            | `nix-env -i git-annex`-[[Gentoo]]           | `emerge git-annex`-[[ScientificLinux5]] | (and other RHEL5 clones like CentOS5)-[[Fedora]]           | -[[openSUSE]]         | -Windows              | [[sorry, Windows not supported yet|todo/windows_support]]+[[Debian]]            | `apt-get install git-annex`+[[Ubuntu]]            | `apt-get install git-annex`+[[Fedora]]            | `yum install git-annex`+[[FreeBSD]]           | `pkg_add -r hs-git-annex`+[[ArchLinux]]         | `yaourt -Sy git-annex`+[[NixOS]]             | `nix-env -i git-annex`+[[Gentoo]]            | `emerge git-annex`+[[NixOS]]             | `nix install git-annex`+[[ScientificLinux5]]  | (and other RHEL5 clones like CentOS5)+[[openSUSE]]          | +Windows               | [[sorry, Windows not supported yet|todo/windows_support]] """]]  ## Using cabal

Limit.hs view

@@ -139,13 +139,13 @@  {- Adds a limit to skip files not believed to be present in all  - repositories in the specified group. -}-addInGroup :: String -> Annex ()-addInGroup groupname = do+addInAllGroup :: String -> Annex ()+addInAllGroup groupname = do 	m <- groupMap-	addLimit $ limitInGroup m groupname+	addLimit $ limitInAllGroup m groupname -limitInGroup :: GroupMap -> MkLimit-limitInGroup m groupname+limitInAllGroup :: GroupMap -> MkLimit+limitInAllGroup m groupname 	| S.null want = Right $ const $ const $ return True 	| otherwise = Right $ \notpresent -> 		Backend.lookupFile >=> check notpresent

Logs/Group.hs view

@@ -10,6 +10,7 @@ 	groupSet, 	lookupGroups, 	groupMap,+	getStandardGroup, ) where  import qualified Data.Map as M@@ -21,6 +22,7 @@ import qualified Annex import Logs.UUIDBased import Types.Group+import Types.StandardGroups  {- Filename of group.log. -} groupLog :: FilePath@@ -64,3 +66,9 @@ 		bygroup = M.fromListWith S.union $ 			concat $ map explode $ M.toList byuuid 		explode (u, s) = map (\g -> (g, S.singleton u)) (S.toList s)++{- If a repository is in exactly one standard group, returns it. -}+getStandardGroup :: S.Set Group -> Maybe StandardGroup+getStandardGroup s = case catMaybes $ map toStandardGroup $ S.toList s of+	[g] -> Just g+	_ -> Nothing

Logs/PreferredContent.hs view

@@ -11,9 +11,11 @@ 	preferredContentMap, 	preferredContentMapRaw, 	checkPreferredContentExpression,+	setStandardGroup, ) where  import qualified Data.Map as M+import qualified Data.Set as S import Data.Either import Data.Time.Clock.POSIX @@ -27,6 +29,7 @@ import Git.FilePath import Types.Group import Logs.Group+import Types.StandardGroups  {- Filename of preferred-content.log. -} preferredContentLog :: FilePath@@ -61,7 +64,8 @@ 	case cached of 		Just m -> return m 		Nothing -> do-			m <- simpleMap . parseLog (Just . makeMatcher groupmap)+			m <- simpleMap+				. parseLogWithUUID ((Just .) . makeMatcher groupmap) 				<$> Annex.Branch.get preferredContentLog 			Annex.changeState $ \s -> s { Annex.preferredcontentmap = Just m } 			return m@@ -74,17 +78,28 @@  - because the configuration is shared amoung repositories and newer  - versions of git-annex may add new features. Instead, parse errors  - result in a Matcher that will always succeed. -}-makeMatcher :: GroupMap -> String -> Utility.Matcher.Matcher MatchFiles-makeMatcher groupmap s-	| null (lefts tokens) =  Utility.Matcher.generate $ rights tokens- 	| otherwise = Utility.Matcher.generate []+makeMatcher :: GroupMap -> UUID -> String -> Utility.Matcher.Matcher MatchFiles+makeMatcher groupmap u s+	| s == "standard" = standardMatcher groupmap u+	| null (lefts tokens) = Utility.Matcher.generate $ rights tokens+ 	| otherwise = matchAll 	where 		tokens = map (parseToken groupmap) (tokenizeMatcher s) +{- Standard matchers are pre-defined for some groups. If none is defined,+ - or a repository is in multiple groups with standard matchers, match all. -}+standardMatcher :: GroupMap -> UUID -> Utility.Matcher.Matcher MatchFiles+standardMatcher m u = maybe matchAll (makeMatcher m u . preferredContent) $+	getStandardGroup =<< u `M.lookup` groupsByUUID m++matchAll :: Utility.Matcher.Matcher MatchFiles+matchAll = Utility.Matcher.generate []+ {- Checks if an expression can be parsed, if not returns Just error -} checkPreferredContentExpression :: String -> Maybe String-checkPreferredContentExpression s = -	case lefts $ map (parseToken emptyGroupMap) (tokenizeMatcher s) of+checkPreferredContentExpression s+	| s == "standard" = Nothing+	| otherwise = case lefts $ map (parseToken emptyGroupMap) (tokenizeMatcher s) of 		[] -> Nothing 		l -> Just $ unwords $ map ("Parse failure: " ++) l @@ -102,7 +117,7 @@ 			, ("inbackend", limitInBackend) 			, ("largerthan", limitSize (>)) 			, ("smallerthan", limitSize (<))-			, ("ingroup", limitInGroup groupmap)+			, ("inallgroup", limitInAllGroup groupmap) 			] 		use a = Utility.Matcher.Operation <$> a v @@ -113,3 +128,12 @@ tokenizeMatcher = filter (not . null ) . concatMap splitparens . words 	where 		splitparens = segmentDelim (`elem` "()")++{- Puts a UUID in a standard group, and sets its preferred content to use+ - the standard expression for that group, unless something is already set. -}+setStandardGroup :: UUID -> StandardGroup -> Annex ()+setStandardGroup u g = do+	groupSet u $ S.singleton $ fromStandardGroup g+	m <- preferredContentMap+	unless (isJust $ M.lookup u m) $+		preferredContentSet u "standard"

Logs/UUIDBased.hs view

@@ -17,6 +17,7 @@ 	LogEntry(..), 	TimeStamp(..), 	parseLog,+	parseLogWithUUID, 	showLog, 	changeLog, 	addLog,@@ -56,15 +57,18 @@ 			unwords [fromUUID k, shower v]  parseLog :: (String -> Maybe a) -> String -> Log a-parseLog parser = M.fromListWith best . mapMaybe parse . lines+parseLog = parseLogWithUUID . const++parseLogWithUUID :: (UUID -> String -> Maybe a) -> String -> Log a+parseLogWithUUID parser = M.fromListWith best . mapMaybe parse . lines 	where 		parse line 			| null ws = Nothing-			| otherwise = parser (unwords info) >>= makepair+			| otherwise = parser u (unwords info) >>= makepair 			where-				makepair v = Just (toUUID u, LogEntry ts v)+				makepair v = Just (u, LogEntry ts v) 				ws = words line-				u = Prelude.head ws+				u = toUUID $ Prelude.head ws 				t = Prelude.last ws 				ts 					| tskey `isPrefixOf` t =

Makefile view

@@ -1,7 +1,7 @@ CFLAGS=-Wall GIT_ANNEX_TMP_BUILD_DIR?=tmp IGNORE=-ignore-package monads-fd -ignore-package monads-tf-BASEFLAGS=-threaded -Wall $(IGNORE) -outputdir $(GIT_ANNEX_TMP_BUILD_DIR) -IUtility+BASEFLAGS=-Wall $(IGNORE) -outputdir $(GIT_ANNEX_TMP_BUILD_DIR) -IUtility  # If you get build failures due to missing haskell libraries, # you can turn off some of these features.@@ -18,8 +18,10 @@ ifeq ($(OS),Linux) OPTFLAGS=-DWITH_INOTIFY -DWITH_DBUS clibs=Utility/libdiskfree.o Utility/libmounts.o+THREADFLAGS=$(shell if test -e  `ghc --print-libdir`/libHSrts_thr.a; then printf -- -threaded; fi) else # BSD system+THREADFLAGS=-threaded OPTFLAGS=-DWITH_KQUEUE clibs=Utility/libdiskfree.o Utility/libmounts.o Utility/libkqueue.o ifeq ($(OS),Darwin)@@ -31,11 +33,13 @@ endif endif +ALLFLAGS = $(BASEFLAGS) $(FEATURES) $(OPTFLAGS) $(THREADFLAGS)+ PREFIX=/usr-GHCFLAGS=-O2 $(BASEFLAGS) $(FEATURES) $(OPTFLAGS)+GHCFLAGS=-O2 $(ALLFLAGS)  ifdef PROFILE-GHCFLAGS=-prof -auto-all -rtsopts -caf-all -fforce-recomp $(BASEFLAGS) $(FEATURES) $(OPTFLAGS)+GHCFLAGS=-prof -auto-all -rtsopts -caf-all -fforce-recomp $(ALLFLAGS) endif  GHCMAKE=ghc $(GHCFLAGS) --make@@ -51,7 +55,7 @@ sources: $(sources)  # Disables optimisation. Not for production use.-fast: GHCFLAGS=$(BASEFLAGS) $(FEATURES) $(OPTFLAGS)+fast: GHCFLAGS=$(ALLFLAGS) fast: $(bins)  Build/SysConfig.hs: configure.hs Build/TestConfig.hs Build/Configure.hs

Remote.hs view

@@ -27,6 +27,7 @@ 	byCost, 	prettyPrintUUIDs, 	prettyListUUIDs,+	repoFromUUID, 	remotesWithUUID, 	remotesWithoutUUID, 	keyLocations,@@ -52,6 +53,7 @@ import Logs.Trust import Logs.Location import Remote.List+import qualified Git  {- Map from UUIDs of Remotes to a calculated value. -} remoteMap :: (Remote -> a) -> Annex (M.Map UUID a)@@ -144,6 +146,17 @@ 			| otherwise = n 			where 				n = finddescription m u++{- Gets the git repo associated with a UUID.+ - There's no associated remote when this is the UUID of the local repo. -}+repoFromUUID :: UUID -> Annex (Git.Repo, Maybe Remote)+repoFromUUID u = ifM ((==) u <$> getUUID)+	( (,) <$> gitRepo <*> pure Nothing+	, do+		remote <- fromMaybe (error "Unknown UUID") . M.lookup u+			<$> remoteMap id+		return (repo remote, Just remote)+	)  {- Filters a list of remotes to ones that have the listed uuids. -} remotesWithUUID :: [Remote] -> [UUID] -> [Remote]

Remote/Git.hs view

@@ -22,6 +22,7 @@ import qualified Git import qualified Git.Config import qualified Git.Construct+import qualified Git.Command import qualified Annex import Logs.Presence import Logs.Transfer@@ -126,7 +127,20 @@ tryGitConfigRead :: Git.Repo -> Annex Git.Repo tryGitConfigRead r  	| not $ M.null $ Git.config r = return r -- already read-	| Git.repoIsSsh r = store $ onRemote r (pipedconfig, r) "configlist" [] []+	| Git.repoIsSsh r = store $ do+		v <- onRemote r (pipedsshconfig, Left undefined) "configlist" [] []+		case (v, Git.remoteName r) of+			(Right r', _) -> return r'+			(Left _, Just n) -> do+				{- Is this remote just not available, or does+				 - it not have git-annex-shell?+				 - Find out by trying to fetch from the remote. -}+				whenM (inRepo $ Git.Command.runBool "fetch" [Param "--quiet", Param n]) $ do+					let k = "remote." ++ n ++ ".annex-ignore"+					warning $ "Remote " ++ n ++ " does not have git-annex installed; setting " ++ k+					inRepo $ Git.Command.run "config" [Param k, Param "true"]+				return r+			_ -> return r 	| Git.repoIsHttp r = do 		headers <- getHttpHeaders 		store $ safely $ geturlconfig headers@@ -140,18 +154,21 @@ 		safely a = either (const $ return r) return 				=<< liftIO (try a :: IO (Either SomeException Git.Repo)) -		pipedconfig cmd params = safely $+		pipedconfig cmd params = 			withHandle StdoutHandle createProcessSuccess p $ 				Git.Config.hRead r 			where 				p = proc cmd $ toCommand params +		pipedsshconfig cmd params =+			liftIO (try (pipedconfig cmd params) :: IO (Either SomeException Git.Repo))+ 		geturlconfig headers = do 			s <- Url.get (Git.repoLocation r ++ "/config") headers 			withTempFile "git-annex.tmp" $ \tmpfile h -> do 				hPutStr h s 				hClose h-				pipedconfig "git" [Param "config", Param "--null", Param "--list", Param "--file", File tmpfile]+				safely $ pipedconfig "git" [Param "config", Param "--null", Param "--list", Param "--file", File tmpfile]  		store = observe $ \r' -> do 			g <- gitRepo

+ Types/StandardGroups.hs view

@@ -0,0 +1,37 @@+{- git-annex standard repository groups+ -+ - Copyright 2012 Joey Hess <joey@kitenet.net>+ -+ - Licensed under the GNU GPL version 3 or higher.+ -}++module Types.StandardGroups where++data StandardGroup = ClientGroup | TransferGroup | ArchiveGroup | BackupGroup+	deriving (Eq, Ord, Enum, Bounded, Show)++fromStandardGroup :: StandardGroup -> String+fromStandardGroup ClientGroup = "client"+fromStandardGroup TransferGroup = "transfer"+fromStandardGroup ArchiveGroup = "archive"+fromStandardGroup BackupGroup = "backup"++toStandardGroup :: String -> Maybe StandardGroup+toStandardGroup "client" = Just ClientGroup+toStandardGroup "transfer" = Just TransferGroup+toStandardGroup "archive" = Just ArchiveGroup+toStandardGroup "backup" = Just BackupGroup+toStandardGroup _ = Nothing++descStandardGroup :: StandardGroup -> String+descStandardGroup ClientGroup = "client: a repository on your computer"+descStandardGroup TransferGroup = "transfer: distributes files to clients"+descStandardGroup ArchiveGroup = "archive: collects files that are not archived elsewhere"+descStandardGroup BackupGroup = "backup: collects all files"++{- See doc/preferred_content.mdwn for explanations of these expressions. -}+preferredContent :: StandardGroup -> String+preferredContent ClientGroup = "exclude=*/archive/*"+preferredContent TransferGroup = "not inallgroup=client and " ++ preferredContent ClientGroup+preferredContent ArchiveGroup = "not copies=archive:1"+preferredContent BackupGroup = "" -- all content is preferred

+ Utility/Applicative.o view

binary file changed (absent → 1308 bytes)

+ Utility/CoProcess.o view

binary file changed (absent → 4160 bytes)

+ Utility/Directory.o view

binary file changed (absent → 17128 bytes)

+ Utility/Exception.o view

binary file changed (absent → 5404 bytes)

+ Utility/FileMode.o view

binary file changed (absent → 15124 bytes)

+ Utility/FileSystemEncoding.o view

binary file changed (absent → 5668 bytes)

+ Utility/Misc.o view

binary file changed (absent → 10856 bytes)

+ Utility/Monad.o view

binary file changed (absent → 7376 bytes)

+ Utility/PartialPrelude.o view

binary file changed (absent → 5448 bytes)

+ Utility/Path.o view

binary file changed (absent → 23096 bytes)

Utility/Process.hs view

@@ -64,17 +64,24 @@ 			, env = environ 			} -{- Writes stdout to a process, returns its output, and also allows specifying- - the environment. -}+{- Writes a string to a process on its stdout, + - returns its output, and also allows specifying the environment.+ -+ -+ -} writeReadProcessEnv 	:: FilePath 	-> [String] 	-> Maybe [(String, String)]-	-> String	+	-> String+	-> (Maybe (Handle -> IO ())) 	-> IO String-writeReadProcessEnv cmd args environ input = do+writeReadProcessEnv cmd args environ input adjusthandle = do 	(Just inh, Just outh, _, pid) <- createProcess p +	maybe (return ()) (\a -> a inh) adjusthandle+	maybe (return ()) (\a -> a outh) adjusthandle+ 	-- fork off a thread to start consuming the output 	output  <- hGetContents outh 	outMVar <- newEmptyMVar@@ -203,7 +210,6 @@ 	debugM "Utility.Process" $ unwords 		[ action ++ ":" 		, showCmd p-		, maybe "" show (env p) 		] 	where 		action

+ Utility/Process.o view

binary file changed (absent → 31680 bytes)

+ Utility/SafeCommand.o view

binary file changed (absent → 25780 bytes)

+ Utility/TempFile.o view

binary file changed (absent → 11312 bytes)

Utility/Url.hs view

@@ -5,6 +5,8 @@  - Licensed under the GNU GPL version 3 or higher.  -} +{-# LANGUAGE CPP #-}+ module Utility.Url ( 	URLString, 	check,@@ -108,6 +110,10 @@ 					Nothing -> return rsp 					Just newURI -> go n newURI_abs 						where+#ifdef URI_24+							newURI_abs = newURI `relativeTo` u+#else 							newURI_abs = fromMaybe newURI (newURI `relativeTo` u)+#endif 		addheaders req = setHeaders req (rqHeaders req ++ userheaders) 		userheaders = rights $ map parseHeader headers

debian/changelog view

@@ -1,3 +1,25 @@+git-annex (3.20121010) unstable; urgency=low++  * Renamed --ingroup to --inallgroup.+  * Standard groups changed to client, transfer, archive, and backup.+    Each of these has its own standard preferred content setting.+  * dead: Remove dead repository from all groups.+  * Avoid unsetting HOME when running certian git commands. Closes: #690193+  * test: Fix threaded runtime hang.+  * Makefile: Avoid building with -threaded if the ghc threaded runtime does+    not exist.+  * webapp: Improve wording of intro display. Closes: #689848+  * webapp: Repositories can now be configured, to change their description,+    their group, or even to disable syncing to them.+  * git config remote.name.annex-sync can be used to control whether+    a remote gets synced.+  * Fix a crash when merging files in the git-annex branch that contain+    invalid utf8.+  * Automatically detect when a ssh remote does not have git-annex-shell+    installed, and set annex-ignore.++ -- Joey Hess <joeyh@debian.org>  Fri, 12 Oct 2012 13:45:21 -0400+ git-annex (3.20121009) unstable; urgency=low    * watch, assistant: It's now safe to git annex unlock files while

doc/assistant/errata.mdwn view

@@ -1,3 +1,36 @@+## version 3.20121009++This is a maintenance release of the git-annex assistant, which is still in+beta.++In general, anything you can configure with the assistant's web app+will work. Some examples of use cases supported by this release include:++* [[Pairing|pairing_walkthrough]] two computers that are on the same local+  network (or VPN) and automatically keeping the files in the annex in+  sync as changes are made to them.+* Cloning your repository to removable drives, USB keys, etc. The assistant+  will notice when the drive is mounted and keep it in sync.+  Such a drive can be stored as an offline backup, or transported between+  computers to keep them in sync.+* Cloning your repository to a remote server, running ssh, and uploading+  changes made to your files to the server. There is special support+  for using the rsync.net cloud provider this way, or any shell account+  on a typical unix server, such as a Linode VPS can be used.++The following are known limitations of this release of the git-annex+assistant:++* On Mac OSX and BSD operating systems, the assistant uses kqueue to watch+  files. Kqueue has to open every directory it watches, so too many+  directories will run it out of the max number of open files (typically+  1024), and fail. See [[bugs/Issue_on_OSX_with_some_system_limits]]+  for a workaround.+* In order to ensure that all multiple repositories are kept in sync,+  each computer with a repository must be running the git-annex assistant.+* The assistant does not yet always manage to keep repositories in sync+  when some are hidden from others behind firewalls.+ ## version 3.20120924  This is the first beta release of the git-annex assistant.

+ doc/assistant/repogroups.png view

binary file changed (absent → 18490 bytes)

doc/assistant/thanks.mdwn view

@@ -32,6 +32,7 @@ * AJ Ashton * Svenne Krap * Drew Hess+* Peter van Westen  ## Prioritizers @@ -45,7 +46,8 @@ Ian McEwen, asc, Paul Tagliamonte, Sherif Abouseda, Igor Támara, Anne Wind, Mesar Hameed, Brandur K. Holm Petersen, Takahiro Inoue, Kai Hendry, Stephen Youndt, Lee Roberson, Ben Strawbridge, Andrew Greenberg, Alfred Adams-Andrew, Aaron De Vries, Monti Knazze, Jorge Canseco, Hamish, Mark Eichin+Andrew, Aaron De Vries, Monti Knazze, Jorge Canseco, Hamish, Mark Eichin,+Sherif Abouseda, Ben Strawbridge  And special thanks to Kevin McKenzie, who also gave me a login to a Mac OSX machine, which has proven invaluable, and Jimmy Tang who has helped@@ -79,7 +81,7 @@ Manuel Roumain, Jason Walsh, np, Shawn, Johan Tibell, Branden Tyree, Dinyar Rabady, Andrew Mason, damond armstead, Ethan Aubin, TomTom Tommie, Jimmy Kaplowitz, Steven Zakulec, mike smith, Jacob Kirkwood, Mark Hymers, Nathan-Collins, Asbjørn Sloth Tønnesen, Misty De Meo,+Collins, Asbjørn Sloth Tønnesen, Misty De Meo, James Shubin, Jim Paris, Adam Sjøgren, miniBill, Taneli, Kumar Appaiah, Greg Grossmeier, Sten Turpin, Otavio Salvador, Teemu Hukkanen, Brian Stengaard, bob walker, bibeneus, andrelo, Yaroslav Halchenko, hesfalling, Tommy L, jlargentaye,@@ -215,7 +217,8 @@ Woofenden, Joe Danziger, Declan Morahan, KaptainUfolog, Vladron, bart, Jeff McNeill, Christian Schlotter, Ben McQuillan, Anthony, Julian, Martin O, altruism, Eric Solheim, MarkS, ndrwc, Matthew, David Lehn, Matthew-Cisneros, Mike Skoglund, Kristy Carey+Cisneros, Mike Skoglund, Kristy Carey, fmotta, Tom Lowenthal, Branden+Tyree  ## Also thanks to

doc/bugs/error_when_using_repositories_with_non-ASCII_characters.mdwn view

@@ -57,3 +57,6 @@ > try to look at it again soon; the last 2 times I looked at that code > I could not see an easy way to make it allow invalid utf-8 encoded data. > --[[Joey]] ++>> [[done]], although I am no longer so sure this was the last utf-8+>> encoding bug.. --[[Joey]]

doc/bugs/fatal:_empty_ident_name.mdwn view

@@ -46,3 +46,6 @@ **Please provide any additional information below.**  > [[done]] by adding name to the user, in /etc/passwd. --Stone++>> Actually, [[done]] by avoiding clobbering HOME when running some git+>> commands. --[[Joey]]

− doc/design/assistant/blog/.day_101__transfer_control_done.mdwn.swp

binary file changed (12288 → absent bytes)

− doc/design/assistant/blog/day_101__transfer_control_done.mdwn

@@ -1,12 +0,0 @@-Got the assistant honoring preferred content settings. Although so far that-only determines what it transfers. Additional work will be needed to make-content be dropped when it stops being preferred.--------Now all repositories created by the webapp will be put into one of three-groups: clients, drives, and servers.--------

+ doc/design/assistant/blog/day_102__very_high_level_programming.mdwn view

@@ -0,0 +1,37 @@+## today++Came up with four groups of repositories that it makes sense to+define standard preferred content expressions for.++[[!format haskell """+	preferredContent :: StandardGroup -> String+	preferredContent ClientGroup = "exclude=*/archive/*"+	preferredContent TransferGroup = "not inallgroup=client and " ++ preferredContent ClientGroup+	preferredContent ArchiveGroup = "not copies=archive:1"+	preferredContent BackupGroup = "" -- all content is preferred+"""]]++[[preferred_content]] has the details about these groups, but+as I was writing those three preferred content expressions,+I realized they are some of the highest level programming I've ever done,+in a way.++Anyway, these make for a very simple repository configuration UI:++[[!img /assistant/repogroups.png alt="form with simple select box"]]++## yesterday (forgot to post this)++Got the assistant honoring preferred content settings. Although so far that+only determines what it transfers. Additional work will be needed to make+content be dropped when it stops being preferred.++----++Added a "configure" link next to each repository on the repository config+page. This will go to a form to allow setting things like repository+descriptions, groups, and preferred content settings.++----++Cut a release.

+ doc/design/assistant/blog/day_103__bugfix_day.mdwn view

@@ -0,0 +1,25 @@+Bugfixes all day.++The most amusing bug, which I just stumbled over randomly on my own,+after someone on IRC yesterday was possibly encountering the same issue,+made `git annex webapp` go into an infinite memory-consuming loop on+startup if the repository it had been using was no longer a valid git+repository.++Then there was the place where HOME got unset, with also sometimes amusing+results.++Also fixed several build problems, including a threaded runtime hang+in the test suite. Hopefully the next release will build on all Debian+architectures again.++I'll be cutting that release tomorrow. I also updated the linux+prebuilt tarballs today.++----++Hmm, not entirely bugfixes after all. Had time (and power) to work+on the repository configuration form too, and added a check box to it that+can be unchecked to disable syncing with a repository. +Also, made that form be displayed after the webapp creates a new+repository.

+ doc/design/assistant/blog/day_104__foo.mdwn view

@@ -0,0 +1,15 @@+Switched the OSX standalone app to use `DYLD_ROOT_PATH`.+This is the third `DYLD_*` variable I've tried; neither+of the other two worked in all situations. This one may do better.+If not, I may be stuck modifying the library names in each executable+using `install_name_tool`+([good reference for doing that](http://www.mikeash.com/pyblog/friday-qa-2009-11-06-linking-and-install-names.html)).+As far as I know, every existing dynamic library lookup system is broken+in some way other other; nothing I've seen about OSX's so far+disproves that rule.++Fixed a nasty utf-8 encoding crash that could occur when merging the+git-annex branch. I hope I'm almost done with those.++Made git-annex auto-detect when a git remote is on a sever like github+that doesn't support git-annex, and automatically set annex-ignore.

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 14 "Amazon S3 (done)" 9 "Amazon Glacier" 7 "Box.com" 54 "My phone (or MP3 player)" 7 "Tahoe-LAFS" 3 "OpenStack SWIFT" 16 "Google Drive"]]+[[!poll open=yes 15 "Amazon S3 (done)" 9 "Amazon Glacier" 7 "Box.com" 55 "My phone (or MP3 player)" 9 "Tahoe-LAFS" 4 "OpenStack SWIFT" 16 "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/design/assistant/webapp.mdwn view

@@ -8,6 +8,11 @@   This is quite likely because of how the div containing transfers is refereshed.   If instead javascript was used to update the progress bar etc for transfers   with json data, the buttons would work better.+* Disabling syncing to a remote doesn't stop any running transfer scan,+  which can still queue uploads or downloads to the remote.+* Transfers from a remote with syncing disabled show as from "unknown".+  (Note that it's probably not practical to prevent a remote with syncing+  disabled from initiating transfers, so this can happen.)  ## interface

+ doc/forum/Can__39__t_get_pairing_to_work.mdwn view

@@ -0,0 +1,5 @@+I'm trying to pair my ~/music repositories on my two laptops (Ubuntu 10.04 and 12.04) using the Linux standalone tarball on my home WiFi network. After entering the same passphrase on both machines, nothing happens, both remain in "Pairing in progress" state.++The router I'm using is, I think, fairly standard, it's a ZyXEL P-2812HNU-F1 with factory settings.++Are others having the problem too? Any advice where I should start looking for what goes wrong?

+ doc/forum/Pushing_git_repo_to_AWS_S3_from_behind_proxy.mdwn view

@@ -0,0 +1,9 @@+I want to setup my remote git repo on S3+Referred to+http://git-annex.branchable.com/tips/using_Amazon_S3/+http://git-annex.branchable.com/special_remotes/S3/++I need support for AWS.config param proxy_uri+http://docs.amazonwebservices.com/AWSRubySDK/latest/AWS.html++Can some one help?

doc/git-annex.mdwn view

@@ -636,14 +636,14 @@    Matches only files that git-annex believes have the specified number of   copies, on remotes in the specified group. For example,-  "--copies=archival:2"+  "--copies=archive:2"  * --inbackend=name    Matches only files whose content is stored using the specified key-value   backend. -* --ingroup=groupname+* --inallgroup=groupname    Matches only files that git-annex believes are present in all repositories   in the specified group.@@ -794,6 +794,11 @@   without git-annex-shell. (For example, if it's on GitHub).   Or, it could be used if the network connection between two   repositories is too slow to be used normally.++* `remote.<name>.annex-sync`++  If set to `false`, prevents git-annex sync (and the git-annex assistant)+  from syncing with this remote.  * `remote.<name>.annexUrl`

doc/install.mdwn view

@@ -1,21 +1,20 @@ ## Pick your OS -Quick commands given where possible, but see the individual pages for-details.--[[!table format=dsv header=no data="""-[[OSX]]              | [download git-annex.app](http://downloads.kitenet.net/git-annex/OSX/git-annex.dmg.bz2) **beta**+[[!table format=dsv header=yes data="""+detailed instructions | quick install+[[OSX]]               | [download git-annex.app](http://downloads.kitenet.net/git-annex/OSX/git-annex.dmg.bz2) **beta** [[Linux|linux_standalone]] | [download prebuilt linux tarball](http://downloads.kitenet.net/git-annex/linux/)-[[Debian]]           | `apt-get install git-annex`-[[Ubuntu]]           | `apt-get install git-annex`-[[FreeBSD]]          | `pkg_add -r hs-git-annex`-[[ArchLinux]]        | `yaourt -Sy git-annex`-[[NixOS]]            | `nix-env -i git-annex`-[[Gentoo]]           | `emerge git-annex`-[[ScientificLinux5]] | (and other RHEL5 clones like CentOS5)-[[Fedora]]           | -[[openSUSE]]         | -Windows              | [[sorry, Windows not supported yet|todo/windows_support]]+[[Debian]]            | `apt-get install git-annex`+[[Ubuntu]]            | `apt-get install git-annex`+[[Fedora]]            | `yum install git-annex`+[[FreeBSD]]           | `pkg_add -r hs-git-annex`+[[ArchLinux]]         | `yaourt -Sy git-annex`+[[NixOS]]             | `nix-env -i git-annex`+[[Gentoo]]            | `emerge git-annex`+[[NixOS]]             | `nix install git-annex`+[[ScientificLinux5]]  | (and other RHEL5 clones like CentOS5)+[[openSUSE]]          | +Windows               | [[sorry, Windows not supported yet|todo/windows_support]] """]]  ## Using cabal

doc/install/Fedora.mdwn view

@@ -1,10 +1,12 @@-git-annex is recently finding its way into Fedora.+git-annex is available in recent versions of Fedora. Although it is+not currently a very recent version, it should work ok.+[status](http://koji.fedoraproject.org/koji/packageinfo?packageID=14145) -* [Status of getting a Fedora package](https://bugzilla.redhat.com/show_bug.cgi?id=662259)-* [Koji build for F17](http://koji.fedoraproject.org/koji/buildinfo?buildID=328654)-* [Koji build for F16](http://koji.fedoraproject.org/koji/buildinfo?buildID=328656)+Should be as simple as: `yum install git-annex` -Installation recipe for Fedora 14 thruough 15.+----++Older version? Here's an installation recipe for Fedora 14 through 15.  <pre> sudo yum install ghc cabal-install pcre-devel

+ doc/install/OSX/comment_4_d68c36432c7be3f4a76f4f0d7300bac9._comment view

@@ -0,0 +1,20 @@+[[!comment format=mdwn+ username="https://www.google.com/accounts/o8/id?id=AItOawmY_4MvT5yEeztrS7UIJseStUe4mtgp6YE"+ nickname="Сергей"+ subject="Have error"+ date="2012-10-10T11:47:09Z"+ content="""+[ 98 of 248] Compiling Utility.DiskFree ( Utility/DiskFree.hs, dist/build/git-annex/git-annex-tmp/Utility/DiskFree.o )+[ 99 of 248] Compiling Utility.Url      ( Utility/Url.hs, dist/build/git-annex/git-annex-tmp/Utility/Url.o )++Utility/Url.hs:111:88:+    Couldn't match expected type `Maybe URI' with actual type `URI'+    In the second argument of `fromMaybe', namely+      `(newURI `relativeTo` u)'+    In the expression: fromMaybe newURI (newURI `relativeTo` u)+    In an equation for `newURI_abs':+        newURI_abs = fromMaybe newURI (newURI `relativeTo` u)+cabal: Error: some packages failed to install:+git-annex-3.20121009 failed during the building phase. The exception was:+ExitFailure 1+"""]]

+ doc/install/OSX/comment_5_626a4b4bf302d4ae750174f860402f70._comment view

@@ -0,0 +1,8 @@+[[!comment format=mdwn+ username="http://joeyh.name/"+ ip="4.153.248.164"+ subject="comment 5"+ date="2012-10-10T15:34:23Z"+ content="""+@Сергей, I've fixeed that in git.+"""]]

− doc/news/version_3.20120807.mdwn

@@ -1,7 +0,0 @@-git-annex 3.20120807 released with [[!toggle text="these changes"]]-[[!toggleable text="""-   * initremote: Avoid recording remote's description before checking-     that its config is valid.-   * unused, status: Avoid crashing when ran in bare repo.-   * Avoid crashing when "git annex get" fails to download from one-     location, and falls back to downloading from a second location."""]]

+ doc/news/version_3.20121010.mdwn view

@@ -0,0 +1,19 @@+git-annex 3.20121010 released with [[!toggle text="these changes"]]+[[!toggleable text="""+   * Renamed --ingroup to --inallgroup.+   * Standard groups changed to client, transfer, archive, and backup.+     Each of these has its own standard preferred content setting.+   * dead: Remove dead repository from all groups.+   * Avoid unsetting HOME when running certian git commands. Closes: #[690193](http://bugs.debian.org/690193)+   * test: Fix threaded runtime hang.+   * Makefile: Avoid building with -threaded if the ghc threaded runtime does+     not exist.+   * webapp: Improve wording of intro display. Closes: #[689848](http://bugs.debian.org/689848)+   * webapp: Repositories can now be configured, to change their description,+     their group, or even to disable syncing to them.+   * git config remote.name.annex-sync can be used to control whether+     a remote gets synced.+   * Fix a crash when merging files in the git-annex branch that contain+     invalid utf8.+   * Automatically detect when a ssh remote does not have git-annex-shell+     installed, and set annex-ignore."""]]

doc/preferred_content.mdwn view

@@ -28,10 +28,52 @@  So, just remove the dashes, basically. +## file matching+ Note that while --include and --exclude match files relative to the current directory, preferred content expressions always match files relative to the-top of the git repository. Perhaps you put files into `out/` directories+top of the git repository. Perhaps you put files into `archive` directories when you're done with them. Then you could configure your laptop to prefer to not retain those files, like this: -	exclude=*/out/*+	exclude=*/archive/*++## standard expressions++git-annex comes with some standard preferred content expressions, that can+be used with repositories that are in some pre-defined groups. To make a+repository use one of these, just set its preferred content expression+to "standard", and put it in one of these groups:++### client++All content is preferred, unless it's in a "archive" directory.++`exclude=*/archive/*`++### transfer++Use for repositories that are used to transfer data between other+repositories, but do not need to retain data themselves. For+example, a repository on a server, or in the cloud, or a small+USB drive used in a sneakernet.++The preferred content expression for these causes them to get and retain+data until all clients have a copy.++`not inallgroup=client and exclude=*/archive/*`++### archive++All content is preferred, unless it's already been archived somewhere else.++`not copies=archive:1`++Note that if you want to archive multiple copies (not a bad idea!),+you should instead configure all your archive repositories with a+version of the above preferred content expression with a larger+number of copies.++### backup++All content is preferred.

git-annex.1 view

@@ -564,13 +564,13 @@ .IP "\-\-copies=groupname:number" Matches only files that git\-annex believes have the specified number of copies, on remotes in the specified group. For example,-"\-\-copies=archival:2"+"\-\-copies=archive:2" .IP .IP "\-\-inbackend=name" Matches only files whose content is stored using the specified key\-value backend. .IP-.IP "\-\-ingroup=groupname"+.IP "\-\-inallgroup=groupname" Matches only files that git\-annex believes are present in all repositories in the specified group. .IP@@ -697,6 +697,10 @@ without git\-annex\-shell. (For example, if it's on GitHub). Or, it could be used if the network connection between two repositories is too slow to be used normally.+.IP+.IP "remote.<name>.annex\-sync"+If set to false, prevents git\-annex sync (and the git\-annex assistant)+from syncing with this remote. .IP .IP "remote.<name>.annexUrl" Can be used to specify a different url than the regular remote.<name>.url

git-annex.cabal view

@@ -1,5 +1,5 @@ Name: git-annex-Version: 3.20121009+Version: 3.20121010 Cabal-Version: >= 1.8 License: GPL Maintainer: Joey Hess <joey@kitenet.net>@@ -46,7 +46,8 @@ Executable git-annex   Main-Is: git-annex.hs   Build-Depends: MissingH, hslogger, directory, filepath,-   unix, containers, utf8-string, network, mtl, bytestring, old-locale, time,+   unix, containers, utf8-string, network (>= 2.4.0.1), mtl,+   bytestring, old-locale, time,    pcre-light, extensible-exceptions, dataenc, SHA, process, json, HTTP,    base == 4.5.*, monad-control, transformers-base, lifted-base,    IfElse, text, QuickCheck >= 2.1, bloomfilter, edit-distance, process@@ -58,6 +59,7 @@     C-Sources: Utility/libkqueue.c   Extensions: CPP   GHC-Options: -threaded+  CPP-Options: -DURI_24    if flag(S3)     Build-Depends: hS3

standalone/osx/git-annex.app/Contents/MacOS/runshell view

@@ -31,15 +31,17 @@ PATH=$base/bin:$PATH export PATH -# Using DYLD_FALLBACK_LIBRARY_PATH rather than DYLD_LIBRARY_PATH, so as-# not to force binaries to link against possibly the wrong versions of-# libraries found in the path. With DYLD_FALLBACK_LIBRARY_PATH, the-# system's versions of libraries will be used when possible, and otherwise-# it will fall back to using the libraries bundled with this app.-for lib in $(cat $base/libdirs); do-	DYLD_FALLBACK_LIBRARY_PATH="$base/$lib:$DYLD_FALLBACK_LIBRARY_PATH"-done-export DYLD_FALLBACK_LIBRARY_PATH+# This makes the linker first look in the library directories bundled+# in this app. Only if it fails to find a library there will a system+# library be used.+# +# This seems to work better than DYLD_LIBRARY_PATH, which can force+# the wrong version of a library to be used, if the app bundles two+# different versions of a single library. And it seems to work better+# than DYLD_FALLBACK_LIBRARY_PATH, which fails to override old system+# versions of libraries when a program in the app needs a newer version.+DYLD_ROOT_PATH=$base+export DYLD_ROOT_PATH  GIT_EXEC_PATH=$base/git-core export GIT_EXEC_PATH

templates/configurators/editrepository.hamlet view

@@ -1,6 +1,17 @@ <div .span9 .hero-unit>   <h2>-    Configuring #{description}+    Configuring repository+  $if new+    <p>+      This repository is set up and ready to go!+    <p>+      Now you can do a little more configuring of it, if you like. #+      Perhaps enter a better description than the automatically generated one.+    $if istransfer+      <div .alert .alert-info>+        This repository is currently in the transfer group. That's the #+        right choice if you'll use it to shuttle data back and forth #+        between other repositories. Otherwise, pick one of the other groups.   <p>     <form .form-horizontal enctype=#{enctype}>       <fieldset>@@ -11,3 +22,7 @@             Save Changes           <a .btn href="@{RepositoriesR}">             Cancel+  $if new+    <p>+      In a hurry? Feel free to skip this step! You can always come back #+      and configure this repository later.

templates/configurators/intro.hamlet view

@@ -3,18 +3,14 @@    <h2>       git-annex is watching over your files in <small><tt>#{reldir}</tt></small>     <p>-      It will automatically notice changes, and keep files in sync between #+      It will automatically notice changes, and keep files in sync #       $if notenough-        repositories on your devices ...+        with repositories elsewhere ...         <h2>           But no other repositories are set up yet.         <a .btn .btn-primary .btn-large href="@{RepositoriesR}">Add another repository</a>       $else-        $if barelyenough-          <span .badge .badge-warning>#{numrepos}</span>-        $else-          <span .badge .badge-success>#{numrepos}</span>-        \ repositories and devices:+        \ with these repositories:         <table .table .table-striped .table-condensed>           <tbody>             $forall (num, name, _) <- repolist

templates/configurators/repositories.hamlet view

@@ -3,23 +3,28 @@     Your repositories   <table .table .table-condensed>     <tbody>-      $forall (num, name, setuprepo) <- repolist+      $forall (num, name, actions) <- repolist         <tr>           <td>             #{num}           <td>-            $if needsEnabled setuprepo-              <i>#{name}+            #{name}+          <td>+            $if needsEnabled actions+              <a href="@{setupRepoLink actions}">+                <i .icon-warning-sign></i> not enabled             $else-              #{name}+              <a href="@{syncToggleLink actions}">+                $if notSyncing actions+                  <i .icon-pause></i> syncing paused+                $else+                  <i .icon-refresh></i> syncing enabled           <td>-            $if needsEnabled setuprepo-              <i>not enabled here #-              &rarr; #-              <a href="@{setupRepoLink setuprepo}">+            $if needsEnabled actions+              <a href="@{setupRepoLink actions}">                 enable             $else-              <a href="@{setupRepoLink setuprepo}">+              <a href="@{setupRepoLink actions}">                 configure   <div .row-fluid>     <div .span6>

templates/documentation/about.hamlet view

@@ -3,7 +3,7 @@     git-annex watches over your files   <p>     It will automatically notice changes, and keep files in sync between #-    repositories and devices.+    here and repositories elsewhere.   <p>     For full details, see #     <a href="http://git-annex.branchable.com/">the git-annex website</a>.

test.hs view

@@ -14,7 +14,6 @@ import System.Posix.Directory (changeWorkingDirectory) import System.Posix.Files import System.Posix.Env-import System.Posix.Process import Control.Exception.Extensible import qualified Data.Map as M import System.IO.HVFS (SystemFS(..))@@ -48,6 +47,7 @@ import qualified Build.SysConfig import qualified Utility.Format import qualified Utility.Verifiable+import qualified Utility.Process  -- for quickcheck instance Arbitrary Types.Key.Key where@@ -696,20 +696,10 @@ {- Runs git-annex and returns its output. -} git_annex_output :: String -> [String] -> IO String git_annex_output command params = do-	(frompipe, topipe) <- createPipe-	pid <- forkProcess $ do-		_ <- dupTo topipe stdOutput-		closeFd frompipe-		_ <- git_annex command params-		exitSuccess+	got <- Utility.Process.readProcess "git-annex" (command:params) 	-- XXX since the above is a separate process, code coverage stats are 	-- not gathered for things run in it.-	closeFd topipe-	fromh <- fdToHandle frompipe-	got <- hGetContentsStrict fromh-	hClose fromh-	_ <- getProcessStatus True False pid-	-- XXX hack Run same command again, to get code coverage.+	-- Run same command again, to get code coverage. 	_ <- git_annex command params 	return got @@ -877,8 +867,9 @@  prepare :: IO () prepare = do-	-- While PATH is mostly avoided, the commit hook does run it. Make-	-- sure that the just-built git annex is used.+	-- While PATH is mostly avoided, the commit hook does run it,+	-- and so does git_annex_output. Make sure that the just-built+	-- git annex is used. 	cwd <- getCurrentDirectory 	p <- getEnvDefault  "PATH" "" 	setEnv "PATH" (cwd ++ ":" ++ p) True