when reading configs of local repos, first initializeSafe
This auto-generates a uuid if the local repo does not already have one.
This commit is contained in:
		
					parent
					
						
							
								cf33eff684
							
						
					
				
			
			
				commit
				
					
						32f27cc3e8
					
				
			
		
					 3 changed files with 34 additions and 25 deletions
				
			
		
							
								
								
									
										12
									
								
								CmdLine.hs
									
										
									
									
									
								
							
							
						
						
									
										12
									
								
								CmdLine.hs
									
										
									
									
									
								
							|  | @ -19,7 +19,6 @@ import Control.Monad (when) | ||||||
| import qualified Annex | import qualified Annex | ||||||
| import qualified AnnexQueue | import qualified AnnexQueue | ||||||
| import qualified Git | import qualified Git | ||||||
| import qualified Branch |  | ||||||
| import Content | import Content | ||||||
| import Types | import Types | ||||||
| import Command | import Command | ||||||
|  | @ -60,16 +59,7 @@ parseCmd argv header cmds options = do | ||||||
| 
 | 
 | ||||||
| {- Checks that the command can be run in the current environment. -} | {- Checks that the command can be run in the current environment. -} | ||||||
| checkCmdEnviron :: Command -> Annex () | checkCmdEnviron :: Command -> Annex () | ||||||
| checkCmdEnviron command = do | checkCmdEnviron command = when (cmdusesrepo command) $ checkVersion $ initializeSafe | ||||||
| 	when (cmdusesrepo command) $ checkVersion $ do |  | ||||||
| 		{- Automatically initialize if there is already a git-annex |  | ||||||
| 		   branch from somewhere. Otherwise, require a manual init |  | ||||||
| 		   to avoid git-annex accidentially being run in git |  | ||||||
| 		   repos that did not intend to use it. -} |  | ||||||
| 		annexed <- Branch.hasSomeBranch |  | ||||||
| 		if annexed |  | ||||||
| 			then initialize |  | ||||||
| 			else error "First run: git-annex init" |  | ||||||
| 
 | 
 | ||||||
| {- Usage message with lists of commands and options. -} | {- Usage message with lists of commands and options. -} | ||||||
| usage :: String -> [Command] -> [Option] -> String | usage :: String -> [Command] -> [Option] -> String | ||||||
|  |  | ||||||
							
								
								
									
										17
									
								
								Init.hs
									
										
									
									
									
								
							
							
						
						
									
										17
									
								
								Init.hs
									
										
									
									
									
								
							|  | @ -5,7 +5,11 @@ | ||||||
|  - Licensed under the GNU GPL version 3 or higher. |  - Licensed under the GNU GPL version 3 or higher. | ||||||
|  -} |  -} | ||||||
| 
 | 
 | ||||||
| module Init (initialize, uninitialize) where | module Init ( | ||||||
|  | 	initialize, | ||||||
|  | 	initializeSafe, | ||||||
|  | 	uninitialize | ||||||
|  | ) where | ||||||
| 
 | 
 | ||||||
| import Control.Monad.State (liftIO) | import Control.Monad.State (liftIO) | ||||||
| import Control.Monad (unless) | import Control.Monad (unless) | ||||||
|  | @ -34,6 +38,17 @@ uninitialize = do | ||||||
| 	g <- Annex.gitRepo | 	g <- Annex.gitRepo | ||||||
| 	gitPreCommitHookUnWrite g | 	gitPreCommitHookUnWrite g | ||||||
| 
 | 
 | ||||||
|  | {- Call to automatically initialize if there is already a git-annex | ||||||
|  |    branch from somewhere. Otherwise, require a manual init | ||||||
|  |    to avoid git-annex accidentially being run in git | ||||||
|  |    repos that did not intend to use it. -} | ||||||
|  | initializeSafe :: Annex () | ||||||
|  | initializeSafe = do | ||||||
|  | 	annexed <- Branch.hasSomeBranch | ||||||
|  | 	if annexed | ||||||
|  | 		then initialize | ||||||
|  | 		else error "First run: git-annex init" | ||||||
|  | 
 | ||||||
| {- set up a git pre-commit hook, if one is not already present -} | {- set up a git pre-commit hook, if one is not already present -} | ||||||
| gitPreCommitHookWrite :: Git.Repo -> Annex () | gitPreCommitHookWrite :: Git.Repo -> Annex () | ||||||
| gitPreCommitHookWrite repo = do | gitPreCommitHookWrite repo = do | ||||||
|  |  | ||||||
|  | @ -28,6 +28,7 @@ import Utility.RsyncFile | ||||||
| import Remote.Helper.Ssh | import Remote.Helper.Ssh | ||||||
| import qualified Remote.Helper.Url as Url | import qualified Remote.Helper.Url as Url | ||||||
| import Config | import Config | ||||||
|  | import Init | ||||||
| 
 | 
 | ||||||
