Bug fix: A recent change caused git-annex-shell to crash.

5 files changed, 39 insertions, 2 deletions

diff --git a/GitAnnexShell.hs b/GitAnnexShell.hs
index ebe280279..4436ab3e1 100644
--- a/GitAnnexShell.hs
+++ b/GitAnnexShell.hs
@@ -105,6 +105,7 @@ external params = do
  -}
 partitionParams :: [String] -> ([String], [String])
 partitionParams params
+	| null segments = ([], [])
 	| length segments < 2 = (segments !! 0, [])
 	| otherwise = (segments !! 0, segments !! 1)
 	where
diff --git a/Utility/Misc.hs b/Utility/Misc.hs
index 88d210de6..f03504040 100644
--- a/Utility/Misc.hs
+++ b/Utility/Misc.hs
@@ -40,9 +40,23 @@ firstLine :: String -> String
 firstLine = takeWhile (/= '\n')
 
 {- Splits a list into segments that are delimited by items matching
- - a predicate. (The delimiters are not included in the segments.) -}
+ - a predicate. (The delimiters are not included in the segments.)
+ - Segments may be empty. -}
 segment :: (a -> Bool) -> [a] -> [[a]]
-segment p = filter (not . all p) . segmentDelim p
+segment p l = map reverse $ go [] [] l
+	where
+		go c r [] = reverse $ c:r
+		go c r (i:is)
+			| p i = go [] (c:r) is
+			| otherwise = go (i:c) r is
+
+prop_segment_regressionTest :: Bool
+prop_segment_regressionTest = all id
+	-- Even an empty list is a segment.
+	[ segment (== "--") [] == [[]]
+	-- There are two segements in this list, even though the first is empty.
+	, segment (== "--") ["--", "foo", "bar"] == [[],["foo","bar"]]
+	]
 
 {- Includes the delimiters as segments of their own. -}
 segmentDelim :: (a -> Bool) -> [a] -> [[a]]
diff --git a/debian/changelog b/debian/changelog
index bedea5c05..156993871 100644
--- a/debian/changelog
+++ b/debian/changelog
@@ -2,6 +2,7 @@ git-annex (3.20121011) UNRELEASED; urgency=low
 
   * vicfg: New file format, avoids ambiguity with repos that have the same
     description, or no description.
+  * Bug fix: A recent change caused git-annex-shell to crash.
 
  -- Joey Hess <joeyh@debian.org>  Fri, 12 Oct 2012 22:46:08 -0400
 
diff --git a/doc/bugs/Crash_trying_to_sync_with_a_repo_over_ssh.mdwn b/doc/bugs/Crash_trying_to_sync_with_a_repo_over_ssh.mdwn
index 1df26fc81..38f54d2b6 100644
--- a/doc/bugs/Crash_trying_to_sync_with_a_repo_over_ssh.mdwn
+++ b/doc/bugs/Crash_trying_to_sync_with_a_repo_over_ssh.mdwn
@@ -22,3 +22,22 @@ I'm on OS X 10.8.2, using GHC 7.6.1.  The annex in question has 38G in a few hun
 Please provide any additional information below.
 
 I'm willing to help track this down!
+
+> I've got it, October 9th's release 
+> included commit bc649a35bacbecef93e378b1497f6a05b30bf452, which included a
+> change to a `segment` function. It was supposed to be a
+> rewrite in terms of a more general version, but it introduced a bug
+> in what it returned in an edge case and this in turn led git-annex-shell's
+> parameter parser to fail in a code path that was never reachable before.
+> 
+> It'd fail both when a new repo was running `git-annex-shell configlist`,
+> and in `git-annex-shell commit`, although this latter crash was less
+> noticible and I'm sure you saw the former.
+> 
+> Fixed the reversion; fixed insufficient guards around the partial code
+> (which I cannot see a way to entirely eliminate sadly; look at
+> GitAnnexShell.hs's `partitionParams` and weep or let me know if you have 
+> any smart ideas..); added a regression test to check the non-obvious
+> behavior of segment with an empty segment. I'll be releasing a new
+> version with this fix as soon as I have bandwidth, ie tomorrow.
+> [[done]] --[[Joey]]
diff --git a/test.hs b/test.hs
index 2417f681b..875668b86 100644
--- a/test.hs
+++ b/test.hs
@@ -48,6 +48,7 @@ import qualified Build.SysConfig
 import qualified Utility.Format
 import qualified Utility.Verifiable
 import qualified Utility.Process
+import qualified Utility.Misc
 
 -- for quickcheck
 instance Arbitrary Types.Key.Key where
@@ -91,6 +92,7 @@ quickcheck = TestLabel "quickcheck" $ TestList
 	, qctest "prop_TimeStamp_sane" Logs.UUIDBased.prop_TimeStamp_sane
 	, qctest "prop_addLog_sane" Logs.UUIDBased.prop_addLog_sane
 	, qctest "prop_verifiable_sane" Utility.Verifiable.prop_verifiable_sane
+	, qctest "prop_segment_regressionTest" Utility.Misc.prop_segment_regressionTest
 	]
 
 blackbox :: Test