diff --git a/Assistant/MakeRemote.hs b/Assistant/MakeRemote.hs index 2619039c0e..32a3fd6f52 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,47 +20,20 @@ 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) -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) (genSshUrl 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) - then [u, h, T.pack ":", sshDirectory sshdata] - else [T.pack "ssh://", u, h, d] - where - u = maybe (T.pack "") (\v -> T.concat [v, T.pack "@"]) $ sshUserName sshdata - h = sshHostName sshdata - d - | T.pack "/" `T.isPrefixOf` sshDirectory sshdata = sshDirectory sshdata - | T.pack "~/" `T.isPrefixOf` sshDirectory sshdata = T.concat [T.pack "/", sshDirectory sshdata] - | otherwise = T.concat [T.pack "/~/", sshDirectory sshdata] - addtrailingslash s - | "/" `isSuffixOf` s = s - | otherwise = s ++ "/" - {- Runs an action that returns a name of the remote, and finishes adding it. -} addRemote :: Annex RemoteName -> Annex Remote addRemote a = do @@ -146,7 +118,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 edd27e35a2..144b236a41 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 a623190964..f316aa5008 100644 --- a/Assistant/Ssh.hs +++ b/Assistant/Ssh.hs @@ -1,6 +1,6 @@ {- git-annex assistant ssh utilities - - - Copyright 2012 Joey Hess + - Copyright 2012-2013 Joey Hess - - Licensed under the GNU GPL version 3 or higher. -} @@ -11,6 +11,7 @@ import Common.Annex import Utility.Tmp import Utility.UserInfo import Utility.Shell +import Utility.Rsync import Git.Remote import Data.Text (Text) @@ -25,10 +26,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 @@ -52,6 +62,48 @@ sshDir = do genSshHost :: Text -> Maybe Text -> String genSshHost host user = maybe "" (\v -> T.unpack v ++ "@") user ++ T.unpack host +{- Generates a ssh or rsync url from a SshData. -} +genSshUrl :: SshData -> String +genSshUrl 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 + u = maybe (T.pack "") (\v -> T.concat [v, T.pack "@"]) $ sshUserName sshdata + h = sshHostName sshdata + d + | T.pack "/" `T.isPrefixOf` sshDirectory sshdata = sshDirectory sshdata + | T.pack "~/" `T.isPrefixOf` sshDirectory sshdata = T.concat [T.pack "/", sshDirectory sshdata] + | otherwise = T.concat [T.pack "/~/", sshDirectory sshdata] + addtrailingslash s + | "/" `isSuffixOf` s = s + | otherwise = s ++ "/" + +{- Reverses genSshUrl -} +parseSshUrl :: String -> Maybe SshData +parseSshUrl u + | "ssh://" `isPrefixOf` u = fromssh (drop (length "ssh://") u) + | otherwise = fromrsync u + where + mkdata (userhost, dir) = Just $ SshData + { sshHostName = T.pack host + , sshUserName = if null user then Nothing else Just $ T.pack user + , sshDirectory = T.pack dir + , sshRepoName = genSshRepoName host dir + -- dummy values, cannot determine from url + , sshPort = 22 + , needsPubKey = True + , sshCapabilities = [] + } + where + (user, host) = if '@' `elem` userhost + then separate (== '@') userhost + else ("", userhost) + fromrsync s + | not (rsyncUrlIsShell u) = Nothing + | otherwise = mkdata $ separate (== ':') s + fromssh = mkdata . break (== '/') + {- Generates a git remote name, like host_dir or host -} genSshRepoName :: String -> FilePath -> String genSshRepoName host dir @@ -92,12 +144,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 +162,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 +174,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 +193,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/Assistant/WebApp/Configurators/AWS.hs b/Assistant/WebApp/Configurators/AWS.hs index f38b3e009d..3f82ba3754 100644 --- a/Assistant/WebApp/Configurators/AWS.hs +++ b/Assistant/WebApp/Configurators/AWS.hs @@ -205,7 +205,8 @@ enableAWSRemote _ _ = error "S3 not supported by this build" makeAWSRemote :: SpecialRemoteMaker -> RemoteType -> StandardGroup -> AWSCreds -> RemoteName -> RemoteConfig -> Handler () makeAWSRemote maker remotetype defaultgroup (AWSCreds ak sk) name config = do liftIO $ AWS.setCredsEnv (T.unpack ak, T.unpack sk) - setupCloudRemote defaultgroup $ maker hostname remotetype config + setupCloudRemote defaultgroup Nothing $ + maker hostname remotetype config where {- AWS services use the remote name as the basis for a host - name, so filter it to contain valid characters. -} diff --git a/Assistant/WebApp/Configurators/Pairing.hs b/Assistant/WebApp/Configurators/Pairing.hs index 4ebb1ed88d..7f7f172cdf 100644 --- a/Assistant/WebApp/Configurators/Pairing.hs +++ b/Assistant/WebApp/Configurators/Pairing.hs @@ -152,7 +152,7 @@ postFinishLocalPairR msg = promptSecret (Just msg) $ \_ secret -> do where alert = pairRequestAcknowledgedAlert (pairRepo msg) . Just setup repodir = setupAuthorizedKeys msg repodir - cleanup repodir = removeAuthorizedKeys False repodir $ + cleanup repodir = removeAuthorizedKeys True repodir $ remoteSshPubKey $ pairMsgData msg uuid = Just $ pairUUID $ pairMsgData msg #else diff --git a/Assistant/WebApp/Configurators/Ssh.hs b/Assistant/WebApp/Configurators/Ssh.hs index 5ac24ab6e8..811a44babc 100644 --- a/Assistant/WebApp/Configurators/Ssh.hs +++ b/Assistant/WebApp/Configurators/Ssh.hs @@ -1,6 +1,6 @@ {- git-annex assistant webapp configurator for ssh-based remotes - - - Copyright 2012 Joey Hess + - Copyright 2012-2013 Joey Hess - - Licensed under the GNU AGPL version 3 or higher. -} @@ -14,14 +14,12 @@ import Assistant.WebApp.Common import Assistant.WebApp.Gpg import Assistant.Ssh import Assistant.MakeRemote -import Utility.Rsync (rsyncUrlIsShell) import Logs.Remote import Remote -import Logs.PreferredContent import Types.StandardGroups import Utility.UserInfo import Utility.Gpg -import Types.Remote (RemoteConfigKey) +import Types.Remote (RemoteConfig) import Git.Remote import Assistant.WebApp.Utility import qualified Remote.GCrypt as GCrypt @@ -54,7 +52,7 @@ mkSshData s = SshData (maybe "" T.unpack $ inputDirectory s) , sshPort = inputPort s , needsPubKey = False - , rsyncOnly = False + , sshCapabilities = [] -- untested } mkSshInput :: SshData -> SshInput @@ -103,15 +101,12 @@ sshInputAForm hostnamefield def = SshInput data ServerStatus = UntestedServer | UnusableServer Text -- reason why it's not usable - | UsableRsyncServer - | UsableSshInput + | UsableServer [SshServerCapability] deriving (Eq) -usable :: ServerStatus -> Bool -usable UntestedServer = False -usable (UnusableServer _) = False -usable UsableRsyncServer = True -usable UsableSshInput = True +capabilities :: ServerStatus -> [SshServerCapability] +capabilities (UsableServer cs) = cs +capabilities _ = [] getAddSshR :: Handler Html getAddSshR = postAddSshR @@ -140,10 +135,11 @@ sshTestModal = $(widgetFile "configurators/ssh/testmodal") getEnableRsyncR :: UUID -> Handler Html getEnableRsyncR = postEnableRsyncR postEnableRsyncR :: UUID -> Handler Html -postEnableRsyncR = enableSpecialSshRemote "rsyncurl" enableRsyncNet enablersync +postEnableRsyncR = enableSpecialSshRemote getsshinput enableRsyncNet enablersync where enablersync sshdata = redirect $ ConfirmSshR $ - sshdata { rsyncOnly = True } + sshdata { sshCapabilities = [RsyncCapable] } + getsshinput = parseSshUrl <=< M.lookup "rsyncurl" {- This only handles gcrypt repositories that are located on ssh servers; - ones on local drives are handled via another part of the UI. -} @@ -151,19 +147,23 @@ getEnableGCryptR :: UUID -> Handler Html getEnableGCryptR = postEnableGCryptR postEnableGCryptR :: UUID -> Handler Html postEnableGCryptR u = whenGcryptInstalled $ - enableSpecialSshRemote "gitrepo" enableRsyncNetGCrypt enablersync u + enableSpecialSshRemote getsshinput enableRsyncNetGCrypt enablegcrypt u where - enablersync sshdata = error "TODO enable ssh gcrypt remote" + enablegcrypt sshdata = prepSsh True sshdata $ \sshdata' -> + sshConfigurator $ + checkExistingGCrypt sshdata' $ + error "Expected to find an encrypted git repository, but did not." + getsshinput = parseSshUrl <=< M.lookup "gitrepo" -{- To enable an special remote that uses ssh as its transport, +{- To enable a special remote that uses ssh as its transport, - parse a config key to get its url, and display a form whose - only real purpose is to check if ssh public keys need to be - set up. -} -enableSpecialSshRemote :: RemoteConfigKey -> (SshInput -> RemoteName -> Handler Html) -> (SshData -> Handler ()) -> UUID -> Handler Html -enableSpecialSshRemote urlkey rsyncnetsetup genericsetup u = do +enableSpecialSshRemote :: (RemoteConfig -> Maybe SshData) -> (SshInput -> RemoteName -> Handler Html) -> (SshData -> Handler Html) -> UUID -> Handler Html +enableSpecialSshRemote getsshinput rsyncnetsetup genericsetup u = do m <- fromMaybe M.empty . M.lookup u <$> liftAnnex readRemoteLog - case (parseSshRsyncUrl =<< M.lookup urlkey m, M.lookup "name" m) of + case (mkSshInput . unmangle <$> getsshinput m, M.lookup "name" m) of (Just sshinput, Just reponame) -> sshConfigurator $ do ((result, form), enctype) <- liftH $ runFormPost $ renderBootstrap $ sshInputAForm textField sshinput @@ -175,38 +175,19 @@ enableSpecialSshRemote urlkey rsyncnetsetup genericsetup u = do s <- liftIO $ testServer sshinput' case s of Left status -> showform form enctype status - Right sshdata -> liftH $ genericsetup sshdata + Right sshdata -> void $ liftH $ genericsetup sshdata { sshRepoName = reponame } _ -> showform form enctype UntestedServer _ -> redirect AddSshR where + unmangle sshdata = sshdata + { sshHostName = T.pack $ unMangleSshHostName $ + T.unpack $ sshHostName sshdata + } showform form enctype status = do description <- liftAnnex $ T.pack <$> prettyUUID u $(widgetFile "configurators/ssh/enable") -{- Converts a rsyncurl value to a SshInput. But only if it's a ssh rsync - - url; rsync:// urls or bare path names are not supported. - - - - The hostname is stored mangled in the remote log for rsync special - - remotes configured by this webapp. So that mangling has to reversed - - here to get back the original hostname. - -} -parseSshRsyncUrl :: String -> Maybe SshInput -parseSshRsyncUrl u - | not (rsyncUrlIsShell u) = Nothing - | otherwise = Just $ SshInput - { inputHostname = val $ unMangleSshHostName host - , inputUsername = if null user then Nothing else val user - , inputDirectory = val dir - , inputPort = 22 - } - where - val = Just . T.pack - (userhost, dir) = separate (== ':') u - (user, host) = if '@' `elem` userhost - then separate (== '@') userhost - else (userhost, "") - {- Test if we can ssh into the server. - - Two probe attempts are made. First, try sshing in using the existing @@ -214,8 +195,9 @@ parseSshRsyncUrl u - passwordless login is already enabled, use it. Otherwise, - a special ssh key will need to be generated just for this server. - - - Once logged into the server, probe to see if git-annex-shell is - - available, or rsync. Note that, ~/.ssh/git-annex-shell may be + - Once logged into the server, probe to see if git-annex-shell, + - git, and rsync are available. + - Note that, ~/.ssh/git-annex-shell may be - present, while git-annex-shell is not in PATH. -} testServer :: SshInput -> IO (Either ServerStatus SshData) @@ -223,22 +205,23 @@ testServer (SshInput { inputHostname = Nothing }) = return $ Left $ UnusableServer "Please enter a host name." testServer sshinput@(SshInput { inputHostname = Just hn }) = do status <- probe [sshOpt "NumberOfPasswordPrompts" "0"] - if usable status - then ret status False - else do + case capabilities status of + [] -> do status' <- probe [] - if usable status' - then ret status' True - else return $ Left status' + case capabilities status' of + [] -> return $ Left status' + cs -> ret cs True + cs -> ret cs False where - ret status needspubkey = return $ Right $ (mkSshData sshinput) + ret cs needspubkey = return $ Right $ (mkSshData sshinput) { needsPubKey = needspubkey - , rsyncOnly = status == UsableRsyncServer + , sshCapabilities = cs } probe extraopts = do let remotecommand = shellWrap $ intercalate ";" [ report "loggedin" , checkcommand "git-annex-shell" + , checkcommand "git" , checkcommand "rsync" , checkcommand shim ] @@ -256,14 +239,19 @@ testServer sshinput@(SshInput { inputHostname = Just hn }) = do , remotecommand ] parsetranscript . fst <$> sshTranscript sshopts Nothing - parsetranscript s - | reported "git-annex-shell" = UsableSshInput - | reported shim = UsableSshInput - | reported "rsync" = UsableRsyncServer - | reported "loggedin" = UnusableServer - "Neither rsync nor git-annex are installed on the server. Perhaps you should go install them?" - | otherwise = UnusableServer $ T.pack $ - "Failed to ssh to the server. Transcript: " ++ s + parsetranscript s = + let cs = map snd $ filter (reported . fst) + [ ("git-annex-shell", GitAnnexShellCapable) + , (shim, GitAnnexShellCapable) + , ("git", GitCapable) + , ("rsync", RsyncCapable) + ] + in if null cs + then if reported "loggedin" + then UnusableServer "Neither rsync nor git-annex are installed on the server. Perhaps you should go install them?" + else UnusableServer $ T.pack $ + "Failed to ssh to the server. Transcript: " ++ s + else UsableServer cs where reported r = token r `isInfixOf` s @@ -286,7 +274,9 @@ showSshErr msg = sshConfigurator $ $(widgetFile "configurators/ssh/error") getConfirmSshR :: SshData -> Handler Html -getConfirmSshR sshdata = sshConfigurator $ +getConfirmSshR sshdata = sshConfigurator $ do + secretkeys <- sortBy (comparing snd) . M.toList + <$> liftIO secretKeys $(widgetFile "configurators/ssh/confirm") getRetrySshR :: SshData -> Handler () @@ -295,44 +285,81 @@ getRetrySshR sshdata = do redirect $ either (const $ ConfirmSshR sshdata) ConfirmSshR s getMakeSshGitR :: SshData -> Handler Html -getMakeSshGitR = makeSsh False +getMakeSshGitR sshdata = prepSsh False sshdata makeSshRepo getMakeSshRsyncR :: SshData -> Handler Html -getMakeSshRsyncR = makeSsh True +getMakeSshRsyncR sshdata = prepSsh False (rsyncOnly sshdata) makeSshRepo -makeSsh :: Bool -> SshData -> Handler Html -makeSsh rsync sshdata +rsyncOnly :: SshData -> SshData +rsyncOnly sshdata = sshdata { sshCapabilities = [RsyncCapable] } + +getMakeSshGCryptR :: SshData -> RepoKey -> Handler Html +getMakeSshGCryptR sshdata NoRepoKey = whenGcryptInstalled $ + withNewSecretKey $ getMakeSshGCryptR sshdata . RepoKey +getMakeSshGCryptR sshdata (RepoKey keyid) = whenGcryptInstalled $ + prepSsh True sshdata $ makeGCryptRepo keyid + +{- Detect if the user entered a location with an existing, known + - gcrypt repository, and enable it. Otherwise, runs the action. -} +checkExistingGCrypt :: SshData -> Widget -> Widget +checkExistingGCrypt sshdata nope = ifM (liftIO isGcryptInstalled) + ( checkGCryptRepoEncryption repourl nope $ do + mu <- liftAnnex $ probeGCryptRemoteUUID repourl + case mu of + Just u -> do + reponame <- liftAnnex $ getGCryptRemoteName u repourl + void $ liftH $ enableGCrypt sshdata reponame + Nothing -> error "The location contains a gcrypt repository that is not a git-annex special remote. This is not supported." + , nope + ) + where + repourl = genSshUrl sshdata + +{- Enables an existing gcrypt special remote. -} +enableGCrypt :: SshData -> RemoteName -> Handler Html +enableGCrypt sshdata reponame = + setupCloudRemote TransferGroup Nothing $ + enableSpecialRemote reponame GCrypt.remote $ M.fromList + [("gitrepo", genSshUrl sshdata)] + +{- Sets up remote repository for ssh, or directory for rsync. -} +prepSsh :: Bool -> SshData -> (SshData -> Handler Html) -> Handler Html +prepSsh gcrypt sshdata a | needsPubKey sshdata = do keypair <- liftIO genSshKeyPair sshdata' <- liftIO $ setupSshKeyPair keypair sshdata - makeSsh' rsync sshdata sshdata' (Just keypair) + prepSsh' gcrypt sshdata sshdata' (Just keypair) a | sshPort sshdata /= 22 = do sshdata' <- liftIO $ setSshConfig sshdata [] - makeSsh' rsync sshdata sshdata' Nothing - | otherwise = makeSsh' rsync sshdata sshdata Nothing + prepSsh' gcrypt sshdata sshdata' Nothing a + | otherwise = prepSsh' gcrypt sshdata sshdata Nothing a -makeSsh' :: Bool -> SshData -> SshData -> Maybe SshKeyPair -> Handler Html -makeSsh' rsync origsshdata sshdata keypair = do - sshSetup ["-p", show (sshPort origsshdata), sshhost, remoteCommand] "" $ - makeSshRepo rsync sshdata +prepSsh' :: Bool -> SshData -> SshData -> Maybe SshKeyPair -> (SshData -> Handler Html) -> Handler Html +prepSsh' gcrypt origsshdata sshdata keypair a = sshSetup + [ "-p", show (sshPort origsshdata) + , genSshHost (sshHostName origsshdata) (sshUserName origsshdata) + , remoteCommand + ] "" (a sshdata) where - sshhost = genSshHost (sshHostName origsshdata) (sshUserName origsshdata) remotedir = T.unpack $ sshDirectory sshdata remoteCommand = shellWrap $ intercalate "&&" $ catMaybes [ Just $ "mkdir -p " ++ shellEscape remotedir , Just $ "cd " ++ shellEscape remotedir - , if rsync then Nothing else Just "if [ ! -d .git ]; then git init --bare --shared; fi" - , if rsync then Nothing else Just "git annex init" - , if needsPubKey sshdata - then addAuthorizedKeysCommand (rsync || rsyncOnly sshdata) remotedir . sshPubKey <$> keypair + , if rsynconly then Nothing else Just "if [ ! -d .git ]; then git init --bare --shared; fi" + , if (rsynconly || gcrypt) then Nothing else Just "git annex init" + , if needsPubKey origsshdata + then addAuthorizedKeysCommand (hasCapability origsshdata GitAnnexShellCapable) remotedir . sshPubKey <$> keypair else Nothing ] + rsynconly = onlyCapability origsshdata RsyncCapable -makeSshRepo :: Bool -> SshData -> Handler Html -makeSshRepo forcersync sshdata = do - r <- liftAssistant $ makeSshRemote forcersync sshdata Nothing - liftAnnex $ setStandardGroup (Remote.uuid r) TransferGroup - redirect $ EditNewCloudRepositoryR $ Remote.uuid r +makeSshRepo :: SshData -> Handler Html +makeSshRepo sshdata = setupCloudRemote TransferGroup Nothing $ + makeSshRemote sshdata + +makeGCryptRepo :: KeyId -> SshData -> Handler Html +makeGCryptRepo keyid sshdata = setupCloudRemote TransferGroup Nothing $ + makeGCryptRemote (sshRepoName sshdata) (genSshUrl sshdata) keyid getAddRsyncNetR :: Handler Html getAddRsyncNetR = postAddRsyncNetR @@ -366,56 +393,35 @@ postAddRsyncNetR = do let reponame = genSshRepoName "rsync.net" (maybe "" T.unpack $ inputDirectory sshinput) prepRsyncNet sshinput reponame $ \sshdata -> inpage $ - checkexistinggcrypt sshdata $ do + checkExistingGCrypt sshdata $ do secretkeys <- sortBy (comparing snd) . M.toList <$> liftIO secretKeys $(widgetFile "configurators/rsync.net/encrypt") - {- Detect if the user entered an existing gcrypt repository, - - and enable it. -} - checkexistinggcrypt sshdata a = ifM (liftIO isGcryptInstalled) - ( checkGCryptRepoEncryption repourl a $ do - mu <- liftAnnex $ probeGCryptRemoteUUID repourl - case mu of - Just u -> do - reponame <- liftAnnex $ getGCryptRemoteName u repourl - void $ liftH $ enableRsyncNetGCrypt' sshdata reponame - Nothing -> error "The location contains a gcrypt repository that is not a git-annex special remote. This is not supported." - , a - ) - where - repourl = sshUrl True sshdata getMakeRsyncNetSharedR :: SshData -> Handler Html -getMakeRsyncNetSharedR sshdata = makeSshRepo True sshdata +getMakeRsyncNetSharedR = makeSshRepo . rsyncOnly {- Make a gcrypt special remote on rsync.net. -} getMakeRsyncNetGCryptR :: SshData -> RepoKey -> Handler Html getMakeRsyncNetGCryptR sshdata NoRepoKey = whenGcryptInstalled $ withNewSecretKey $ getMakeRsyncNetGCryptR sshdata . RepoKey getMakeRsyncNetGCryptR sshdata (RepoKey keyid) = whenGcryptInstalled $ do - sshSetup [sshhost, gitinit] [] $ - setupCloudRemote TransferGroup $ - makeGCryptRemote (sshRepoName sshdata) (sshUrl True sshdata) keyid + sshSetup [sshhost, gitinit] [] $ makeGCryptRepo keyid sshdata where sshhost = genSshHost (sshHostName sshdata) (sshUserName sshdata) gitinit = "git init --bare " ++ T.unpack (sshDirectory sshdata) enableRsyncNet :: SshInput -> String -> Handler Html enableRsyncNet sshinput reponame = - prepRsyncNet sshinput reponame $ makeSshRepo True + prepRsyncNet sshinput reponame $ makeSshRepo . rsyncOnly enableRsyncNetGCrypt :: SshInput -> RemoteName -> Handler Html enableRsyncNetGCrypt sshinput reponame = prepRsyncNet sshinput reponame $ \sshdata -> - checkGCryptRepoEncryption (sshUrl True sshdata) notencrypted $ - enableRsyncNetGCrypt' sshdata reponame + checkGCryptRepoEncryption (genSshUrl sshdata) notencrypted $ + enableGCrypt sshdata reponame where notencrypted = error "Unexpectedly found a non-encrypted git repository, instead of the expected encrypted git repository." -enableRsyncNetGCrypt' :: SshData -> RemoteName -> Handler Html -enableRsyncNetGCrypt' sshdata reponame = - setupCloudRemote TransferGroup $ - enableSpecialRemote reponame GCrypt.remote $ M.fromList - [("gitrepo", sshUrl True sshdata)] {- Prepares rsync.net ssh key, and if successful, runs an action with - its SshData. -} @@ -427,7 +433,7 @@ prepRsyncNet sshinput reponame a = do (mkSshData sshinput) { sshRepoName = reponame , needsPubKey = True - , rsyncOnly = True + , sshCapabilities = [RsyncCapable] } {- I'd prefer to separate commands with && , but - rsync.net's shell does not support that. diff --git a/Assistant/WebApp/Configurators/WebDAV.hs b/Assistant/WebApp/Configurators/WebDAV.hs index 67701768ce..062e257ce9 100644 --- a/Assistant/WebApp/Configurators/WebDAV.hs +++ b/Assistant/WebApp/Configurators/WebDAV.hs @@ -126,7 +126,8 @@ postEnableWebDAVR _ = error "WebDAV not supported by this build" makeWebDavRemote :: SpecialRemoteMaker -> RemoteName -> CredPair -> RemoteConfig -> Handler () makeWebDavRemote maker name creds config = do liftIO $ WebDAV.setCredsEnv creds - setupCloudRemote TransferGroup $ maker name WebDAV.remote config + setupCloudRemote TransferGroup Nothing $ + maker name WebDAV.remote config {- Only returns creds previously used for the same hostname. -} previouslyUsedWebDAVCreds :: String -> Annex (Maybe CredPair) diff --git a/Assistant/WebApp/Utility.hs b/Assistant/WebApp/Utility.hs index d922de8bd9..5b5ff2cdfb 100644 --- a/Assistant/WebApp/Utility.hs +++ b/Assistant/WebApp/Utility.hs @@ -20,6 +20,7 @@ import qualified Remote.List as Remote import qualified Assistant.Threads.Transferrer as Transferrer import Logs.Transfer import qualified Config +import Config.Cost import Config.Files import Git.Config import Assistant.Threads.Watcher @@ -125,12 +126,13 @@ getCurrentTransfers :: Handler TransferMap getCurrentTransfers = currentTransfers <$> liftAssistant getDaemonStatus {- Runs an action that creates or enables a cloud remote, - - and finishes setting it up; adding it to a group if it's not already in - - one, starts syncing with it, and finishes by displaying the page to edit - - it. -} -setupCloudRemote :: StandardGroup -> Annex RemoteName -> Handler a -setupCloudRemote defaultgroup maker = do + - and finishes setting it up, then starts syncing with it, + - and finishes by displaying the page to edit it. -} +setupCloudRemote :: StandardGroup -> Maybe Cost -> Annex RemoteName -> Handler a +setupCloudRemote defaultgroup mcost maker = do r <- liftAnnex $ addRemote maker - liftAnnex $ setStandardGroup (Remote.uuid r) defaultgroup + liftAnnex $ do + setStandardGroup (Remote.uuid r) defaultgroup + maybe noop (Config.setRemoteCost r) mcost liftAssistant $ syncRemote r redirect $ EditNewCloudRepositoryR $ Remote.uuid r diff --git a/Assistant/WebApp/routes b/Assistant/WebApp/routes index 813c10b2d8..552dcd5daa 100644 --- a/Assistant/WebApp/routes +++ b/Assistant/WebApp/routes @@ -44,6 +44,7 @@ /config/repository/add/ssh/retry/#SshData RetrySshR GET /config/repository/add/ssh/make/git/#SshData MakeSshGitR GET /config/repository/add/ssh/make/rsync/#SshData MakeSshRsyncR GET +/config/repository/add/ssh/make/gcrypt/#SshData/#RepoKey MakeSshGCryptR GET /config/repository/add/cloud/rsync.net AddRsyncNetR GET POST /config/repository/add/cloud/rsync.net/shared/#SshData MakeRsyncNetSharedR GET /config/repository/add/cloud/rsync.net/gcrypt/#SshData/#RepoKey MakeRsyncNetGCryptR GET diff --git a/Command/GCryptSetup.hs b/Command/GCryptSetup.hs new file mode 100644 index 0000000000..a27e470c1b --- /dev/null +++ b/Command/GCryptSetup.hs @@ -0,0 +1,35 @@ +{- git-annex command + - + - Copyright 2013 Joey Hess + - + - Licensed under the GNU GPL version 3 or higher. + -} + +module Command.GCryptSetup where + +import Common.Annex +import Command +import Annex.UUID +import qualified Remote.GCrypt +import qualified Git + +def :: [Command] +def = [dontCheck repoExists $ noCommit $ + command "gcryptsetup" paramValue seek + SectionPlumbing "sets up gcrypt repository"] + +seek :: [CommandSeek] +seek = [withStrings start] + +start :: String -> CommandStart +start gcryptid = next $ next $ do + g <- gitRepo + u <- getUUID + gu <- Remote.GCrypt.getGCryptUUID True g + if u == NoUUID && gu == Nothing + then if Git.repoIsLocalBare g + then do + void $ Remote.GCrypt.setupRepo gcryptid g + return True + else error "cannot use gcrypt in a non-bare repository" + else error "gcryptsetup permission denied" diff --git a/Git/Config.hs b/Git/Config.hs index db795b7a78..a41712addf 100644 --- a/Git/Config.hs +++ b/Git/Config.hs @@ -177,3 +177,14 @@ fromFile r f = fromPipe r "git" , File f , Param "--list" ] + +{- Changes a git config setting in the specified config file. + - (Creates the file if it does not already exist.) -} +changeFile :: FilePath -> String -> String -> IO Bool +changeFile f k v = boolSystem "git" + [ Param "config" + , Param "--file" + , File f + , Param k + , Param v + ] diff --git a/GitAnnexShell.hs b/GitAnnexShell.hs index c34b3b3070..b5f6804e77 100644 --- a/GitAnnexShell.hs +++ b/GitAnnexShell.hs @@ -30,24 +30,26 @@ import qualified Command.RecvKey import qualified Command.SendKey import qualified Command.TransferInfo import qualified Command.Commit +import qualified Command.GCryptSetup cmds_readonly :: [Command] cmds_readonly = concat - [ Command.ConfigList.def - , Command.InAnnex.def - , Command.SendKey.def - , Command.TransferInfo.def + [ gitAnnexShellCheck Command.ConfigList.def + , gitAnnexShellCheck Command.InAnnex.def + , gitAnnexShellCheck Command.SendKey.def + , gitAnnexShellCheck Command.TransferInfo.def ] cmds_notreadonly :: [Command] cmds_notreadonly = concat - [ Command.RecvKey.def - , Command.DropKey.def - , Command.Commit.def + [ gitAnnexShellCheck Command.RecvKey.def + , gitAnnexShellCheck Command.DropKey.def + , gitAnnexShellCheck Command.Commit.def + , Command.GCryptSetup.def ] cmds :: [Command] -cmds = map gitAnnexShellCheck $ map adddirparam $ cmds_readonly ++ cmds_notreadonly +cmds = map adddirparam $ cmds_readonly ++ cmds_notreadonly where adddirparam c = c { cmdparamdesc = "DIRECTORY " ++ cmdparamdesc c } @@ -191,8 +193,8 @@ checkEnv var = do {- Modifies a Command to check that it is run in either a git-annex - repository, or a repository with a gcrypt-id set. -} -gitAnnexShellCheck :: Command -> Command -gitAnnexShellCheck = addCheck okforshell . dontCheck repoExists +gitAnnexShellCheck :: [Command] -> [Command] +gitAnnexShellCheck = map $ addCheck okforshell . dontCheck repoExists where okforshell = unlessM (isInitialized <||> isJust . gcryptId <$> Annex.getGitConfig) $ error "Not a git-annex or gcrypt repository." diff --git a/Remote/GCrypt.hs b/Remote/GCrypt.hs index acbf3cd68a..8ba640bac5 100644 --- a/Remote/GCrypt.hs +++ b/Remote/GCrypt.hs @@ -9,7 +9,8 @@ module Remote.GCrypt ( remote, gen, getGCryptUUID, - coreGCryptId + coreGCryptId, + setupRepo ) where import qualified Data.Map as M @@ -163,7 +164,7 @@ gCryptSetup mu c = go $ M.lookup "gitrepo" c {- Run a git fetch and a push to the git repo in order to get - its gcrypt-id set up, so that later git annex commands - - will use the remote as a ggcrypt remote. The fetch is + - will use the remote as a gcrypt remote. The fetch is - needed if the repo already exists; the push is needed - if the repo has not yet been initialized by gcrypt. -} void $ inRepo $ Git.Command.runBool @@ -185,51 +186,50 @@ gCryptSetup mu c = go $ M.lookup "gitrepo" c method <- setupRepo gcryptid =<< inRepo (Git.Construct.fromRemoteLocation gitrepo) gitConfigSpecialRemote u c' "gcrypt" (fromAccessMethod method) return (c', u) - else error "uuid mismatch" + else error $ "uuid mismatch " ++ show (u, mu, gcryptid) {- Sets up the gcrypt repository. The repository is either a local - repo, or it is accessed via rsync directly, or it is accessed over ssh - and git-annex-shell is available to manage it. - - - The gcrypt-id is stored in the gcrypt repository for later - - double-checking and identification. This is always done using rsync. + - The GCryptID is recorded in the repository's git config for later use. + - Also, if the git config has receive.denyNonFastForwards set, disable + - it; gcrypt relies on being able to fast-forward branches. -} setupRepo :: Git.GCrypt.GCryptId -> Git.Repo -> Annex AccessMethod setupRepo gcryptid r | Git.repoIsUrl r = do - accessmethod <- rsyncsetup + (_, _, accessmethod) <- rsyncTransport r case accessmethod of - AccessDirect -> return AccessDirect - AccessShell -> ifM usablegitannexshell + AccessDirect -> rsyncsetup + AccessShell -> ifM gitannexshellsetup ( return AccessShell - , return AccessDirect + , rsyncsetup ) | Git.repoIsLocalUnknown r = localsetup =<< liftIO (Git.Config.read r) | otherwise = localsetup r where localsetup r' = do - liftIO $ Git.Command.run [Param "config", Param coreGCryptId, Param gcryptid] r' + let setconfig k v = liftIO $ Git.Command.run [Param "config", Param k, Param v] r' + setconfig coreGCryptId gcryptid + setconfig denyNonFastForwards (Git.Config.boolConfig False) return AccessDirect - {- Download any git config file from the remote, - - add the gcryptid to it, and send it back. - - - - At the same time, create the objectDir on the remote, - - which is needed for direct rsync to work. + {- As well as modifying the remote's git config, + - create the objectDir on the remote, + - which is needed for direct rsync of objects to work. -} rsyncsetup = Remote.Rsync.withRsyncScratchDir $ \tmp -> do liftIO $ createDirectoryIfMissing True $ tmp objectDir - (rsynctransport, rsyncurl, accessmethod) <- rsyncTransport r + (rsynctransport, rsyncurl, _) <- rsyncTransport r let tmpconfig = tmp "config" void $ liftIO $ rsync $ rsynctransport ++ [ Param $ rsyncurl ++ "/config" , Param tmpconfig ] - liftIO $ appendFile tmpconfig $ unlines - [ "" - , "[core]" - , "\tgcrypt-id = " ++ gcryptid - ] + liftIO $ do + void $ Git.Config.changeFile tmpconfig coreGCryptId gcryptid + void $ Git.Config.changeFile tmpconfig denyNonFastForwards (Git.Config.boolConfig False) ok <- liftIO $ rsync $ rsynctransport ++ [ Params "--recursive" , Param $ tmp ++ "/" @@ -237,12 +237,14 @@ setupRepo gcryptid r ] unless ok $ error "Failed to connect to remote to set it up." - return accessmethod + return AccessDirect - {- Check if git-annex shell is installed, and is a new enough - - version to work in a gcrypt repo. -} - usablegitannexshell = either (const False) (const True) - <$> Ssh.onRemote r (Git.Config.fromPipe r, Left undefined) "configlist" [] [] + {- Ask git-annex-shell to configure the repository as a gcrypt + - repository. May fail if it is too old. -} + gitannexshellsetup = Ssh.onRemote r (boolSystem, False) + "gcryptsetup" [ Param gcryptid ] [] + + denyNonFastForwards = "receive.denyNonFastForwards" shellOrRsync :: Remote -> Annex a -> Annex a -> Annex a shellOrRsync r ashell arsync = case method of diff --git a/debian/changelog b/debian/changelog index 6727315c02..f7c79e6ea9 100644 --- a/debian/changelog +++ b/debian/changelog @@ -28,6 +28,8 @@ git-annex (4.20130921) UNRELEASED; urgency=low written by MacGPG. * assistant: More robust inotify handling; avoid crashing if a directory cannot be read. + * Disable receive.denyNonFastForwards when setting up a gcrypt special + remote, since gcrypt needs to be able to fast-forward the master branch. -- Joey Hess Sun, 22 Sep 2013 19:42:29 -0400 diff --git a/doc/design/assistant/encrypted_git_remotes.mdwn b/doc/design/assistant/encrypted_git_remotes.mdwn index 63b7be67a2..915f64d289 100644 --- a/doc/design/assistant/encrypted_git_remotes.mdwn +++ b/doc/design/assistant/encrypted_git_remotes.mdwn @@ -3,14 +3,15 @@ using [git-remote-gcrypt](https://github.com/blake2-ppc/git-remote-gcrypt). There are at least two use cases for this in the assistant: -* Storing an encrypted git repository on a local drive. +* Storing an encrypted git repository on a local drive. **done** * Or on a remote server. This could even allow using github. But more likely would be a shell server that has git-annex-shell on it so can also store file contents, and which is not trusted with unencrypted data. + **done** git-remote-gcrypt is already usable with git-annex. What's needed is to make sure it's installed (ie, get it packaged into distros or embedded -into git-annex), and make it easy to set up from the webapp. +into git-annex), and make it easy to set up from the webapp. **done** Hmm, this will need gpg key creation, so would also be a good opportunity to make the webapp allow using that for special remotes too. @@ -18,4 +19,4 @@ to make the webapp allow using that for special remotes too. One change is needed in git-annex core.. It currently does not support storing encrypted files on git remotes, only on special remotes. Perhaps the way to deal with this is to make it consider git-remote-grypt remotes -to be a special remote type? +to be a special remote type? **done** diff --git a/doc/forum/Android:_is_constant_high_cpu_usage_to_be_expected__63__/comment_1_7880fc38792a1fcbf3e5c47e8bcaabce._comment b/doc/forum/Android:_is_constant_high_cpu_usage_to_be_expected__63__/comment_1_7880fc38792a1fcbf3e5c47e8bcaabce._comment new file mode 100644 index 0000000000..28f3dfb925 --- /dev/null +++ b/doc/forum/Android:_is_constant_high_cpu_usage_to_be_expected__63__/comment_1_7880fc38792a1fcbf3e5c47e8bcaabce._comment @@ -0,0 +1,8 @@ +[[!comment format=mdwn + username="https://www.google.com/accounts/o8/id?id=AItOawmKKg3Vmzk7KwRGRKjHVdtyoj1JfxLX6NM" + nickname="Tom" + subject="comment 1" + date="2013-10-01T17:38:03Z" + content=""" +I've had this issue as well. Saw a comment on Joey's blog that implies he knows about it and that a fix will be released soon. +"""]] diff --git a/doc/forum/Import_options/comment_2_21da91f08cb6b28ae3e79ade033db516._comment b/doc/forum/Import_options/comment_2_21da91f08cb6b28ae3e79ade033db516._comment new file mode 100644 index 0000000000..a3e2596248 --- /dev/null +++ b/doc/forum/Import_options/comment_2_21da91f08cb6b28ae3e79ade033db516._comment @@ -0,0 +1,17 @@ +[[!comment format=mdwn + username="https://www.google.com/accounts/o8/id?id=AItOawkeJKC5Sy0stmcTWyePOLEVv0G-x1yaT_w" + nickname="Josef" + subject="Additional Comments" + date="2013-09-30T21:33:31Z" + content=""" +Imported several thousand files to annex and would like to add the following comments: + +- it would be great to have an option to exclude hidden dot files from import, + +- empty directories should be deleted when files located in the directories are deleted, + +- \"git annex add\" seems to process directories and files alphabetically, unfortunately import processes files in a different order, which makes it hard to predict which files are deleted when deduplicating, + +Cheers, + +"""]] diff --git a/doc/forum/Newbie_stuck_at___34__Unable_to_connect_to_the_Jabber_server__34__/comment_3_92a52b523ed4c68b70ddcabc2a050b76._comment b/doc/forum/Newbie_stuck_at___34__Unable_to_connect_to_the_Jabber_server__34__/comment_3_92a52b523ed4c68b70ddcabc2a050b76._comment new file mode 100644 index 0000000000..9b1d95e788 --- /dev/null +++ b/doc/forum/Newbie_stuck_at___34__Unable_to_connect_to_the_Jabber_server__34__/comment_3_92a52b523ed4c68b70ddcabc2a050b76._comment @@ -0,0 +1,12 @@ +[[!comment format=mdwn + username="https://www.google.com/accounts/o8/id?id=AItOawmKKg3Vmzk7KwRGRKjHVdtyoj1JfxLX6NM" + nickname="Tom" + subject="comment 3" + date="2013-10-01T18:33:05Z" + content=""" +I've got the same issue on Xubuntu 13.04. I installed using this script: https://github.com/zerodogg/scriptbucket/blob/master/gitannex-install + +`git-annex version` makes no mention of DNS or ADNS + +`host` command is installed on my machine. any suggestions on how best to fix for this setup? +"""]] diff --git a/doc/git-annex-shell.mdwn b/doc/git-annex-shell.mdwn index 38659d0e28..c866154acb 100644 --- a/doc/git-annex-shell.mdwn +++ b/doc/git-annex-shell.mdwn @@ -60,6 +60,10 @@ first "/~/" or "/~user/" is expanded to the specified home directory. This commits any staged changes to the git-annex branch. It also runs the annex-content hook. +* gcryptsetup gcryptid + + Sets up a repository as a gcrypt repository. + # OPTIONS Most options are the same as in git-annex. The ones specific diff --git a/templates/configurators/rsync.net/encrypt.hamlet b/templates/configurators/rsync.net/encrypt.hamlet index 62811b30ad..af256eee4c 100644 --- a/templates/configurators/rsync.net/encrypt.hamlet +++ b/templates/configurators/rsync.net/encrypt.hamlet @@ -26,11 +26,11 @@

