Added adb special remote which allows exporting files to Android devices.

git annex testremote passes.

exportree not implemented yet, although the documentation talks about it,
since it will be the main way this remote will be used.

The adb push/pull progress is displayed for now; it would be better
to consume it and use it to update the git-annex progress bar.

This commit was sponsored by andrea rota.

14 files changed, 239 insertions, 14 deletions

diff --git a/Remote/Adb.hs b/Remote/Adb.hs
new file mode 100644
index 0000000000..2bce413698
--- /dev/null
+++ b/Remote/Adb.hs
@@ -0,0 +1,222 @@
+{- Remote on Android device accessed using adb.
+ -
+ - Copyright 2018 Joey Hess <id@joeyh.name>
+ -
+ - Licensed under the GNU AGPL version 3 or higher.
+ -}
+
+module Remote.Adb (remote) where
+
+import qualified Data.Map as M
+
+import Annex.Common
+import Types.Remote
+import Types.Creds
+import qualified Git
+import Config.Cost
+import Remote.Helper.Special
+import Remote.Helper.Messages
+import Remote.Helper.Export
+import Annex.UUID
+
+-- | Each Android device has a serial number.
+newtype AndroidSerial = AndroidSerial { fromAndroidSerial :: String }
+	deriving (Show, Eq)
+
+-- | A location on an Android device. 
+newtype AndroidPath = AndroidPath { fromAndroidPath :: FilePath }
+
+remote :: RemoteType
+remote = RemoteType
+	{ typename = "adb"
+	, enumerate = const (findSpecialRemotes "adb")
+	, generate = gen
+	, setup = adbSetup
+	, exportSupported = exportUnsupported
+	}
+
+gen :: Git.Repo -> UUID -> RemoteConfig -> RemoteGitConfig -> Annex (Maybe Remote)
+gen r u c gc = do
+	let this = Remote
+		{ uuid = u
+		-- adb operates over USB or wifi, so is not as cheap
+		-- as local, but not too expensive
+		, cost = semiExpensiveRemoteCost
+		, name = Git.repoDescribe r
+		, storeKey = storeKeyDummy
+		, retrieveKeyFile = retreiveKeyFileDummy
+		, retrieveKeyFileCheap = \_ _ _ -> return False
+		, removeKey = removeKeyDummy
+		, lockContent = Nothing
+		, checkPresent = checkPresentDummy
+		, checkPresentCheap = False
+		, exportActions = exportUnsupported
+		, whereisKey = Nothing
+		, remoteFsck = Nothing
+		, repairRepo = Nothing
+		, config = c
+		, repo = r
+		, gitconfig = gc
+		, localpath = Nothing
+		, remotetype = remote
+		, availability = LocallyAvailable
+		, readonly = False
+		, mkUnavailable = return Nothing
+		, getInfo = return
+			[ ("androidserial", fromAndroidSerial serial)
+			, ("androiddirectory", fromAndroidPath adir)
+			]
+		, claimUrl = Nothing
+		, checkUrl = Nothing
+		}
+	return $ Just $ specialRemote c
+		(simplyPrepare $ store serial adir)
+		(simplyPrepare $ retrieve serial adir)
+		(simplyPrepare $ remove serial adir)
+		(simplyPrepare $ checkKey this serial adir)
+		this
+  where
+	adir = maybe (giveup "missing androiddirectory") AndroidPath
+		(remoteAnnexAndroidDirectory gc)
+	serial = maybe (giveup "missing androidserial") AndroidSerial
+		(remoteAnnexAndroidSerial gc)
+
+adbSetup :: SetupStage -> Maybe UUID -> Maybe CredPair -> RemoteConfig -> RemoteGitConfig -> Annex (RemoteConfig, UUID)
+adbSetup _ mu _ c gc = do
+	u <- maybe (liftIO genUUID) return mu
+
+	-- verify configuration
+	adir <- maybe (giveup "Specify androiddirectory=") (pure . AndroidPath)
+		(M.lookup "androiddirectory" c)
+	serial <- getserial =<< liftIO enumerateAdbConnected
+
+	(c', _encsetup) <- encryptionSetup c gc
+
+	ok <- liftIO $ adbShellBool serial
+		[Param "mkdir", Param "-p", File (fromAndroidPath adir)]
+	unless ok $
+		giveup "Creating directory on Android device failed."
+
+	gitConfigSpecialRemote u c' 
+		[ ("adb", "true")
+		, ("androiddirectory", fromAndroidPath adir)
+		, ("androidserial", fromAndroidSerial serial)
+		]
+
+	return (c', u)
+  where
+	getserial [] = giveup "adb does not list any connected android devices. Plug in an Android device, or configure adb, and try again.."
+	getserial (s:[]) = return s
+	getserial l = case M.lookup "androidserial" c of
+		Nothing -> giveup $ unlines $
+			"There are multiple connected android devices, specify which to use with androidserial="
+			: map fromAndroidSerial l
+		Just cs
+			| AndroidSerial cs `elem` l -> return (AndroidSerial cs)
+			| otherwise -> giveup $ "The device with androidserial=" ++ cs ++ " is not connected."
+
+store :: AndroidSerial -> AndroidPath -> Storer
+store serial adir = fileStorer $ \k src _p -> do
+	let hashdir = fromAndroidPath $ androidHashDir adir k
+	liftIO $ void $ adbShell serial [Param "mkdir", Param "-p", File hashdir]
+	showOutput -- make way for adb push output
+	let dest = fromAndroidPath $ androidLocation adir k
+	let tmpdest = dest ++ ".tmp"
+	ifM (liftIO $ boolSystem "adb" (mkAdbCommand serial [Param "push", File src, File tmpdest]))
+		-- move into place atomically
+		( liftIO $ adbShellBool serial [Param "mv", File tmpdest, File dest]
+		, return False
+		)
+
+retrieve :: AndroidSerial -> AndroidPath -> Retriever
+retrieve serial adir = fileRetriever $ \d k _p -> do
+	showOutput -- make way for adb pull output
+	ok <- liftIO $ boolSystem "adb" $ mkAdbCommand serial
+		[ Param "pull"
+		, File $ fromAndroidPath $ androidLocation adir k
+		, File d
+		]
+	unless ok $
+		giveup "adb pull failed"
+
+remove :: AndroidSerial -> AndroidPath -> Remover
+remove serial adir k = liftIO $ adbShellBool serial
+	[Param "rm", Param "-f", File (fromAndroidPath loc)]
+  where
+	loc = androidLocation adir k
+
+checkKey :: Remote -> AndroidSerial -> AndroidPath -> CheckPresent
+checkKey r serial adir k = do
+	showChecking r
+	(out, st) <- liftIO $ adbShellRaw serial $ unwords
+		[ "if test -e ", shellEscape (fromAndroidPath loc)
+		, "; then echo y"
+		, "; else echo n"
+		, "; fi"
+		]
+	case (out, st) of
+		(["y"], ExitSuccess) -> return True
+		(["n"], ExitSuccess) -> return False
+		_ -> giveup $ "unable to access Android device" ++ show out
+  where
+	loc = androidLocation adir k
+
+androidLocation :: AndroidPath -> Key -> AndroidPath
+androidLocation adir k = AndroidPath $
+	fromAndroidPath (androidHashDir adir k) ++ key2file k
+
+androidHashDir :: AndroidPath -> Key -> AndroidPath
+androidHashDir adir k = AndroidPath $ 
+	fromAndroidPath adir ++ "/" ++ hdir
+  where
+	hdir = replace [pathSeparator] "/" (hashDirLower def k)
+
+-- | List all connected Android devices.
+enumerateAdbConnected :: IO [AndroidSerial]
+enumerateAdbConnected = 
+	mapMaybe parse . lines <$> readProcess "adb" ["devices"]
+  where
+	parse l = 
+		let (serial, desc) = separate (== '\t') l
+		in if null desc || length serial /= 16
+			then Nothing 
+			else Just (AndroidSerial serial)
+
+-- | Runs a command on the android device with the given serial number.
+--
+-- adb shell does not propigate the exit code of the command, so
+-- it is echoed out in a trailing line, and the output is read to determine
+-- it. Any stdout from the command is returned, separated into lines.
+adbShell :: AndroidSerial -> [CommandParam] -> IO ([String], ExitCode)
+adbShell serial cmd = adbShellRaw serial $
+	unwords $ map shellEscape (toCommand cmd)
+
+adbShellBool :: AndroidSerial -> [CommandParam] -> IO Bool
+adbShellBool serial cmd = do
+	(_ , ec) <- adbShell serial cmd
+	return (ec == ExitSuccess)
+
+-- | Runs a raw shell command on the android device.
+-- Any necessary shellEscaping must be done by caller.
+adbShellRaw :: AndroidSerial -> String -> IO ([String], ExitCode)
+adbShellRaw serial cmd = processoutput <$> readProcess "adb"
+	[ "-s"
+	, fromAndroidSerial serial
+	, "shell"
+	-- The extra echo is in case cmd does not output a trailing
+	-- newline after its other output.
+	, cmd ++ "; echo; echo $?"
+	]
+  where
+	processoutput s = case reverse (map trimcr (lines s)) of
+		(c:"":rest) -> case readish c of
+			Just 0 -> (reverse rest, ExitSuccess)
+			Just n -> (reverse rest, ExitFailure n)
+			Nothing -> (reverse rest, ExitFailure 1)
+		ls -> (reverse ls, ExitFailure 1)
+	-- For some reason, adb outputs lines with \r\n on linux,
+	-- despite both linux and android being unix systems.
+	trimcr = takeWhile (/= '\r')
+
+mkAdbCommand :: AndroidSerial -> [CommandParam] -> [CommandParam]
+mkAdbCommand serial cmd = [Param "-s", Param (fromAndroidSerial serial)] ++ cmd
diff --git a/Remote/Bup.hs b/Remote/Bup.hs
index 4180cbb7d4..8a94ee87d9 100644
--- a/Remote/Bup.hs
+++ b/Remote/Bup.hs
@@ -112,7 +112,7 @@ bupSetup _ mu _ c gc = do
 
 	-- The buprepo is stored in git config, as well as this repo's
 	-- persistant state, so it can vary between hosts.
-	gitConfigSpecialRemote u c' "buprepo" buprepo
+	gitConfigSpecialRemote u c' [("buprepo", buprepo)]
 
 	return (c', u)
 
diff --git a/Remote/Ddar.hs b/Remote/Ddar.hs
index 3949bf5698..1cca7dd6e4 100644
--- a/Remote/Ddar.hs
+++ b/Remote/Ddar.hs
@@ -97,7 +97,7 @@ ddarSetup _ mu _ c gc = do
 
 	-- The ddarrepo is stored in git config, as well as this repo's
 	-- persistant state, so it can vary between hosts.
-	gitConfigSpecialRemote u c' "ddarrepo" ddarrepo
+	gitConfigSpecialRemote u c' [("ddarrepo", ddarrepo)]
 
 	return (c', u)
 
diff --git a/Remote/Directory.hs b/Remote/Directory.hs
index f44961ce24..c31b423be1 100644
--- a/Remote/Directory.hs
+++ b/Remote/Directory.hs
@@ -104,7 +104,7 @@ directorySetup _ mu _ c gc = do
 
 	-- The directory is stored in git config, not in this remote's
 	-- persistant state, so it can vary between hosts.
-	gitConfigSpecialRemote u c' "directory" absdir
+	gitConfigSpecialRemote u c' [("directory", absdir)]
 	return (M.delete "directory" c', u)
 
 {- Locations to try to access a given Key in the directory.
diff --git a/Remote/External.hs b/Remote/External.hs
index bff74c3b1e..0545a04b4b 100644
--- a/Remote/External.hs
+++ b/Remote/External.hs
@@ -157,7 +157,7 @@ externalSetup _ mu _ c gc = do
 			withExternalState external $
 				liftIO . atomically . readTVar . externalConfig
 
-	gitConfigSpecialRemote u c'' "externaltype" externaltype
+	gitConfigSpecialRemote u c'' [("externaltype", externaltype)]
 	return (c'', u)
 
 checkExportSupported :: RemoteConfig -> RemoteGitConfig -> Annex Bool
diff --git a/Remote/GCrypt.hs b/Remote/GCrypt.hs
index 15ddfdb313..4eda826a0e 100644
--- a/Remote/GCrypt.hs
+++ b/Remote/GCrypt.hs
@@ -218,7 +218,7 @@ gCryptSetup _ mu _ c gc = go $ M.lookup "gitrepo" c
 				if Just u == mu || isNothing mu
 					then do
 						method <- setupRepo gcryptid =<< inRepo (Git.Construct.fromRemoteLocation gitrepo)
-						gitConfigSpecialRemote u c' "gcrypt" (fromAccessMethod method)
+						gitConfigSpecialRemote u c' [("gcrypt", fromAccessMethod method)]
 						return (c', u)
 					else giveup $ "uuid mismatch; expected " ++ show mu ++ " but remote gitrepo has " ++ show u ++ " (" ++ show gcryptid ++ ")"
 
diff --git a/Remote/Glacier.hs b/Remote/Glacier.hs
index 40a92c7009..99d9523ab1 100644
--- a/Remote/Glacier.hs
+++ b/Remote/Glacier.hs
@@ -93,7 +93,7 @@ glacierSetup' ss u mcreds c gc = do
 	case ss of
 		Init -> genVault fullconfig gc u
 		_ -> return ()
-	gitConfigSpecialRemote u fullconfig "glacier" "true"
+	gitConfigSpecialRemote u fullconfig [("glacier", "true")]
 	return (fullconfig, u)
   where
 	remotename = fromJust (M.lookup "name" c)
diff --git a/Remote/Helper/Special.hs b/Remote/Helper/Special.hs
index 446bd369c7..73486442b8 100644
--- a/Remote/Helper/Special.hs
+++ b/Remote/Helper/Special.hs
@@ -65,9 +65,10 @@ findSpecialRemotes s = do
 	match k _ = "remote." `isPrefixOf` k && (".annex-"++s) `isSuffixOf` k
 
 {- Sets up configuration for a special remote in .git/config. -}
-gitConfigSpecialRemote :: UUID -> RemoteConfig -> String -> String -> Annex ()
-gitConfigSpecialRemote u c k v = do
-	setConfig (remoteConfig remotename k) v
+gitConfigSpecialRemote :: UUID -> RemoteConfig -> [(String, String)] -> Annex ()
+gitConfigSpecialRemote u c cfgs = do
+	forM_ cfgs $ \(k, v) -> 
+		setConfig (remoteConfig remotename k) v
 	setConfig (remoteConfig remotename "uuid") (fromUUID u)
   where
 	remotename = fromJust (M.lookup "name" c)
diff --git a/Remote/Hook.hs b/Remote/Hook.hs
index d7c7eb6b82..c1fb199f35 100644
--- a/Remote/Hook.hs
+++ b/Remote/Hook.hs
@@ -79,7 +79,7 @@ hookSetup _ mu _ c gc = do
 	let hooktype = fromMaybe (giveup "Specify hooktype=") $
 		M.lookup "hooktype" c
 	(c', _encsetup) <- encryptionSetup c gc
-	gitConfigSpecialRemote u c' "hooktype" hooktype
+	gitConfigSpecialRemote u c' [("hooktype", hooktype)]
 	return (c', u)
 
 hookEnv :: Action -> Key -> Maybe FilePath -> IO (Maybe [(String, String)])
diff --git a/Remote/List.hs b/Remote/List.hs
index 2dc5e4823a..b76cccdb0c 100644
--- a/Remote/List.hs
+++ b/Remote/List.hs
@@ -36,6 +36,7 @@ import qualified Remote.BitTorrent
 #ifdef WITH_WEBDAV
 import qualified Remote.WebDAV
 #endif
+import qualified Remote.Adb
 import qualified Remote.Tahoe
 import qualified Remote.Glacier
 import qualified Remote.Ddar
@@ -58,6 +59,7 @@ remoteTypes = map adjustExportableRemoteType
 #ifdef WITH_WEBDAV
 	, Remote.WebDAV.remote
 #endif
+	, Remote.Adb.remote
 	, Remote.Tahoe.remote
 	, Remote.Glacier.remote
 	, Remote.Ddar.remote
diff --git a/Remote/Rsync.hs b/Remote/Rsync.hs
index 7f687a7e29..2f9b353f56 100644
--- a/Remote/Rsync.hs
+++ b/Remote/Rsync.hs
@@ -159,7 +159,7 @@ rsyncSetup _ mu _ c gc = do
 
 	-- The rsyncurl is stored in git config, not only in this remote's
 	-- persistant state, so it can vary between hosts.
-	gitConfigSpecialRemote u c' "rsyncurl" url
+	gitConfigSpecialRemote u c' [("rsyncurl", url)]
 	return (c', u)
 
 {- To send a single key is slightly tricky; need to build up a temporary
diff --git a/Remote/S3.hs b/Remote/S3.hs
index d25a07c763..42dacc0432 100644
--- a/Remote/S3.hs
+++ b/Remote/S3.hs
@@ -135,7 +135,7 @@ s3Setup' ss u mcreds c gc
 		]
 		
 	use fullconfig = do
-		gitConfigSpecialRemote u fullconfig "s3" "true"
+		gitConfigSpecialRemote u fullconfig [("s3", "true")]
 		return (fullconfig, u)
 
 	defaulthost = do
diff --git a/Remote/Tahoe.hs b/Remote/Tahoe.hs
index d3d52d7de6..0091f27ba3 100644
--- a/Remote/Tahoe.hs
+++ b/Remote/Tahoe.hs
@@ -107,7 +107,7 @@ tahoeSetup _ mu _ c _ = do
 			, (scsk, scs)
 			]
 		else c
-	gitConfigSpecialRemote u c' "tahoe" configdir
+	gitConfigSpecialRemote u c' [("tahoe", configdir)]
 	return (c', u)
   where
 	scsk = "shared-convergence-secret"
diff --git a/Remote/WebDAV.hs b/Remote/WebDAV.hs
index e73ff927a2..d8d06c96b7 100644
--- a/Remote/WebDAV.hs
+++ b/Remote/WebDAV.hs
@@ -112,7 +112,7 @@ webdavSetup _ mu mcreds c gc = do
 	(c', encsetup) <- encryptionSetup c gc
 	creds <- maybe (getCreds c' gc u) (return . Just) mcreds
 	testDav url creds
-	gitConfigSpecialRemote u c' "webdav" "true"
+	gitConfigSpecialRemote u c' [("webdav", "true")]
 	c'' <- setRemoteCredPair encsetup c' gc (davCreds u) creds
 	return (c'', u)