diff options
Diffstat (limited to 'Regfish')
| -rw-r--r-- | Regfish/Parser.hs | 44 |
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' = |