$forall (keyid, name) <- secretkeys

- + Encrypt repository # to ^{gpgKeyDisplay keyid (Just name)}

- + Encrypt repository # with a new encryption key ^{genKeyModal} diff --git a/templates/configurators/ssh/confirm.hamlet b/templates/configurators/ssh/confirm.hamlet index f880589817..e708271a2e 100644 --- a/templates/configurators/ssh/confirm.hamlet +++ b/templates/configurators/ssh/confirm.hamlet @@ -3,45 +3,69 @@ Ready to add remote server

-

- The server #{sshHostName sshdata} has been verified to be usable. -

- You have two options for how to use the server: -

- $if not (rsyncOnly sshdata) - - Use a git repository on the server - $else - - Use a git repository on the server (not available) # - - Retry -
+ $if not (hasCapability sshdata GitAnnexShellCapable) +

# - - The server needs git and git-annex installed to use this option. -
- All your data will be uploaded to the server, including the full # - git repository. This is a great choice if you want to set up # - other devices to use the same server, or share the repository with # - others. -

- -or- + The server #{sshHostName sshdata} can be used as is, but # + installing # + $if not (hasCapability sshdata GitCapable) + git and git-annex # + $else + git-annex # + on it would make it work better, and provide more options below. # +

+ If you're able to install software on the server, do so and click + + Retry + $else +

