annex.addunlocked

* add, addurl, import, importfeed: When in a v6 repository on a crippled
  filesystem, add files unlocked.
* annex.addunlocked: New configuration setting, makes files always be
  added unlocked. (v6 only)

8 files changed, 116 insertions, 39 deletions

diff --git a/Annex/Ingest.hs b/Annex/Ingest.hs
index 0dd8b5967..a7f36466f 100644
--- a/Annex/Ingest.hs
+++ b/Annex/Ingest.hs
@@ -1,6 +1,6 @@
 {- git-annex content ingestion
  -
- - Copyright 2010-2015 Joey Hess <id@joeyh.name>
+ - Copyright 2010-2016 Joey Hess <id@joeyh.name>
  -
  - Licensed under the GNU GPL version 3 or higher.
  -}
@@ -11,14 +11,17 @@ module Annex.Ingest (
 	LockedDown(..),
 	LockDownConfig(..),
 	lockDown,
+	ingestAdd,
 	ingest,
 	finishIngestDirect,
 	finishIngestUnlocked,
 	cleanOldKeys,
 	addLink,
 	makeLink,
+	addUnlocked,
 	restoreFile,
 	forceParams,
+	addAnnexedFile,
 ) where
 
 import Annex.Common
@@ -29,6 +32,7 @@ import Annex.Content.Direct
 import Annex.Perms
 import Annex.Link
 import Annex.MetaData
+import Annex.Version
 import Logs.Location
 import qualified Annex
 import qualified Annex.Queue
@@ -111,11 +115,30 @@ lockDown' cfg file = ifM (pure (not (hardlinkFileTmp cfg)) <||> crippledFileSyst
 			, inodeCache = cache
 			}
 
