diff options
| -rw-r--r-- | Assistant/MakeRemote.hs | 25 | ||||
| -rw-r--r-- | Assistant/Pairing/MakeRemote.hs | 10 | ||||
| -rw-r--r-- | Assistant/Ssh.hs | 29 | ||||
| -rw-r--r-- | Command/RecvKey.hs | 17 | ||||
| -rw-r--r-- | Remote/GCrypt.hs | 6 | ||||
| -rw-r--r-- | Remote/Git.hs | 10 | ||||
| -rw-r--r-- | Remote/Helper/Ssh.hs | 6 |
7 files changed, 58 insertions, 45 deletions
diff --git a/Assistant/MakeRemote.hs b/Assistant/MakeRemote.hs index 2619039c0..d85bf0fd7 100644 --- a/Assistant/MakeRemote.hs +++ b/Assistant/MakeRemote.hs @@ -9,7 +9,6 @@ module Assistant.MakeRemote where import Assistant.Common import Assistant.Ssh -import Assistant.Sync import qualified Types.Remote as R import qualified Remote import Remote.List @@ -21,8 +20,6 @@ import qualified Command.InitRemote import Logs.UUID import Logs.Remote import Git.Remote -import Config -import Config.Cost import Creds import Assistant.Gpg import Utility.Gpg (KeyId) @@ -30,25 +27,18 @@ import Utility.Gpg (KeyId) import qualified Data.Text as T import qualified Data.Map as M -{- Sets up and begins syncing with a new ssh or rsync remote. -} -makeSshRemote :: Bool -> SshData -> Maybe Cost -> Assistant Remote -makeSshRemote forcersync sshdata mcost = do - r <- liftAnnex $ - addRemote $ maker (sshRepoName sshdata) - (sshUrl forcersync sshdata) - liftAnnex $ maybe noop (setRemoteCost r) mcost - syncRemote r - return r +{- Sets up a new git or rsync remote, accessed over ssh. -} +makeSshRemote :: SshData -> Annex RemoteName +makeSshRemote sshdata = maker (sshRepoName sshdata) (sshUrl sshdata) where - rsync = forcersync || rsyncOnly sshdata maker - | rsync = makeRsyncRemote + | onlyCapability sshdata RsyncCapable = makeRsyncRemote | otherwise = makeGitRemote {- Generates a ssh or rsync url from a SshData. -} -sshUrl :: Bool -> SshData -> String -sshUrl forcersync sshdata = addtrailingslash $ T.unpack $ T.concat $ - if (forcersync || rsyncOnly sshdata) +sshUrl :: SshData -> String +sshUrl sshdata = addtrailingslash $ T.unpack $ T.concat $ + if (onlyCapability sshdata RsyncCapable) then [u, h, T.pack ":", sshDirectory sshdata] else [T.pack "ssh://", u, h, d] where @@ -146,7 +136,6 @@ makeRemote basename location a = do g <- gitRepo if not (any samelocation $ Git.remotes g) then do - let name = uniqueRemoteName basename 0 g a name return name diff --git a/Assistant/Pairing/MakeRemote.hs b/Assistant/Pairing/MakeRemote.hs index edd27e35a..144b236a4 100644 --- a/Assistant/Pairing/MakeRemote.hs +++ b/Assistant/Pairing/MakeRemote.hs @@ -12,7 +12,9 @@ import Assistant.Ssh import Assistant.Pairing import Assistant.Pairing.Network import Assistant.MakeRemote +import Assistant.Sync import Config.Cost +import Config import Network.Socket import qualified Data.Text as T @@ -22,7 +24,7 @@ import qualified Data.Text as T setupAuthorizedKeys :: PairMsg -> FilePath -> IO () setupAuthorizedKeys msg repodir = do validateSshPubKey pubkey - unlessM (liftIO $ addAuthorizedKeys False repodir pubkey) $ + unlessM (liftIO $ addAuthorizedKeys True repodir pubkey) $ error "failed setting up ssh authorized keys" where pubkey = remoteSshPubKey $ pairMsgData msg @@ -43,7 +45,9 @@ finishedLocalPairing msg keypair = do , "git-annex-shell -c configlist " ++ T.unpack (sshDirectory sshdata) ] Nothing - void $ makeSshRemote False sshdata (Just semiExpensiveRemoteCost) + r <- liftAnnex $ addRemote $ makeSshRemote sshdata + liftAnnex $ setRemoteCost r semiExpensiveRemoteCost + syncRemote r {- Mostly a straightforward conversion. Except: - * Determine the best hostname to use to contact the host. @@ -63,7 +67,7 @@ pairMsgToSshData msg = do , sshRepoName = genSshRepoName hostname dir , sshPort = 22 , needsPubKey = True - , rsyncOnly = False + , sshCapabilities = [GitAnnexShellCapable, GitCapable, RsyncCapable] } {- Finds the best hostname to use for the host that sent the PairMsg. diff --git a/Assistant/Ssh.hs b/Assistant/Ssh.hs index a62319096..c6514e613 100644 --- a/Assistant/Ssh.hs +++ b/Assistant/Ssh.hs @@ -25,10 +25,19 @@ data SshData = SshData , sshRepoName :: String , sshPort :: Int , needsPubKey :: Bool - , rsyncOnly :: Bool + , sshCapabilities :: [SshServerCapability] } deriving (Read, Show, Eq) +data SshServerCapability = GitAnnexShellCapable | GitCapable | RsyncCapable + deriving (Read, Show, Eq) + +hasCapability :: SshData -> SshServerCapability -> Bool +hasCapability d c = c `elem` sshCapabilities d + +onlyCapability :: SshData -> SshServerCapability -> Bool +onlyCapability d c = all (== c) (sshCapabilities d) + data SshKeyPair = SshKeyPair { sshPubKey :: String , sshPrivKey :: String @@ -92,12 +101,12 @@ validateSshPubKey pubkey safeincomment c = isAlphaNum c || c == '@' || c == '-' || c == '_' || c == '.' addAuthorizedKeys :: Bool -> FilePath -> SshPubKey -> IO Bool -addAuthorizedKeys rsynconly dir pubkey = boolSystem "sh" - [ Param "-c" , Param $ addAuthorizedKeysCommand rsynconly dir pubkey ] +addAuthorizedKeys gitannexshellonly dir pubkey = boolSystem "sh" + [ Param "-c" , Param $ addAuthorizedKeysCommand gitannexshellonly dir pubkey ] removeAuthorizedKeys :: Bool -> FilePath -> SshPubKey -> IO () -removeAuthorizedKeys rsynconly dir pubkey = do - let keyline = authorizedKeysLine rsynconly dir pubkey +removeAuthorizedKeys gitannexshellonly dir pubkey = do + let keyline = authorizedKeysLine gitannexshellonly dir pubkey sshdir <- sshDir let keyfile = sshdir </> "authorized_keys" ls <- lines <$> readFileStrict keyfile @@ -110,7 +119,7 @@ removeAuthorizedKeys rsynconly dir pubkey = do - present. -} addAuthorizedKeysCommand :: Bool -> FilePath -> SshPubKey -> String -addAuthorizedKeysCommand rsynconly dir pubkey = intercalate "&&" +addAuthorizedKeysCommand gitannexshellonly dir pubkey = intercalate "&&" [ "mkdir -p ~/.ssh" , intercalate "; " [ "if [ ! -e " ++ wrapper ++ " ]" @@ -122,7 +131,7 @@ addAuthorizedKeysCommand rsynconly dir pubkey = intercalate "&&" , "chmod 600 ~/.ssh/authorized_keys" , unwords [ "echo" - , shellEscape $ authorizedKeysLine rsynconly dir pubkey + , shellEscape $ authorizedKeysLine gitannexshellonly dir pubkey , ">>~/.ssh/authorized_keys" ] ] @@ -141,11 +150,11 @@ addAuthorizedKeysCommand rsynconly dir pubkey = intercalate "&&" runshell var = "exec git-annex-shell -c \"" ++ var ++ "\"" authorizedKeysLine :: Bool -> FilePath -> SshPubKey -> String -authorizedKeysLine rsynconly dir pubkey +authorizedKeysLine gitannexshellonly dir pubkey + | gitannexshellonly = limitcommand ++ pubkey {- TODO: Locking down rsync is difficult, requiring a rather - long perl script. -} - | rsynconly = pubkey - | otherwise = limitcommand ++ pubkey + | otherwise = pubkey where limitcommand = "command=\"GIT_ANNEX_SHELL_DIRECTORY="++shellEscape dir++" ~/.ssh/git-annex-shell\",no-agent-forwarding,no-port-forwarding,no-X11-forwarding " diff --git a/Command/RecvKey.hs b/Command/RecvKey.hs index eb2c88ca9..3b2a8c496 100644 --- a/Command/RecvKey.hs +++ b/Command/RecvKey.hs @@ -72,7 +72,18 @@ start key = ifM (inAnnex key) return $ size == size' if oksize then case Backend.maybeLookupBackendName (Types.Key.keyBackendName key) of - Nothing -> return False - Just backend -> maybe (return True) (\a -> a key tmp) + Nothing -> do + warning "recvkey: received key from direct mode repository using unknown backend; cannot check; discarding" + return False + Just backend -> maybe (return True) runfsck (Types.Backend.fsckKey backend) - else return False + else do + warning "recvkey: received key with wrong size; discarding" + return False + where + runfsck check = ifM (check key tmp) + ( return True + , do + warning "recvkey: received key from direct mode repository seems to have changed as it was transferred; discarding" + return False + ) diff --git a/Remote/GCrypt.hs b/Remote/GCrypt.hs index b09943052..acbf3cd68 100644 --- a/Remote/GCrypt.hs +++ b/Remote/GCrypt.hs @@ -290,7 +290,7 @@ store r rsyncopts (cipher, enck) k p storeshell = withTmp enck $ \tmp -> ifM (spoolencrypted $ readBytes $ \b -> catchBoolIO $ L.writeFile tmp b >> return True) ( Ssh.rsyncHelper (Just p) - =<< Ssh.rsyncParamsRemote r Upload enck tmp Nothing + =<< Ssh.rsyncParamsRemote False r Upload enck tmp Nothing , return False ) spoolencrypted a = Annex.Content.sendAnnex k noop $ \src -> @@ -312,7 +312,7 @@ retrieve r rsyncopts (cipher, enck) k d p (readBytes $ meteredWriteFile meterupdate d) retrieversync = Remote.Rsync.retrieveEncrypted rsyncopts (cipher, enck) k d p retrieveshell = withTmp enck $ \tmp -> - ifM (Ssh.rsyncHelper (Just p) =<< Ssh.rsyncParamsRemote r Download enck tmp Nothing) + ifM (Ssh.rsyncHelper (Just p) =<< Ssh.rsyncParamsRemote False r Download enck tmp Nothing) ( liftIO $ catchBoolIO $ do decrypt cipher (feedFile tmp) $ readBytes $ L.writeFile d @@ -375,7 +375,7 @@ coreGCryptId = "core.gcrypt-id" - (Also returns a version of input repo with its config read.) -} getGCryptId :: Bool -> Git.Repo -> Annex (Maybe Git.GCrypt.GCryptId, Git.Repo) getGCryptId fast r - | Git.repoIsLocal r = extract <$> + | Git.repoIsLocal r || Git.repoIsLocalUnknown r = extract <$> liftIO (catchMaybeIO $ Git.Config.read r) | not fast = extract . liftM fst <$> getM (eitherToMaybe <$>) [ Ssh.onRemote r (Git.Config.fromPipe r, Left undefined) "configlist" [] [] diff --git a/Remote/Git.hs b/Remote/Git.hs index 0f3f35811..e8ab57281 100644 --- a/Remote/Git.hs +++ b/Remote/Git.hs @@ -296,9 +296,10 @@ copyFromRemote' r key file dest upload u key file noRetry (rsyncOrCopyFile params object dest) <&&> checksuccess - | Git.repoIsSsh (repo r) = feedprogressback $ \feeder -> + | Git.repoIsSsh (repo r) = feedprogressback $ \feeder -> do + direct <- isDirect Ssh.rsyncHelper (Just feeder) - =<< Ssh.rsyncParamsRemote r Download key dest file + =<< Ssh.rsyncParamsRemote direct r Download key dest file | Git.repoIsHttp (repo r) = Annex.Content.downloadUrl (keyUrls (repo r) key) dest | otherwise = error "copying from non-ssh, non-http remote not supported" where @@ -370,9 +371,10 @@ copyToRemote r key file p guardUsable (repo r) False $ commitOnCleanup r $ copylocal =<< Annex.Content.prepSendAnnex key | Git.repoIsSsh (repo r) = commitOnCleanup r $ - Annex.Content.sendAnnex key noop $ \object -> + Annex.Content.sendAnnex key noop $ \object -> do + direct <- isDirect Ssh.rsyncHelper (Just p) - =<< Ssh.rsyncParamsRemote r Upload key object file + =<< Ssh.rsyncParamsRemote direct r Upload key object file | otherwise = error "copying to non-ssh repo not supported" where copylocal Nothing = return False diff --git a/Remote/Helper/Ssh.hs b/Remote/Helper/Ssh.hs index 82c7c3896..35655f00b 100644 --- a/Remote/Helper/Ssh.hs +++ b/Remote/Helper/Ssh.hs @@ -19,7 +19,6 @@ import Types.Key import Remote.Helper.Messages import Utility.Metered import Utility.Rsync -import Config import Types.Remote import Logs.Transfer @@ -111,10 +110,9 @@ rsyncHelper callback params = do {- Generates rsync parameters that ssh to the remote and asks it - to either receive or send the key's content. -} -rsyncParamsRemote :: Remote -> Direction -> Key -> FilePath -> AssociatedFile -> Annex [CommandParam] -rsyncParamsRemote r direction key file afile = do +rsyncParamsRemote :: Bool -> Remote -> Direction -> Key -> FilePath -> AssociatedFile -> Annex [CommandParam] +rsyncParamsRemote direct r direction key file afile = do u <- getUUID - direct <- isDirect let fields = (Fields.remoteUUID, fromUUID u) : (Fields.direct, if direct then "1" else "") : maybe [] (\f -> [(Fields.associatedFile, f)]) afile |