diff options
| -rw-r--r-- | Regfish/Parser.hs | 44 | ||||
| -rw-r--r-- | regfish.cabal | 3 | ||||
| -rw-r--r-- | regfish.nix | 7 |
3 files changed, 49 insertions, 5 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' = diff --git a/regfish.cabal b/regfish.cabal index 87a8865..4dd4b9a 100644 --- a/regfish.cabal +++ b/regfish.cabal @@ -12,11 +12,14 @@ library , acid-state , bytestring , data-default + , hex-text , http-client , hxt , lens , mtl , safecopy + , split + , text , wreq exposed-modules: Regfish , Regfish.AcidState diff --git a/regfish.nix b/regfish.nix index d0be0c9..14c7dc6 100644 --- a/regfish.nix +++ b/regfish.nix @@ -1,13 +1,14 @@ { mkDerivation, acid-state, base, bytestring, data-default -, HandsomeSoup, http-client, hxt, lens, lib, mtl, safecopy, wreq +, HandsomeSoup, hex-text, http-client, hxt, lens, lib, mtl +, safecopy, split, text, wreq }: mkDerivation { pname = "regfish"; version = "2.0.0"; src = ./.; libraryHaskellDepends = [ - acid-state base bytestring data-default HandsomeSoup http-client - hxt lens mtl safecopy wreq + acid-state base bytestring data-default HandsomeSoup hex-text + http-client hxt lens mtl safecopy split text wreq ]; license = lib.licenses.mit; } |