From b98edf2c745d6d2a1b5a20c2b50c262d9b4e85f2 Mon Sep 17 00:00:00 2001
From: fiddlosopher <fiddlosopher@788f1e2b-df1e-0410-8736-df70ead52e1b>
Date: Wed, 20 Dec 2006 18:16:07 +0000
Subject: Made javascript obfuscation of emails even more obfuscatory, by
 combining it with entity obfuscation.

git-svn-id: https://pandoc.googlecode.com/svn/trunk@254 788f1e2b-df1e-0410-8736-df70ead52e1b
---
 src/Text/Pandoc/Writers/HTML.hs | 37 +++++++++++++++++++++++++++----------
 1 file changed, 27 insertions(+), 10 deletions(-)

(limited to 'src/Text/Pandoc/Writers/HTML.hs')

diff --git a/src/Text/Pandoc/Writers/HTML.hs b/src/Text/Pandoc/Writers/HTML.hs
index 1b5201191..9ff2f5667 100644
--- a/src/Text/Pandoc/Writers/HTML.hs
+++ b/src/Text/Pandoc/Writers/HTML.hs
@@ -15,9 +15,9 @@ module Text.Pandoc.Writers.HTML (
 import Text.Pandoc.Definition
 import Text.Pandoc.Shared
 import Text.Html ( stringToHtmlString )
-import Text.Regex ( mkRegex )
+import Text.Regex ( mkRegex, matchRegex )
 import Numeric ( showHex )
-import Char ( ord )
+import Data.Char ( ord, toLower )
 import Data.List ( isPrefixOf, partition )
 
 -- | Convert Pandoc document to string in HTML format.
@@ -59,14 +59,27 @@ footnoteSection options notes =
 -- | Obfuscate a "mailto:" link using Javascript.
 obfuscateLink :: WriterOptions -> [Inline] -> String -> String
 obfuscateLink options text src =
-  let text' = inlineListToHtml options text in
-  let linkText = if src == ("mailto:" ++ text')
-                    then "e"
-                    else "'" ++ text' ++ "'" 
-      altText = if src == ("mailto:" ++ text')
-                    then "\\1 [at] \\2"
-                    else text' ++ " (\\1 [at] \\2)" in  
-  gsub "mailto:([^@]*)@(.*)" ("<script type=\"text/javascript\">h='\\2';n='\\1';e=n+'@'+h;document.write('<a href=\"mailto:'+e+'\">'+" ++ linkText  ++ "+'<\\/a>');</script><noscript>" ++ altText ++ "</noscript>") src 
+  let emailRegex = mkRegex "mailto:*([^@]*)@(.*)"
+      text' = inlineListToHtml options text 
+      src' = map toLower src in
+  case (matchRegex emailRegex src') of
+    (Just [name, domain]) ->
+      let domain' = gsub "\\." " dot " domain
+          at' = obfuscateChar '@' in
+      let linkText = if src' == ("mailto:" ++ text')
+                        then "e"
+                        else "'" ++ text' ++ "'" 
+          altText  = if src' == ("mailto:" ++ text')
+                        then name ++ " at " ++ domain'
+                        else text' ++ " (" ++ name ++ " at " ++ 
+                             domain' ++ ")" in 
+      "<script type=\"text/javascript\">\n<!--\nh='" ++ 
+      obfuscateString domain ++ "';a='" ++ at' ++ "';n='" ++ 
+      obfuscateString name ++ "';e=n+a+h;\n" ++
+      "document.write('<a h'+'ref'+'=\"ma'+'ilto'+':'+e+'\">'+" ++ 
+      linkText  ++ "+'<\\/'+'a'+'>');\n// -->\n</script><noscript>" ++ 
+      obfuscateString altText ++ "</noscript>"
+    _ -> "<a href=\"" ++ src ++ "\">" ++ text' ++ "</a>" -- malformed email
 
 -- | Obfuscate character as entity.
 obfuscateChar :: Char -> String
@@ -75,6 +88,10 @@ obfuscateChar char =
   let numstr = if even num then (show num) else ("x" ++ (showHex num "")) in
   "&#" ++ numstr ++ ";"
 
+-- | Obfuscate string using entities.
+obfuscateString :: String -> String
+obfuscateString = concatMap obfuscateChar
+
 -- | Escape string, preserving character entities and quote.
 stringToHtml :: String -> String
 stringToHtml str = escapePreservingRegex stringToHtmlString 
-- 
cgit v1.2.3