get many more commands building again
about half are building now
This commit is contained in:
		
					parent
					
						
							
								6535aea49a
							
						
					
				
			
			
				commit
				
					
						3c7fd09ec8
					
				
			
		
					 19 changed files with 100 additions and 92 deletions
				
			
		| 
						 | 
				
			
			@ -20,15 +20,12 @@ import Types.Benchmark
 | 
			
		|||
 | 
			
		||||
import qualified Command.Help
 | 
			
		||||
import qualified Command.Add
 | 
			
		||||
{-
 | 
			
		||||
import qualified Command.Unannex
 | 
			
		||||
-}
 | 
			
		||||
import qualified Command.Drop
 | 
			
		||||
import qualified Command.Move
 | 
			
		||||
import qualified Command.Copy
 | 
			
		||||
import qualified Command.Get
 | 
			
		||||
import qualified Command.Fsck
 | 
			
		||||
{-
 | 
			
		||||
import qualified Command.LookupKey
 | 
			
		||||
import qualified Command.CalcKey
 | 
			
		||||
import qualified Command.ContentLocation
 | 
			
		||||
| 
						 | 
				
			
			@ -51,9 +48,7 @@ import qualified Command.VAdd
 | 
			
		|||
import qualified Command.VFilter
 | 
			
		||||
import qualified Command.VPop
 | 
			
		||||
import qualified Command.VCycle
 | 
			
		||||
-}
 | 
			
		||||
import qualified Command.Reinject
 | 
			
		||||
{-
 | 
			
		||||
import qualified Command.Fix
 | 
			
		||||
import qualified Command.Init
 | 
			
		||||
import qualified Command.Describe
 | 
			
		||||
| 
						 | 
				
			
			@ -70,6 +65,7 @@ import qualified Command.AddUnused
 | 
			
		|||
import qualified Command.Unlock
 | 
			
		||||
import qualified Command.Lock
 | 
			
		||||
import qualified Command.PreCommit
 | 
			
		||||
{-
 | 
			
		||||
import qualified Command.PostReceive
 | 
			
		||||
-}
 | 
			
		||||
import qualified Command.Find
 | 
			
		||||
| 
						 | 
				
			
			@ -120,7 +116,9 @@ import qualified Command.Forget
 | 
			
		|||
import qualified Command.P2P
 | 
			
		||||
import qualified Command.Proxy
 | 
			
		||||
import qualified Command.DiffDriver
 | 
			
		||||
-}
 | 
			
		||||
