@@ -28,8 +28,8 @@ module Text.Pandoc.Writers.FB2 (writeFB2) where
2828import Control.Monad.State (StateT, evalStateT, get, modify)
2929import Control.Monad.State (liftM, liftM2, liftIO)
3030import Data.ByteString.Base64 (encode)
31−import Data.Char (toUpper, toLower, isSpace)
32−import Data.List (intersperse, intercalate)
31+import Data.Char (toUpper, toLower, isSpace, isAscii, isControl)
32+import Data.List (intersperse, intercalate, isPrefixOf)
3333import Data.Either (lefts, rights)
3434import Network.Browser (browse, request, setAllowRedirects, setOutHandler)
3535import Network.HTTP (catchIO_, getRequest, getHeaders, getResponseBody)
@@ -220,9 +220,15 @@ fetchImages links = do
220220fetchImage :: String -> String -> IO (Either String Content)
221221fetchImage href link = do
222222 mbimg <-
223− if isURI link
224− then fetchURL link
225− else do
223+ case (isURI link, readDataURI link) of
224+ (True, Just (mime,_,True,base64)) ->
225+ let mime' = map toLower mime
226+ in if mime' == "image/png" || mime' == "image/jpeg"
227+ then return (Just (mime',base64))
228+ else return Nothing
229+ (True, Just _) -> return Nothing -- not base64-encoded
230+ (True, Nothing) -> fetchURL link
231+ (False, _) -> do
226232 d <- nothingOnError $ B.readFile (unEscapeString link)
227233 let t = case map toLower (takeExtension link) of
228234 ".png" -> Just "image/png"
@@ -230,15 +236,13 @@ fetchImage href link = do
230236 ".jpeg" -> Just "image/jpeg"
231237 ".jpe" -> Just "image/jpeg"
232238 _ -> Nothing -- only PNG and JPEG are supported in FB2
233− return $ liftM2 (,) t d
239+ return $ liftM2 (,) t (liftM (toStr . encode) d)
234240 case mbimg of
235241 Just (imgtype, imgdata) -> do
236− let encdata = encode imgdata
237− let encstr = map (toEnum . fromEnum) . B.unpack $ encdata
238242 return . Right $ el "binary"
239243 ( [uattr "id" href
240244 , uattr "content-type" imgtype]
241− , txt encstr )
245+ , txt imgdata )
242246 _ -> return (Left ('#':href))
243247 where
244248 nothingOnError :: (IO B.ByteString) -> (IO (Maybe B.ByteString))
@@ -246,8 +250,45 @@ fetchImage href link = do
246250 omnihandler :: E.SomeException -> IO (Maybe B.ByteString)
247251 omnihandler _ = return Nothing
248252
253+-- | Extract mime type and encoded data from the Data URI.
254+readDataURI :: String -- ^ URI
255+ -> Maybe (String,String,Bool,String)
256+ -- ^ Maybe (mime,charset,isBase64,data)
257+readDataURI uri =
258+ let prefix = "data:"
259+ in if not (prefix `isPrefixOf` uri)
260+ then Nothing
261+ else
262+ let rest = drop (length prefix) uri
263+ meta = takeWhile (/= ',') rest -- without trailing ','
264+ uridata = drop (length meta + 1) rest
265+ parts = split (== ';') meta
266+ (mime,cs,enc)=foldr upd ("text/plain","US-ASCII",False) parts
267+ in Just (mime,cs,enc,uridata)
268+ where
269+ upd str m@(mime,cs,enc)
270+ | isMimeType str = (str,cs,enc)
271+ | "charset=" `isPrefixOf` str = (mime,drop (length "charset=") str,enc)
272+ | str == "base64" = (mime,cs,True)
273+ | otherwise = m
274+
275+-- Without parameters like ;charset=...; see RFC 2045, 5.1
276+isMimeType :: String -> Bool
277+isMimeType s =
278+ case split (=='/') s of
279+ [mtype,msubtype] ->
280+ ((map toLower mtype) `elem` types
281+ || "x-" `isPrefixOf` (map toLower mtype))
282+ && all valid mtype
283+ && all valid msubtype
284+ _ -> False
285+ where
286+ types = ["text","image","audio","video","application","message","multipart"]
287+ valid c = isAscii c && not (isControl c) && not (isSpace c) &&
288+ c `notElem` "()<>@,;:\\\"/[]?="
289+
249290-- | Fetch URL, return its Content-Type and binary data on success.
250−fetchURL :: String -> IO (Maybe (String, B.ByteString))
291+fetchURL :: String -> IO (Maybe (String, String))
251292fetchURL url = do
252293 flip catchIO_ (return Nothing) $ do
253294 r <- browse $ do
@@ -255,10 +296,15 @@ fetchURL url = do
255296 setAllowRedirects True
256297 liftM snd . request . getRequest $ url
257298 let content_type = lookupHeader HdrContentType (getHeaders r)
258− content <- liftM (Just . toBS) . getResponseBody $ Right r
299+ content <- liftM (Just . toStr . encode . toBS) . getResponseBody $ Right r
259300 return $ liftM2 (,) content_type content
260301 where
261− toBS = B.pack . map (toEnum . fromEnum)
302+
303+toBS :: String -> B.ByteString
304+toBS = B.pack . map (toEnum . fromEnum)
305+
306+toStr :: B.ByteString -> String
307+toStr = map (toEnum . fromEnum) . B.unpack
262308
263309footnoteID :: Int -> String
264310footnoteID i = "n" ++ (show i)