diff options
| -rw-r--r-- | Assistant/MakeRemote.hs | 6 | ||||
| -rw-r--r-- | Assistant/Ssh.hs | 10 | ||||
| -rw-r--r-- | Git/Remote.hs | 33 | ||||
| -rw-r--r-- | debian/changelog | 1 |
4 files changed, 40 insertions, 10 deletions
diff --git a/Assistant/MakeRemote.hs b/Assistant/MakeRemote.hs index 8f5d903e6..0cd3369be 100644 --- a/Assistant/MakeRemote.hs +++ b/Assistant/MakeRemote.hs @@ -19,10 +19,10 @@ import qualified Git.Command import qualified Command.InitRemote import Logs.UUID import Logs.Remote +import Git.Remote import qualified Data.Text as T import qualified Data.Map as M -import Data.Char {- Sets up and begins syncing with a new ssh or rsync remote. -} makeSshRemote :: Bool -> SshData -> Assistant Remote @@ -112,6 +112,4 @@ uniqueRemoteName basename n r name | n == 0 = legalbasename | otherwise = legalbasename ++ show n - legalbasename = filter legal basename - legal '_' = True - legal c = isAlphaNum c + legalbasename = makeLegalName basename diff --git a/Assistant/Ssh.hs b/Assistant/Ssh.hs index 69e633ac8..0b957cce9 100644 --- a/Assistant/Ssh.hs +++ b/Assistant/Ssh.hs @@ -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) diff --git a/Git/Remote.hs b/Git/Remote.hs new file mode 100644 index 000000000..5640e9ff2 --- /dev/null +++ b/Git/Remote.hs @@ -0,0 +1,33 @@ +{- git remote stuff + - + - Copyright 2012 Joey Hess <joey@kitenet.net> + - + - Licensed under the GNU GPL version 3 or higher. + -} + +module Git.Remote where + +import Common +import Data.Char + +{- Construct a legal git remote name out of an arbitrary input string. + - + - There seems to be no formal definition of this in the git source, + - just some ad-hoc checks, and some other things that fail with certian + - types of names (like ones starting with '-'). + -} +makeLegalName :: String -> String +makeLegalName s = case filter legal $ replace "/" "_" s of + -- it can't be empty + [] -> "unnamed" + -- it can't start with / or - or . + '.':s' -> makeLegalName s' + '/':s' -> makeLegalName s' + '-':s' -> makeLegalName s' + s' -> s' + where + {- Only alphanumerics, and a few common bits of punctuation common + - in hostnames. -} + legal '_' = True + legal '.' = True + legal c = isAlphaNum c diff --git a/debian/changelog b/debian/changelog index b7baf66e4..e65c34fef 100644 --- a/debian/changelog +++ b/debian/changelog @@ -37,6 +37,7 @@ git-annex (3.20121018) UNRELEASED; urgency=low * assistant: Fix syncing local drives. * webapp: Fix creation of rsync.net repositories. * webapp: Fix renaming of special remotes. + * webapp: Generate better git remote names. -- Joey Hess <joeyh@debian.org> Wed, 17 Oct 2012 14:24:10 -0400 |