import qualified Command.Smudge
 | 
			
		||||
{-
 | 
			
		||||
import qualified Command.Undo
 | 
			
		||||
import qualified Command.Version
 | 
			
		||||
import qualified Command.RemoteDaemon
 | 
			
		||||
| 
						 | 
				
			
			@ -146,11 +144,9 @@ cmds testoptparser testrunner mkbenchmarkgenerator =
 | 
			
		|||
	, Command.Move.cmd
 | 
			
		||||
	, Command.Copy.cmd
 | 
			
		||||
	, Command.Fsck.cmd
 | 
			
		||||
{-
 | 
			
		||||
	, Command.Unlock.cmd
 | 
			
		||||
	, Command.Unlock.editcmd
 | 
			
		||||
	, Command.Lock.cmd
 | 
			
		||||
-}
 | 
			
		||||
	, Command.Sync.cmd
 | 
			
		||||
{-
 | 
			
		||||
	, Command.Mirror.cmd
 | 
			
		||||
| 
						 | 
				
			
			@ -160,7 +156,6 @@ cmds testoptparser testrunner mkbenchmarkgenerator =
 | 
			
		|||
-}
 | 
			
		||||
	, Command.Import.cmd
 | 
			
		||||
	, Command.Export.cmd
 | 
			
		||||
{-	
 | 
			
		||||
	, Command.Init.cmd
 | 
			
		||||
	, Command.Describe.cmd
 | 
			
		||||
	, Command.InitRemote.cmd
 | 
			
		||||
| 
						 | 
				
			
			@ -168,13 +163,14 @@ cmds testoptparser testrunner mkbenchmarkgenerator =
 | 
			
		|||
	, Command.RenameRemote.cmd
 | 
			
		||||
	, Command.EnableTor.cmd
 | 
			
		||||
	, Command.Multicast.cmd
 | 
			
		||||
-}
 | 
			
		||||
	, Command.Reinject.cmd
 | 
			
		||||
{-
 | 
			
		||||
	, Command.Unannex.cmd
 | 
			
		||||
{-
 | 
			
		||||
	, Command.Uninit.cmd
 | 
			
		||||
	, Command.Reinit.cmd
 | 
			
		||||
-}
 | 
			
		||||
	, Command.PreCommit.cmd
 | 
			
		||||
{-
 | 
			
		||||
	, Command.PostReceive.cmd
 | 
			
		||||
	, Command.NumCopies.cmd
 | 
			
		||||
	, Command.Trust.cmd
 | 
			
		||||
| 
						 | 
				
			
			@ -189,6 +185,7 @@ cmds testoptparser testrunner mkbenchmarkgenerator =
 | 
			
		|||
	, Command.Ungroup.cmd
 | 
			
		||||
	, Command.Config.cmd
 | 
			
		||||
	, Command.Vicfg.cmd
 | 
			
		||||
-}
 | 
			
		||||
	, Command.LookupKey.cmd
 | 
			
		||||
	, Command.CalcKey.cmd
 | 
			
		||||
	, Command.ContentLocation.cmd
 | 
			
		||||
| 
						 | 
				
			
			@ -217,7 +214,6 @@ cmds testoptparser testrunner mkbenchmarkgenerator =
 | 
			
		|||
	, Command.Unused.cmd
 | 
			
		||||
	, Command.DropUnused.cmd
 | 
			
		||||
	, Command.AddUnused.cmd
 | 
			
		||||
-}
 | 
			
		||||
	, Command.Find.cmd
 | 
			
		||||
{-
 | 
			
		||||
	, Command.FindRef.cmd
 | 
			
		||||
| 
						 | 
				
			
			@ -240,7 +236,9 @@ cmds testoptparser testrunner mkbenchmarkgenerator =
 | 
			
		|||
	, Command.P2P.cmd
 | 
			
		||||
	, Command.Proxy.cmd
 | 
			
		||||
	, Command.DiffDriver.cmd
 | 
			
		||||
-}
 | 
			
		||||
	, Command.Smudge.cmd
 | 
			
		||||
{-
 | 
			
		||||
	, Command.Undo.cmd
 | 
			
		||||
	, Command.Version.cmd
 | 
			
		||||
	, Command.RemoteDaemon.cmd
 | 
			
		||||
| 
						 | 
				
			
			
 | 
			
		|||
| 
						 | 
				
			
			@ -5,6 +5,8 @@
 | 
			
		|||
 - Licensed under the GNU AGPL version 3 or higher.
 | 
			
		||||
 -}
 | 
			
		||||
 | 
			
		||||
{-# LANGUAGE OverloadedStrings #-}
 | 
			
		||||
 | 
			
		||||
module Command.EnableRemote where
 | 
			
		||||
 | 
			
		||||
import Command
 | 
			
		||||
| 
						 | 
				
			
			
 | 
			
		|||
| 
						 | 
				
			
			@ -22,5 +22,5 @@ cmd = noCommit $ noMessages $ dontCheck repoExists $
 | 
			
		|||
run :: Maybe Utility.Format.Format -> String -> Annex Bool
 | 
			
		||||
run format p = do
 | 
			
		||||
	let k = fromMaybe (giveup "bad key") $ deserializeKey p
 | 
			
		||||
	showFormatted format (serializeKey k) (keyVars k)
 | 
			
		||||
	showFormatted format (serializeKey' k) (keyVars k)
 | 
			
		||||
	return True
 | 
			
		||||
| 
						 | 
				
			
			
 | 
			
		|||
| 
						 | 
				
			
			@ -9,6 +9,7 @@ module Command.Find where
 | 
			
		|||
 | 
			
		||||
import Data.Default
 | 
			
		||||
import qualified Data.Map as M
 | 
			
		||||
import qualified Data.ByteString as S
 | 
			
		||||
import qualified Data.ByteString.Char8 as S8
 | 
			
		||||
 | 
			
		||||
import Command
 | 
			
		||||
| 
						 | 
				
			
			@ -76,7 +77,7 @@ startKeys o (key, ActionItemBranchFilePath (BranchFilePath _ topf) _) =
 | 
			
		|||
	start o (toRawFilePath (getTopFilePath topf)) key
 | 
			
		||||
startKeys _ _ = stop
 | 
			
		||||
 | 
			
		||||
showFormatted :: Maybe Utility.Format.Format -> RawFilePath -> [(String, String)] -> Annex ()
 | 
			
		||||
showFormatted :: Maybe Utility.Format.Format -> S.ByteString -> [(String, String)] -> Annex ()
 | 
			
		||||
showFormatted format unformatted vars =
 | 
			
		||||
	unlessM (showFullJSON $ JSONChunk vars) $
 | 
			
		||||
		case format of
 | 
			
		||||
| 
						 | 
				
			
			
 | 
			
		|||
| 
						 | 
				
			
			@ -37,13 +37,14 @@ seek ps = unlessM crippledFileSystem $ do
 | 
			
		|||
 | 
			
		||||
data FixWhat = FixSymlinks | FixAll
 | 
			
		||||
 | 
			
		||||
start :: FixWhat -> FilePath -> Key -> CommandStart
 | 
			
		||||
start :: FixWhat -> RawFilePath -> Key -> CommandStart
 | 
			
		||||
start fixwhat file key = do
 | 
			
		||||
	currlink <- liftIO $ catchMaybeIO $ readSymbolicLink file
 | 
			
		||||
	wantlink <- calcRepo $ gitAnnexLink file key
 | 
			
		||||
	currlink <- liftIO $ catchMaybeIO $ readSymbolicLink $ fromRawFilePath file
 | 
			
		||||
	wantlink <- calcRepo $ gitAnnexLink (fromRawFilePath file) key
 | 
			
		||||
	case currlink of
 | 
			
		||||
		Just l
 | 
			
		||||
			| l /= wantlink -> fixby $ fixSymlink file wantlink
 | 
			
		||||
			| l /= wantlink -> fixby $
 | 
			
		||||
				fixSymlink (fromRawFilePath file) wantlink
 | 
			
		||||
			| otherwise -> stop
 | 
			
		||||
		Nothing -> case fixwhat of
 | 
			
		||||
			FixAll -> fixthin
 | 
			
		||||
| 
						 | 
				
			
			@ -52,15 +53,15 @@ start fixwhat file key = do
 | 
			
		|||
	fixby = starting "fix" (mkActionItem (key, file))
 | 
			
		||||
	fixthin = do
 | 
			
		||||
		obj <- calcRepo $ gitAnnexLocation key
 | 
			
		||||
		stopUnless (isUnmodified key file <&&> isUnmodified key obj) $ do
 | 
			
		||||
		stopUnless (isUnmodified key (fromRawFilePath file) <&&> isUnmodified key obj) $ do
 | 
			
		||||
			thin <- annexThin <$> Annex.getGitConfig
 | 
			
		||||
			fs <- liftIO $ catchMaybeIO $ getFileStatus file
 | 
			
		||||
			fs <- liftIO $ catchMaybeIO $ getFileStatus (fromRawFilePath file)
 | 
			
		||||
			os <- liftIO $ catchMaybeIO $ getFileStatus obj
 | 
			
		||||
			case (linkCount <$> fs, linkCount <$> os, thin) of
 | 
			
		||||
				(Just 1, Just 1, True) ->
 | 
			
		||||
					fixby $ makeHardLink file key
 | 
			
		||||
					fixby $ makeHardLink (fromRawFilePath file) key
 | 
			
		||||
				(Just n, Just n', False) | n > 1 && n == n' ->
 | 
			
		||||
					fixby $ breakHardLink file key obj
 | 
			
		||||
					fixby $ breakHardLink (fromRawFilePath file) key obj
 | 
			
		||||
				_ -> stop
 | 
			
		||||
 | 
			
		||||
breakHardLink :: FilePath -> Key -> FilePath -> CommandPerform
 | 
			
		||||
| 
						 | 
				
			
			
 | 
			
		|||
| 
						 | 
				
			
			@ -51,7 +51,7 @@ seekBatch fmt = batchInput fmt parse commandAction
 | 
			
		|||
		in if not (null keyname) && not (null file)
 | 
			
		||||
			then Right $ go file (keyOpt keyname)
 | 
			
		||||
			else Left "Expected pairs of key and filename"
 | 
			
		||||
	go file key = starting "fromkey" (mkActionItem (key, file)) $
 | 
			
		||||
	go file key = starting "fromkey" (mkActionItem (key, toRawFilePath file)) $
 | 
			
		||||
		perform key file
 | 
			
		||||
 | 
			
		||||
start :: Bool -> (String, FilePath) -> CommandStart
 | 
			
		||||
| 
						 | 
				
			
			@ -61,7 +61,7 @@ start force (keyname, file) = do
 | 
			
		|||
		inbackend <- inAnnex key
 | 
			
		||||
		unless inbackend $ giveup $
 | 
			
		||||
			"key ("++ keyname ++") is not present in backend (use --force to override this sanity check)"
 | 
			
		||||
	starting "fromkey" (mkActionItem (key, file)) $
 | 
			
		||||
	starting "fromkey" (mkActionItem (key, toRawFilePath file)) $
 | 
			
		||||
		perform key file
 | 
			
		||||
 | 
			
		||||
-- From user input to a Key.
 | 
			
		||||
| 
						 | 
				
			
			@ -80,7 +80,7 @@ keyOpt s = case parseURI s of
 | 
			
		|||
		Nothing -> giveup $ "bad key/url " ++ s
 | 
			
		||||
 | 
			
		||||
perform :: Key -> FilePath -> CommandPerform
 | 
			
		||||
perform key file = lookupFileNotHidden file >>= \case
 | 
			
		||||
perform key file = lookupFileNotHidden (toRawFilePath file) >>= \case
 | 
			
		||||
	Nothing -> ifM (liftIO $ doesFileExist file)
 | 
			
		||||
		( hasothercontent
 | 
			
		||||
		, do
 | 
			
		||||
| 
						 | 
				
			
			
 | 
			
		|||
| 
						 | 
				
			
			@ -5,6 +5,8 @@
 | 
			
		|||
 - Licensed under the GNU AGPL version 3 or higher.
 | 
			
		||||
 -}
 | 
			
		||||
 | 
			
		||||
{-# LANGUAGE OverloadedStrings #-}
 | 
			
		||||
 | 
			
		||||
module Command.InitRemote where
 | 
			
		||||
 | 
			
		||||
import qualified Data.Map as M
 | 
			
		||||
| 
						 | 
				
			
			
 | 
			
		|||
| 
						 | 
				
			
			@ -32,7 +32,7 @@ seek ps = do
 | 
			
		|||
	l <- workTreeItems ps
 | 
			
		||||
	withFilesInGit (commandAction . (whenAnnexed startNew)) l
 | 
			
		||||
 | 
			
		||||
startNew :: FilePath -> Key -> CommandStart
 | 
			
		||||
startNew :: RawFilePath -> Key -> CommandStart
 | 
			
		||||
startNew file key = ifM (isJust <$> isAnnexLink file)
 | 
			
		||||
	( stop
 | 
			
		||||
	, starting "lock" (mkActionItem (key, file)) $
 | 
			
		||||
| 
						 | 
				
			
			@ -43,7 +43,7 @@ startNew file key = ifM (isJust <$> isAnnexLink file)
 | 
			
		|||
		| key' == key = cont
 | 
			
		||||
		| otherwise = errorModified
 | 
			
		||||
	go Nothing = 
 | 
			
		||||
		ifM (isUnmodified key file) 
 | 
			
		||||
		ifM (isUnmodified key (fromRawFilePath file))
 | 
			
		||||
			( cont
 | 
			
		||||
			, ifM (Annex.getState Annex.force)
 | 
			
		||||
				( cont
 | 
			
		||||
| 
						 | 
				
			
			@ -52,11 +52,11 @@ startNew file key = ifM (isJust <$> isAnnexLink file)
 | 
			
		|||
			)
 | 
			
		||||
	cont = performNew file key
 | 
			
		||||
 | 
			
		||||
performNew :: FilePath -> Key -> CommandPerform
 | 
			
		||||
performNew :: RawFilePath -> Key -> CommandPerform
 | 
			
		||||
performNew file key = do
 | 
			
		||||
	lockdown =<< calcRepo (gitAnnexLocation key)
 | 
			
		||||
	addLink file key
 | 
			
		||||
		=<< withTSDelta (liftIO . genInodeCache file)
 | 
			
		||||
	addLink (fromRawFilePath file) key
 | 
			
		||||
		=<< withTSDelta (liftIO . genInodeCache (fromRawFilePath file))
 | 
			
		||||
	next $ cleanupNew file key
 | 
			
		||||
  where
 | 
			
		||||
	lockdown obj = do
 | 
			
		||||
| 
						 | 
				
			
			@ -70,7 +70,7 @@ performNew file key = do
 | 
			
		|||
	-- It's ok if the file is hard linked to obj, but if some other
 | 
			
		||||
	-- associated file is, we need to break that link to lock down obj.
 | 
			
		||||
	breakhardlink obj = whenM (catchBoolIO $ (> 1) . linkCount <$> liftIO (getFileStatus obj)) $ do
 | 
			
		||||
		mfc <- withTSDelta (liftIO . genInodeCache file)
 | 
			
		||||
		mfc <- withTSDelta (liftIO . genInodeCache (fromRawFilePath file))
 | 
			
		||||
		unlessM (sameInodeCache obj (maybeToList mfc)) $ do
 | 
			
		||||
			modifyContent obj $ replaceFile obj $ \tmp -> do
 | 
			
		||||
				unlessM (checkedCopyFile key obj tmp Nothing) $
 | 
			
		||||
| 
						 | 
				
			
			@ -92,21 +92,21 @@ performNew file key = do
 | 
			
		|||
 | 
			
		||||
	lostcontent = logStatus key InfoMissing
 | 
			
		||||
 | 
			
		||||
cleanupNew :: FilePath -> Key -> CommandCleanup
 | 
			
		||||
cleanupNew :: RawFilePath -> Key -> CommandCleanup
 | 
			
		||||
cleanupNew file key = do
 | 
			
		||||
	Database.Keys.removeAssociatedFile key =<< inRepo (toTopFilePath file)
 | 
			
		||||
	Database.Keys.removeAssociatedFile key =<< inRepo (toTopFilePath (fromRawFilePath file))
 | 
			
		||||
	return True
 | 
			
		||||
 | 
			
		||||
startOld :: FilePath -> CommandStart
 | 
			
		||||
startOld :: RawFilePath -> CommandStart
 | 
			
		||||
startOld file = do
 | 
			
		||||
	unlessM (Annex.getState Annex.force)
 | 
			
		||||
		errorModified
 | 
			
		||||
	starting "lock" (ActionItemWorkTreeFile file) $
 | 
			
		||||
		performOld file
 | 
			
		||||
 | 
			
		||||
performOld :: FilePath -> CommandPerform
 | 
			
		||||
performOld :: RawFilePath -> CommandPerform
 | 
			
		||||
performOld file = do
 | 
			
		||||
	Annex.Queue.addCommand "checkout" [Param "--"] [file]
 | 
			
		||||
	Annex.Queue.addCommand "checkout" [Param "--"] [fromRawFilePath file]
 | 
			
		||||
	next $ return True
 | 
			
		||||
 | 
			
		||||
errorModified :: a
 | 
			
		||||
| 
						 | 
				
			
			
 | 
			
		|||
| 
						 | 
				
			
			@ -29,11 +29,12 @@ run _ file = seekSingleGitFile file >>= \case
 | 
			
		|||
 | 
			
		||||
-- To support absolute filenames, pass through git ls-files.
 | 
			
		||||
-- But, this plumbing command does not recurse through directories.
 | 
			
		||||
seekSingleGitFile :: FilePath -> Annex (Maybe FilePath)
 | 
			
		||||
seekSingleGitFile :: FilePath -> Annex (Maybe RawFilePath)
 | 
			
		||||
seekSingleGitFile file = do
 | 
			
		||||
	(l, cleanup) <- inRepo (Git.LsFiles.inRepo [file])
 | 
			
		||||
	(l, cleanup) <- inRepo (Git.LsFiles.inRepo [toRawFilePath file])
 | 
			
		||||
	r <- case l of
 | 
			
		||||
		(f:[]) | takeFileName f == takeFileName file -> return (Just f)
 | 
			
		||||
		(f:[]) | takeFileName (fromRawFilePath f) == takeFileName file ->
 | 
			
		||||
			return (Just f)
 | 
			
		||||
		_ -> return Nothing
 | 
			
		||||
	void $ liftIO cleanup
 | 
			
		||||
	return r
 | 
			
		||||
| 
						 | 
				
			
			
 | 
			
		|||
| 
						 | 
				
			
			@ -92,7 +92,7 @@ seek o = case batchOption o of
 | 
			
		|||
			)
 | 
			
		||||
		_ -> giveup "--batch is currently only supported in --json mode"
 | 
			
		||||
 | 
			
		||||
start :: VectorClock -> MetaDataOptions -> FilePath -> Key -> CommandStart
 | 
			
		||||
start :: VectorClock -> MetaDataOptions -> RawFilePath -> Key -> CommandStart
 | 
			
		||||
start c o file k = startKeys c o (k, mkActionItem (k, afile))
 | 
			
		||||
  where
 | 
			
		||||
	afile = AssociatedFile (Just file)
 | 
			
		||||
| 
						 | 
				
			
			@ -147,7 +147,7 @@ instance FromJSON MetaDataFields where
 | 
			
		|||
fieldsField :: T.Text
 | 
			
		||||
fieldsField = T.pack "fields"
 | 
			
		||||
 | 
			
		||||
parseJSONInput :: String -> Either String (Either FilePath Key, MetaData)
 | 
			
		||||
parseJSONInput :: String -> Either String (Either RawFilePath Key, MetaData)
 | 
			
		||||
parseJSONInput i = do
 | 
			
		||||
	v <- eitherDecode (BU.fromString i)
 | 
			
		||||
	let m = case itemAdded v of
 | 
			
		||||
| 
						 | 
				
			
			@ -155,16 +155,16 @@ parseJSONInput i = do
 | 
			
		|||
		Just (MetaDataFields m') -> m'
 | 
			
		||||
	case (itemKey v, itemFile v) of
 | 
			
		||||
		(Just k, _) -> Right (Right k, m)
 | 
			
		||||
		(Nothing, Just f) -> Right (Left f, m)
 | 
			
		||||
		(Nothing, Just f) -> Right (Left (toRawFilePath f), m)
 | 
			
		||||
		(Nothing, Nothing) -> Left "JSON input is missing either file or key"
 | 
			
		||||
 | 
			
		||||
startBatch :: (Either FilePath Key, MetaData) -> CommandStart
 | 
			
		||||
startBatch :: (Either RawFilePath Key, MetaData) -> CommandStart
 | 
			
		||||
startBatch (i, (MetaData m)) = case i of
 | 
			
		||||
	Left f -> do
 | 
			
		||||
		mk <- lookupFile f
 | 
			
		||||
		case mk of
 | 
			
		||||
			Just k -> go k (mkActionItem (k, AssociatedFile (Just f)))
 | 
			
		||||
			Nothing -> giveup $ "not an annexed file: " ++ f
 | 
			
		||||
			Nothing -> giveup $ "not an annexed file: " ++ fromRawFilePath f
 | 
			
		||||
	Right k -> go k (mkActionItem k)
 | 
			
		||||
  where
 | 
			
		||||
	go k ai = starting "metadata" ai $ do
 | 
			
		||||
| 
						 | 
				
			
			
 | 
			
		|||
| 
						 | 
				
			
			@ -137,7 +137,7 @@ send ups fs = do
 | 
			
		|||
				mk <- lookupFile f
 | 
			
		||||
				case mk of
 | 
			
		||||
					Nothing -> noop
 | 
			
		||||
					Just k -> withObjectLoc k (addlist f)
 | 
			
		||||
					Just k -> withObjectLoc k (addlist (fromRawFilePath f))
 | 
			
		||||
			liftIO $ hClose h
 | 
			
		||||
			
 | 
			
		||||
			serverkey <- uftpKey
 | 
			
		||||
| 
						 | 
				
			
			
 | 
			
		|||
| 
						 | 
				
			
			@ -53,11 +53,11 @@ seek ps = lockPreCommitHook $ do
 | 
			
		|||
			(removeViewMetaData v)
 | 
			
		||||
 | 
			
		||||
addViewMetaData :: View -> ViewedFile -> Key -> CommandStart
 | 
			
		||||
addViewMetaData v f k = starting "metadata" (mkActionItem (k, f)) $
 | 
			
		||||
addViewMetaData v f k = starting "metadata" (mkActionItem (k, toRawFilePath f)) $
 | 
			
		||||
	next $ changeMetaData k $ fromView v f
 | 
			
		||||
 | 
			
		||||
removeViewMetaData :: View -> ViewedFile -> Key -> CommandStart
 | 
			
		||||
removeViewMetaData v f k = starting "metadata" (mkActionItem (k, f)) $
 | 
			
		||||
removeViewMetaData v f k = starting "metadata" (mkActionItem (k, toRawFilePath f)) $
 | 
			
		||||
	next $ changeMetaData k $ unsetMetaData $ fromView v f
 | 
			
		||||
 | 
			
		||||
changeMetaData :: Key -> MetaData -> CommandCleanup
 | 
			
		||||
| 
						 | 
				
			
			
 | 
			
		|||
| 
						 | 
				
			
			@ -38,13 +38,13 @@ optParser desc = ReKeyOptions
 | 
			
		|||
 | 
			
		||||
-- Split on the last space, since a FilePath can contain whitespace,
 | 
			
		||||
-- but a Key very rarely does.
 | 
			
		||||
batchParser :: String -> Either String (FilePath, Key)
 | 
			
		||||
batchParser :: String -> Either String (RawFilePath, Key)
 | 
			
		||||
batchParser s = case separate (== ' ') (reverse s) of
 | 
			
		||||
	(rk, rf)
 | 
			
		||||
		| null rk || null rf -> Left "Expected: \"file key\""
 | 
			
		||||
		| otherwise -> case deserializeKey (reverse rk) of
 | 
			
		||||
			Nothing -> Left "bad key"
 | 
			
		||||
			Just k -> Right (reverse rf, k)
 | 
			
		||||
			Just k -> Right (toRawFilePath (reverse rf), k)
 | 
			
		||||
 | 
			
		||||
seek :: ReKeyOptions -> CommandSeek
 | 
			
		||||
seek o = case batchOption o of
 | 
			
		||||
| 
						 | 
				
			
			@ -52,9 +52,9 @@ seek o = case batchOption o of
 | 
			
		|||
	NoBatch -> withPairs (commandAction . start . parsekey) (reKeyThese o)
 | 
			
		||||
  where
 | 
			
		||||
	parsekey (file, skey) =
 | 
			
		||||
		(file, fromMaybe (giveup "bad key") (deserializeKey skey))
 | 
			
		||||
		(toRawFilePath file, fromMaybe (giveup "bad key") (deserializeKey skey))
 | 
			
		||||
 | 
			
		||||
start :: (FilePath, Key) -> CommandStart
 | 
			
		||||
start :: (RawFilePath, Key) -> CommandStart
 | 
			
		||||
start (file, newkey) = ifAnnexed file go stop
 | 
			
		||||
  where
 | 
			
		||||
	go oldkey
 | 
			
		||||
| 
						 | 
				
			
			@ -62,19 +62,19 @@ start (file, newkey) = ifAnnexed file go stop
 | 
			
		|||
		| otherwise = starting "rekey" (ActionItemWorkTreeFile file) $
 | 
			
		||||
			perform file oldkey newkey
 | 
			
		||||
 | 
			
		||||
perform :: FilePath -> Key -> Key -> CommandPerform
 | 
			
		||||
perform :: RawFilePath -> Key -> Key -> CommandPerform
 | 
			
		||||
perform file oldkey newkey = do
 | 
			
		||||
	ifM (inAnnex oldkey) 
 | 
			
		||||
		( unlessM (linkKey file oldkey newkey) $
 | 
			
		||||
			giveup "failed creating link from old to new key"
 | 
			
		||||
		, unlessM (Annex.getState Annex.force) $
 | 
			
		||||
			giveup $ file ++ " is not available (use --force to override)"
 | 
			
		||||
			giveup $ fromRawFilePath file ++ " is not available (use --force to override)"
 | 
			
		||||
		)
 | 
			
		||||
	next $ cleanup file oldkey newkey
 | 
			
		||||
 | 
			
		||||
{- Make a hard link to the old key content (when supported),
 | 
			
		||||
 - to avoid wasting disk space. -}
 | 
			
		||||
linkKey :: FilePath -> Key -> Key -> Annex Bool
 | 
			
		||||
linkKey :: RawFilePath -> Key -> Key -> Annex Bool
 | 
			
		||||
linkKey file oldkey newkey = ifM (isJust <$> isAnnexLink file)
 | 
			
		||||
 	{- If the object file is already hardlinked to elsewhere, a hard
 | 
			
		||||
	 - link won't be made by getViaTmpFromDisk, but a copy instead.
 | 
			
		||||
| 
						 | 
				
			
			@ -89,40 +89,40 @@ linkKey file oldkey newkey = ifM (isJust <$> isAnnexLink file)
 | 
			
		|||
		 - it's hard linked to the old key, that link must be broken. -}
 | 
			
		||||
		oldobj <- calcRepo (gitAnnexLocation oldkey)
 | 
			
		||||
		v <- tryNonAsync $ do
 | 
			
		||||
			st <- liftIO $ getFileStatus file
 | 
			
		||||
			st <- liftIO $ getFileStatus (fromRawFilePath file)
 | 
			
		||||
			when (linkCount st > 1) $ do
 | 
			
		||||
				freezeContent oldobj
 | 
			
		||||
				replaceFile file $ \tmp -> do
 | 
			
		||||
				replaceFile (fromRawFilePath file) $ \tmp -> do
 | 
			
		||||
					unlessM (checkedCopyFile oldkey oldobj tmp Nothing) $
 | 
			
		||||
						error "can't lock old key"
 | 
			
		||||
					thawContent tmp
 | 
			
		||||
		ic <- withTSDelta (liftIO . genInodeCache file)
 | 
			
		||||
		ic <- withTSDelta (liftIO . genInodeCache (fromRawFilePath file))
 | 
			
		||||
		case v of
 | 
			
		||||
			Left e -> do
 | 
			
		||||
				warning (show e)
 | 
			
		||||
				return False
 | 
			
		||||
			Right () -> do
 | 
			
		||||
				r <- linkToAnnex newkey file ic
 | 
			
		||||
				r <- linkToAnnex newkey (fromRawFilePath file) ic
 | 
			
		||||
				return $ case r of
 | 
			
		||||
					LinkAnnexFailed -> False
 | 
			
		||||
					LinkAnnexOk -> True
 | 
			
		||||
					LinkAnnexNoop -> True
 | 
			
		||||
	)
 | 
			
		||||
 | 
			
		||||
cleanup :: FilePath -> Key -> Key -> CommandCleanup
 | 
			
		||||
cleanup :: RawFilePath -> Key -> Key -> CommandCleanup
 | 
			
		||||
cleanup file oldkey newkey = do
 | 
			
		||||
	ifM (isJust <$> isAnnexLink file)
 | 
			
		||||
		( do
 | 
			
		||||
			-- Update symlink to use the new key.
 | 
			
		||||
			liftIO $ removeFile file
 | 
			
		||||
			addLink file newkey Nothing
 | 
			
		||||
			liftIO $ removeFile (fromRawFilePath file)
 | 
			
		||||
			addLink (fromRawFilePath file) newkey Nothing
 | 
			
		||||
		, do
 | 
			
		||||
			mode <- liftIO $ catchMaybeIO $ fileMode <$> getFileStatus file
 | 
			
		||||
			mode <- liftIO $ catchMaybeIO $ fileMode <$> getFileStatus (fromRawFilePath file)
 | 
			
		||||
			liftIO $ whenM (isJust <$> isPointerFile file) $
 | 
			
		||||
				writePointerFile file newkey mode
 | 
			
		||||
			stagePointerFile file mode =<< hashPointerFile newkey
 | 
			
		||||
			Database.Keys.removeAssociatedFile oldkey 
 | 
			
		||||
				=<< inRepo (toTopFilePath file)
 | 
			
		||||
				=<< inRepo (toTopFilePath (fromRawFilePath file))
 | 
			
		||||
		)
 | 
			
		||||
	whenM (inAnnex newkey) $
 | 
			
		||||
		logStatus newkey InfoPresent
 | 
			
		||||
| 
						 | 
				
			
			
 | 
			
		|||
| 
						 | 
				
			
			@ -86,9 +86,9 @@ clean file = do
 | 
			
		|||
		( liftIO $ L.hPut stdout b
 | 
			
		||||
		, case parseLinkTargetOrPointerLazy b of
 | 
			
		||||
			Just k -> do
 | 
			
		||||
				getMoveRaceRecovery k file
 | 
			
		||||
				getMoveRaceRecovery k (toRawFilePath file)
 | 
			
		||||
				liftIO $ L.hPut stdout b
 | 
			
		||||
			Nothing -> go b =<< catKeyFile file
 | 
			
		||||
			Nothing -> go b =<< catKeyFile (toRawFilePath file)
 | 
			
		||||
		)
 | 
			
		||||
	stop
 | 
			
		||||
  where
 | 
			
		||||
| 
						 | 
				
			
			@ -187,10 +187,10 @@ emitPointer = S.putStr . formatPointer
 | 
			
		|||
-- This also handles the case where a copy of a pointer file is made,
 | 
			
		||||
-- then git-annex gets the content, and later git add is run on
 | 
			
		||||
-- the pointer copy. It will then be populated with the content.
 | 
			
		||||
getMoveRaceRecovery :: Key -> FilePath -> Annex ()
 | 
			
		||||
getMoveRaceRecovery :: Key -> RawFilePath -> Annex ()
 | 
			
		||||
getMoveRaceRecovery k file = void $ tryNonAsync $
 | 
			
		||||
	whenM (inAnnex k) $ do
 | 
			
		||||
		obj <- calcRepo (gitAnnexLocation k)
 | 
			
		||||
		obj <- toRawFilePath <$> calcRepo (gitAnnexLocation k)
 | 
			
		||||
		-- Cannot restage because git add is running and has
 | 
			
		||||
		-- the index locked.
 | 
			
		||||
		populatePointerFile (Restage False) k obj file >>= \case
 | 
			
		||||
| 
						 | 
				
			
			@ -204,11 +204,11 @@ update = do
 | 
			
		|||
 | 
			
		||||
updateSmudged :: Restage -> Annex ()
 | 
			
		||||
updateSmudged restage = streamSmudged $ \k topf -> do
 | 
			
		||||
	f <- fromRepo $ fromTopFilePath topf
 | 
			
		||||
	f <- toRawFilePath <$> fromRepo (fromTopFilePath topf)
 | 
			
		||||
	whenM (inAnnex k) $ do
 | 
			
		||||
		obj <- calcRepo (gitAnnexLocation k)
 | 
			
		||||
		obj <- toRawFilePath <$> calcRepo (gitAnnexLocation k)
 | 
			
		||||
		unlessM (isJust <$> populatePointerFile restage k obj f) $
 | 
			
		||||
			liftIO (isPointerFile f) >>= \case
 | 
			
		||||
				Just k' | k' == k -> toplevelWarning False $
 | 
			
		||||
					"unable to populate worktree file " ++ f
 | 
			
		||||
					"unable to populate worktree file " ++ fromRawFilePath f
 | 
			
		||||
				_ -> noop
 | 
			
		||||
| 
						 | 
				
			
			
 | 
			
		|||
| 
						 | 
				
			
			@ -116,10 +116,10 @@ instance TCSerialized Direction where
 | 
			
		|||
	deserialize _ = Nothing
 | 
			
		||||
 | 
			
		||||
instance TCSerialized AssociatedFile where
 | 
			
		||||
	serialize (AssociatedFile (Just f)) = f
 | 
			
		||||
	serialize (AssociatedFile (Just f)) = fromRawFilePath f
 | 
			
		||||
	serialize (AssociatedFile Nothing) = ""
 | 
			
		||||
	deserialize "" = Just (AssociatedFile Nothing)
 | 
			
		||||
	deserialize f = Just (AssociatedFile (Just f))
 | 
			
		||||
	deserialize f = Just (AssociatedFile (Just (toRawFilePath f)))
 | 
			
		||||
 | 
			
		||||
instance TCSerialized RemoteName where
 | 
			
		||||
	serialize n = n
 | 
			
		||||
| 
						 | 
				
			
			
 | 
			
		|||
| 
						 | 
				
			
			@ -31,17 +31,18 @@ seek ps = withFilesInGit (commandAction . whenAnnexed start) =<< workTreeItems p
 | 
			
		|||
{- Before v6, the unlock subcommand replaces the symlink with a copy of
 | 
			
		||||
 - the file's content. In v6 and above, it converts the file from a symlink
 | 
			
		||||
 - to a pointer. -}
 | 
			
		||||
start :: FilePath -> Key -> CommandStart
 | 
			
		||||
start :: RawFilePath -> Key -> CommandStart
 | 
			
		||||
start file key = ifM (isJust <$> isAnnexLink file)
 | 
			
		||||
	( starting "unlock" (mkActionItem (key, AssociatedFile (Just file))) $
 | 
			
		||||
		perform file key
 | 
			
		||||
	, stop
 | 
			
		||||
	)
 | 
			
		||||
 | 
			
		||||
perform :: FilePath -> Key -> CommandPerform
 | 
			
		||||
perform :: RawFilePath -> Key -> CommandPerform
 | 
			
		||||
perform dest key = do
 | 
			
		||||
	destmode <- liftIO $ catchMaybeIO $ fileMode <$> getFileStatus dest
 | 
			
		||||
	replaceFile dest $ \tmp ->
 | 
			
		||||
	destmode <- liftIO $ catchMaybeIO $ fileMode
 | 
			
		||||
		<$> getFileStatus (fromRawFilePath dest)
 | 
			
		||||
	replaceFile (fromRawFilePath dest) $ \tmp ->
 | 
			
		||||
		ifM (inAnnex key)
 | 
			
		||||
			( do
 | 
			
		||||
				r <- linkFromAnnex key tmp destmode
 | 
			
		||||
| 
						 | 
				
			
			@ -49,12 +50,12 @@ perform dest key = do
 | 
			
		|||
					LinkAnnexOk -> return ()
 | 
			
		||||
					LinkAnnexNoop -> return ()
 | 
			
		||||
					LinkAnnexFailed -> error "unlock failed"
 | 
			
		||||
			, liftIO $ writePointerFile tmp key destmode
 | 
			
		||||
			, liftIO $ writePointerFile (toRawFilePath tmp) key destmode
 | 
			
		||||
			)
 | 
			
		||||
	next $ cleanup dest key destmode
 | 
			
		||||
 | 
			
		||||
cleanup ::  FilePath -> Key -> Maybe FileMode -> CommandCleanup
 | 
			
		||||
cleanup ::  RawFilePath -> Key -> Maybe FileMode -> CommandCleanup
 | 
			
		||||
cleanup dest key destmode = do
 | 
			
		||||
	stagePointerFile dest destmode =<< hashPointerFile key
 | 
			
		||||
	Database.Keys.addAssociatedFile key =<< inRepo (toTopFilePath dest)
 | 
			
		||||
	Database.Keys.addAssociatedFile key =<< inRepo (toTopFilePath (fromRawFilePath dest))
 | 
			
		||||
	return True
 | 
			
		||||
| 
						 | 
				
			
			
 | 
			
		|||
| 
						 | 
				
			
			@ -192,10 +192,10 @@ withKeysReferencedM a = withKeysReferenced' Nothing () calla
 | 
			
		|||
	calla k _ _ = a k
 | 
			
		||||
 | 
			
		||||
{- Folds an action over keys and files referenced in a particular directory. -}
 | 
			
		||||
withKeysFilesReferencedIn :: FilePath -> v -> (Key -> FilePath -> v -> Annex v) -> Annex v
 | 
			
		||||
withKeysFilesReferencedIn :: FilePath -> v -> (Key -> RawFilePath -> v -> Annex v) -> Annex v
 | 
			
		||||
withKeysFilesReferencedIn = withKeysReferenced' . Just
 | 
			
		||||
 | 
			
		||||
withKeysReferenced' :: Maybe FilePath -> v -> (Key -> FilePath -> v -> Annex v) -> Annex v
 | 
			
		||||
withKeysReferenced' :: Maybe FilePath -> v -> (Key -> RawFilePath -> v -> Annex v) -> Annex v
 | 
			
		||||
withKeysReferenced' mdir initial a = do
 | 
			
		||||
	(files, clean) <- getfiles
 | 
			
		||||
	r <- go initial files
 | 
			
		||||
| 
						 | 
				
			
			@ -207,9 +207,9 @@ withKeysReferenced' mdir initial a = do
 | 
			
		|||
			( return ([], return True)
 | 
			
		||||
			, do
 | 
			
		||||
				top <- fromRepo Git.repoPath
 | 
			
		||||
				inRepo $ LsFiles.allFiles [top]
 | 
			
		||||
				inRepo $ LsFiles.allFiles [toRawFilePath top]
 | 
			
		||||
			)
 | 
			
		||||
		Just dir -> inRepo $ LsFiles.inRepo [dir]
 | 
			
		||||
		Just dir -> inRepo $ LsFiles.inRepo [toRawFilePath dir]
 | 
			
		||||
	go v [] = return v
 | 
			
		||||
	go v (f:fs) = do
 | 
			
		||||
		mk <- lookupFile f
 | 
			
		||||
| 
						 | 
				
			
			@ -221,7 +221,8 @@ withKeysReferenced' mdir initial a = do
 | 
			
		|||
 | 
			
		||||
withKeysReferencedDiffGitRefs :: RefSpec -> (Key -> Annex ()) -> Annex ()
 | 
			
		||||
withKeysReferencedDiffGitRefs refspec a = do
 | 
			
		||||
	rs <- relevantrefs <$> inRepo (Git.Command.pipeReadStrict [Param "show-ref"])
 | 
			
		||||
	rs <- relevantrefs . decodeBS'
 | 
			
		||||
		<$> inRepo (Git.Command.pipeReadStrict [Param "show-ref"])
 | 
			
		||||
	shaHead <- maybe (return Nothing) (inRepo . Git.Ref.sha)
 | 
			
		||||
		=<< inRepo Git.Branch.currentUnsafe
 | 
			
		||||
	let haveHead = any (\(shaRef, _) -> Just shaRef == shaHead) rs
 | 
			
		||||
| 
						 | 
				
			
			
 | 
			
		|||
| 
						 | 
				
			
			@ -101,7 +101,8 @@ checkoutViewBranch view mkbranch = do
 | 
			
		|||
		 - removed.) -}
 | 
			
		||||
		top <- liftIO . absPath =<< fromRepo Git.repoPath
 | 
			
		||||
		(l, cleanup) <- inRepo $
 | 
			
		||||
			LsFiles.notInRepoIncludingEmptyDirectories False [top]
 | 
			
		||||
			LsFiles.notInRepoIncludingEmptyDirectories False
 | 
			
		||||
				[toRawFilePath top]
 | 
			
		||||
		forM_ l (removeemptydir top)
 | 
			
		||||
		liftIO $ void cleanup
 | 
			
		||||
		unlessM (liftIO $ doesDirectoryExist here) $ do
 | 
			
		||||
| 
						 | 
				
			
			@ -109,7 +110,7 @@ checkoutViewBranch view mkbranch = do
 | 
			
		|||
	return ok
 | 
			
		||||
  where
 | 
			
		||||
	removeemptydir top d = do
 | 
			
		||||
		p <- inRepo $ toTopFilePath d
 | 
			
		||||
		p <- inRepo $ toTopFilePath $ fromRawFilePath d
 | 
			
		||||
		liftIO $ tryIO $ removeDirectory (top </> getTopFilePath p)
 | 
			
		||||
	cwdmissing top = unlines
 | 
			
		||||
		[ "This view does not include the subdirectory you are currently in."
 | 
			
		||||
| 
						 | 
				
			
			
 | 
			
		|||
| 
						 | 
				
			
			@ -284,7 +284,7 @@ findUncorruptedCommit missing goodcommits branch r = do
 | 
			
		|||
				, Param "--format=%H"
 | 
			
		||||
				, Param (fromRef branch)
 | 
			
		||||
				] r
 | 
			
		||||
			let branchshas = catMaybes $ map (extractSha . decodeBS) ls
 | 
			
		||||
			let branchshas = catMaybes $ map (extractSha . decodeBL) ls
 | 
			
		||||
			reflogshas <- RefLog.get branch r
 | 
			
		||||
			-- XXX Could try a bit harder here, and look
 | 
			
		||||
			-- for uncorrupted old commits in branches in the
 | 
			
		||||
| 
						 | 
				
			
			@ -313,7 +313,7 @@ verifyCommit missing goodcommits commit r
 | 
			
		|||
			, Param "--format=%H %T"
 | 
			
		||||
			, Param (fromRef commit)
 | 
			
		||||
			] r
 | 
			
		||||
		let committrees = map (parse . decodeBS) ls
 | 
			
		||||
		let committrees = map (parse . decodeBL) ls
 | 
			
		||||
		if any isNothing committrees || null committrees
 | 
			
		||||
			then do
 | 
			
		||||
				void cleanup
 | 
			
		||||
| 
						 | 
				
			
			@ -342,7 +342,7 @@ verifyTree missing treesha r
 | 
			
		|||
	| S.member treesha missing = return False
 | 
			
		||||
	| otherwise = do
 | 
			
		||||
		(ls, cleanup) <- pipeNullSplit (LsTree.lsTreeParams LsTree.LsTreeRecursive treesha []) r
 | 
			
		||||
		let objshas = map (LsTree.sha . LsTree.parseLsTree) ls
 | 
			
		||||
		let objshas = mapMaybe (LsTree.sha <$$> eitherToMaybe . LsTree.parseLsTree) ls
 | 
			
		||||
		if any (`S.member` missing) objshas
 | 
			
		||||
			then do
 | 
			
		||||
				void cleanup
 | 
			
		||||
| 
						 | 
				
			
			@ -366,7 +366,7 @@ checkIndex r = do
 | 
			
		|||
 - itself is not corrupt. -}
 | 
			
		||||
checkIndexFast :: Repo -> IO Bool
 | 
			
		||||
checkIndexFast r = do
 | 
			
		||||
	(indexcontents, cleanup) <- LsFiles.stagedDetails [repoPath r] r
 | 
			
		||||
	(indexcontents, cleanup) <- LsFiles.stagedDetails [toRawFilePath (repoPath r)] r
 | 
			
		||||
	length indexcontents `seq` cleanup
 | 
			
		||||
 | 
			
		||||
missingIndex :: Repo -> IO Bool
 | 
			
		||||
| 
						 | 
				
			
			@ -375,7 +375,7 @@ missingIndex r = not <$> doesFileExist (localGitDir r </> "index")
 | 
			
		|||
{- Finds missing and ok files staged in the index. -}
 | 
			
		||||
partitionIndex :: Repo -> IO ([LsFiles.StagedDetails], [LsFiles.StagedDetails], IO Bool)
 | 
			
		||||
partitionIndex r = do
 | 
			
		||||
	(indexcontents, cleanup) <- LsFiles.stagedDetails [repoPath r] r
 | 
			
		||||
	(indexcontents, cleanup) <- LsFiles.stagedDetails [toRawFilePath (repoPath r)] r
 | 
			
		||||
	l <- forM indexcontents $ \i -> case i of
 | 
			
		||||
		(_file, Just sha, Just _mode) -> (,) <$> isMissing sha r <*> pure i
 | 
			
		||||
		_ -> pure (False, i)
 | 
			
		||||
| 
						 | 
				
			
			@ -394,12 +394,12 @@ rewriteIndex r
 | 
			
		|||
			UpdateIndex.streamUpdateIndex r
 | 
			
		||||
				=<< (catMaybes <$> mapM reinject good)
 | 
			
		||||
		void cleanup
 | 
			
		||||
		return $ map fst3 bad
 | 
			
		||||
		return $ map (fromRawFilePath . fst3) bad
 | 
			
		||||
  where
 | 
			
		||||
	reinject (file, Just sha, Just mode) = case toTreeItemType mode of
 | 
			
		||||
		Nothing -> return Nothing
 | 
			
		||||
		Just treeitemtype -> Just <$>
 | 
			
		||||
			UpdateIndex.stageFile sha treeitemtype file r
 | 
			
		||||
			UpdateIndex.stageFile sha treeitemtype (fromRawFilePath file) r
 | 
			
		||||
	reinject _ = return Nothing
 | 
			
		||||
 | 
			
		||||
newtype GoodCommits = GoodCommits (S.Set Sha)
 | 
			
		||||
| 
						 | 
				
			
			
 | 
			
		|||
		Loading…
	
	Add table
		Add a link
		
	
		Reference in a new issue