{- 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, remoteTypes, byName, nameToUUID, keyPossibilities, remotesWithUUID, remotesWithoutUUID, remoteLog, readRemoteLog, configSet, keyValToMap ) where import Control.Monad.State (liftIO) import Control.Monad (when, liftM) import Data.List import qualified Data.Map as M import Data.Maybe import RemoteClass import Types import UUID import qualified Annex import Trust import LocationLog import Locations import Utility import qualified Remote.Git import qualified Remote.S3 remoteTypes :: [RemoteType Annex] remoteTypes = [ Remote.Git.remote , Remote.S3.remote ] {- Builds a list of all available Remotes. - Since doing so can be expensive, the list is cached. -} genList :: Annex [Remote Annex] genList = do rs <- Annex.getState Annex.remotes if null rs then do l <- mapM generator remoteTypes rs' <- getConfigs (concat l) 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" {- Load stored config into remotes. - - This way, the log is read once, lazily, so if no remotes access - their config, no work is done. -} getConfigs :: [Remote Annex] -> Annex [Remote Annex] getConfigs rs = do m <- readRemoteLog return $ map (get m) rs where get m r = r { config = M.lookup (uuid r) m } {- Adds or updates a remote's config in the log. -} configSet :: UUID -> M.Map String String -> Annex () configSet u c = do m <- readRemoteLog l <- remoteLog liftIO $ safeWriteFile l $ unlines $ sort $ map toline $ M.toList $ M.insert u c m where toline (u', c') = u' ++ " " ++ (unwords $ mapToKeyVal c') {- Map of remotes by uuid containing key/value config maps. -} readRemoteLog :: Annex (M.Map UUID (M.Map String String)) readRemoteLog = do l <- remoteLog s <- liftIO $ catch (readFile l) ignoreerror return $ remoteLogParse s where ignoreerror _ = return "" remoteLogParse :: String -> M.Map UUID (M.Map String String) remoteLogParse s = M.fromList $ catMaybes $ map parseline $ filter (not . null) $ lines s where parseline l | length w > 2 = Just (u, c) | otherwise = Nothing where w = words l u = w !! 0 c = keyValToMap $ tail 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 $ sort $ M.toList m where toword (k, v) = k ++ "=" ++ v