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.

CHANGELOG

@@ -1,5 +1,6 @@
 git-annex (6.20180317) UNRELEASED; urgency=medium
 
+  * Added adb special remote which allows exporting files to Android devices.
   * Fix calculation of estimated completion for progress meter.
   * OSX app: Work around libz/libPng/ImageIO.framework version skew
     by not bundling libz, assuming OSX includes a suitable libz.1.dylib.

COPYRIGHT

@@ -10,7 +10,7 @@ Copyright: © 2012-2017 Joey Hess <id@joeyh.name>
            © 2014 Sören Brunk
 License: AGPL-3+
 
-Files: Remote/Git.hs Remote/Helper/Ssh.hs
+Files: Remote/Git.hs Remote/Helper/Ssh.hs Remote/Adb.hs
 Copyright: © 2011-2018 Joey Hess <id@joeyh.name>
 License: AGPL-3+
 

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

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)
 

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)
 

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.

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

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 ++ ")"
 

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)

Remote/Helper/Special.hs

@@ -65,8 +65,9 @@ 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 :: UUID -> RemoteConfig -> [(String, String)] -> Annex ()
-gitConfigSpecialRemote u c k v = do
+gitConfigSpecialRemote u c cfgs = do
+	forM_ cfgs $ \(k, v) -> 
 		setConfig (remoteConfig remotename k) v
 	setConfig (remoteConfig remotename "uuid") (fromUUID u)
   where

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)])

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

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

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

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"

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)
 

Types/GitConfig.hs

@@ -231,6 +231,8 @@ data RemoteGitConfig = RemoteGitConfig
 	, remoteAnnexTahoe :: Maybe FilePath
 	, remoteAnnexBupSplitOptions :: [String]
 	, remoteAnnexDirectory :: Maybe FilePath
+	, remoteAnnexAndroidDirectory :: Maybe FilePath
+	, remoteAnnexAndroidSerial :: Maybe String
 	, remoteAnnexGCrypt :: Maybe String
 	, remoteAnnexDdarRepo :: Maybe String
 	, remoteAnnexHookType :: Maybe String
@@ -282,6 +284,8 @@ extractRemoteGitConfig r remotename = do
 		, remoteAnnexTahoe = getmaybe "tahoe"
 		, remoteAnnexBupSplitOptions = getoptions "bup-split-options"
 		, remoteAnnexDirectory = notempty $ getmaybe "directory"
+		, remoteAnnexAndroidDirectory = notempty $ getmaybe "androiddirectory"
+		, remoteAnnexAndroidSerial = notempty $ getmaybe "androidserial"
 		, remoteAnnexGCrypt = notempty $ getmaybe "gcrypt"
 		, remoteAnnexDdarRepo = getmaybe "ddarrepo"
 		, remoteAnnexHookType = notempty $ getmaybe "hooktype"

debian/control

@@ -115,6 +115,7 @@ Recommends:
 Suggests:
 	xdot,
 	bup,
+	adb,
 	tor,
 	magic-wormhole,
 	tahoe-lafs,

doc/git-annex.mdwn

@@ -1427,6 +1427,25 @@ Here are all the supported configuration settings.
   remote. Normally this is automatically set up by `git annex initremote`,
   but you can change it if needed.
 
+* `remote.<name>.adb`
+
+  Used to identify remotes on Android devices accessed via adb.
+  Normally this is automatically set up by `git annex initremote`.
+
+* `remote.<name>.androiddirectory`
+
+  Used by adb special remotes, this is the directory on the Android
+  device where files are stored for this remote. Normally this is
+  automatically set up by `git annex initremote`, but you can change
+  it if needed.
+
+* `remote.<name>.androidserial`
+
+  Used by adb special remotes, this is the serial number of the Android
+  device used by the remote. Normally this is automatically set up by
+  `git annex initremote`, but you can change it if needed, eg when
+  upgrading to a new Android device.
+
 * `remote.<name>.s3`
 
   Used to identify Amazon S3 special remotes.

doc/special_remotes.mdwn

@@ -15,6 +15,7 @@ They cannot be used by other git commands though.
 * [[directory]]
 * [[rsync]]
 * [[webdav]]
+* [[adb]] (for Android devices)
 * [[tahoe]]
 * [[web]]
 * [[bittorrent]]

doc/special_remotes/adb.mdwn

@@ -0,0 +1,28 @@
+This special remote stores files on an Android device.
+
+The `adb` program is used to access the Android device, which
+allows connecting to it in various ways like a USB cable or wifi.
+
+## configuration
+
+A number of parameters can be passed to `git annex initremote` to configure
+the adb remote.
+
+* `androiddirectory` - Set to the location on the Android device where
+  files for the special remote are stored.
+
+* `androidserial` - Normally this is not needed, but if multiple Android
+  devices are accessible, you'll be prompted to use it to specify which
+  one to use.
+
+* `exporttree` - Set to "yes" to make this special remote usable
+  by [[git-annex-export]]. It will not be usable as a general-purpose
+  special remote. Since this makes the exported files easily browsable
+  on the Android device, you will almost always want to enable this.
+
+* `encryption` - One of "none", "hybrid", "shared", or "pubkey".
+  See [[encryption]].
+
+* `keyid` - Specifies the gpg key to use for [[encryption]].
+
+* `chunk` - Enables [[chunking]] when storing large files.

doc/todo/adb_special_remote.mdwn

@@ -15,7 +15,5 @@ repository.
 And, [[export preferred content]] would be a useful feature for
 excluding some files from a tree exported to android.
 
-----
+> Status: Basic special remote now implemented. exporttree and import
-
+> not yet. --[[Joey]]
-initremote will need to store the uuid of the remote in it, to avoid
-operating on the wrong device.

git-annex.cabal

@@ -915,6 +915,7 @@ Executable git-annex
     P2P.IO
     P2P.Protocol
     Remote
+    Remote.Adb
     Remote.BitTorrent
     Remote.Bup
     Remote.Ddar