From d83a244986eaa90f797a78b9d514627eb27f396c Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Sun, 29 Sep 2013 14:39:10 -0400 Subject: [PATCH 01/13] UI for making encrypted ssh remotes with gcrypt Improved probing the remote server, so it gathers a list of the capabilities it has. From that list, we can determine which types of remotes are supported, and display an appropriate UI. The new buttons for making gcrypt repos don't work yet, but the old buttons for unencrypted git repo and encrypted rsync repo have been adapted to the new data types and are working. This commit was sponsored by David Schmitt. --- Assistant/MakeRemote.hs | 21 ++-- Assistant/Pairing/MakeRemote.hs | 8 +- Assistant/Ssh.hs | 8 +- Assistant/WebApp/Configurators/AWS.hs | 3 +- Assistant/WebApp/Configurators/Ssh.hs | 88 +++++++++-------- Assistant/WebApp/Configurators/WebDAV.hs | 3 +- Assistant/WebApp/Utility.hs | 14 +-- Assistant/WebApp/routes | 1 + .../configurators/rsync.net/encrypt.hamlet | 4 +- templates/configurators/ssh/confirm.hamlet | 96 ++++++++++++------- 10 files changed, 141 insertions(+), 105 deletions(-) diff --git a/Assistant/MakeRemote.hs b/Assistant/MakeRemote.hs index 2619039c0e..1880d519e3 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,17 +27,12 @@ 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 ssh or rsync remote. -} +makeSshRemote :: Bool -> SshData -> Annex RemoteName +makeSshRemote forcersync sshdata = + maker (sshRepoName sshdata) (sshUrl forcersync sshdata) where - rsync = forcersync || rsyncOnly sshdata + rsync = forcersync || sshCapabilities sshdata == [RsyncCapable] maker | rsync = makeRsyncRemote | otherwise = makeGitRemote @@ -48,7 +40,7 @@ makeSshRemote forcersync sshdata mcost = do {- 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) + if (forcersync || sshCapabilities sshdata == [RsyncCapable]) then [u, h, T.pack ":", sshDirectory sshdata] else [T.pack "ssh://", u, h, d] where @@ -146,7 +138,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..47811963b1 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 @@ -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 False 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..9df9b64b9b 100644 --- a/Assistant/Ssh.hs +++ b/Assistant/Ssh.hs @@ -25,10 +25,16 @@ 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 + data SshKeyPair = SshKeyPair { sshPubKey :: String , sshPrivKey :: String 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/Ssh.hs b/Assistant/WebApp/Configurators/Ssh.hs index 5ac24ab6e8..7f516376c4 100644 --- a/Assistant/WebApp/Configurators/Ssh.hs +++ b/Assistant/WebApp/Configurators/Ssh.hs @@ -17,7 +17,6 @@ import Assistant.MakeRemote import Utility.Rsync (rsyncUrlIsShell) import Logs.Remote import Remote -import Logs.PreferredContent import Types.StandardGroups import Utility.UserInfo import Utility.Gpg @@ -54,7 +53,7 @@ mkSshData s = SshData (maybe "" T.unpack $ inputDirectory s) , sshPort = inputPort s , needsPubKey = False - , rsyncOnly = False + , sshCapabilities = [] -- untested } mkSshInput :: SshData -> SshInput @@ -103,15 +102,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 @@ -143,7 +139,7 @@ postEnableRsyncR :: UUID -> Handler Html postEnableRsyncR = enableSpecialSshRemote "rsyncurl" enableRsyncNet enablersync where enablersync sshdata = redirect $ ConfirmSshR $ - sshdata { rsyncOnly = True } + sshdata { sshCapabilities = [RsyncCapable] } {- This only handles gcrypt repositories that are located on ssh servers; - ones on local drives are handled via another part of the UI. -} @@ -214,8 +210,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 +220,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 +254,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 +289,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 () @@ -300,6 +305,9 @@ getMakeSshGitR = makeSsh False getMakeSshRsyncR :: SshData -> Handler Html getMakeSshRsyncR = makeSsh True +getMakeSshGCryptR :: SshData -> RepoKey -> Handler Html +getMakeSshGCryptR sshdata repokey = error "TODO" + makeSsh :: Bool -> SshData -> Handler Html makeSsh rsync sshdata | needsPubKey sshdata = do @@ -312,27 +320,25 @@ makeSsh rsync sshdata | otherwise = makeSsh' rsync sshdata sshdata Nothing makeSsh' :: Bool -> SshData -> SshData -> Maybe SshKeyPair -> Handler Html -makeSsh' rsync origsshdata sshdata keypair = do +makeSsh' rsynconly origsshdata sshdata keypair = do sshSetup ["-p", show (sshPort origsshdata), sshhost, remoteCommand] "" $ - makeSshRepo rsync sshdata + makeSshRepo rsynconly 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 rsynconly then Nothing else Just "if [ ! -d .git ]; then git init --bare --shared; fi" + , if rsynconly then Nothing else Just "git annex init" , if needsPubKey sshdata - then addAuthorizedKeysCommand (rsync || rsyncOnly sshdata) remotedir . sshPubKey <$> keypair + then addAuthorizedKeysCommand rsynconly remotedir . sshPubKey <$> keypair else Nothing ] 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 forcersync sshdata = setupCloudRemote TransferGroup Nothing $ + makeSshRemote forcersync sshdata getAddRsyncNetR :: Handler Html getAddRsyncNetR = postAddRsyncNetR @@ -394,7 +400,7 @@ getMakeRsyncNetGCryptR sshdata NoRepoKey = whenGcryptInstalled $ withNewSecretKey $ getMakeRsyncNetGCryptR sshdata . RepoKey getMakeRsyncNetGCryptR sshdata (RepoKey keyid) = whenGcryptInstalled $ do sshSetup [sshhost, gitinit] [] $ - setupCloudRemote TransferGroup $ + setupCloudRemote TransferGroup Nothing $ makeGCryptRemote (sshRepoName sshdata) (sshUrl True sshdata) keyid where sshhost = genSshHost (sshHostName sshdata) (sshUserName sshdata) @@ -413,7 +419,7 @@ enableRsyncNetGCrypt sshinput reponame = 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 $ + setupCloudRemote TransferGroup Nothing $ enableSpecialRemote reponame GCrypt.remote $ M.fromList [("gitrepo", sshUrl True 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/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}

