{- git-annex remotes - - Copyright 2011 Joey Hess - - Licensed under the GNU GPL version 3 or higher. -} module Remote ( Remote, uuid, name, storeKey, retrieveKeyFile, removeKey, hasKey, hasKeyCheap, byName, nameToUUID, keyPossibilities, remotesWithUUID, remotesWithoutUUID, configGet, configSet, keyValToMap ) where import Control.Monad.State (liftIO) import Control.Monad (when, liftM) import Data.List import Data.String.Utils import qualified Data.Map as M import Data.Maybe import RemoteClass import qualified Remote.Git import qualified Remote.S3 import Types import UUID import qualified Annex import Trust import LocationLog import Locations import Messages {- Add generators for new Remotes here. -} generators :: [Annex (RemoteGenerator Annex)] generators = [ Remote.Git.generate , Remote.S3.generate ] {- Runs a list of generators. -} runGenerators :: [Annex (RemoteGenerator Annex)] -> Annex [Remote Annex] runGenerators gs = do (actions, expensive) <- collect ([], []) gs when (not $ null expensive) $ showNote $ "getting UUID for " ++ join ", " expensive sequence actions where collect v [] = return v collect (actions, expensive) (x:xs) = do (a, e) <- x collect (a++actions, e++expensive) xs {- Builds a list of all available Remotes. - Since doing so can be expensive, the list is cached in the Annex. -} genList :: Annex [Remote Annex] genList = do rs <- Annex.getState Annex.remotes if null rs then do rs' <- runGenerators generators Annex.changeState $ \s -> s { Annex.remotes = rs' } return rs' else return rs {- Looks up a remote by name. (Or by UUID.) -} byName :: String -> Annex (Remote Annex) byName "" = error "no remote specified" byName n = do allremotes <- genList let match = filter matching allremotes when (null match) $ error $ "there is no git remote named \"" ++ n ++ "\"" return $ head match where matching r = n == name r || n == uuid r {- Looks up a remote by name (or by UUID), and returns its UUID. -} nameToUUID :: String -> Annex UUID nameToUUID "." = do -- special case for current repo g <- Annex.gitRepo getUUID g nameToUUID n = liftM uuid (byName n) {- Cost ordered lists of remotes that the LocationLog indicate may have a key. - - Also returns a list of UUIDs that are trusted to have the key - (some may not have configured remotes). -} keyPossibilities :: Key -> Annex ([Remote Annex], [UUID]) keyPossibilities key = do g <- Annex.gitRepo u <- getUUID g trusted <- trustGet Trusted -- get uuids of all remotes that are recorded to have the key uuids <- liftIO $ keyLocations g key let validuuids = filter (/= u) uuids -- note that validuuids is assumed to not have dups let validtrusteduuids = intersect validuuids trusted -- remotes that match uuids that have the key allremotes <- genList let validremotes = remotesWithUUID allremotes validuuids return (sort validremotes, validtrusteduuids) {- Filters a list of remotes to ones that have the listed uuids. -} remotesWithUUID :: [Remote Annex] -> [UUID] -> [Remote Annex] remotesWithUUID rs us = filter (\r -> uuid r `elem` us) rs {- Filters a list of remotes to ones that do not have the listed uuids. -} remotesWithoutUUID :: [Remote Annex] -> [UUID] -> [Remote Annex] remotesWithoutUUID rs us = filter (\r -> uuid r `notElem` us) rs {- Filename of remote.log. -} remoteLog :: Annex FilePath remoteLog = do g <- Annex.gitRepo return $ gitStateDir g ++ "remote.log" {- Reads the uuid and config of the specified remote from the remoteLog. -} configGet :: String -> Annex (Maybe (UUID, M.Map String String)) configGet n = do rs <- readRemoteLog let matches = filter (matchName n) rs case matches of [] -> return Nothing ((u, _, c):_) -> return $ Just (u, c) {- Changes or adds a remote's config in the remoteLog. -} configSet :: String -> UUID -> M.Map String String -> Annex () configSet n u c = do rs <- readRemoteLog let others = filter (not . matchName n) rs writeRemoteLog $ (u, n, c):others matchName :: String -> (UUID, String, M.Map String String) -> Bool matchName n (_, n', _) = n == n' readRemoteLog :: Annex [(UUID, String, M.Map String String)] readRemoteLog = do l <- remoteLog s <- liftIO $ catch (readFile l) ignoreerror return $ remoteLogParse s where ignoreerror _ = return [] writeRemoteLog :: [(UUID, String, M.Map String String)] -> Annex () writeRemoteLog rs = do l <- remoteLog liftIO $ writeFile l $ unlines $ map toline rs where toline (u, n, c) = u ++ " " ++ n ++ (unwords $ mapToKeyVal c) remoteLogParse :: String -> [(UUID, String, M.Map String String)] remoteLogParse s = catMaybes $ map parseline $ filter (not . null) $ lines s where parseline l | length w > 2 = Just (u, n, c) | otherwise = Nothing where w = words l u = w !! 0 n = w !! 1 c = keyValToMap $ drop 2 w {- Given Strings like "key=value", generates a Map. -} keyValToMap :: [String] -> M.Map String String keyValToMap ws = M.fromList $ map (/=/) ws where (/=/) s = (k, v) where k = takeWhile (/= '=') s v = drop (1 + length k) s mapToKeyVal :: M.Map String String -> [String] mapToKeyVal m = map toword $ M.toList m where toword (k, v) = k ++ "=" ++ v