1{- git-annex command, used internally by assistant in version 2 - 8.20201127 and older and provided only to avoid upgrade breakage. 3 - Remove at some point when such old versions of git-annex are unlikely 4 - to be running any longer. 5 - 6 - Copyright 2012, 2013 Joey Hess <id@joeyh.name> 7 - 8 - Licensed under the GNU AGPL version 3 or higher. 9 -} 10 11{-# LANGUAGE TypeSynonymInstances, FlexibleInstances #-} 12 13module Command.TransferKeys where 14 15import Command 16import Annex.Content 17import Logs.Location 18import Annex.Transfer 19import qualified Remote 20import Utility.SimpleProtocol (dupIoHandles) 21import Git.Types (RemoteName) 22import qualified Database.Keys 23import Annex.BranchState 24 25data TransferRequest = TransferRequest Direction Remote Key AssociatedFile 26 27cmd :: Command 28cmd = command "transferkeys" SectionPlumbing "transfers keys (deprecated)" 29 paramNothing (withParams seek) 30 31seek :: CmdParams -> CommandSeek 32seek = withNothing (commandAction start) 33 34start :: CommandStart 35start = do 36 enableInteractiveBranchAccess 37 (readh, writeh) <- liftIO dupIoHandles 38 runRequests readh writeh runner 39 stop 40 where 41 runner (TransferRequest direction remote key file) 42 | direction == Upload = notifyTransfer direction file $ 43 upload' (Remote.uuid remote) key file Nothing stdRetry $ \p -> do 44 tryNonAsync (Remote.storeKey remote key file p) >>= \case 45 Left e -> do 46 warning (show e) 47 return False 48 Right () -> do 49 Remote.logStatus remote key InfoPresent 50 return True 51 | otherwise = notifyTransfer direction file $ 52 download' (Remote.uuid remote) key file Nothing stdRetry $ \p -> 53 logStatusAfter key $ getViaTmp (Remote.retrievalSecurityPolicy remote) (RemoteVerify remote) key file $ \t -> do 54 r <- tryNonAsync (Remote.retrieveKeyFile remote key file (fromRawFilePath t) p (RemoteVerify remote)) >>= \case 55 Left e -> do 56 warning (show e) 57 return (False, UnVerified) 58 Right v -> return (True, v) 59 -- Make sure we get the current 60 -- associated files data for the key, 61 -- not old cached data. 62 Database.Keys.closeDb 63 return r 64 65runRequests 66 :: Handle 67 -> Handle 68 -> (TransferRequest -> Annex Bool) 69 -> Annex () 70runRequests readh writeh a = do 71 liftIO $ hSetBuffering readh NoBuffering 72 go =<< readrequests 73 where 74 go (d:rn:k:f:rest) = do 75 case (deserialize d, deserialize rn, deserialize k, deserialize f) of 76 (Just direction, Just remotename, Just key, Just file) -> do 77 mremote <- Remote.byName' remotename 78 case mremote of 79 Left _ -> sendresult False 80 Right remote -> sendresult =<< a 81 (TransferRequest direction remote key file) 82 _ -> sendresult False 83 go rest 84 go [] = noop 85 go [""] = noop 86 go v = error $ "transferkeys protocol error: " ++ show v 87 88 readrequests = liftIO $ split fieldSep <$> hGetContents readh 89 sendresult b = liftIO $ do 90 hPutStrLn writeh $ serialize b 91 hFlush writeh 92 93sendRequest :: Transfer -> TransferInfo -> Handle -> IO () 94sendRequest t tinfo h = do 95 hPutStr h $ intercalate fieldSep 96 [ serialize (transferDirection t) 97 , maybe (serialize ((fromUUID (transferUUID t)) :: String)) 98 (serialize . Remote.name) 99 (transferRemote tinfo) 100 , serialize (transferKey t) 101 , serialize (associatedFile tinfo) 102 , "" -- adds a trailing null 103 ] 104 hFlush h 105 106readResponse :: Handle -> IO Bool 107readResponse h = fromMaybe False . deserialize <$> hGetLine h 108 109fieldSep :: String 110fieldSep = "\0" 111 112class TCSerialized a where 113 serialize :: a -> String 114 deserialize :: String -> Maybe a 115 116instance TCSerialized Bool where 117 serialize True = "1" 118 serialize False = "0" 119 deserialize "1" = Just True 120 deserialize "0" = Just False 121 deserialize _ = Nothing 122 123instance TCSerialized Direction where 124 serialize Upload = "u" 125 serialize Download = "d" 126 deserialize "u" = Just Upload 127 deserialize "d" = Just Download 128 deserialize _ = Nothing 129 130instance TCSerialized AssociatedFile where 131 serialize (AssociatedFile (Just f)) = fromRawFilePath f 132 serialize (AssociatedFile Nothing) = "" 133 deserialize "" = Just (AssociatedFile Nothing) 134 deserialize f = Just (AssociatedFile (Just (toRawFilePath f))) 135 136instance TCSerialized RemoteName where 137 serialize n = n 138 deserialize n = Just n 139 140instance TCSerialized Key where 141 serialize = serializeKey 142 deserialize = deserializeKey 143