1{- Remote on Android device accessed using adb. 2 - 3 - Copyright 2018-2020 Joey Hess <id@joeyh.name> 4 - 5 - Licensed under the GNU AGPL version 3 or higher. 6 -} 7 8{-# LANGUAGE RankNTypes #-} 9 10module Remote.Adb (remote) where 11 12import Annex.Common 13import Types.Remote 14import Types.Creds 15import Types.Export 16import Types.Import 17import qualified Git 18import Config.Cost 19import Remote.Helper.Special 20import Remote.Helper.ExportImport 21import Annex.UUID 22import Utility.Metered 23import Types.ProposedAccepted 24import Annex.SpecialRemote.Config 25 26import qualified Data.Map as M 27import qualified System.FilePath.Posix as Posix 28 29-- | Each Android device has a serial number. 30newtype AndroidSerial = AndroidSerial { fromAndroidSerial :: String } 31 deriving (Show, Eq) 32 33-- | A location on an Android device. 34newtype AndroidPath = AndroidPath { fromAndroidPath :: FilePath } 35 36remote :: RemoteType 37remote = specialRemoteType $ RemoteType 38 { typename = "adb" 39 , enumerate = const (findSpecialRemotes "adb") 40 , generate = gen 41 , configParser = mkRemoteConfigParser 42 [ optionalStringParser androiddirectoryField 43 (FieldDesc "location on the Android device where the files are stored") 44 , optionalStringParser androidserialField 45 (FieldDesc "sometimes needed to specify which Android device to use") 46 ] 47 , setup = adbSetup 48 , exportSupported = exportIsSupported 49 , importSupported = importIsSupported 50 , thirdPartyPopulated = False 51 } 52 53androiddirectoryField :: RemoteConfigField 54androiddirectoryField = Accepted "androiddirectory" 55 56androidserialField :: RemoteConfigField 57androidserialField = Accepted "androidserial" 58 59gen :: Git.Repo -> UUID -> RemoteConfig -> RemoteGitConfig -> RemoteStateHandle -> Annex (Maybe Remote) 60gen r u rc gc rs = do 61 c <- parsedRemoteConfig remote rc 62 let this = Remote 63 { uuid = u 64 -- adb operates over USB or wifi, so is not as cheap 65 -- as local, but not too expensive 66 , cost = semiExpensiveRemoteCost 67 , name = Git.repoDescribe r 68 , storeKey = storeKeyDummy 69 , retrieveKeyFile = retrieveKeyFileDummy 70 , retrieveKeyFileCheap = Nothing 71 , retrievalSecurityPolicy = RetrievalAllKeysSecure 72 , removeKey = removeKeyDummy 73 , lockContent = Nothing 74 , checkPresent = checkPresentDummy 75 , checkPresentCheap = False 76 , exportActions = ExportActions 77 { storeExport = storeExportM serial adir 78 , retrieveExport = retrieveExportM serial adir 79 , removeExport = removeExportM serial adir 80 , versionedExport = False 81 , checkPresentExport = checkPresentExportM serial adir 82 , removeExportDirectory = Just $ removeExportDirectoryM serial adir 83 , renameExport = renameExportM serial adir 84 } 85 , importActions = ImportActions 86 { listImportableContents = listImportableContentsM serial adir 87 , importKey = Nothing 88 , retrieveExportWithContentIdentifier = retrieveExportWithContentIdentifierM serial adir 89 , storeExportWithContentIdentifier = storeExportWithContentIdentifierM serial adir 90 , removeExportWithContentIdentifier = removeExportWithContentIdentifierM serial adir 91 , removeExportDirectoryWhenEmpty = Nothing 92 , checkPresentExportWithContentIdentifier = checkPresentExportWithContentIdentifierM serial adir 93 } 94 , whereisKey = Nothing 95 , remoteFsck = Nothing 96 , repairRepo = Nothing 97 , config = c 98 , getRepo = return r 99 , gitconfig = gc 100 , localpath = Nothing 101 , remotetype = remote 102 , availability = LocallyAvailable 103 , readonly = False 104 , appendonly = False 105 , untrustworthy = False 106 , mkUnavailable = return Nothing 107 , getInfo = return 108 [ ("androidserial", fromAndroidSerial serial) 109 , ("androiddirectory", fromAndroidPath adir) 110 ] 111 , claimUrl = Nothing 112 , checkUrl = Nothing 113 , remoteStateHandle = rs 114 } 115 return $ Just $ specialRemote c 116 (store serial adir) 117 (retrieve serial adir) 118 (remove serial adir) 119 (checkKey serial adir) 120 this 121 where 122 adir = maybe (giveup "missing androiddirectory") AndroidPath 123 (remoteAnnexAndroidDirectory gc) 124 serial = maybe (giveup "missing androidserial") AndroidSerial 125 (remoteAnnexAndroidSerial gc) 126 127adbSetup :: SetupStage -> Maybe UUID -> Maybe CredPair -> RemoteConfig -> RemoteGitConfig -> Annex (RemoteConfig, UUID) 128adbSetup _ mu _ c gc = do 129 u <- maybe (liftIO genUUID) return mu 130 131 -- verify configuration 132 adir <- maybe 133 (giveup "Specify androiddirectory=") 134 (pure . AndroidPath . fromProposedAccepted) 135 (M.lookup androiddirectoryField c) 136 serial <- getserial =<< enumerateAdbConnected 137 let c' = M.insert androidserialField (Proposed (fromAndroidSerial serial)) c 138 139 (c'', _encsetup) <- encryptionSetup c' gc 140 141 ok <- adbShellBool serial 142 [Param "mkdir", Param "-p", File (fromAndroidPath adir)] 143 unless ok $ 144 giveup "Creating directory on Android device failed." 145 146 gitConfigSpecialRemote u c'' 147 [ ("adb", "true") 148 , ("androiddirectory", fromAndroidPath adir) 149 , ("androidserial", fromAndroidSerial serial) 150 ] 151 152 return (c'', u) 153 where 154 getserial [] = giveup "adb does not list any connected android devices. Plug in an Android device, or configure adb, and try again.." 155 getserial l = case fromProposedAccepted <$> M.lookup androidserialField c of 156 Nothing -> case l of 157 (s:[]) -> return s 158 _ -> giveup $ unlines $ 159 "There are multiple connected android devices, specify which to use with androidserial=" 160 : map fromAndroidSerial l 161 Just cs 162 | AndroidSerial cs `elem` l -> return (AndroidSerial cs) 163 | otherwise -> giveup $ "The device with androidserial=" ++ cs ++ " is not connected." 164 165store :: AndroidSerial -> AndroidPath -> Storer 166store serial adir = fileStorer $ \k src _p -> 167 let dest = androidLocation adir k 168 in unlessM (store' serial dest src) $ 169 giveup "adb failed" 170 171store' :: AndroidSerial -> AndroidPath -> FilePath -> Annex Bool 172store' serial dest src = store'' serial dest src (return True) 173 174store'' :: AndroidSerial -> AndroidPath -> FilePath -> Annex Bool -> Annex Bool 175store'' serial dest src canoverwrite = checkAdbInPath False $ do 176 let destdir = takeDirectory $ fromAndroidPath dest 177 void $ adbShell serial [Param "mkdir", Param "-p", File destdir] 178 showOutput -- make way for adb push output 179 let tmpdest = fromAndroidPath dest ++ ".annextmp" 180 ifM (liftIO $ boolSystem "adb" (mkAdbCommand serial [Param "push", File src, File tmpdest])) 181 ( ifM canoverwrite 182 -- move into place atomically 183 ( adbShellBool serial [Param "mv", File tmpdest, File (fromAndroidPath dest)] 184 , do 185 void $ remove' serial (AndroidPath tmpdest) 186 return False 187 ) 188 , return False 189 ) 190 191retrieve :: AndroidSerial -> AndroidPath -> Retriever 192retrieve serial adir = fileRetriever $ \dest k _p -> 193 let src = androidLocation adir k 194 in retrieve' serial src (fromRawFilePath dest) 195 196retrieve' :: AndroidSerial -> AndroidPath -> FilePath -> Annex () 197retrieve' serial src dest = 198 unlessM go $ 199 giveup "adb pull failed" 200 where 201 go = checkAdbInPath False $ do 202 showOutput -- make way for adb pull output 203 liftIO $ boolSystem "adb" $ mkAdbCommand serial 204 [ Param "pull" 205 , File $ fromAndroidPath src 206 , File dest 207 ] 208 209remove :: AndroidSerial -> AndroidPath -> Remover 210remove serial adir k = 211 unlessM (remove' serial (androidLocation adir k)) $ 212 giveup "adb failed" 213 214remove' :: AndroidSerial -> AndroidPath -> Annex Bool 215remove' serial aloc = adbShellBool serial 216 [Param "rm", Param "-f", File (fromAndroidPath aloc)] 217 218checkKey :: AndroidSerial -> AndroidPath -> CheckPresent 219checkKey serial adir k = checkKey' serial (androidLocation adir k) 220 221checkKey' :: AndroidSerial -> AndroidPath -> Annex Bool 222checkKey' serial aloc = do 223 out <- adbShellRaw serial $ unwords 224 [ "if test -e ", shellEscape (fromAndroidPath aloc) 225 , "; then echo y" 226 , "; else echo n" 227 , "; fi" 228 ] 229 case out of 230 Just ["y"] -> return True 231 Just ["n"] -> return False 232 _ -> giveup "unable to access Android device" 233 234androidLocation :: AndroidPath -> Key -> AndroidPath 235androidLocation adir k = AndroidPath $ 236 fromAndroidPath (androidHashDir adir k) ++ serializeKey k 237 238androidHashDir :: AndroidPath -> Key -> AndroidPath 239androidHashDir adir k = AndroidPath $ 240 fromAndroidPath adir ++ "/" ++ hdir 241 where 242 hdir = replace [pathSeparator] "/" (fromRawFilePath (hashDirLower def k)) 243 244storeExportM :: AndroidSerial -> AndroidPath -> FilePath -> Key -> ExportLocation -> MeterUpdate -> Annex () 245storeExportM serial adir src _k loc _p = 246 unlessM (store' serial dest src) $ 247 giveup "adb failed" 248 where 249 dest = androidExportLocation adir loc 250 251retrieveExportM :: AndroidSerial -> AndroidPath -> Key -> ExportLocation -> FilePath -> MeterUpdate -> Annex () 252retrieveExportM serial adir _k loc dest _p = retrieve' serial src dest 253 where 254 src = androidExportLocation adir loc 255 256removeExportM :: AndroidSerial -> AndroidPath -> Key -> ExportLocation -> Annex () 257removeExportM serial adir _k loc = 258 unlessM (remove' serial aloc) $ 259 giveup "adb failed" 260 where 261 aloc = androidExportLocation adir loc 262 263removeExportDirectoryM :: AndroidSerial -> AndroidPath -> ExportDirectory -> Annex () 264removeExportDirectoryM serial abase dir = 265 unlessM go $ 266 giveup "adb failed" 267 where 268 go = adbShellBool serial [Param "rm", Param "-rf", File (fromAndroidPath adir)] 269 adir = androidExportLocation abase (mkExportLocation (fromExportDirectory dir)) 270 271checkPresentExportM :: AndroidSerial -> AndroidPath -> Key -> ExportLocation -> Annex Bool 272checkPresentExportM serial adir _k loc = checkKey' serial aloc 273 where 274 aloc = androidExportLocation adir loc 275 276renameExportM :: AndroidSerial -> AndroidPath -> Key -> ExportLocation -> ExportLocation -> Annex (Maybe ()) 277renameExportM serial adir _k old new = do 278 unlessM (adbShellBool serial ps) $ 279 giveup "adb failed" 280 return (Just ()) 281 where 282 oldloc = fromAndroidPath $ androidExportLocation adir old 283 newloc = fromAndroidPath $ androidExportLocation adir new 284 ps = 285 [ Param "mv" 286 , Param "-f" 287 , File oldloc 288 , File newloc 289 ] 290 291listImportableContentsM :: AndroidSerial -> AndroidPath -> Annex (Maybe (ImportableContents (ContentIdentifier, ByteSize))) 292listImportableContentsM serial adir = adbfind >>= \case 293 Just ls -> return $ Just $ ImportableContents (mapMaybe mk ls) [] 294 Nothing -> giveup "adb find failed" 295 where 296 adbfind = adbShell serial 297 [ Param "find" 298 -- trailing slash is needed, or android's find command 299 -- won't recurse into the directory 300 , File $ fromAndroidPath adir ++ "/" 301 , Param "-type", Param "f" 302 , Param "-exec", Param "stat" 303 , Param "-c", Param statformat 304 , Param "{}", Param "+" 305 ] 306 307 statformat = adbStatFormat ++ "\t%n" 308 309 mk ('S':'T':'\t':l) = 310 let (stat, fn) = separate (== '\t') l 311 sz = fromMaybe 0 (readish (takeWhile (/= ' ') stat)) 312 cid = ContentIdentifier (encodeBS stat) 313 loc = mkImportLocation $ toRawFilePath $ 314 Posix.makeRelative (fromAndroidPath adir) fn 315 in Just (loc, (cid, sz)) 316 mk _ = Nothing 317 318-- This does not guard against every possible race. As long as the adb 319-- connection is resonably fast, it's probably as good as 320-- git's handling of similar situations with files being modified while 321-- it's updating the working tree for a merge. 322retrieveExportWithContentIdentifierM :: AndroidSerial -> AndroidPath -> ExportLocation -> ContentIdentifier -> FilePath -> Annex Key -> MeterUpdate -> Annex Key 323retrieveExportWithContentIdentifierM serial adir loc cid dest mkkey _p = do 324 retrieve' serial src dest 325 k <- mkkey 326 currcid <- getExportContentIdentifier serial adir loc 327 if currcid == Right (Just cid) 328 then return k 329 else giveup "the file on the android device has changed" 330 where 331 src = androidExportLocation adir loc 332 333storeExportWithContentIdentifierM :: AndroidSerial -> AndroidPath -> FilePath -> Key -> ExportLocation -> [ContentIdentifier] -> MeterUpdate -> Annex ContentIdentifier 334storeExportWithContentIdentifierM serial adir src _k loc overwritablecids _p = 335 -- Check if overwrite is safe before sending, because sending the 336 -- file is expensive and don't want to do it unncessarily. 337 ifM checkcanoverwrite 338 ( ifM (store'' serial dest src checkcanoverwrite) 339 ( getExportContentIdentifier serial adir loc >>= \case 340 Right (Just cid) -> return cid 341 Right Nothing -> giveup "adb failed to store file" 342 Left _ -> giveup "unable to get content identifier for file stored by adb" 343 , giveup "adb failed to store file" 344 ) 345 , giveup "unsafe to overwrite file" 346 ) 347 where 348 dest = androidExportLocation adir loc 349 checkcanoverwrite = 350 getExportContentIdentifier serial adir loc >>= return . \case 351 Right (Just cid) | cid `elem` overwritablecids -> True 352 Right Nothing -> True 353 _ -> False 354 355removeExportWithContentIdentifierM :: AndroidSerial -> AndroidPath -> Key -> ExportLocation -> [ContentIdentifier] -> Annex () 356removeExportWithContentIdentifierM serial adir k loc removeablecids = 357 getExportContentIdentifier serial adir loc >>= \case 358 Right Nothing -> return () 359 Right (Just cid) 360 | cid `elem` removeablecids -> 361 removeExportM serial adir k loc 362 | otherwise -> giveup "file on Android device is modified, cannot remove" 363 Left _ -> giveup "unable to access Android device" 364 365checkPresentExportWithContentIdentifierM :: AndroidSerial -> AndroidPath -> Key -> ExportLocation -> [ContentIdentifier] -> Annex Bool 366checkPresentExportWithContentIdentifierM serial adir _k loc knowncids = 367 getExportContentIdentifier serial adir loc >>= \case 368 Right (Just cid) | cid `elem` knowncids -> return True 369 Right _ -> return False 370 Left _ -> giveup "unable to access Android device" 371 372androidExportLocation :: AndroidPath -> ExportLocation -> AndroidPath 373androidExportLocation adir loc = AndroidPath $ 374 fromAndroidPath adir ++ "/" ++ fromRawFilePath (fromExportLocation loc) 375 376-- | List all connected Android devices. 377enumerateAdbConnected :: Annex [AndroidSerial] 378enumerateAdbConnected = checkAdbInPath [] $ liftIO $ 379 mapMaybe parse . lines <$> readProcess "adb" ["devices"] 380 where 381 parse l = 382 let (serial, desc) = separate (== '\t') l 383 in if null desc || length serial < 4 384 then Nothing 385 else Just (AndroidSerial serial) 386 387-- | Runs a command on the android device with the given serial number. 388-- 389-- Any stdout from the command is returned, separated into lines. 390adbShell :: AndroidSerial -> [CommandParam] -> Annex (Maybe [String]) 391adbShell serial cmd = adbShellRaw serial $ 392 unwords $ map shellEscape (toCommand cmd) 393 394adbShellBool :: AndroidSerial -> [CommandParam] -> Annex Bool 395adbShellBool serial cmd = 396 adbShellRaw serial cmd' >>= return . \case 397 Just l -> end l == ["y"] 398 Nothing -> False 399 where 400 cmd' = "if " ++ unwords (map shellEscape (toCommand cmd)) 401 ++ "; then echo y; else echo n; fi" 402 403-- | Runs a raw shell command on the android device. 404-- Any necessary shellEscaping must be done by caller. 405adbShellRaw :: AndroidSerial -> String -> Annex (Maybe [String]) 406adbShellRaw serial cmd = checkAdbInPath Nothing $ liftIO $ catchMaybeIO $ 407 processoutput <$> readProcess "adb" 408 [ "-s" 409 , fromAndroidSerial serial 410 , "shell" 411 , cmd 412 ] 413 where 414 processoutput s = map trimcr (lines s) 415 -- For some reason, adb outputs lines with \r\n on linux, 416 -- despite both linux and android being unix systems. 417 trimcr = takeWhile (/= '\r') 418 419checkAdbInPath :: a -> Annex a -> Annex a 420checkAdbInPath d a = ifM (isJust <$> liftIO (searchPath "adb")) 421 ( a 422 , do 423 warning "adb command not found in PATH. Install it to use this remote." 424 return d 425 ) 426 427mkAdbCommand :: AndroidSerial -> [CommandParam] -> [CommandParam] 428mkAdbCommand serial cmd = [Param "-s", Param (fromAndroidSerial serial)] ++ cmd 429 430-- Gets the current content identifier for a file on the android device. 431-- If the file is not present, returns Right Nothing 432getExportContentIdentifier :: AndroidSerial -> AndroidPath -> ExportLocation -> Annex (Either ExitCode (Maybe ContentIdentifier)) 433getExportContentIdentifier serial adir loc = do 434 ls <- adbShellRaw serial $ unwords 435 [ "if test -e ", shellEscape aloc 436 , "; then stat -c" 437 , shellEscape adbStatFormat 438 , shellEscape aloc 439 , "; else echo n" 440 , "; fi" 441 ] 442 return $ case ls of 443 Just ["n"] -> Right Nothing 444 Just (('S':'T':'\t':stat):[]) -> Right $ Just $ 445 ContentIdentifier (encodeBS stat) 446 _ -> Left (ExitFailure 1) 447 where 448 aloc = fromAndroidPath $ androidExportLocation adir loc 449 450-- Includes size, modificiation time, and inode. 451-- Device not included because the adb interface ensures we're talking to 452-- the same android device. 453adbStatFormat :: String 454adbStatFormat = "ST\t%s %Y %i" 455