From 87a56a93b8dcec8274041b4bc7020b54c60fb4ec Mon Sep 17 00:00:00 2001
From: Chris Done <chrisdone@gmail.com>
Date: Fri, 22 May 2015 11:32:41 +0200
Subject: [PATCH] Disallow ..

---
 CHANGELOG    |  7 +++++++
 src/Path.hs  | 28 +++++++++++++++++++++++-----
 test/Main.hs | 22 ++++++++++++++++++++++
 3 files changed, 52 insertions(+), 5 deletions(-)

diff --git a/CHANGELOG b/CHANGELOG
index 5e3a7a8..47e0a47 100644
--- a/CHANGELOG
+++ b/CHANGELOG
@@ -2,3 +2,10 @@
 
         * Rename parentAbs to simply parent.
 	* Add dirname.
+
+0.3.0:
+	* Removed Generic instance.
+
+0.4.0:
+	* Implemented stricter parsing, disabling use of "..".
+	* Made stripDir
diff --git a/src/Path.hs b/src/Path.hs
index a9ab58e..3951980 100644
--- a/src/Path.hs
+++ b/src/Path.hs
@@ -65,6 +65,7 @@ data PathParseException
   | InvalidRelDir FilePath
   | InvalidAbsFile FilePath
   | InvalidRelFile FilePath
+  | Couldn'tStripPrefixDir FilePath FilePath
   deriving (Show,Typeable)
 instance Exception PathParseException
 
@@ -81,7 +82,10 @@ parseAbsDir :: MonadThrow m
 parseAbsDir filepath =
   if FilePath.isAbsolute filepath &&
      not (null (normalizeDir filepath)) &&
-     not (isPrefixOf "~/" filepath)
+     not (isPrefixOf "~/" filepath) &&
+     not (isSuffixOf "/.." filepath) &&
+     not (isInfixOf "/../" filepath) &&
+     not (isPrefixOf "../" filepath)
      then return (Path (normalizeDir filepath))
      else throwM (InvalidAbsDir filepath)
 
@@ -96,7 +100,11 @@ parseRelDir filepath =
   if not (FilePath.isAbsolute filepath) &&
      not (null filepath) &&
      not (isPrefixOf "~/" filepath) &&
-     not (null (normalizeDir filepath))
+     not (isPrefixOf "../" filepath) &&
+     not (isSuffixOf "/.." filepath) &&
+     not (isInfixOf "/../" filepath) &&
+     not (null (normalizeDir filepath)) &&
+     filepath /= ".."
      then return (Path (normalizeDir filepath))
      else throwM (InvalidRelDir filepath)
 
@@ -110,7 +118,11 @@ parseAbsFile filepath =
   if FilePath.isAbsolute filepath &&
      not (FilePath.hasTrailingPathSeparator filepath) &&
      not (isPrefixOf "~/" filepath) &&
-     not (null (normalizeFile filepath))
+     not (isPrefixOf "../" filepath) &&
+     not (isSuffixOf "/.." filepath) &&
+     not (isInfixOf "/../" filepath) &&
+     not (null (normalizeFile filepath)) &&
+     filepath /= ".."
      then return (Path (normalizeFile filepath))
      else throwM (InvalidAbsFile filepath)
 
@@ -121,10 +133,16 @@ parseAbsFile filepath =
 parseRelFile :: MonadThrow m
              => FilePath -> m (Path Rel File)
 parseRelFile filepath =
-  if not (FilePath.isAbsolute filepath || FilePath.hasTrailingPathSeparator filepath) &&
+  if not (FilePath.isAbsolute filepath ||
+          FilePath.hasTrailingPathSeparator filepath) &&
      not (null filepath) &&
      not (isPrefixOf "~/" filepath) &&
-     not (null (normalizeFile filepath))
+     not (isPrefixOf "../" filepath) &&
+     not (isInfixOf "/../" filepath) &&
+     not (isSuffixOf "/.." filepath) &&
+     not (isInfixOf "/../" filepath) &&
+     not (null (normalizeFile filepath)) &&
+     filepath /= ".."
      then return (Path (normalizeFile filepath))
      else throwM (InvalidRelFile filepath)
 
diff --git a/test/Main.hs b/test/Main.hs
index b0f973e..42bc906 100644
--- a/test/Main.hs
+++ b/test/Main.hs
@@ -4,6 +4,9 @@
 
 module Main where
 
+import Control.Applicative
+import Control.Monad
+import Data.Maybe
 import Data.Monoid
 import Path
 import Path.Internal
@@ -25,6 +28,25 @@ spec =
      describe "Operations: isParentOf" operationIsParentOf
      describe "Operations: parent" operationParent
      describe "Operations: filename" operationFilename
+     describe "Restrictions" restrictions
+
+-- | Restricting the input of any tricks.
+restrictions :: Spec
+restrictions =
+  do parseFails "~/"
+     parseFails "~/foo"
+     parseFails "~/foo/bar"
+     parseFails "../"
+     parseFails ".."
+     parseFails "/.."
+     parseFails "/foo/../bar/"
+     parseFails "/foo/bar/.."
+  where parseFails x =
+          it (show x ++ " should be rejected")
+             (isNothing (void (parseAbsDir x) <|>
+                         void (parseRelDir x) <|>
+                         void (parseAbsFile x) <|>
+                         void (parseRelDir x)))
 
 -- | The 'filename' operation.
 operationFilename :: Spec