summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--Assistant/MakeRemote.hs6
-rw-r--r--Assistant/Ssh.hs10
-rw-r--r--Git/Remote.hs33
-rw-r--r--debian/changelog1
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