From ce5583460c9a936a70a05836cb9efb1021c06f2a Mon Sep 17 00:00:00 2001
From: John MacFarlane <jgm@berkeley.edu>
Date: Tue, 24 Nov 2015 11:05:31 -0800
Subject: Improved fetchItem so that C:/Blah/Blah.jpg isn't treated as URL.

The Haskell URI parsing routines will accept "C:" as a scheme,
so we rule that out manually.

This helps with `--self-contained` and absolute Windows paths.
See
http://stackoverflow.com/questions/33899126/rchart-in-markdown-doesnt-render-due-to-invalidurlexception-from-pandoc
---
 src/Text/Pandoc/Shared.hs | 25 +++++++++++++++++++------
 1 file changed, 19 insertions(+), 6 deletions(-)

(limited to 'src/Text/Pandoc')

diff --git a/src/Text/Pandoc/Shared.hs b/src/Text/Pandoc/Shared.hs
index 96dbec6f6..b7f567435 100644
--- a/src/Text/Pandoc/Shared.hs
+++ b/src/Text/Pandoc/Shared.hs
@@ -110,8 +110,9 @@ import Data.Char ( toLower, isLower, isUpper, isAlpha,
 import Data.List ( find, stripPrefix, intercalate )
 import Data.Version ( showVersion )
 import qualified Data.Map as M
-import Network.URI ( escapeURIString, isURI, nonStrictRelativeTo,
-                     unEscapeString, parseURIReference, isAllowedInURI )
+import Network.URI ( escapeURIString, nonStrictRelativeTo,
+                     unEscapeString, parseURIReference, isAllowedInURI,
+                     parseURI, URI(..) )
 import qualified Data.Set as Set
 import System.Directory
 import System.FilePath (splitDirectories, isPathSeparator)
@@ -879,18 +880,30 @@ readDataFileUTF8 :: Maybe FilePath -> FilePath -> IO String
 readDataFileUTF8 userDir fname =
   UTF8.toString `fmap` readDataFile userDir fname
 
+-- | Specialized version of parseURIReference that disallows
+-- single-letter schemes.  Reason:  these are usually windows absolute
+-- paths.
+parseURIReference' :: String -> Maybe URI
+parseURIReference' s =
+  case parseURIReference s of
+       Just u | length (uriScheme u) > 2 -> Just u
+       _                                 -> Nothing
+
 -- | Fetch an image or other item from the local filesystem or the net.
 -- Returns raw content and maybe mime type.
 fetchItem :: Maybe String -> String
           -> IO (Either E.SomeException (BS.ByteString, Maybe MimeType))
 fetchItem sourceURL s =
-  case (sourceURL >>= parseURIReference . ensureEscaped, ensureEscaped s) of
-       (_, s') | isURI s'  -> openURL s'
+  case (sourceURL >>= parseURIReference' . ensureEscaped, ensureEscaped s) of
        (Just u, s') -> -- try fetching from relative path at source
-          case parseURIReference s' of
+          case parseURIReference' s' of
                Just u' -> openURL $ show $ u' `nonStrictRelativeTo` u
                Nothing -> openURL s' -- will throw error
-       (Nothing, _) -> E.try readLocalFile -- get from local file system
+       (Nothing, s') ->
+          case parseURI s' of  -- requires absolute URI
+               -- We don't want to treat C:/ as a scheme:
+               Just u' | length (uriScheme u') > 2 -> openURL (show u')
+               _ -> E.try readLocalFile -- get from local file system
   where readLocalFile = do
           cont <- BS.readFile fp
           return (cont, mime)
-- 
cgit v1.2.3