diff --git a/Data/PHPSession.hs b/Data/PHPSession.hs new file mode 100644 --- /dev/null +++ b/Data/PHPSession.hs @@ -0,0 +1,346 @@ +{-# LANGUAGE OverloadedStrings #-} +-- | +-- Module : Data.PHPSession +-- Copyright: (c) 2013-2014 Edward Blake +-- License: BSD-style +-- Maintainer: Edward L. Blake +-- Stability: experimental +-- Portability: portable +-- +-- Encodes and decodes serialized PHP sessions in the format used by the \"php\" setting +-- for session.serialize_handler. +-- + +module Data.PHPSession ( + -- * Decode from 'ByteString' + decodePHPSession, + decodePHPSessionValue, + -- * Encode to 'ByteString' + encodePHPSession, + encodePHPSessionValue, + -- * Decode only part of a 'ByteString' + decodePartialPHPSession, + decodePartialPHPSessionValue, + -- * PHP session types + PHPSessionVariableList, + PHPSessionClassName (..), + PHPSessionValue (..), + PHPSessionAttr (..) +) where + +import Data.PHPSession.Types + +import qualified Data.ByteString.Char8 as BS +import qualified Data.ByteString.Lazy.Char8 as LBS +import qualified Data.List as L +import Data.List (foldl') +import qualified Data.Char as C + +-- import qualified Text.Regex.Posix as TR + +-- | Decodes a 'ByteString' representing a PHP session into a 'PHPSessionVariableList' +decodePHPSession :: LBS.ByteString -> Maybe PHPSessionVariableList +decodePHPSession input = + case decodePartialPHPSession input of + (everything,"") -> everything + (_, _) -> Nothing + +-- -> [(LBS.ByteString, PHPSessionValue)] +-- | Decodes as much as needed of a 'ByteString' representing a PHP session into a 'PHPSessionVariableList' +decodePartialPHPSession :: LBS.ByteString -> (Maybe PHPSessionVariableList, LBS.ByteString) +decodePartialPHPSession "" = (Nothing, "") +decodePartialPHPSession input = + decodePartialPHPSessionEachTopLevel input [] + where + decodePartialPHPSessionEachTopLevel input lst = + case input of + "" -> (Just $ reverse lst,"") + _ -> + case LBS.take 1 input of + "}" -> + (Just $ reverse lst, LBS.drop 1 input) + _ -> + case decodePartialPHPSessionVarName input of + (Nothing,_) -> (Nothing, input) + (Just name, rest) -> + case decodePartialPHPSessionValue rest of + (Nothing,_) -> (Nothing, input) + (Just sym,rest') -> + decodePartialPHPSessionEachTopLevel rest' ((name, sym):lst) + decodePartialPHPSessionVarName input = + case dec input of + Nothing -> (Nothing, input) + Just (sername, rest) -> (Just sername, rest) + --case input TR.=~ ("[a-zA-Z_][a-zA-Z0-9_]*\\|" :: LBS.ByteString) :: (LBS.ByteString,LBS.ByteString,LBS.ByteString) of + -- ("",sernametype,rest) -> + -- let (sername,_) = LBS.span (/='|') sernametype + -- in (sername,rest) +-- where + dec input = do + (f0,n0) <- get_alpha input + (restname,n1) <- get_alphanum_any_left n0 + (_,n2) <- get_vertbar n1 + return (LBS.concat [f0,restname], n2) + get_alpha input = + case LBS.takeWhile (\a -> (C.isAsciiLower a) || (C.isAsciiUpper a) || (a == '_')) input of + "" -> Nothing; l -> Just (l, LBS.drop (LBS.length l) input) + get_alphanum_any_left input = + case LBS.takeWhile (\a -> (C.isAsciiLower a) || (C.isAsciiUpper a) || (C.isDigit a) || (a == '_')) input of + l -> Just (l, LBS.drop (LBS.length l) input) + get_vertbar input = case LBS.take 1 input of "|" -> Just ("|", LBS.drop 1 input); _ -> Nothing + + + +-- Not exported and used by decodePartialPHPSessionValue +decodePartialPHPSessionValuesNested :: LBS.ByteString -> [PHPSessionValue] -> (Maybe [PHPSessionValue], LBS.ByteString) +decodePartialPHPSessionValuesNested input lst = + case input of + "" -> (Just $ reverse lst,"") + _ -> + case LBS.take 1 input of + "}" -> + (Just $ reverse lst, LBS.drop 1 input) + _ -> + case decodePartialPHPSessionValue input of + (Just sym,rest) -> + decodePartialPHPSessionValuesNested rest (sym:lst) + _ -> (Nothing, input) + + +-- | Decodes a 'ByteString' into a 'PHPSessionValue' +decodePHPSessionValue :: LBS.ByteString -> Maybe PHPSessionValue +decodePHPSessionValue input = + case decodePartialPHPSessionValue input of + (everything,"") -> everything + (_,_) -> Nothing + +-- | Decodes as much of a 'ByteString' as needed into a 'PHPSessionValue' +decodePartialPHPSessionValue :: LBS.ByteString -> (Maybe PHPSessionValue, LBS.ByteString) +decodePartialPHPSessionValue "" = (Nothing, "") +decodePartialPHPSessionValue input = + let sertype = LBS.take 1 input + rest = LBS.drop 1 input + in case sertype of + -- "Object implementing Serializeable" (C) + -- ex: hi|C:9:"ClassName":5:{harr}} + "C" -> + case dec_colon_integer_colon_dquote_classname_dquote_colon rest of + Nothing -> (Nothing, input) + Just (_classnamelen,cls',numrest) -> + + --case rest TR.=~ (":[0-9]+:\"[A-Za-z0-9_]+\":" :: LBS.ByteString) :: (LBS.ByteString,LBS.ByteString,LBS.ByteString) of + -- ("",cls,numrest) -> + case LBS.span (/=':') numrest of + (num, colrest) -> + -- let [_,cls',_] = LBS.split '"' cls + let num' = read (LBS.unpack num) + (dat,rest') = LBS.splitAt num' $ LBS.drop 2 colrest + rest'' = LBS.drop 1 rest' + in (Just $ PHPSessionValueObjectSerializeable (PHPSessionClassName cls') dat, rest'') + + -- Object (O) ex: hi|O:9:"ClassName":2:{s:4:"blah";i:1;s:3:"str";s:6:"string";} + "O" -> + case dec_colon_integer_colon_dquote_classname_dquote rest of + Nothing -> (Nothing, input) + Just (_,cls',attrest) -> + -- case rest TR.=~ (":[0-9]+:\"[A-Za-z0-9_]+\"" :: LBS.ByteString) :: (LBS.ByteString,LBS.ByteString,LBS.ByteString) of + -- ("",cls,attrest) -> + -- let [_,cls',_] = LBS.split '"' cls + let (l,rest') = decodePartialPHPSessionAttr attrest [] + in case l of + Nothing -> (Nothing, input) + Just [PHPSessionAttrInt _, PHPSessionAttrNested vals] -> + let (al, bl) = L.partition (odd . snd) (zip vals [1..]) + arlst = map (\[a,b] -> (a,b)) $ L.transpose [ map (\(a,_)->a) al, map (\(a,_)->a) bl ] + in ((Just $ PHPSessionValueObject (PHPSessionClassName cls') arlst),rest') + + -- String (s) ex: hi|s:6:"string"; + "s" -> + case dec_colon_integer_colon_dquote rest of + Nothing -> (Nothing, input) + Just (len, strrest) -> + --case rest TR.=~ (":[0-9]+:\"" :: LBS.ByteString) :: (LBS.ByteString,LBS.ByteString,LBS.ByteString) of + -- ("",strlen,strrest) -> + -- let [_,len,_] = LBS.split ':' strlen + let len' = read (LBS.unpack len) + (str,rest') = LBS.splitAt len' $ strrest + rest'' = LBS.drop 2 rest' + in (Just $ PHPSessionValueString str,rest'') + + _ -> + let (l,rest') = decodePartialPHPSessionAttr rest [] + in case (sertype, l) of + -- Array (a) ex: hi|a:3:{i:0;i:1;i:1;i:2;i:2;s:3:"abc";} + ("a",Just [PHPSessionAttrInt _, PHPSessionAttrNested vals]) -> + let (al, bl) = L.partition (odd . snd) (zip vals [1..]) + arlst = map (\[a,b] -> (a,b)) $ L.transpose [ map (\(a,_)->a) al, map (\(a,_)->a) bl ] + in (Just $ PHPSessionValueArray arlst, rest') + + -- Boolean (b) ex: hi|b:0; = FALSE -- hi|b:1; = TRUE + ("b",Just [PHPSessionAttrInt 1]) -> (Just $ PHPSessionValueBool True,rest') + ("b",Just [PHPSessionAttrInt 0]) -> (Just $ PHPSessionValueBool False,rest') + + -- Float (d) ex: hi|d:0.1000000000000000055511151231257827021181583404541015625; + ("d",Just [PHPSessionAttrFloat num]) -> (Just (PHPSessionValueFloat $ Right num),rest') + ("d",Just [PHPSessionAttrInt num]) -> (Just (PHPSessionValueFloat $ Left num),rest') + + -- Integer (i) ex: hi|i:26; + ("i",Just [PHPSessionAttrInt num]) -> (Just $ PHPSessionValueInt num,rest') + + -- Null (N) ex: hi|N; + ("N",Just []) -> (Just PHPSessionValueNull,rest') + + -- Recursive values and references (r), (R), TODO: PHP 6 encoded String (S) + _ -> case l of + Just l' -> (Just (PHPSessionValueMisc sertype l'),rest') + Nothing -> (Nothing, input) + where + + decodePartialPHPSessionAttr :: LBS.ByteString -> [PHPSessionAttr] -> (Maybe [PHPSessionAttr],LBS.ByteString) + decodePartialPHPSessionAttr input l = + case LBS.take 1 input of + ";" -> + (Just $ reverse l,LBS.drop 1 input) + _ -> + case dec_colon_and_number input of + Just (num,rest) -> + --case input TR.=~ (":[-0-9.]+" :: LBS.ByteString) :: (LBS.ByteString,LBS.ByteString,LBS.ByteString) of + -- ("",num,rest) -> + let num' = LBS.unpack $ num -- LBS.drop 1 + in case LBS.elem '.' num of + True -> + decodePartialPHPSessionAttr rest ((PHPSessionAttrFloat $ read $ num'):l) + False -> + decodePartialPHPSessionAttr rest ((PHPSessionAttrInt $ read $ num'):l) + _ -> + case dec_colon_and_open_curly input of + Just (":{", rest) -> + -- case input TR.=~ (":{" :: LBS.ByteString) :: (LBS.ByteString,LBS.ByteString,LBS.ByteString) of + -- ("",":{",rest) -> + let (Just sub,rest') = decodePartialPHPSessionValuesNested rest [] + in (Just $ reverse (PHPSessionAttrNested sub:l),rest') + Nothing -> + (Nothing, input) + -- error "No good" + dec_colon_integer_colon_dquote_classname_dquote_colon input = do + (_0,n0) <- dec_get_colon input + (len,n1) <- dec_get_integer n0 + (_2,n2) <- dec_get_colon n1 + (_3,n3) <- dec_get_dquote n2 + (classname,n4) <- dec_get_alphanum n3 + (_5,n5) <- dec_get_dquote n4 + (_6,n6) <- dec_get_colon n5 + return (len,classname,n6) + dec_colon_integer_colon_dquote_classname_dquote input = do + (_0,n0) <- dec_get_colon input + (len,n1) <- dec_get_integer n0 + (_2,n2) <- dec_get_colon n1 + (_3,n3) <- dec_get_dquote n2 + (classname,n4) <- dec_get_alphanum n3 + (_5,n5) <- dec_get_dquote n4 + return (len,classname,n5) + dec_colon_integer_colon_dquote input = do + (_0,n0) <- dec_get_colon input + (len,n1) <- dec_get_integer n0 + (_2,n2) <- dec_get_colon n1 + (_3,n3) <- dec_get_dquote n2 + return (len,n3) + dec_colon_and_number input = do + (_0,n0) <- dec_get_colon input + (num,n1) <- dec_get_number n0 + return (num,n1) + dec_colon_and_open_curly input = do + (_0,n0) <- dec_get_colon input + (_1,n1) <- dec_get_openc input + return (":{", n1) + + dec_one_or_more input a = case a of "" -> Nothing; l -> Just (l, LBS.drop (LBS.length l) input) + dec_get_number input = + dec_one_or_more input $ LBS.takeWhile (\a -> (C.isDigit a) || (a == '-') || (a == '.')) input + dec_get_alphanum input = + dec_one_or_more input $ LBS.takeWhile (\a -> (C.isDigit a) || (C.isAsciiLower a) || (C.isAsciiUpper a) || (a == '_')) input + dec_get_integer input = + dec_one_or_more input $ LBS.takeWhile C.isDigit input + dec_get_openc input = case LBS.take 1 input of "{" -> Just ("{", LBS.drop 1 input); _ -> Nothing + dec_get_dquote input = case LBS.take 1 input of "\"" -> Just ("\"", LBS.drop 1 input); _ -> Nothing + dec_get_colon input = case LBS.take 1 input of ":" -> Just (":", LBS.drop 1 input); _ -> Nothing + +-- | Encode a 'PHPSessionVariableList' into a 'ByteString'. +encodePHPSession :: PHPSessionVariableList -> LBS.ByteString +encodePHPSession lst = + encodePHPSessionTop lst [] +encodePHPSessionTop lst outlst = + case lst of + [] -> LBS.concat $ reverse outlst + (name,var):xs -> + let out' = (encodePHPSessionVarName name) : outlst + out'' = (encodePHPSessionValue var) : out' + in encodePHPSessionTop xs out'' + where + encodePHPSessionVarName name = + LBS.concat [name, "|"] + +-- | Encode a 'PHPSessionValue' into a 'ByteString'. +encodePHPSessionValue var = + case var of + PHPSessionValueObjectSerializeable (PHPSessionClassName cls) dat -> + LBS.concat + [ + "C:", LBS.pack $ show (LBS.length cls), ":\"", cls, "\":", + LBS.pack $ show (LBS.length dat), ":{", dat, "}" + ] + PHPSessionValueArray arlst -> + let nst = reverse $ foldl' (\l (k,v) -> (v:(k:l))) [] arlst + in LBS.concat + [ + "a", encodePHPSessionAttr (PHPSessionAttrInt $ length arlst), + encodePHPSessionAttr (PHPSessionAttrNested nst) + ] + PHPSessionValueBool b -> + LBS.concat + [ + "b", encodePHPSessionAttr (PHPSessionAttrInt $ if b then 1 else 0), ";" + ] + PHPSessionValueFloat d -> + LBS.concat + [ + "d", encodePHPSessionAttr $ + case d of + Left i -> PHPSessionAttrInt i; + Right d' -> PHPSessionAttrFloat d', + ";" + ] + PHPSessionValueInt i -> + LBS.concat + [ + "i", encodePHPSessionAttr (PHPSessionAttrInt i), ";" + ] + PHPSessionValueNull -> + "N;" + PHPSessionValueObject (PHPSessionClassName cls) proplst -> + let nst = reverse $ foldl' (\l (k,v) -> (v:(k:l))) [] proplst + cls' = BS.concat $ LBS.toChunks cls + in LBS.concat + [ + "O", encodePHPSessionAttr (PHPSessionAttrInt $ BS.length cls'), + ":\"", LBS.fromChunks [cls'], "\"", + encodePHPSessionAttr (PHPSessionAttrInt $ length proplst), + encodePHPSessionAttr (PHPSessionAttrNested nst) + ] + PHPSessionValueString str -> + let str' = BS.concat $ LBS.toChunks str + in LBS.concat + [ + "s", encodePHPSessionAttr (PHPSessionAttrInt $ BS.length str'), + ":\"", LBS.fromChunks [str'], "\";" + ] + PHPSessionValueMisc sertype atts -> + LBS.concat $ [sertype] ++ map encodePHPSessionAttr atts ++ [";"] + where + + encodePHPSessionAttr att = + case att of + PHPSessionAttrInt i -> LBS.concat [":", LBS.pack $ show i] + PHPSessionAttrFloat f -> LBS.concat [":", LBS.pack $ show f] + PHPSessionAttrNested vars -> + LBS.concat $ [":{"] ++ map encodePHPSessionValue vars ++ ["}"] diff --git a/Data/PHPSession/Types.hs b/Data/PHPSession/Types.hs new file mode 100644 --- /dev/null +++ b/Data/PHPSession/Types.hs @@ -0,0 +1,98 @@ +{-# LANGUAGE OverloadedStrings #-} +-- | +-- Module : Data.PHPSession +-- Copyright: (c) 2013-2014 Edward Blake +-- License: BSD-style +-- Maintainer: Edward L. Blake +-- Stability: experimental +-- Portability: portable +-- +-- Encodes and decodes serialized PHP sessions in the format used by the \"php\" setting +-- for serialize_handler. +-- + +module Data.PHPSession.Types ( + -- * PHP session types + PHPSessionVariableList, + PHPSessionClassName (..), + PHPSessionValue (..), + PHPSessionAttr (..) +) where + +import qualified Data.ByteString.Lazy.Char8 as LBS + +-- | Holds the "top-level" session variables and their value contents. +type PHPSessionVariableList = [(LBS.ByteString, PHPSessionValue)] + +data PHPSessionClassName = + PHPSessionClassName LBS.ByteString + +instance Show PHPSessionClassName where + show (PHPSessionClassName str) = "PHPSessionClassName " ++ show str + +instance Eq PHPSessionClassName where + PHPSessionClassName a == PHPSessionClassName b = a == b + +data PHPSessionValue = + PHPSessionValueArray [(PHPSessionValue,PHPSessionValue)] | + PHPSessionValueBool Bool | + PHPSessionValueFloat (Either Int Double) | + PHPSessionValueInt Int | + PHPSessionValueNull | + PHPSessionValueObject PHPSessionClassName [(PHPSessionValue,PHPSessionValue)] | + PHPSessionValueObjectSerializeable PHPSessionClassName LBS.ByteString | + PHPSessionValueString LBS.ByteString | + PHPSessionValueMisc LBS.ByteString [PHPSessionAttr] + +instance Show PHPSessionValue where + show (PHPSessionValueArray arlst) = "PHPSessionValueArray " ++ show arlst + show (PHPSessionValueBool b) = "PHPSessionValueBool " ++ show b + show (PHPSessionValueFloat f) = "PHPSessionValueFloat " ++ show f + show (PHPSessionValueInt i) = "PHPSessionValue " ++ show i + show (PHPSessionValueNull) = "PHPSessionValueNull" + show (PHPSessionValueObject cls xs) = "PHPSessionValueObject " ++ show cls ++ " " ++ show xs + show (PHPSessionValueObjectSerializeable x xs) = + "PHPSessionValueObjectSerializeable " ++ show x ++ " " ++ show xs + show (PHPSessionValueString s) = "PHPSessionValueString " ++ show s + show (PHPSessionValueMisc x xs) = "PHPSessionValueMisc " ++ show x ++ " " ++ show xs + +instance Eq PHPSessionValue where + PHPSessionValueArray a == PHPSessionValueArray b = a == b + PHPSessionValueBool a == PHPSessionValueBool b = a == b + PHPSessionValueFloat a == PHPSessionValueFloat b = a == b + PHPSessionValueInt a == PHPSessionValueInt b = a == b + PHPSessionValueNull == PHPSessionValueNull = True + PHPSessionValueObject a b == PHPSessionValueObject c d = a == c && b == d + PHPSessionValueObjectSerializeable a b == PHPSessionValueObjectSerializeable c d = a == c && b == d + PHPSessionValueString a == PHPSessionValueString b = a == b + PHPSessionValueMisc a b == PHPSessionValueMisc c d = False + _ == _ = False + +instance Ord PHPSessionValue where + PHPSessionValueArray a <= PHPSessionValueArray b = a <= b + PHPSessionValueBool a <= PHPSessionValueBool b = a <= b + PHPSessionValueFloat a <= PHPSessionValueFloat b = a <= b + PHPSessionValueInt a <= PHPSessionValueInt b = a <= b + PHPSessionValueNull <= PHPSessionValueNull = True + PHPSessionValueObject (PHPSessionClassName a) b <= PHPSessionValueObject (PHPSessionClassName c) d = a <= c && b <= d + PHPSessionValueObjectSerializeable (PHPSessionClassName a) b <= PHPSessionValueObjectSerializeable (PHPSessionClassName c) d = a <= c && b <= d + PHPSessionValueString a <= PHPSessionValueString b = a <= b + PHPSessionValueMisc a b <= PHPSessionValueMisc c d = False + _ <= _ = False + +data PHPSessionAttr = + PHPSessionAttrInt Int | + PHPSessionAttrFloat Double | + PHPSessionAttrNested [PHPSessionValue] + +instance Show PHPSessionAttr where + show (PHPSessionAttrInt n) = "PHPSessionAttrInt " ++ show n + show (PHPSessionAttrFloat n) = "PHPSessionAttrFloat " ++ show n + show (PHPSessionAttrNested ns) = "PHPSessionAttrNested " ++ show ns + +instance Eq PHPSessionAttr where + PHPSessionAttrInt a == PHPSessionAttrInt b = a == b + PHPSessionAttrFloat a == PHPSessionAttrFloat b = a == b + PHPSessionAttrNested a == PHPSessionAttrNested b = a == b + _ == _ = False + diff --git a/LICENSE b/LICENSE new file mode 100644 --- /dev/null +++ b/LICENSE @@ -0,0 +1,30 @@ +Copyright (c) 2014, Edward L. Blake + +All rights reserved. + +Redistribution and use in source and binary forms, with or without +modification, are permitted provided that the following conditions are met: + + * Redistributions of source code must retain the above copyright + notice, this list of conditions and the following disclaimer. + + * Redistributions in binary form must reproduce the above + copyright notice, this list of conditions and the following + disclaimer in the documentation and/or other materials provided + with the distribution. + + * Neither the name of Edward L. Blake nor the names of other + contributors may be used to endorse or promote products derived + from this software without specific prior written permission. + +THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS +"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT +LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR +A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT +OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, +SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT +LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, +DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY +THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT +(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE +OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. diff --git a/README.md b/README.md new file mode 100644 --- /dev/null +++ b/README.md @@ -0,0 +1,4 @@ +hs-php-session +============== + +Haskell library for encoding and decoding PHP session serializations diff --git a/Setup.hs b/Setup.hs new file mode 100644 --- /dev/null +++ b/Setup.hs @@ -0,0 +1,2 @@ +import Distribution.Simple +main = defaultMain diff --git a/Test/General.hs b/Test/General.hs new file mode 100644 --- /dev/null +++ b/Test/General.hs @@ -0,0 +1,36 @@ +-- | +-- Module : Data.PHPSession +-- License: BSD3 +-- Maintainer: Edward L. Blake +-- Stability: experimental +-- Portability: unknown +-- +-- Testing Data.PHPSession +-- +{-# LANGUAGE OverloadedStrings #-} + +module Test.General where + +import Data.PHPSession + +import qualified Data.ByteString.Char8 as BS +import qualified Data.ByteString.Lazy.Char8 as LBS +import qualified Data.List as L +import qualified Text.Regex.Posix as TR +import Data.List (foldl') + +testcases :: Bool +testcases = + let test1 = "v1|s:94:\" !\"#$%&'()*+,-./0123456789:;<=>?@ABCDEFGHIJKLMNOPQRSTUVWXYZ[\\]^_`abcdefghijklmnopqrstuvwxyz{|}\";v2|a:3:{i:0;i:10;i:1;i:9;i:2;s:5:\"eight\";}v3|C:9:\"ClassName\":94:{ !\"#$%&'()*+,-./0123456789:;<=>?@ABCDEFGHIJKLMNOPQRSTUVWXYZ[\\]^_`abcdefghijklmnopqrstuvwxyz{|}}v4|b:1;v5|i:10;v6|d:5.5;v7|N;" + test2 = "v1|a:3:{i:0;i:10;i:1;i:9;i:2;a:3:{i:0;i:8;i:1;i:7;i:2;a:3:{i:0;i:6;i:1;s:4:\"five\";i:2;d:4;}}}v2|O:9:\"ClassName\":2:{s:4:\"blah\";i:1;s:3:\"str\";s:94:\" !\"#$%&'()*+,-./0123456789:;<=>?@ABCDEFGHIJKLMNOPQRSTUVWXYZ[\\]^_`abcdefghijklmnopqrstuvwxyz{|}\";}" + test3 = "v1|s:256:\"00000000000000000000000000000000 !\"#$%&'()*+,-./0123456789:;<=>?@ABCDEFGHIJKLMNOPQRSTUVWXYZ[\\]^_`abcdefghijklmnopqrstuvwxyz{|}~000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000\";" + tresults = map (\test -> case decodePHPSession test of + Nothing -> False + Just dec -> let result = encodePHPSession dec in + if result == test + then True + else error $ "Not same: " ++ LBS.unpack test ++ " and " ++ LBS.unpack result) + [test3] -- [test1,test2,test3] + fresults = map (\test -> case decodePHPSession test of Nothing -> False; Just dec -> let result = encodePHPSession dec in result == test) + [] + in and tresults && ((or fresults) /= True) diff --git a/hs-php-session.cabal b/hs-php-session.cabal new file mode 100644 --- /dev/null +++ b/hs-php-session.cabal @@ -0,0 +1,26 @@ +name: hs-php-session +version: 0.0.8.8 +synopsis: PHP session serialization +-- description: +homepage: https://github.com/elblake/hs-php-session +license: BSD3 +license-file: LICENSE +author: Edward L. Blake +maintainer: edwardlblake@gmail.com +-- copyright: +category: Data +build-type: Simple +cabal-version: >=1.8 + +extra-source-files: + README.md + Test/General.hs + +library + exposed-modules: + Data.PHPSession + Data.PHPSession.Types + -- other-modules: + build-depends: + base ==4.6.*, + bytestring