-{- Ingests a locked down file into the annex.
- -
- - The file may be added to the git repository as a locked or an unlocked
- - file. When unlocked, the work tree file is left alone. When locked, 
- - the work tree file is deleted, in preparation for adding the symlink.
+{- Ingests a locked down file into the annex. Updates the work tree and
+ - index. -}
+ingestAdd :: Maybe LockedDown -> Annex (Maybe Key)
+ingestAdd Nothing = return Nothing
+ingestAdd ld@(Just (LockedDown cfg source)) = do
+	(mk, mic) <- ingest ld
+	case mk of
+		Nothing -> return Nothing
+		Just k -> do
+			let f = keyFilename source
+			if lockingFile cfg
+				then do
+					liftIO $ nukeFile f
+					addLink f k mic
+				else ifM isDirect
+					( do
+						l <- calcRepo $ gitAnnexLink f k
+						stageSymlink f =<< hashSymlink l
+					, stagePointerFile f =<< hashPointerFile k
+					)
+			return (Just k)
+
+{- Ingests a locked down file into the annex. Does not update the working
+ - tree or the index.
  -}
 ingest :: Maybe LockedDown -> Annex (Maybe Key, Maybe InodeCache)
 ingest Nothing = return (Nothing, Nothing)
@@ -141,7 +164,6 @@ ingest (Just (LockedDown cfg source)) = withTSDelta $ \delta -> do
 	golocked key mcache s = do
 		catchNonAsync (moveAnnex key $ contentLocation source)
 			(restoreFile (keyFilename source) key)
-		liftIO $ nukeFile $ keyFilename source
 		populateAssociatedFiles key source
 		success key mcache s
 
@@ -295,3 +317,50 @@ forceParams = ifM (Annex.getState Annex.force)
 	( return [Param "-f"]
 	, return []
 	)
+
+{- Whether a file should be added unlocked or not. Default is to not,
+ - unless symlinks are not supported. annex.addunlocked can override that. -}
+addUnlocked :: Annex Bool
+addUnlocked = isDirect <||>
+	(versionSupportsUnlockedPointers <&&>
+	 ((not . coreSymlinks <$> Annex.getGitConfig) <||>
+	  (annexAddUnlocked <$> Annex.getGitConfig)
+	 )
+	)
+
+{- Adds a file to the work tree for the key, and stages it in the index.
+ - The content of the key may be provided in a temp file, which will be
+ - moved into place. -}
+addAnnexedFile :: FilePath -> Key -> Maybe FilePath -> Annex ()
+addAnnexedFile file key mtmp = ifM (addUnlocked <&&> not <$> isDirect)
+	( do
+		stagePointerFile file =<< hashPointerFile key
+		Database.Keys.addAssociatedFile key =<< inRepo (toTopFilePath file)
+		case mtmp of
+			Just tmp -> do
+				moveAnnex key tmp
+				linkunlocked
+			Nothing -> ifM (inAnnex key)
+				( linkunlocked
+				, writepointer
+				)
+	, do
+		addLink file key Nothing
+		whenM isDirect $ do
+			void $ addAssociatedFile key file
+		case mtmp of
+			Just tmp -> do
+				{- For moveAnnex to work in direct mode, the
+				 - symlink must already exist, so flush the queue. -}
+				whenM isDirect $
+					Annex.Queue.flush
+				moveAnnex key tmp
+			Nothing -> return ()
+	)
+  where
+	writepointer = liftIO $ writeFile file (formatPointer key)
+	linkunlocked = do
+		r <- linkFromAnnex key file
+		case r of
+			LinkAnnexFailed -> writepointer
+			_ -> return ()
diff --git a/Command/Add.hs b/Command/Add.hs
index 7a1150d10..194e34de0 100644
--- a/Command/Add.hs
+++ b/Command/Add.hs
@@ -12,12 +12,10 @@ import Annex.Ingest
 import Logs.Location
 import Annex.Content
 import Annex.Content.Direct
-import Annex.Link
 import qualified Annex
 import qualified Annex.Queue
 import qualified Database.Keys
 import Config
-import Utility.InodeCache
 import Annex.FileMatcher
 import Annex.Version
 
@@ -99,48 +97,42 @@ start file = ifAnnexed file addpresent add
 		( do
 			ms <- liftIO $ catchMaybeIO $ getSymbolicLinkStatus file
 			case ms of
-				Just s | isSymbolicLink s -> fixup key
+				Just s | isSymbolicLink s -> fixuplink key
 				_ -> ifM (sameInodeCache file =<< Database.Keys.getInodeCaches key)
 						( stop, add )
 		, ifM isDirect
 			( do
 				ms <- liftIO $ catchMaybeIO $ getSymbolicLinkStatus file
 				case ms of
-					Just s | isSymbolicLink s -> fixup key
+					Just s | isSymbolicLink s -> fixuplink key
 					_ -> ifM (goodContent key file)
 						( stop , add )
-			, fixup key
+			, fixuplink key
 			)
 		)
-	fixup key = do
+	fixuplink key = do
 		-- the annexed symlink is present but not yet added to git
 		showStart "add" file
 		liftIO $ removeFile file
-		whenM isDirect $
-			void $ addAssociatedFile key file
-		next $ next $ cleanup file key Nothing =<< inAnnex key
+		next $ next $ do
+			addLink file key Nothing
+			cleanup key =<< inAnnex key
 
 perform :: FilePath -> CommandPerform
 perform file = do
-	lockingfile <- not <$> isDirect
+	lockingfile <- not <$> addUnlocked
 	let cfg = LockDownConfig
 		{ lockingFile = lockingfile
 		, hardlinkFileTmp = True
 		}
-	lockDown cfg file >>= ingest >>= go
+	lockDown cfg file >>= ingestAdd >>= finish
   where
-	go (Just key, cache) = next $ cleanup file key cache True
-	go (Nothing, _) = stop
+	finish (Just key) = next $ cleanup key True
+	finish Nothing = stop
 
-cleanup :: FilePath -> Key -> Maybe InodeCache -> Bool -> CommandCleanup
-cleanup file key mcache hascontent = do
+cleanup :: Key -> Bool -> CommandCleanup
+cleanup key hascontent = do
 	maybeShowJSON [("key", key2file key)]
-	ifM (isDirect <&&> pure hascontent)
-		( do
-			l <- calcRepo $ gitAnnexLink file key
-			stageSymlink file =<< hashSymlink l
-		, addLink file key mcache
-		)
 	when hascontent $
 		logStatus key InfoPresent
 	return True
diff --git a/Command/AddUrl.hs b/Command/AddUrl.hs
index 333ca494d..0370a2fc9 100644
--- a/Command/AddUrl.hs
+++ b/Command/AddUrl.hs
@@ -12,7 +12,6 @@ import Network.URI
 import Command
 import Backend
 import qualified Annex
-import qualified Annex.Queue
 import qualified Annex.Url as Url
 import qualified Backend.URL
 import qualified Remote
@@ -24,8 +23,6 @@ import Annex.UUID
 import Logs.Web
 import Types.KeySource
 import Types.UrlContents
-import Config
-import Annex.Content.Direct
 import Annex.FileMatcher
 import Logs.Location
 import Utility.Metered
@@ -363,13 +360,7 @@ cleanup u url file key mtmp = case mtmp of
 		when (isJust mtmp) $
 			logStatus key InfoPresent
 		setUrlPresent u key url
-		addLink file key Nothing
-		whenM isDirect $ do
-			void $ addAssociatedFile key file
-			{- For moveAnnex to work in direct mode, the symlink
-			 - must already exist, so flush the queue. -}
-			Annex.Queue.flush
-		maybe noop (moveAnnex key) mtmp
+		addAnnexedFile file key mtmp
 
 nodownload :: URLString -> Url.UrlInfo -> FilePath -> Annex (Maybe Key)
 nodownload url urlinfo file
diff --git a/Types/GitConfig.hs b/Types/GitConfig.hs
index fbc3484d0..b5e3d795e 100644
--- a/Types/GitConfig.hs
+++ b/Types/GitConfig.hs
@@ -69,6 +69,7 @@ data GitConfig = GitConfig
 	, annexVerify :: Bool
 	, annexPidLock :: Bool
 	, annexPidLockTimeout :: Seconds
+	, annexAddUnlocked :: Bool
 	, coreSymlinks :: Bool
 	, coreSharedRepository :: SharedRepository
 	, gcryptId :: Maybe String
@@ -118,6 +119,7 @@ extractGitConfig r = GitConfig
 	, annexPidLock = getbool (annex "pidlock") False
 	, annexPidLockTimeout = Seconds $ fromMaybe 300 $
 		getmayberead (annex "pidlocktimeout")
+	, annexAddUnlocked = getbool (annex "addunlocked") False
 	, coreSymlinks = getbool "core.symlinks" True
 	, coreSharedRepository = getSharedRepository r
 	, gcryptId = getmaybe "core.gcrypt-id"
diff --git a/debian/changelog b/debian/changelog
index cd8387987..a005518d6 100644
--- a/debian/changelog
+++ b/debian/changelog
@@ -14,6 +14,12 @@ git-annex (6.20160212) UNRELEASED; urgency=medium
   * When initializing a v6 repo on a crippled filesystem, don't force it
     into direct mode.
   * Windows: Fix v6 unlocked files to actually work.
+  * add, addurl, import, importfeed: When in a v6 repository on a crippled
+    filesystem, add files unlocked.
+  * annex.addunlocked: New configuration setting, makes files always be
+    added unlocked. (v6 only)
+  * Improve format of v6 unlocked pointer files to support keys containing
+    slashes.
 
  -- Joey Hess <id@joeyh.name>  Fri, 12 Feb 2016 14:03:46 -0400
 
diff --git a/doc/git-annex-add.mdwn b/doc/git-annex-add.mdwn
index 5f1ab33b0..b65ed5132 100644
--- a/doc/git-annex-add.mdwn
+++ b/doc/git-annex-add.mdwn
@@ -21,7 +21,8 @@ to the git repository, instead of to the annex.
 
 Large files are added to the annex in locked form, which prevents further
 modification of their content unless unlocked by [[git-annex-unlock]](1).
-(This is not the case however when a repository is in direct mode.)
+(This is not the case however when a repository is in a filesystem not
+supporting symlinks, or is in direct mode.)
 To add a file to the annex in unlocked form, `git add` can be used instead 
 (that only works when the repository has annex.version 6 or higher).
 
diff --git a/doc/git-annex.mdwn b/doc/git-annex.mdwn
index cb27ec11a..6830f741f 100644
--- a/doc/git-annex.mdwn
+++ b/doc/git-annex.mdwn
@@ -823,6 +823,15 @@ Here are all the supported configuration settings.
   should be checked into git by `git annex add`. Defaults to true;
   set to false to instead make small files be skipped.
 
+* `annex.addunlocked`
+
+  Set to true to make commands like `git-annex add` that add files to the
+  repository add them in unlocked form. The default is to add files in
+  locked form. This only has effect in version 6 repositories.
+
+  When a repository has core.symlinks set to false, it implicitly
+  sets annex.addunlocked to true.
+
 * `annex.numcopies`
 
   This is a deprecated setting. You should instead use the
diff --git a/doc/tips/unlocked_files.mdwn b/doc/tips/unlocked_files.mdwn
index 31f9e9756..fd103940e 100644
--- a/doc/tips/unlocked_files.mdwn
+++ b/doc/tips/unlocked_files.mdwn
@@ -88,6 +88,13 @@ git-annex converts between the content of the big file and a pointer file,
 which is what gets committed to git. All the regular git-annex commands
 (get, drop, etc) can be used on unlocked files too.
 
+[[!template id=note text="""
+By default, git-annex commands will add files in locked mode,
+unless used on a filesystem that does not support symlinks, when unlocked
+mode is used. To make them always use unlocked mode, run:
+`git config annex.addunlocked true`
+"""]]
+
 A v6 repository can contain both locked and unlocked files. You can switch 
 a file back and forth using the `git annex lock` and `git annex unlock`
 commands. This changes what's stored in git between a git-annex symlink