summaryrefslogtreecommitdiffstats
path: root/Regfish
diff options
context:
space:
mode:
Diffstat (limited to 'Regfish')
-rw-r--r--Regfish/Parser.hs44
1 files changed, 42 insertions, 2 deletions
diff --git a/Regfish/Parser.hs b/Regfish/Parser.hs
index 4cfc5d6..be131e7 100644
--- a/Regfish/Parser.hs
+++ b/Regfish/Parser.hs
@@ -6,11 +6,17 @@ module Regfish.Parser
( readZoneIO
) where
+import qualified Data.Char as C
import qualified Data.List as L
+import qualified Data.ByteString as BS
import qualified Data.ByteString.Lazy.Char8 as LBS8
+import qualified Data.Text as T
+import Data.Bits (xor)
+import Data.Maybe (fromMaybe)
import Regfish.Types
import Text.HandsomeSoup
import Text.XML.HXT.Core
+import Text.Hex (decodeHex)
normalizeId :: String -> String
@@ -55,7 +61,7 @@ readRRs rrtype s = do
rrname <- runX $ css "#name" //> getText <<< t
rrttl <- runX $ css "#ttl" //> getText <<< t
rraux <- runX $ css "#aux" //> getText <<< t
- rrdata <- runX $ css "#data" //> getText <<< t
+ rrdata <- runX $ css "#data" //> getText <<< decodeAllProtectedEmail <<< t
return $ map (parse rrtype) $
L.transpose [rrid, rrname, rrttl, rraux, rrdata]
@@ -96,7 +102,41 @@ readRRs rrtype s = do
parse x y = errorBadArgument "readRRs.parse" (x, y)
-
+
+decodeAllProtectedEmail :: ArrowXml a => a XmlTree XmlTree
+decodeAllProtectedEmail =
+ (
+ processTopDown (
+ (
+ getAttrValue "data-cfemail"
+ >>> arr (\x -> fromMaybe x (decodeEmail x))
+ >>> mkText
+ )
+ `when` hasAttr "data-cfemail"
+ )
+ >>> processTopDown (
+ replaceChildren (
+ listA (deep getText) >>> arr concat
+ >>> mkText
+ )
+ `when` hasAttrValue "id" (== "data")
+ )
+ ) `when` css ".__cf_email__"
+
+
+decodeEmail :: String -> Maybe String
+decodeEmail cfemail =
+ case decodeHexString cfemail of
+ Just (x:text) ->
+ Just $ map (C.chr . (`xor` x)) text
+
+ _ ->
+ Nothing
+
+
+decodeHexString :: String -> Maybe [Int]
+decodeHexString =
+ fmap (map fromIntegral . BS.unpack) . decodeHex . T.pack
removeAllWhiteSpace' :: ArrowXml a => a XmlTree XmlTree
removeAllWhiteSpace' =