451 lines
16 KiB
Haskell
451 lines
16 KiB
Haskell
#!/usr/bin/env runhaskell
|
|
{-# LANGUAGE DeriveDataTypeable #-}
|
|
|
|
module Main where
|
|
import System.Console.CmdArgs
|
|
import Control.Arrow
|
|
import Data.Text (pack, unpack)
|
|
import Text.Read (readMaybe)
|
|
import qualified Data.Text as T
|
|
import qualified Data.Text.Encoding as T
|
|
import qualified Data.Text.IO as T
|
|
import Data.Text (Text)
|
|
import qualified Data.Text.Lazy as TL
|
|
import Data.Text.Lazy.Builder (toLazyText)
|
|
import Data.Text.Encoding (decodeUtf8With, decodeUtf8, encodeUtf8)
|
|
import Data.Maybe (fromJust, fromMaybe)
|
|
import Data.Text.Encoding.Error (lenientDecode)
|
|
import TextShow (toText)
|
|
import Text.XML.HXT.DOM.Util (hexStringToInt, intToHexString, decimalStringToInt)
|
|
import TextShow.Data.Integral (showbBin, showbOct)
|
|
import Text.Ascii (fromBinDigit, fromOctDigit)
|
|
import Codec.CBOR.Magic (intToWord64)
|
|
import qualified Data.Either.Unwrap as U
|
|
import Data.Bytes.Text.Latin1 as Latin1
|
|
import qualified Codec.Binary.Base91 as B91
|
|
import qualified Codec.Binary.Base85 as B85
|
|
import qualified Codec.Binary.Base64 as B64
|
|
import qualified Data.ByteString.Base64 as B64L
|
|
import qualified Codec.Binary.Base64Url as B64U
|
|
import qualified Network.HTTP.Base as HB
|
|
import qualified Data.Word.Base62 as B62
|
|
import qualified Haskoin.Address.Base58 as B58
|
|
import qualified Codec.Binary.Base32 as B32
|
|
import qualified Codec.Binary.Base16 as B16
|
|
import qualified Codec.Binary.QuotedPrintable as QP
|
|
import qualified Codec.Binary.Uu as UU
|
|
import qualified Codec.Binary.Xx as XX
|
|
import qualified Codec.Binary.Yenc as Y
|
|
import qualified Data.Bytes as Bytes
|
|
import qualified Data.Bytes.Text.Ascii as ASCII
|
|
import Data.Bytes.Get (getWord64host)
|
|
import Data.ByteString.UTF8 as BSU -- from utf8-string
|
|
-- import Data.ByteString (singleton)
|
|
import GHC.Word (Word8)
|
|
-- import Data.Char
|
|
import qualified Data.ByteString.Char8 as C
|
|
-- Regex imports
|
|
import Text.Regex.TDFA
|
|
import Data.Word (Word8)
|
|
import Data.Char (ord, chr)
|
|
|
|
data Based = Decode {
|
|
b91 :: Bool,
|
|
b85 :: Bool,
|
|
b64 :: Bool,
|
|
b64url :: Bool,
|
|
url :: Bool,
|
|
b62 :: Bool,
|
|
b58 :: Bool,
|
|
b32 :: Bool,
|
|
b16 :: Bool,
|
|
b10 :: Bool,
|
|
b8 :: Bool,
|
|
b2 :: Bool,
|
|
qp :: Bool,
|
|
uu :: Bool,
|
|
xx :: Bool,
|
|
yenc :: Bool,
|
|
solve :: Bool
|
|
}
|
|
| Encode {
|
|
b91 :: Bool,
|
|
b85 :: Bool,
|
|
b64 :: Bool,
|
|
b64url :: Bool,
|
|
url :: Bool,
|
|
b62 :: Bool,
|
|
b58 :: Bool,
|
|
b32 :: Bool,
|
|
b16 :: Bool,
|
|
b10 :: Bool,
|
|
b8 :: Bool,
|
|
b2 :: Bool,
|
|
qp :: Bool,
|
|
uu :: Bool,
|
|
xx :: Bool,
|
|
yenc :: Bool
|
|
}
|
|
deriving(Show, Data, Typeable)
|
|
|
|
-- helper functions
|
|
|
|
-- convertToByteString :: String -> Either String C.ByteString
|
|
-- convertToByteString str =
|
|
-- case BSU.fromString str of
|
|
-- Just bs -> Right bs
|
|
-- Nothing -> Left "Failed to convert string to ByteString."
|
|
|
|
-- decodeFromBase91 :: String -> Either String C.ByteString
|
|
-- decodeFromBase91 decoded =
|
|
-- case B91.decode of
|
|
-- decoded | C.null decoded -> Left "Failed to decode from base91"
|
|
-- | otherwise -> Right decoded
|
|
|
|
|
|
encodeToBase64 :: C.ByteString -> Either String C.ByteString
|
|
encodeToBase64 bs =
|
|
case B64.encode bs of
|
|
encoded | C.null encoded -> Left "Failed to encode Base64.\n"
|
|
| otherwise -> Right encoded
|
|
|
|
decodeFromBase64 :: C.ByteString -> Either String C.ByteString
|
|
decodeFromBase64 bs =
|
|
case B64L.decodeLenient bs of
|
|
decoded | C.null decoded -> Left "Failed to decode from Base64.\n"
|
|
| otherwise -> Right decoded
|
|
-- | otherwise -> Right (BSU.toString decoded)
|
|
-- Left err -> Left $ "Failed to decode from base64: " ++ err
|
|
-- Right decoded -> Right decoded
|
|
|
|
binToInt :: [Int] -> Int
|
|
binToInt [] = 0
|
|
binToInt (x : xs) = x + 2 * binToInt xs
|
|
|
|
octToInt :: [Int] -> Int
|
|
octToInt [] = 0
|
|
octToInt (x : xs) = x + 8 * octToInt xs
|
|
|
|
-- base functions
|
|
-- without the show func, sequences like \n will not be shown as characters but will be executed as newline
|
|
|
|
dec91 :: String -> String
|
|
dec91 = T.unpack . T.decodeUtf8 . B91.decode
|
|
|
|
-- dec91 input =
|
|
-- maybe "Error decoding Base91.\n" T.unpack (T.decodeUtf8 (B91.decode input)
|
|
|
|
-- dec91 :: String -> String
|
|
-- dec91 input =
|
|
-- case B91.decode input :: BSU.ByteString of
|
|
-- decoded -> C.unpack decoded
|
|
|
|
-- toWord8 :: String -> [Word8]
|
|
-- toWord8 = map (fromIntegral . fromEnum)
|
|
|
|
-- dec91 :: String -> String
|
|
-- dec91 input =
|
|
-- map (chr . fromIntegral) (B91.decode input :: [Word8])
|
|
|
|
-- or
|
|
-- case B91.decode input :: [Word8] of
|
|
-- Right decoded -> map (toEnum . fromIntegral) decoded
|
|
-- Left err -> "Error decoding Base91: " ++ err
|
|
|
|
|
|
enc91 :: String -> String
|
|
enc91 = B91.encode . BSU.fromString
|
|
|
|
-- dec85 = C.unpack . U.fromRight . B85.decode . BSU.fromString
|
|
dec85 :: String -> String
|
|
dec85 input =
|
|
case B85.decode (BSU.fromString input) of
|
|
Right decodedStr -> C.unpack decodedStr
|
|
Left _ -> "Error decoding Base85.\n"
|
|
|
|
enc85 :: String -> String
|
|
enc85 = C.unpack . B85.encode . BSU.fromString
|
|
|
|
-- dec64 = C.unpack . B64L.decodeLenient . BSU.fromString
|
|
dec64 :: String -> String
|
|
dec64 input =
|
|
case decodeFromBase64 (BSU.fromString input) of
|
|
Right byteString -> C.unpack byteString
|
|
Left errMsg -> "Error: " ++ errMsg
|
|
|
|
-- enc64 = C.unpack . B64.encode . BSU.fromString
|
|
enc64 :: String -> String
|
|
enc64 input =
|
|
case encodeToBase64 (BSU.fromString input) of
|
|
Right byteString -> C.unpack byteString
|
|
Left errMsg -> "Error: " ++ errMsg
|
|
|
|
dec64url :: String -> String
|
|
-- dec64url = C.unpack . U.fromRight . B64U.decode . BSU.fromString
|
|
dec64url input =
|
|
case B64.decode (BSU.fromString input) of
|
|
Right decoded -> C.unpack decoded
|
|
Left _ -> "Error decoding Base64 for URLs.\n"
|
|
|
|
enc64url :: String -> String
|
|
enc64url = C.unpack . B64U.encode . BSU.fromString
|
|
|
|
decurl :: String -> String
|
|
decurl = HB.urlDecode
|
|
|
|
encurl :: String -> String
|
|
encurl = HB.urlEncode
|
|
|
|
dec62 :: String -> String
|
|
-- dec62 = T.unpack . B62.text128 . fromJust . B62.decode128 . Bytes.fromAsciiString
|
|
-- dec62 input =
|
|
-- case B62.decode128 (Bytes.fromAsciiString input) of
|
|
-- Just decoded -> (T.unpack (B62.text128 decoded))
|
|
-- -- Just decoded -> C.unpack decoded
|
|
-- Nothing -> "Error decoding Base62.\n"
|
|
|
|
-- dec62 = show . fromJust . B62.decode128 . (Bytes.fromByteString . BSU.fromString)
|
|
dec62 input =
|
|
let decoded = B62.decode128 (Bytes.fromByteString (BSU.fromString input))
|
|
in fromMaybe "Error decoding Base62.\n" (show <$> decoded)
|
|
|
|
-- dec62 input =
|
|
-- maybe "Error decoding Base62.\n" show (B62.decode128 (Bytes.fromByteString (BSU.fromString input)))
|
|
|
|
stringToInt :: String -> Maybe Integer
|
|
stringToInt = readMaybe
|
|
|
|
-- enc62 :: String -> String
|
|
-- enc62 = C.unpack . BSU.fromString. Latin1.toString . (Bytes.fromByteArray . ( B62.encode64 . (intToWord64 . decimalStringToInt)))
|
|
-- enc62 = T.unpack . T.decodeUtf8 . BSU.fromString . Latin1.toString . (Bytes.fromByteArray . ( B62.encode64 . (intToWord64 . decimalStringToInt)))
|
|
-- enc62 = T.unpack . T.decodeUtf8 . BSU.fromString . Latin1.toString . (Bytes.fromByteArray . (B62.encode128 . (fromIntegral . ( BSU.fromString . fromJust StringToInt))))
|
|
|
|
-- working correct:
|
|
-- enc62 :: String -> String
|
|
-- enc62 = T.unpack . T.decodeUtf8 . BSU.fromString . Latin1.toString . Bytes.fromByteArray . B62.encode64 . fromIntegral . fromJust . stringToInt
|
|
|
|
enc62 :: String -> String
|
|
enc62 input =
|
|
let intValue = fromMaybe (error "Error: Unable to convert input string to integer") (stringToInt input)
|
|
encoded = B62.encode64 (fromIntegral intValue)
|
|
encodedText = T.decodeUtf8 (BSU.fromString (Latin1.toString (Bytes.fromByteArray encoded)))
|
|
in T.unpack encodedText
|
|
-- enc62 :: Text -> Text
|
|
-- enc62 text = B62.text128 (fromIntegral (T.length text))
|
|
|
|
dec58 :: String -> String
|
|
-- dec58 = C.unpack . fromJust . B58.decodeBase58 . pack
|
|
dec58 input =
|
|
maybe "Error decoding Base58.\n" C.unpack (B58.decodeBase58 (T.pack input))
|
|
|
|
enc58 :: String -> String
|
|
enc58 = unpack . B58.encodeBase58 . BSU.fromString
|
|
|
|
dec32 :: String -> String
|
|
-- dec32 = C.unpack . U.fromRight . B32.decode . BSU.fromString
|
|
dec32 input =
|
|
case B32.decode (BSU.fromString input) of
|
|
Right decoded -> C.unpack decoded
|
|
Left _ -> "Error decoding Base32.\n"
|
|
|
|
enc32 :: String -> String
|
|
enc32 = C.unpack . B32.encode . BSU.fromString
|
|
|
|
dec16 :: String -> String
|
|
-- dec16 = C.unpack . U.fromRight . B16.decode . BSU.fromString
|
|
dec16 input =
|
|
case B16.decode (BSU.fromString input) of
|
|
Right decoded -> C.unpack decoded
|
|
Left _ -> "Error decoding Base16.\n"
|
|
|
|
enc16 :: String -> String
|
|
enc16 = C.unpack . B16.encode . BSU.fromString
|
|
|
|
dec10 :: String -> String
|
|
dec10 = show . hexStringToInt
|
|
|
|
enc10 :: String -> String
|
|
enc10 = C.unpack . BSU.fromString . intToHexString . decimalStringToInt -- Depending on what you want, do enc10 = show . map ord
|
|
|
|
dec8 = C.unpack . encodeUtf8 . toText . showbOct . hexStringToInt
|
|
enc8 = C.unpack . BSU.fromString . intToHexString . octToInt . (reverse . (map fromJust . (map fromOctDigit)))
|
|
|
|
dec2 :: String -> String
|
|
-- dec2 = C.unpack . encodeUtf8 . toText . showbBin . hexStringToInt
|
|
dec2 = TL.unpack . toLazyText . showbBin . hexStringToInt
|
|
|
|
enc2 :: String -> String
|
|
enc2 = C.unpack . BSU.fromString . intToHexString . binToInt . (reverse . (map fromJust . (map fromBinDigit)))
|
|
|
|
decqp :: String -> String
|
|
-- decqp = C.unpack . U.fromRight . QP.decode . BSU.fromString
|
|
decqp input =
|
|
case QP.decode (BSU.fromString input) of
|
|
Right decoded -> C.unpack decoded
|
|
Left _ -> "Error decoding QP.\n"
|
|
|
|
encqp :: String -> String
|
|
encqp = C.unpack . QP.encode . BSU.fromString
|
|
|
|
decuu :: String -> String
|
|
-- decuu = C.unpack . U.fromRight . UU.decode . BSU.fromString
|
|
decuu input =
|
|
case UU.decode (BSU.fromString input) of
|
|
Right decoded -> C.unpack decoded
|
|
Left _ -> "Error decoding UU.\n"
|
|
|
|
encuu :: String -> String
|
|
encuu = C.unpack . UU.encode . BSU.fromString
|
|
|
|
decxx :: String -> String
|
|
-- decxx = C.unpack . U.fromRight . XX.decode . BSU.fromString
|
|
decxx input =
|
|
case XX.decode (BSU.fromString input) of
|
|
Right decoded -> C.unpack decoded
|
|
Left _ -> "Error decoding XX.\n"
|
|
|
|
encxx :: String -> String
|
|
encxx = C.unpack . XX.encode . BSU.fromString
|
|
|
|
decy :: String -> String
|
|
-- decy = C.unpack . U.fromRight . Y.decode . BSU.fromString
|
|
decy input =
|
|
case Y.decode (BSU.fromString input) of
|
|
Right decoded -> C.unpack decoded
|
|
Left _ -> "Error decoding Y.\n"
|
|
|
|
|
|
ency :: String -> String
|
|
ency = C.unpack . Y.encode . BSU.fromString
|
|
|
|
base91Regex = "^[!-~]*$"
|
|
base85Regex = "^[0-9A-Za-z!#$%&()*+,-;<=>?@^_`{|}~]+$"
|
|
-- base85Regex = "^[A-Za-u0-9!\"#$%&((*+,-./;:<=@[]\\`]*$"
|
|
base64Regex = "^([A-Za-z0-9+/]{4})*([A-Za-z0-9+/]{3}=|[A-Za-z0-9+/]{2}==)?$"
|
|
base58Regex = "^[1-9A-HJ-NP-Za-km-z]+$" -- incorrect
|
|
base32Regex = "^(?:[A-Z2-7]{8})*(?:[A-Z2-7]{2}={6}|[A-Z2-7]{4}={4}|[A-Z2-7]{5}={3}|[A-Z2-7]{7}=)?$"
|
|
base16Regex = "^[0-9A-FXx]*$"
|
|
base10Regex = "^[0-9]*$"
|
|
base8Regex = "^[0-7]*$"
|
|
base2Regex = "^[01]*$"
|
|
urlRegex = "^[a-zA-Z0-9%]*$"
|
|
|
|
solveEnc :: String -> String
|
|
solveEnc input =
|
|
let isBase91 = BSU.fromString input =~ base91Regex :: Bool
|
|
isBase85 = BSU.fromString input =~ base85Regex :: Bool
|
|
isBase64 = BSU.fromString input =~ base64Regex :: Bool
|
|
isBase58 = BSU.fromString input =~ base58Regex :: Bool
|
|
isBase32 = BSU.fromString input =~ base32Regex :: Bool
|
|
isBase16 = BSU.fromString input =~ base16Regex :: Bool
|
|
isBase10 = BSU.fromString input =~ base10Regex :: Bool
|
|
isBase8 = BSU.fromString input =~ base8Regex :: Bool
|
|
isBase2 = BSU.fromString input =~ base2Regex :: Bool
|
|
isURL = BSU.fromString input =~ urlRegex :: Bool
|
|
base91Result = if isBase91 then "\nTrying base91:\n" ++ dec91 input else ""
|
|
base85Result = if isBase85 then "\nTrying base85:\n" ++ dec85 input else ""
|
|
base64Result = if isBase64 then "\nTrying base64:\n" ++ dec64 input else ""
|
|
base58Result = if isBase58 then "\nTrying base58:\n" ++ dec58 input else ""
|
|
base32Result = if isBase64 then "\nTrying base32:\n" ++ dec32 input else ""
|
|
base16Result = if isBase16 then "\nTrying base16:\n" ++ dec16 input else ""
|
|
base10Result = if isBase10 then "\nTrying base10:\n" ++ dec10 input else ""
|
|
base2Result = if isBase2 then "\nTrying base2:\n" ++ dec2 input else ""
|
|
base8Result = if isBase8 then "\nTrying base8:\n" ++ dec8 input else ""
|
|
urlResult = if isURL then "\nTrying URL decode:\n" ++ decurl input else ""
|
|
results = filter (not . null) [base91Result, base85Result, base64Result, base58Result, base32Result, base16Result, base10Result, base8Result, base2Result, urlResult]
|
|
in
|
|
if null results
|
|
then "Not able to solve the encoding.\n"
|
|
else unlines results
|
|
|
|
--
|
|
-- | input =~ base64Regex = dec64 input
|
|
-- | input =~ base32Regex = dec32 input
|
|
-- | otherwise = "Cannot decode: " ++ input
|
|
--
|
|
-- if BSU.fromString input =~ base64Regex :: Bool
|
|
-- then dec64 input
|
|
-- else "Not Base64.\n"
|
|
-- ++ if BSU.fromString input =~ base32Regex :: Bool
|
|
-- then dec32 input
|
|
-- else "Not able to solve the encoding.\n"
|
|
|
|
-- optionHandler :: EncodeOptions -> Text -> Text
|
|
optionHandler Decode{b91=True} = dec91
|
|
optionHandler Encode{b91=True} = enc91
|
|
optionHandler Decode{b85=True} = dec85
|
|
optionHandler Encode{b85=True} = enc85
|
|
optionHandler Decode{b64=True} = dec64
|
|
optionHandler Encode{b64=True} = enc64
|
|
optionHandler Decode{b64url=True} = dec64url
|
|
optionHandler Encode{b64url=True} = enc64url
|
|
optionHandler Decode{url=True} = decurl
|
|
optionHandler Encode{url=True} = encurl
|
|
optionHandler Decode{b62=True} = dec62
|
|
optionHandler Encode{b62=True} = enc62
|
|
optionHandler Decode{b58=True} = dec58
|
|
optionHandler Encode{b58=True} = enc58
|
|
optionHandler Decode{b32=True} = dec32
|
|
optionHandler Encode{b32=True} = enc32
|
|
optionHandler Decode{b16=True} = dec16
|
|
optionHandler Encode{b16=True} = enc16
|
|
optionHandler Decode{b10=True} = dec10
|
|
optionHandler Encode{b10=True} = enc10
|
|
optionHandler Decode{b8=True} = dec8
|
|
optionHandler Encode{b8=True} = enc8
|
|
optionHandler Decode{b2=True} = dec2
|
|
optionHandler Encode{b2=True} = enc2
|
|
optionHandler Decode{qp=True} = decqp
|
|
optionHandler Encode{qp=True} = encqp
|
|
optionHandler Encode{uu=True} = encuu
|
|
optionHandler Decode{uu=True} = decuu
|
|
optionHandler Decode{xx=True} = decxx
|
|
optionHandler Encode{xx=True} = encxx
|
|
optionHandler Decode{yenc=True} = decy
|
|
optionHandler Encode{yenc=True} = ency
|
|
optionHandler Decode{solve=True} = solveEnc
|
|
|
|
decodeMode :: Based
|
|
decodeMode = Decode {
|
|
b91 = def &= help "decode base91",
|
|
b85 = def &= help "decode base85",
|
|
b64 = def &= help "decode base64",
|
|
b64url = def &= help "decode base64Url",
|
|
url = def &= help "decode URI",
|
|
b62 = def &= help "decode base62",
|
|
b58 = def &= help "decode base58",
|
|
b32 = def &= help "decode base32",
|
|
b16 = def &= help "decode base16",
|
|
b10 = def &= help "decode decimal from hex",
|
|
b8 = def &= help "decode octal from hex",
|
|
b2 = def &= help "decode binary from hex",
|
|
qp = def &= help "decode quoted-printable",
|
|
uu = def &= help "decode uu",
|
|
xx = def &= help "decode xx",
|
|
yenc = def &= help "decode yEncode",
|
|
solve = def &= help "solve encoding"
|
|
} &= help "Decode chosen base" &=auto
|
|
|
|
encodeMode :: Based
|
|
encodeMode = Encode {
|
|
b91 = def &= help "encode base91",
|
|
b85 = def &= help "encode base85",
|
|
b64 = def &= help "encode base64",
|
|
b64url = def &= help "encode base64Url",
|
|
url = def &= help "encode URI",
|
|
b62 = def &= help "encode base62",
|
|
b58 = def &= help "encode base58",
|
|
b32 = def &= help "encode base32",
|
|
b16 = def &= help "encode base16",
|
|
b10 = def &= help "encode base10 to hex",
|
|
b8 = def &= help "encode octal to hex",
|
|
b2 = def &= help "encode binary to hex",
|
|
qp = def &= help "encode quoted-printable",
|
|
uu = def &= help "encode uu",
|
|
xx = def &= help "encode xx",
|
|
yenc = def &= help "encode yEncode"
|
|
} &= help "Encode chosen base"
|
|
|
|
main :: IO()
|
|
main = cmdArgs (modes[decodeMode, encodeMode] &= help "Anybased, when Cyberchef simply doesn't cut it.\nTo see every parameter of every mode use --help=all" &= program "based" &= summary "based v0.4") >>= interact . optionHandler
|