| remote :: RemoteType Annex | remote :: RemoteType Annex | ||||||
| remote = RemoteType { | remote = RemoteType { | ||||||
|  | @ -79,7 +80,9 @@ tryGitConfigRead r | ||||||
| 	| Git.repoIsSsh r = store $ onRemote r (pipedconfig, r) "configlist" [] | 	| Git.repoIsSsh r = store $ onRemote r (pipedconfig, r) "configlist" [] | ||||||
| 	| Git.repoIsHttp r = store $ safely $ geturlconfig | 	| Git.repoIsHttp r = store $ safely $ geturlconfig | ||||||
| 	| Git.repoIsUrl r = return r | 	| Git.repoIsUrl r = return r | ||||||
| 	| otherwise = store $ safely $ Git.configRead r | 	| otherwise = store $ safely $ do | ||||||
|  | 		onLocal r initializeSafe | ||||||
|  | 		Git.configRead r | ||||||
| 	where | 	where | ||||||
| 		-- Reading config can fail due to IO error or | 		-- Reading config can fail due to IO error or | ||||||
| 		-- for other reasons; catch all possible exceptions. | 		-- for other reasons; catch all possible exceptions. | ||||||
|  | @ -124,11 +127,7 @@ inAnnex r key | ||||||
| 	| Git.repoIsUrl r = checkremote | 	| Git.repoIsUrl r = checkremote | ||||||
| 	| otherwise = safely checklocal | 	| otherwise = safely checklocal | ||||||
| 	where | 	where | ||||||
| 		checklocal = do | 		checklocal = onLocal r (Content.inAnnex key) | ||||||
| 			-- run a local check inexpensively, |  | ||||||
| 			-- by making an Annex monad using the remote |  | ||||||
| 			a <- Annex.new r |  | ||||||
| 			Annex.eval a (Content.inAnnex key) |  | ||||||
| 		checkremote = do | 		checkremote = do | ||||||
| 			showAction $ "checking " ++ Git.repoDescribe r | 			showAction $ "checking " ++ Git.repoDescribe r | ||||||
| 			inannex <- onRemote r (boolSystem, False) "inannex"  | 			inannex <- onRemote r (boolSystem, False) "inannex"  | ||||||
|  | @ -137,6 +136,13 @@ inAnnex r key | ||||||
| 		checkhttp = Url.exists $ keyUrl r key | 		checkhttp = Url.exists $ keyUrl r key | ||||||
| 		safely a = liftIO (try a ::IO (Either IOException Bool)) | 		safely a = liftIO (try a ::IO (Either IOException Bool)) | ||||||
| 
 | 
 | ||||||
|  | {- Runs an action on a local repository inexpensively, by making an annex | ||||||
|  |  - monad using that repository. -} | ||||||
|  | onLocal :: Git.Repo -> Annex a -> IO a | ||||||
|  | onLocal r a = do | ||||||
|  | 	annex <- Annex.new r | ||||||
|  | 	Annex.eval annex a | ||||||
|  | 
 | ||||||
| keyUrl :: Git.Repo -> Key -> String | keyUrl :: Git.Repo -> Key -> String | ||||||
| keyUrl r key = Git.repoLocation r ++ "/" ++ annexLocation key | keyUrl r key = Git.repoLocation r ++ "/" ++ annexLocation key | ||||||
| 
 | 
 | ||||||
|  | @ -163,9 +169,7 @@ copyToRemote r key | ||||||
| 		g <- Annex.gitRepo | 		g <- Annex.gitRepo | ||||||
| 		let keysrc = gitAnnexLocation g key | 		let keysrc = gitAnnexLocation g key | ||||||
| 		-- run copy from perspective of remote | 		-- run copy from perspective of remote | ||||||
| 		liftIO $ do | 		liftIO $ onLocal r $ do | ||||||
| 			a <- Annex.new r |  | ||||||
| 			Annex.eval a $ do |  | ||||||
| 			ok <- Content.getViaTmp key $ | 			ok <- Content.getViaTmp key $ | ||||||
| 				rsyncOrCopyFile r keysrc | 				rsyncOrCopyFile r keysrc | ||||||
| 			Content.saveState | 			Content.saveState | ||||||
|  |  | ||||||
		Loading…
	
	Add table
		Add a link
		
	
		Reference in a new issue
	
	 Joey Hess
				Joey Hess