module Extra.SSH
( sshVerify
, sshExportDeprecated
, sshCopy
) where
import System.Cmd
import System.Directory
import System.Posix.User
import System.Environment
import System.Exit
import System.IO
import System.Process (readProcessWithExitCode, showCommandForUser)
sshExportDeprecated :: String -> Maybe Int -> IO (Either String ())
sshExportDeprecated dest port =
generatePublicKey >>=
either (return . Left) (testAccess dest port) >>=
either (return . Left) (openAccess dest port)
generatePublicKey :: IO (Either String FilePath)
generatePublicKey =
do user <- getEffectiveUserID
home <- getUserEntryForID user >>= return . homeDirectory
let cmd = "yes '' | ssh-keygen -t rsa 2>&1 >/dev/null"
let keypath = home ++ "/.ssh/id_rsa.pub"
exists <- doesFileExist keypath
case exists of
True -> return . Right $ keypath
False ->
do hPutStrLn stderr $ "generatePublicKey " ++ " -> " ++ keypath
code <- system cmd
case code of
ExitFailure n ->
return . Left $ "Failure: " ++ show cmd ++ " -> " ++ show n
_ -> return . Right $ keypath
sshVerify :: String -> Maybe Int -> IO Bool
sshVerify dest port =
do result <- system (sshTestCmd dest port)
return $ case result of
ExitSuccess -> True
ExitFailure _ -> False
where
sshTestCmd dest port =
("ssh -o 'PreferredAuthentications hostbased,publickey' " ++
(maybe "" (("-p " ++) . show) port) ++ " " ++ show dest ++ " pwd > /dev/null && exit 0")
testAccess :: String -> Maybe Int -> FilePath -> IO (Either String (Maybe FilePath))
testAccess dest port keypath =
do flag <- sshVerify dest port
case flag of
True -> return . Right $ Nothing
False -> return . Right . Just $ keypath
openAccess :: String -> Maybe Int -> Maybe FilePath -> IO (Either String ())
openAccess _ _ Nothing = return . Right $ ()
openAccess dest port (Just keypath) =
do hPutStrLn stderr $ "openAccess " ++ show dest ++ " " ++ show port ++ " " ++ show keypath
let args = maybe [] (\ x -> ["-p", show x]) port ++ [show dest, sshOpenRemoteCmd]
(code, out, err) <- readFile keypath >>= readProcessWithExitCode "ssh" args
case code of
ExitFailure n -> return . Left $ "Failure: " ++ showCommandForUser "ssh" args ++ " -> " ++ show n ++
"\n\nstdout: " ++ out ++ "\n\nstderr: " ++ err
_ -> return . Right $ ()
where
sshOpenRemoteCmd =
("chmod g-w . && " ++
"chmod o-rwx . && " ++
"mkdir -p .ssh && " ++
"chmod 700 .ssh && " ++
"cat >> .ssh/authorized_keys2 && " ++
"chmod 600 .ssh/authorized_keys2")
sshCopy :: FilePath -> IO ExitCode
sshCopy root =
do exists <- doesDirectoryExist "~/.ssh"
home <- getEnv "HOME"
case exists of
True -> system ("rsync -aHxSpDt --delete " ++ home ++ "/.ssh/ " ++ root ++ "/root/.ssh && " ++
"chown -R root.root " ++ root ++ "/root/.ssh")
False -> system "mkdir -p /root/.ssh"