diff options
Diffstat (limited to 'Assistant')
| -rw-r--r-- | Assistant/Pairing/MakeRemote.hs | 10 | ||||
| -rw-r--r-- | Assistant/Ssh.hs | 19 | ||||
| -rw-r--r-- | Assistant/Threads/PairListener.hs | 5 | ||||
| -rw-r--r-- | Assistant/WebApp/Configurators/Pairing.hs | 43 | ||||
| -rw-r--r-- | Assistant/WebApp/Configurators/Ssh.hs | 2 |
5 files changed, 40 insertions, 39 deletions
diff --git a/Assistant/Pairing/MakeRemote.hs b/Assistant/Pairing/MakeRemote.hs index 9e65f4d13..1b39fcff7 100644 --- a/Assistant/Pairing/MakeRemote.hs +++ b/Assistant/Pairing/MakeRemote.hs @@ -19,6 +19,16 @@ import Assistant.MakeRemote import Network.Socket import qualified Data.Text as T +{- Authorized keys are set up before pairing is complete, so that the other + - side can immediately begin syncing. -} +setupAuthorizedKeys :: PairMsg -> IO () +setupAuthorizedKeys msg = do + validateSshPubKey pubkey + unlessM (liftIO $ addAuthorizedKeys False pubkey) $ + error "failed setting up ssh authorized keys" + where + pubkey = remoteSshPubKey $ pairMsgData msg + {- When pairing is complete, this is used to set up the remote for the host - we paired with. -} finishedPairing :: ThreadState -> DaemonStatusHandle -> ScanRemoteMap -> PairMsg -> SshKeyPair -> IO () diff --git a/Assistant/Ssh.hs b/Assistant/Ssh.hs index ad0749fb7..eefc2a2e2 100644 --- a/Assistant/Ssh.hs +++ b/Assistant/Ssh.hs @@ -101,14 +101,23 @@ validateSshPubKey pubkey = do unless (all (\c -> isAlphaNum c || c == '@') (ws !! 2)) $ error $ "bad comment in ssh public key " ++ pubkey -makeAuthorizedKeys :: Bool -> SshPubKey -> IO Bool -makeAuthorizedKeys rsynconly pubkey = boolSystem "sh" - [ Param "-c" , Param $ makeAuthorizedKeysCommand rsynconly pubkey ] +addAuthorizedKeys :: Bool -> SshPubKey -> IO Bool +addAuthorizedKeys rsynconly pubkey = boolSystem "sh" + [ Param "-c" , Param $ addAuthorizedKeysCommand rsynconly pubkey ] + +removeAuthorizedKeys :: Bool -> SshPubKey -> IO () +removeAuthorizedKeys rsynconly pubkey = do + let keyline = authorizedKeysLine rsynconly pubkey + sshdir <- sshDir + let keyfile = sshdir </> ".authorized_keys" + ls <- lines <$> readFileStrict keyfile + writeFile keyfile $ unlines $ + filter (\l -> not $ l == keyline) ls {- Implemented as a shell command, so it can be run on remote servers over - ssh. -} -makeAuthorizedKeysCommand :: Bool -> SshPubKey -> String -makeAuthorizedKeysCommand rsynconly pubkey = join "&&" $ +addAuthorizedKeysCommand :: Bool -> SshPubKey -> String +addAuthorizedKeysCommand rsynconly pubkey = join "&&" $ [ "mkdir -p ~/.ssh" , "touch ~/.ssh/authorized_keys" , "chmod 600 ~/.ssh/authorized_keys" diff --git a/Assistant/Threads/PairListener.hs b/Assistant/Threads/PairListener.hs index e0ed1217a..5cf20fa70 100644 --- a/Assistant/Threads/PairListener.hs +++ b/Assistant/Threads/PairListener.hs @@ -94,7 +94,7 @@ pairReqReceived False dstatus urlrenderer msg = do {- When a verified PairAck is seen, a host is ready to pair with us, and has - already configured our ssh key. Stop sending PairReqs, finish the pairing, - - and send a few PairDones. + - and send a single PairDone. - - TODO: A stale PairAck might also be seen, after we've finished pairing. - Perhaps our PairDone was not received. To handle this, we keep @@ -106,9 +106,10 @@ pairAckReceived False _ _ _ _ _ = noop -- not verified pairAckReceived True Nothing _ _ _ _ = noop -- not in progress pairAckReceived True (Just pip) st dstatus scanremotes msg = do stopSending dstatus pip + setupAuthorizedKeys msg finishedPairing st dstatus scanremotes msg (inProgressSshKeyPair pip) startSending dstatus pip $ multicastPairMsg - (Just 10) (inProgressSecret pip) PairDone (inProgressPairData pip) + (Just 1) (inProgressSecret pip) PairDone (inProgressPairData pip) {- If we get a verified PairDone, the host has accepted our PairAck, and - has paired with us. Stop sending PairAcks, and finish pairing with them. diff --git a/Assistant/WebApp/Configurators/Pairing.hs b/Assistant/WebApp/Configurators/Pairing.hs index 4ff81c750..dab5bf4f8 100644 --- a/Assistant/WebApp/Configurators/Pairing.hs +++ b/Assistant/WebApp/Configurators/Pairing.hs @@ -1,25 +1,5 @@ {- git-annex assistant webapp configurator for pairing - - - Pairing works like this: - - - - * The user opens StartPairR, which prompts them for a secret. - - * The user submits it. The pairing secret is stored for later. - - A PairReq is broadcast out. - - * On another device, it's received, and that causes its webapp to - - display an Alert. - - * The user there clicks the button, which opens FinishPairR, - - which prompts them for the same secret. - - * The secret is used to verify the PairReq. If it checks out, - - a PairAck is sent, and the other device adds the ssh key from the - - PairReq to its authorized_keys, and sets up the remote. - - * The PairAck is received back at the device that started the process. - - It's verified using the stored secret. The ssh key from the PairAck - - is added. An Alert is displayed noting that the pairing has been set - - up. The pairing secret is removed to prevent anyone cracking the - - crypto. Syncing starts. A PairDone is sent. - - * The PairDone is received, and an alert shown indicating pairing is - - done. - - - Copyright 2012 Joey Hess <joey@kitenet.net> - - Licensed under the GNU GPL version 3 or higher. @@ -38,6 +18,7 @@ import Utility.Yesod #ifdef WITH_PAIRING import Assistant.Common import Assistant.Pairing.Network +import Assistant.Pairing.MakeRemote import Assistant.Ssh import Assistant.Alert import Assistant.DaemonStatus @@ -57,6 +38,7 @@ import qualified Control.Exception as E import Control.Concurrent #endif +{- Starts sending out pair requests. -} getStartPairR :: Handler RepHtml #ifdef WITH_PAIRING getStartPairR = promptSecret Nothing $ startPairing PairReq noop @@ -64,18 +46,18 @@ getStartPairR = promptSecret Nothing $ startPairing PairReq noop getStartPairR = noPairing #endif +{- Runs on the system that responds to a pair request; sets up the ssh + - authorized key first so that the originating host can immediately sync + - with us. -} getFinishPairR :: PairMsg -> Handler RepHtml #ifdef WITH_PAIRING getFinishPairR msg = promptSecret (Just msg) $ \_ secret -> do - setup + liftIO $ setup startPairing PairAck cleanup "" secret where - pubkey = remoteSshPubKey $ pairMsgData msg - setup = do - liftIO $ validateSshPubKey pubkey - unlessM (liftIO $ makeAuthorizedKeys False pubkey) $ - error "failed setting up ssh authorized keys" - cleanup = error "TODO clean up authorized keys and generated ssh key and remove git remote" + setup = setupAuthorizedKeys msg + cleanup = removeAuthorizedKeys False $ + remoteSshPubKey $ pairMsgData msg #else getFinishPairR _ = noPairing #endif @@ -104,7 +86,6 @@ startPairing stage oncancel displaysecret secret = do keypair <- liftIO $ genSshKeyPair dstatus <- daemonStatus <$> lift getYesod urlrender <- lift getUrlRender - let homeurl = urlrender HomeR pairdata <- PairData <$> liftIO getHostname <*> liftIO getUserName @@ -113,7 +94,7 @@ startPairing stage oncancel displaysecret secret = do liftIO $ do let sender = multicastPairMsg Nothing secret stage pairdata let pip = PairingInProgress secret Nothing keypair pairdata - startSending dstatus pip $ sendrequests sender dstatus homeurl + startSending dstatus pip $ sendrequests sender dstatus urlrender lift $ redirect $ InprogressPairR displaysecret where {- Sends pairing messages until the thread is killed, @@ -124,11 +105,11 @@ startPairing stage oncancel displaysecret secret = do - have been on a page specific to the in-process pairing - that just stopped, so can't go back there. -} - sendrequests sender dstatus homeurl = do + sendrequests sender dstatus urlrender = do tid <- myThreadId let selfdestruct = AlertButton { buttonLabel = "Cancel" - , buttonUrl = homeurl + , buttonUrl = urlrender HomeR , buttonAction = Just $ const $ do oncancel killThread tid diff --git a/Assistant/WebApp/Configurators/Ssh.hs b/Assistant/WebApp/Configurators/Ssh.hs index f2e80ff5b..e39291459 100644 --- a/Assistant/WebApp/Configurators/Ssh.hs +++ b/Assistant/WebApp/Configurators/Ssh.hs @@ -204,7 +204,7 @@ makeSsh' rsync sshdata keypair = , if rsync then Nothing else Just $ "git init --bare --shared" , if rsync then Nothing else Just $ "git annex init" , if needsPubKey sshdata - then maybe Nothing (Just . makeAuthorizedKeysCommand (rsyncOnly sshdata) . sshPubKey) keypair + then maybe Nothing (Just . addAuthorizedKeysCommand (rsyncOnly sshdata) . sshPubKey) keypair else Nothing ] |