From 213377e17c18d04b9a14c8c5077f0b370ad50cdc Mon Sep 17 00:00:00 2001 From: "https://www.google.com/accounts/o8/id?id=AItOawkeJKC5Sy0stmcTWyePOLEVv0G-x1yaT_w" Date: Mon, 30 Sep 2013 21:33:31 +0000 Subject: [PATCH 02/13] Added a comment: Additional Comments --- ..._2_21da91f08cb6b28ae3e79ade033db516._comment | 17 +++++++++++++++++ 1 file changed, 17 insertions(+) create mode 100644 doc/forum/Import_options/comment_2_21da91f08cb6b28ae3e79ade033db516._comment 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, + +"""]] From baf5069d498276ce747900cfd53f681bbed68074 Mon Sep 17 00:00:00 2001 From: "https://www.google.com/accounts/o8/id?id=AItOawmKKg3Vmzk7KwRGRKjHVdtyoj1JfxLX6NM" Date: Tue, 1 Oct 2013 17:38:04 +0000 Subject: [PATCH 03/13] Added a comment --- .../comment_1_7880fc38792a1fcbf3e5c47e8bcaabce._comment | 8 ++++++++ 1 file changed, 8 insertions(+) create mode 100644 doc/forum/Android:_is_constant_high_cpu_usage_to_be_expected__63__/comment_1_7880fc38792a1fcbf3e5c47e8bcaabce._comment 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. +"""]] From 61e06c972ff685e8fadcb371366ad8ad804bbc9f Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Tue, 1 Oct 2013 13:43:35 -0400 Subject: [PATCH 04/13] webapp can now set up gcrypt repos on ssh servers --- Assistant/MakeRemote.hs | 16 ++- Assistant/Pairing/MakeRemote.hs | 4 +- Assistant/Ssh.hs | 21 ++-- Assistant/WebApp/Configurators/Pairing.hs | 2 +- Assistant/WebApp/Configurators/Ssh.hs | 114 ++++++++++++---------- 5 files changed, 87 insertions(+), 70 deletions(-) diff --git a/Assistant/MakeRemote.hs b/Assistant/MakeRemote.hs index 1880d519e3..d85bf0fd7c 100644 --- a/Assistant/MakeRemote.hs +++ b/Assistant/MakeRemote.hs @@ -27,20 +27,18 @@ import Utility.Gpg (KeyId) import qualified Data.Text as T import qualified Data.Map as M -{- Sets up a new ssh or rsync remote. -} -makeSshRemote :: Bool -> SshData -> Annex RemoteName -makeSshRemote forcersync sshdata = - maker (sshRepoName sshdata) (sshUrl forcersync sshdata) +{- 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 || sshCapabilities sshdata == [RsyncCapable] 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 || sshCapabilities sshdata == [RsyncCapable]) +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 diff --git a/Assistant/Pairing/MakeRemote.hs b/Assistant/Pairing/MakeRemote.hs index 47811963b1..144b236a41 100644 --- a/Assistant/Pairing/MakeRemote.hs +++ b/Assistant/Pairing/MakeRemote.hs @@ -24,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 @@ -45,7 +45,7 @@ finishedLocalPairing msg keypair = do , "git-annex-shell -c configlist " ++ T.unpack (sshDirectory sshdata) ] Nothing - r <- liftAnnex $ addRemote $ makeSshRemote False sshdata + r <- liftAnnex $ addRemote $ makeSshRemote sshdata liftAnnex $ setRemoteCost r semiExpensiveRemoteCost syncRemote r diff --git a/Assistant/Ssh.hs b/Assistant/Ssh.hs index 9df9b64b9b..c6514e6130 100644 --- a/Assistant/Ssh.hs +++ b/Assistant/Ssh.hs @@ -35,6 +35,9 @@ data SshServerCapability = GitAnnexShellCapable | GitCapable | RsyncCapable 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 @@ -98,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 @@ -116,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 ++ " ]" @@ -128,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" ] ] @@ -147,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/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 7f516376c4..91c6ab2127 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. -} @@ -147,16 +147,19 @@ getEnableGCryptR :: UUID -> Handler Html getEnableGCryptR = postEnableGCryptR postEnableGCryptR :: UUID -> Handler Html postEnableGCryptR u = whenGcryptInstalled $ - enableSpecialSshRemote "gitrepo" enableRsyncNetGCrypt enablersync u + enableSpecialSshRemote "gitrepo" 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." {- To enable an 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 :: RemoteConfigKey -> (SshInput -> RemoteName -> Handler Html) -> (SshData -> Handler Html) -> UUID -> Handler Html enableSpecialSshRemote urlkey rsyncnetsetup genericsetup u = do m <- fromMaybe M.empty . M.lookup u <$> liftAnnex readRemoteLog case (parseSshRsyncUrl =<< M.lookup urlkey m, M.lookup "name" m) of @@ -171,7 +174,7 @@ 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 @@ -300,29 +303,58 @@ 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 + +rsyncOnly :: SshData -> SshData +rsyncOnly sshdata = sshdata { sshCapabilities = [RsyncCapable] } getMakeSshGCryptR :: SshData -> RepoKey -> Handler Html -getMakeSshGCryptR sshdata repokey = error "TODO" +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 = sshUrl sshdata -makeSsh :: Bool -> SshData -> Handler Html -makeSsh rsync 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", sshUrl 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' rsynconly origsshdata sshdata keypair = do - sshSetup ["-p", show (sshPort origsshdata), sshhost, remoteCommand] "" $ - makeSshRepo rsynconly sshdata +prepSsh' :: Bool -> SshData -> SshData -> Maybe SshKeyPair -> (SshData -> Handler Html) -> Handler Html +prepSsh' gcrypt origsshdata sshdata keypair a = + sshSetup ["-p", show (sshPort origsshdata), sshhost, remoteCommand] "" (a origsshdata) where sshhost = genSshHost (sshHostName origsshdata) (sshUserName origsshdata) remotedir = T.unpack $ sshDirectory sshdata @@ -330,15 +362,20 @@ makeSsh' rsynconly origsshdata sshdata keypair = do [ Just $ "mkdir -p " ++ shellEscape remotedir , Just $ "cd " ++ shellEscape remotedir , if rsynconly then Nothing else Just "if [ ! -d .git ]; then git init --bare --shared; fi" - , if rsynconly then Nothing else Just "git annex init" + , if (rsynconly || gcrypt) then Nothing else Just "git annex init" , if needsPubKey sshdata - then addAuthorizedKeysCommand rsynconly remotedir . sshPubKey <$> keypair + then addAuthorizedKeysCommand (hasCapability sshdata GitAnnexShellCapable) remotedir . sshPubKey <$> keypair else Nothing ] + rsynconly = onlyCapability sshdata RsyncCapable -makeSshRepo :: Bool -> SshData -> Handler Html -makeSshRepo forcersync sshdata = setupCloudRemote TransferGroup Nothing $ - makeSshRemote forcersync sshdata +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) (sshUrl sshdata) keyid getAddRsyncNetR :: Handler Html getAddRsyncNetR = postAddRsyncNetR @@ -372,56 +409,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 Nothing $ - 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 (sshUrl 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 Nothing $ - enableSpecialRemote reponame GCrypt.remote $ M.fromList - [("gitrepo", sshUrl True sshdata)] {- Prepares rsync.net ssh key, and if successful, runs an action with - its SshData. -} From 995e1e3c5d6285c0050db95cc24909fd7580a42c Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Tue, 1 Oct 2013 14:10:45 -0400 Subject: [PATCH 05/13] fix transferring to gcrypt repo from direct mode repo recvkey was told it was receiving a HMAC key from a direct mode repo, and that confused it into rejecting the transfer, since it has no way to verify a key using that backend, since there is no HMAC backend. I considered making recvkey skip verification in the case of an unknown backend. However, that could lead to bad results; a key can legitimately be in the annex with a backend that the remote git-annex-shell doesn't know about. Better to keep it rejecting if it cannot verify. Instead, made the gcrypt special remote not set the direct mode flag when sending (and receiving) files. Also, added some recvkey messages when its checks fail, since otherwise all that is shown is a confusing error message from rsync when the remote git-annex-shell exits nonzero. --- Command/RecvKey.hs | 17 ++++++++++++++--- Remote/GCrypt.hs | 4 ++-- Remote/Git.hs | 10 ++++++---- Remote/Helper/Ssh.hs | 6 ++---- 4 files changed, 24 insertions(+), 13 deletions(-) diff --git a/Command/RecvKey.hs b/Command/RecvKey.hs index eb2c88ca97..3b2a8c496a 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 b099430523..475a4785f9 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 diff --git a/Remote/Git.hs b/Remote/Git.hs index 0f3f358116..e8ab572816 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 82c7c38964..35655f00b2 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 From caa5116c0a9ac123037e2ff7705919e607dc58ef Mon Sep 17 00:00:00 2001 From: "https://www.google.com/accounts/o8/id?id=AItOawmKKg3Vmzk7KwRGRKjHVdtyoj1JfxLX6NM" Date: Tue, 1 Oct 2013 18:33:06 +0000 Subject: [PATCH 06/13] Added a comment --- ...mment_3_92a52b523ed4c68b70ddcabc2a050b76._comment | 12 ++++++++++++ 1 file changed, 12 insertions(+) create mode 100644 doc/forum/Newbie_stuck_at___34__Unable_to_connect_to_the_Jabber_server__34__/comment_3_92a52b523ed4c68b70ddcabc2a050b76._comment 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? +"""]] From 101099f7b573d53644fb07b207614ac31eee13fc Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Tue, 1 Oct 2013 14:38:20 -0400 Subject: [PATCH 07/13] fix probing for local gcrypt repos --- Remote/GCrypt.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/Remote/GCrypt.hs b/Remote/GCrypt.hs index 475a4785f9..acbf3cd68a 100644 --- a/Remote/GCrypt.hs +++ b/Remote/GCrypt.hs @@ -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" [] [] From 1536ebfe477634d50b1be24ec0d44a0a694cee93 Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Tue, 1 Oct 2013 15:16:20 -0400 Subject: [PATCH 08/13] Disable receive.denyNonFastForwards when setting up a gcrypt special remote gcrypt needs to be able to fast-forward the master branch. If a git repository is set up with git init --shared --bare, it gets that set, and pushing to it will then fail, even when it's up-to-date. --- Git/Config.hs | 11 +++++++++++ Remote/GCrypt.hs | 27 ++++++++++++++------------- debian/changelog | 2 ++ 3 files changed, 27 insertions(+), 13 deletions(-) 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/Remote/GCrypt.hs b/Remote/GCrypt.hs index acbf3cd68a..3f2a80172a 100644 --- a/Remote/GCrypt.hs +++ b/Remote/GCrypt.hs @@ -191,8 +191,9 @@ gCryptSetup mu c = go $ M.lookup "gitrepo" c - 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 @@ -208,14 +209,14 @@ setupRepo gcryptid 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 @@ -225,11 +226,9 @@ setupRepo gcryptid r [ Param $ rsyncurl ++ "/config" , Param tmpconfig ] - liftIO $ appendFile tmpconfig $ unlines - [ "" - , "[core]" - , "\tgcrypt-id = " ++ gcryptid - ] + liftIO $ do + Git.Config.changeFile tmpconfig coreGCryptId gcryptid + Git.Config.changeFile tmpconfig denyNonFastForwards (Git.Config.boolConfig False) ok <- liftIO $ rsync $ rsynctransport ++ [ Params "--recursive" , Param $ tmp ++ "/" @@ -244,6 +243,8 @@ setupRepo gcryptid r usablegitannexshell = either (const False) (const True) <$> Ssh.onRemote r (Git.Config.fromPipe r, Left undefined) "configlist" [] [] + denyNonFastForwards = "receive.denyNonFastForwards" + shellOrRsync :: Remote -> Annex a -> Annex a -> Annex a shellOrRsync r ashell arsync = case method of AccessShell -> ashell 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 From 5f9f7024e9915317737a375714b629c00a932a0b Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Tue, 1 Oct 2013 16:08:01 -0400 Subject: [PATCH 09/13] enabling ssh gcrypt now works --- Assistant/MakeRemote.hs | 20 +---------- Assistant/Ssh.hs | 45 ++++++++++++++++++++++- Assistant/WebApp/Configurators/Ssh.hs | 52 +++++++++------------------ 3 files changed, 62 insertions(+), 55 deletions(-) diff --git a/Assistant/MakeRemote.hs b/Assistant/MakeRemote.hs index d85bf0fd7c..32a3fd6f52 100644 --- a/Assistant/MakeRemote.hs +++ b/Assistant/MakeRemote.hs @@ -24,34 +24,16 @@ import Creds import Assistant.Gpg import Utility.Gpg (KeyId) -import qualified Data.Text as T import qualified Data.Map as M {- Sets up a new git or rsync remote, accessed over ssh. -} makeSshRemote :: SshData -> Annex RemoteName -makeSshRemote sshdata = maker (sshRepoName sshdata) (sshUrl sshdata) +makeSshRemote sshdata = maker (sshRepoName sshdata) (genSshUrl sshdata) where maker | onlyCapability sshdata RsyncCapable = makeRsyncRemote | otherwise = makeGitRemote -{- Generates a ssh or rsync url from a 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 - 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 diff --git a/Assistant/Ssh.hs b/Assistant/Ssh.hs index c6514e6130..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) @@ -61,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 diff --git a/Assistant/WebApp/Configurators/Ssh.hs b/Assistant/WebApp/Configurators/Ssh.hs index 91c6ab2127..7e8eb31962 100644 --- a/Assistant/WebApp/Configurators/Ssh.hs +++ b/Assistant/WebApp/Configurators/Ssh.hs @@ -14,13 +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 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 @@ -136,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 { 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. -} @@ -147,22 +147,23 @@ getEnableGCryptR :: UUID -> Handler Html getEnableGCryptR = postEnableGCryptR postEnableGCryptR :: UUID -> Handler Html postEnableGCryptR u = whenGcryptInstalled $ - enableSpecialSshRemote "gitrepo" enableRsyncNetGCrypt enablegcrypt u + enableSpecialSshRemote getsshinput enableRsyncNetGCrypt enablegcrypt u where 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 Html) -> 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 @@ -179,33 +180,14 @@ enableSpecialSshRemote urlkey rsyncnetsetup genericsetup u = do _ -> 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 @@ -331,14 +313,14 @@ checkExistingGCrypt sshdata nope = ifM (liftIO isGcryptInstalled) , nope ) where - repourl = sshUrl sshdata + 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", sshUrl sshdata)] + [("gitrepo", genSshUrl sshdata)] {- Sets up remote repository for ssh, or directory for rsync. -} prepSsh :: Bool -> SshData -> (SshData -> Handler Html) -> Handler Html @@ -375,7 +357,7 @@ makeSshRepo sshdata = setupCloudRemote TransferGroup Nothing $ makeGCryptRepo :: KeyId -> SshData -> Handler Html makeGCryptRepo keyid sshdata = setupCloudRemote TransferGroup Nothing $ - makeGCryptRemote (sshRepoName sshdata) (sshUrl sshdata) keyid + makeGCryptRemote (sshRepoName sshdata) (genSshUrl sshdata) keyid getAddRsyncNetR :: Handler Html getAddRsyncNetR = postAddRsyncNetR @@ -434,7 +416,7 @@ enableRsyncNet sshinput reponame = enableRsyncNetGCrypt :: SshInput -> RemoteName -> Handler Html enableRsyncNetGCrypt sshinput reponame = prepRsyncNet sshinput reponame $ \sshdata -> - checkGCryptRepoEncryption (sshUrl sshdata) notencrypted $ + checkGCryptRepoEncryption (genSshUrl sshdata) notencrypted $ enableGCrypt sshdata reponame where notencrypted = error "Unexpectedly found a non-encrypted git repository, instead of the expected encrypted git repository." From 245d5590c9805bfad14c1c993d13626a96818a9d Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Tue, 1 Oct 2013 16:16:38 -0400 Subject: [PATCH 10/13] fix use of mangled ssh hostname However, this is not working for gcrypt repos with a mangled hostname. Problem is that the locked down key is installed before the repo is initialized, so git-annex-shell refuses to allow the gcrypt special remote to do its setup. --- Assistant/WebApp/Configurators/Ssh.hs | 14 ++++++++------ 1 file changed, 8 insertions(+), 6 deletions(-) diff --git a/Assistant/WebApp/Configurators/Ssh.hs b/Assistant/WebApp/Configurators/Ssh.hs index 7e8eb31962..811a44babc 100644 --- a/Assistant/WebApp/Configurators/Ssh.hs +++ b/Assistant/WebApp/Configurators/Ssh.hs @@ -335,21 +335,23 @@ prepSsh gcrypt sshdata a | otherwise = prepSsh' gcrypt sshdata sshdata Nothing a prepSsh' :: Bool -> SshData -> SshData -> Maybe SshKeyPair -> (SshData -> Handler Html) -> Handler Html -prepSsh' gcrypt origsshdata sshdata keypair a = - sshSetup ["-p", show (sshPort origsshdata), sshhost, remoteCommand] "" (a origsshdata) +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 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 sshdata - then addAuthorizedKeysCommand (hasCapability sshdata GitAnnexShellCapable) remotedir . sshPubKey <$> keypair + , if needsPubKey origsshdata + then addAuthorizedKeysCommand (hasCapability origsshdata GitAnnexShellCapable) remotedir . sshPubKey <$> keypair else Nothing ] - rsynconly = onlyCapability sshdata RsyncCapable + rsynconly = onlyCapability origsshdata RsyncCapable makeSshRepo :: SshData -> Handler Html makeSshRepo sshdata = setupCloudRemote TransferGroup Nothing $ From bddfbef8bea76dbde1d34e62cc62670387758cb9 Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Tue, 1 Oct 2013 17:20:51 -0400 Subject: [PATCH 11/13] git-annex-shell gcryptsetup command This was the least-bad alternative to get dedicated key gcrypt repos working in the assistant. --- Command/GCryptSetup.hs | 35 +++++++++++++++++++++++++++++++++++ GitAnnexShell.hs | 22 ++++++++++++---------- Remote/GCrypt.hs | 27 ++++++++++++++------------- doc/git-annex-shell.mdwn | 4 ++++ 4 files changed, 65 insertions(+), 23 deletions(-) create mode 100644 Command/GCryptSetup.hs 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/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 3f2a80172a..74facfdc77 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 @@ -198,12 +199,12 @@ gCryptSetup mu c = go $ M.lookup "gitrepo" c 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 @@ -220,15 +221,15 @@ setupRepo gcryptid r -} 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 $ do - Git.Config.changeFile tmpconfig coreGCryptId gcryptid - Git.Config.changeFile tmpconfig denyNonFastForwards (Git.Config.boolConfig False) + 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 ++ "/" @@ -236,12 +237,12 @@ 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" 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 From 0ede6b7def32cef8d4c4313f1abbee4d0a704d09 Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Tue, 1 Oct 2013 19:10:45 -0400 Subject: [PATCH 12/13] typoe and debug info --- Remote/GCrypt.hs | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/Remote/GCrypt.hs b/Remote/GCrypt.hs index 74facfdc77..8ba640bac5 100644 --- a/Remote/GCrypt.hs +++ b/Remote/GCrypt.hs @@ -164,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 @@ -186,7 +186,7 @@ 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 From 7286fbd93ee71f21dfbb2b95940ad4ebaa0e1673 Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Tue, 1 Oct 2013 19:12:08 -0400 Subject: [PATCH 13/13] gcrypt basically done --- doc/design/assistant/encrypted_git_remotes.mdwn | 7 ++++--- 1 file changed, 4 insertions(+), 3 deletions(-) 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**