webapp: Generate better git remote names.

Wrote a better git remote name sanitizer. Git blows up on lots of weird
stuff, especially if it starts the remote name, but I managed to get
some common punctuation working.
This commit is contained in:
Joey Hess 2012-10-31 15:17:00 -04:00
parent c03d9b2310
commit 39e82b1af8
4 changed files with 40 additions and 10 deletions

View file

@ -10,6 +10,7 @@ module Assistant.Ssh where
import Common.Annex
import Utility.TempFile
import Utility.UserInfo
import Git.Remote
import Data.Text (Text)
import qualified Data.Text as T
@ -51,14 +52,11 @@ sshDir = do
genSshHost :: Text -> Maybe Text -> String
genSshHost host user = maybe "" (\v -> T.unpack v ++ "@") user ++ T.unpack host
{- host_dir, with all / in dir replaced by _, and bad characters removed -}
{- Generates a git remote name, like host_dir or host -}
genSshRepoName :: String -> FilePath -> String
genSshRepoName host dir
| null dir = filter legal host
| otherwise = filter legal $ host ++ "_" ++ replace "/" "_" dir
where
legal '_' = True
legal c = isAlphaNum c
| null dir = makeLegalName host
| otherwise = makeLegalName $ host ++ "_" ++ dir
{- The output of ssh, including both stdout and stderr. -}
sshTranscript :: [String] -> String -> IO (String, Bool)