+ The server #{sshHostName sshdata} has been verified to be usable. # + Depending on whether you trust this server, you can choose between # + storing your data on it encrypted, or unencrypted. +

+ Unencrypted repository +

+ All your data will be uploaded to the server, including a clone of # + the git repository. This is a good choice if you want to set up # + other devices to use the same server, or share the repository with # + others. +

+ + Make an unencrypted git repository on the server +

+ -or- +

+ Simple shared encryption

- - Use an encrypted rsync repository on the server -
- The contents of your files will be stored, fully encrypted, on the # - server. The server will not store other information about your # - git repository. This is the best choice if you don't run the server # - yourself, or have sensitive data. -

- $if needsPubKey sshdata -
- # - A ssh key will be installed on the server, allowing git-annex to # - access it securely without a password. + This allows everyone who has a clone of this repository to # + decrypt the files stored on #{sshHostName sshdata}. That makes # + it good for sharing. And it's easy to set up and use. +

+ + Use shared encryption + $if hasCapability sshdata GitCapable +

+ -or- +

+ Encrypt with GnuPG key +

+ This stores an encrypted clone of your repository on # + #{sshHostName sshdata}, unlike shared encryption which only # + stores file contents there. So it's good for backups. But the # + encryption will prevent you from sharing the repository with # + friends, or easily accessing its contents on another computer. +

+ $forall (keyid, name) <- secretkeys +

+ + Encrypt repository # + to ^{gpgKeyDisplay keyid (Just name)} +

+ + Encrypt repository # + with a new encryption key ^{sshTestModal} +^{genKeyModal}