diff --git a/Data/PHPSession.hs b/Data/PHPSession.hs --- a/Data/PHPSession.hs +++ b/Data/PHPSession.hs @@ -196,7 +196,13 @@ let Just (sub,rest') = decodePartialPHPSessionValuesNested rest [] in (Just $ reverse (PHPSessionAttrNested sub:l),rest') Nothing -> - (Nothing, input) + case dec_colon_uppercase_letters input of + Just ("NAN", rest) -> decodePartialPHPSessionAttr rest ((PHPSessionAttrFloat $ 0/0):l) + Just ("INF", rest) -> decodePartialPHPSessionAttr rest ((PHPSessionAttrFloat $ 1/0):l) + Just ("-INF", rest) -> decodePartialPHPSessionAttr rest ((PHPSessionAttrFloat $ -1/0):l) + Nothing -> + error $ show input + -- (Nothing, input) -- error "No good" dec_colon_integer_colon_dquote_classname_dquote_colon input = do (_0,n0) <- dec_get_colon input @@ -229,17 +235,48 @@ (_0,n0) <- dec_get_colon input (_1,n1) <- dec_get_openc n0 return (":{", n1) + dec_colon_uppercase_letters input = do + (_0,n0) <- dec_get_colon input + (a1,n1) <- dec_get_uppercase_letters n0 + return (a1,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 + case dec_get_neg_number input of + Just result -> Just result + Nothing -> + dec_get_pos_number input + dec_get_neg_number input = do + (a0,n0) <- dec_get_dash input + (a1,n1) <- dec_get_pos_number n0 + return (LBS.concat [a0,a1], n1) + dec_get_pos_number input = do + (a0,n0) <- dec_get_integer input + case dec_get_dot n0 of + Nothing -> return (a0,n0) + Just (a1,n1) -> do + (a2,n2) <- dec_get_integer n1 + return (LBS.concat [a0,a1,a2], n2) 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_uppercase_letters input = + case dec_get_neg_uppercase_letters input of + Just result -> Just result + Nothing -> + dec_get_pos_uppercase_letters input + dec_get_neg_uppercase_letters input = do + (a0,n0) <- dec_get_dash input + (a1,n1) <- dec_one_or_more n0 $ LBS.takeWhile C.isAsciiUpper n0 + return (LBS.concat [a0,a1], n1) + dec_get_pos_uppercase_letters input = + dec_one_or_more input $ LBS.takeWhile C.isAsciiUpper 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 + dec_get_dash input = case LBS.take 1 input of "-" -> Just ("-", LBS.drop 1 input); _ -> Nothing + dec_get_dot input = case LBS.take 1 input of "." -> Just (".", LBS.drop 1 input); _ -> Nothing -- | Encode a 'PHPSessionVariableList' into a 'ByteString' containing the serialization -- of a list of session variables using the \"php\" session serialization format. @@ -321,6 +358,11 @@ encodePHPSessionAttr att = case att of PHPSessionAttrInt i -> LBS.concat [":", LBS.pack $ show i] + PHPSessionAttrFloat f | isNaN f -> ":NAN" + PHPSessionAttrFloat f | isInfinite f -> + if f < 0 + then ":-INF" + else ":INF" PHPSessionAttrFloat f -> LBS.concat [":", LBS.pack $ show f] PHPSessionAttrNested vars -> LBS.concat $ [":{"] ++ map encodePHPSessionValue vars ++ ["}"] diff --git a/Test/General.hs b/Test/General.hs --- a/Test/General.hs +++ b/Test/General.hs @@ -16,7 +16,7 @@ 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 qualified Text.Regex.Posix as TR import Data.List (foldl') testcases :: Bool @@ -25,13 +25,14 @@ 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\";" + test5 = "testfloat1|d:1.00001121;testfloat2|d:NAN;testfloat3|d:INF;testfloat4|d:-INF;" 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) - [test1,test2,test3,test4] + [test1,test2,test3,test4,test5] 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,5 +1,5 @@ name: hs-php-session -version: 0.0.9.0 +version: 0.0.9.1 synopsis: PHP session and values serialization description: A library for encoding and decoding serialized PHP sessions in the format @@ -26,5 +26,5 @@ Data.PHPSession.Types -- other-modules: build-depends: - base ==4.6.*, - bytestring + base == 4.*, + bytestring >= 0.10.0.0