diff --git a/Data/PHPSession.hs b/Data/PHPSession.hs --- a/Data/PHPSession.hs +++ b/Data/PHPSession.hs @@ -19,7 +19,6 @@ encodePHPSession, encodePHPSessionValue, -- * Decode only part of a 'ByteString' - decodePartialPHPSession, decodePartialPHPSessionValue, -- * PHP session types PHPSessionVariableList, @@ -33,139 +32,116 @@ 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 Data.List (foldl') -- import qualified Text.Regex.Posix as TR --- | Decodes a 'ByteString' representing a PHP session into a 'PHPSessionVariableList' +-- | Decodes a 'ByteString' containing a serialization of a list of session variables +-- using the \"php\" session serialization format into a 'PHPSessionVariableList' decodePHPSession :: LBS.ByteString -> Maybe PHPSessionVariableList decodePHPSession input = - case decodePartialPHPSession input of - (everything,"") -> everything - (_, _) -> Nothing + case decodePHPSessionEachTopLevel input [] of + Nothing -> Nothing + Just (everything,"") -> Just everything + Just (_, _) -> 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 = + decodePHPSessionEachTopLevel 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 + "" -> Just (reverse lst,"") + _ -> do + (name, rest) <- decodePHPSessionTopLevelVarName input + (sym, rest') <- decodePartialPHPSessionValue rest + decodePHPSessionEachTopLevel rest' ((name, sym):lst) + + decodePHPSessionTopLevelVarName input = do + (varname,n1) <- get_name_until_vertbar input (_,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 + return (varname, n2) + get_name_until_vertbar input = + case LBS.takeWhile (/= '|') 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 :: LBS.ByteString -> [PHPSessionValue] -> Maybe ([PHPSessionValue], LBS.ByteString) decodePartialPHPSessionValuesNested input lst = case input of - "" -> (Just $ reverse lst,"") + "" -> 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) + Just (reverse lst, LBS.drop 1 input) + _ -> do + (sym,rest) <- decodePartialPHPSessionValue input + decodePartialPHPSessionValuesNested rest (sym:lst) --- | Decodes a 'ByteString' into a 'PHPSessionValue' +-- | Decodes a 'ByteString' containing a session serialization of a value into a +-- 'PHPSessionValue'. The format being decoded is similar if not probably the same +-- format used by PHP's serialize/unserialize functions. +-- 'Nothing' is returned if the input bytestring could not be parsed correctly. +-- decodePHPSessionValue :: LBS.ByteString -> Maybe PHPSessionValue decodePHPSessionValue input = case decodePartialPHPSessionValue input of - (everything,"") -> everything - (_,_) -> Nothing + Nothing -> Nothing + Just (everything,"") -> Just everything + Just (_, _) -> Nothing --- | Decodes as much of a 'ByteString' as needed into a 'PHPSessionValue' -decodePartialPHPSessionValue :: LBS.ByteString -> (Maybe PHPSessionValue, LBS.ByteString) -decodePartialPHPSessionValue "" = (Nothing, "") +-- | Decodes as much of a 'ByteString' as needed into a 'PHPSessionValue' and returns +-- the rest of the string. Decoding ends at either the end of the string or when the +-- extent of the current nested structure is met when an extra closing curly brace is +-- encountered. The format being decoded is similar if not probably the same +-- format used by PHP's serialize/unserialize functions. +-- 'Nothing' is returned if the input bytestring could not be parsed correctly. +-- +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) -> - + "C" -> do + (_classnamelen,cls',numrest) <- + dec_colon_integer_colon_dquote_classname_dquote_colon rest --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 + 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'') + 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) -> + "O" -> do + (_,cls',attrest) <- + dec_colon_integer_colon_dquote_classname_dquote rest -- 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 [] + let (l,rest') = decodePartialPHPSessionAttr attrest [] in case l of - Nothing -> (Nothing, input) + 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') + 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) -> + "s" -> do + (len, strrest) <- dec_colon_integer_colon_dquote rest --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 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 [] @@ -174,26 +150,26 @@ ("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') + 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') + ("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') + ("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') + ("i",Just [PHPSessionAttrInt num]) -> Just (PHPSessionValueInt num,rest') -- Null (N) ex: hi|N; - ("N",Just []) -> (Just PHPSessionValueNull,rest') + ("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) + Just l' -> Just ((PHPSessionValueMisc sertype l'),rest') + Nothing -> Nothing -- , input) where decodePartialPHPSessionAttr :: LBS.ByteString -> [PHPSessionAttr] -> (Maybe [PHPSessionAttr],LBS.ByteString) @@ -212,12 +188,12 @@ decodePartialPHPSessionAttr rest ((PHPSessionAttrFloat $ read $ num'):l) False -> decodePartialPHPSessionAttr rest ((PHPSessionAttrInt $ read $ num'):l) - _ -> + Nothing -> 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 [] + let Just (sub,rest') = decodePartialPHPSessionValuesNested rest [] in (Just $ reverse (PHPSessionAttrNested sub:l),rest') Nothing -> (Nothing, input) @@ -251,7 +227,7 @@ return (num,n1) dec_colon_and_open_curly input = do (_0,n0) <- dec_get_colon input - (_1,n1) <- dec_get_openc input + (_1,n1) <- dec_get_openc n0 return (":{", n1) dec_one_or_more input a = case a of "" -> Nothing; l -> Just (l, LBS.drop (LBS.length l) input) @@ -265,7 +241,8 @@ 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'. +-- | Encode a 'PHPSessionVariableList' into a 'ByteString' containing the serialization +-- of a list of session variables using the \"php\" session serialization format. encodePHPSession :: PHPSessionVariableList -> LBS.ByteString encodePHPSession lst = encodePHPSessionTop lst [] @@ -280,7 +257,10 @@ encodePHPSessionVarName name = LBS.concat [name, "|"] --- | Encode a 'PHPSessionValue' into a 'ByteString'. +-- | Encode a 'PHPSessionValue' into a 'ByteString' containing the serialization of a +-- PHP value. The format being encoded into is similar if not probably the same +-- format used by PHP's serialize/unserialize functions. +-- encodePHPSessionValue var = case var of PHPSessionValueObjectSerializeable (PHPSessionClassName cls) dat -> diff --git a/Data/PHPSession/Types.hs b/Data/PHPSession/Types.hs --- a/Data/PHPSession/Types.hs +++ b/Data/PHPSession/Types.hs @@ -7,8 +7,7 @@ -- Stability: experimental -- Portability: portable -- --- Encodes and decodes serialized PHP sessions in the format used by the \"php\" setting --- for serialize_handler. +-- Types used for representing PHP data types from encoding and decoding a PHP session. -- module Data.PHPSession.Types ( @@ -21,9 +20,10 @@ import qualified Data.ByteString.Lazy.Char8 as LBS --- | Holds the "top-level" session variables and their value contents. +-- | Holds the \"top-level\" session variables and their value contents. type PHPSessionVariableList = [(LBS.ByteString, PHPSessionValue)] +-- | Represents the name of a PHP class. data PHPSessionClassName = PHPSessionClassName LBS.ByteString @@ -33,6 +33,34 @@ instance Eq PHPSessionClassName where PHPSessionClassName a == PHPSessionClassName b = a == b +-- | 'PHPSessionValue' Represents a PHP value, which may be a number, string, +-- array, object, boolean, null, or references. +-- +-- * 'PHPSessionValueArray' represents an array as a list of key-value pairs +-- of values of type 'PHPSessionValue'. +-- +-- * 'PHPSessionValueObject' is similar to 'PHPSessionValueArray' but also +-- includes a class name of type 'PHPSessionClassName'. +-- +-- * 'PHPSessionValueObjectSerializeable' represent objects of which their classes +-- implement Serializeable to handle their own serialization and don't use +-- the normal serialization format for its contained objects. +-- +-- * 'PHPSessionValueBool', 'PHPSessionValueInt', 'PHPSessionValueFloat', +-- 'PHPSessionValueNull', and 'PHPSessionValueString' represent basic types +-- boolean, integer, floats, null and string respectively. +-- +-- * 'PHPSessionValueFloat' stores the number representation as an 'Either' 'Int' 'Double' +-- to preserve instances where the number representation is actually an integer. +-- It should be noted that the re-encoded value is usually rounded unlike PHP's +-- representation. +-- +-- * 'PHPSessionValueMisc' stores a few other types such as references and +-- values which follow the general serialization format but aren't recognized +-- by the decoder. A list of 'PHPSessionAttr' provides the information for +-- reconstructing the serialized representation when re-encoding this type +-- of value. +-- data PHPSessionValue = PHPSessionValueArray [(PHPSessionValue,PHPSessionValue)] | PHPSessionValueBool Bool | @@ -80,6 +108,9 @@ PHPSessionValueMisc a b <= PHPSessionValueMisc c d = False _ <= _ = False +-- | 'PHPSessionAttr' are values associated with 'PHPSessionValueMisc' to inspect and +-- generally re-encode the necessary information for that value. +-- data PHPSessionAttr = PHPSessionAttrInt Int | PHPSessionAttrFloat Double | diff --git a/Test/General.hs b/Test/General.hs --- a/Test/General.hs +++ b/Test/General.hs @@ -24,13 +24,14 @@ 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\";" + test4 = "teststr1|s:0:\"\";test_array|a:1:{i:0;a:2:{s:4:\"ABCD\";s:9:\"987654321\";s:0:\"\";b:1;}}test_int|i:1;teststr2|s:4:\"1234\";" 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] + [test1,test2,test3,test4] 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 --- a/hs-php-session.cabal +++ b/hs-php-session.cabal @@ -1,13 +1,17 @@ name: hs-php-session -version: 0.0.8.8 -synopsis: PHP session serialization --- description: +version: 0.0.9.0 +synopsis: PHP session and values serialization +description: + A library for encoding and decoding serialized PHP sessions in the format + used by the \"php\" setting for session.serialize_handler as well as + encoding and decoding serialized values. + homepage: https://github.com/elblake/hs-php-session license: BSD3 license-file: LICENSE author: Edward L. Blake maintainer: edwardlblake@gmail.com --- copyright: +copyright: (c) 2013-2014 Edward L. Blake category: Data build-type: Simple cabal-version: >=1.8