%% %% %CopyrightBegin% %% %% Copyright Ericsson AB 2008-2010. All Rights Reserved. %% %% The contents of this file are subject to the Erlang Public License, %% Version 1.1, (the "License"); you may not use this file except in %% compliance with the License. You should have received a copy of the %% Erlang Public License along with this software. If not, it can be %% retrieved online at http://www.erlang.org/. %% %% Software distributed under the License is distributed on an "AS IS" %% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See %% the License for the specific language governing rights and limitations %% under the License. %% %% %CopyrightEnd% %% %% Test suite for erlang:decode_packet/3 -module(decode_packet_SUITE). -include_lib("test_server/include/test_server.hrl"). -export([all/0, suite/0,groups/0,init_per_group/2,end_per_group/2,init_per_testcase/2,fin_per_testcase/2, basic/1, packet_size/1, neg/1, http/1, line/1, ssl/1, otp_8536/1]). suite() -> [{suite_callbacks,[ts_install_scb]}]. all() -> [basic, packet_size, neg, http, line, ssl, otp_8536]. groups() -> []. init_per_group(_GroupName, Config) -> Config. end_per_group(_GroupName, Config) -> Config. init_per_testcase(Func, Config) when is_atom(Func), is_list(Config) -> Seed = {S1,S2,S3} = now(), random:seed(S1,S2,S3), io:format("*** SEED: ~p ***\n", [Seed]), Dog=?t:timetrap(?t:minutes(1)), [{watchdog, Dog}|Config]. fin_per_testcase(_Func, Config) -> Dog=?config(watchdog, Config), ?t:timetrap_cancel(Dog). basic(doc) -> []; basic(suite) -> []; basic(Config) when is_list(Config) -> ?line Packet = <<101,22,203,54,175>>, ?line Rest = <<123,34,0,250>>, ?line Bin = <>, ?line {ok, Bin, <<>>} = decode_pkt(raw,Bin), ?line {more, 5+1} = decode_pkt(1,<<5,1,2,3,4>>), ?line {more, 5+2} = decode_pkt(2,<<0,5,1,2,3,4>>), ?line {more, 5+4} = decode_pkt(4,<<0,0,0,5,1,2,3,4>>), ?line {more, undefined} = decode_pkt(1,<<>>), ?line {more, undefined} = decode_pkt(2,<<0>>), ?line {more, undefined} = decode_pkt(4,<<0,0,0>>), Types = [1,2,4,asn1,sunrm,cdr,fcgi,tpkt,ssl_tls], %% Run tests for different header types and bit offsets. lists:foreach(fun({Type,Bits})->basic_pack(Type,Packet,Rest,Bits), more_length(Type,Packet,Bits) end, [{T,B} || T<-Types, B<-lists:seq(0,32)]), ok. basic_pack(Type,Body,Rest,BitOffs) -> ?line {Bin,Unpacked,_} = pack(Type,Body,Rest,BitOffs), ?line {ok, Unpacked, Rest} = decode_pkt(Type,Bin), case Rest of <<>> -> ok; _ -> ?line <<_:1,NRest/bits>> = Rest, basic_pack(Type,Body,NRest,BitOffs) end. more_length(Type,Body,BitOffs) -> ?line {Bin,_,_} = pack(Type,Body,<<>>,BitOffs), HdrSize = byte_size(Bin) - byte_size(Body), more_length_do(Type,HdrSize,Bin,byte_size(Bin)). more_length_do(_,_,_,0) -> ok; more_length_do(Type,HdrSize,Bin,Size) -> TrySize = (Size*3) div 4, NSize = if TrySize < HdrSize -> Size - 1; true -> TrySize end, {B1,_} = split_binary(Bin,NSize), ?line {more, Length} = decode_pkt(Type,B1), case Length of L when L=:=byte_size(Bin) -> ok; undefined when NSize ok end, more_length_do(Type,HdrSize,Bin,NSize). pack(Type,Packet,Rest) -> {Bin,Unpacked} = pack(Type,Packet), {<>,Unpacked}. %pack(0,B,R,Bits) -> % pack(raw,B,R,Bits); %pack(raw,Body,Rest,BitOffs) -> % Orig = <<0:BitOffs,Body/binary,Rest/bits>>, % <<_:BitOffs,Bin/bits>> = Orig, % {Bin,<>,Orig}; pack(Type,Body,Rest,BitOffs) -> {Packet,Unpacked} = pack(Type,Body), %% Make Bin a sub-bin with an arbitrary bitoffset within Orig Prefix = random:uniform(1 bsl BitOffs) - 1, Orig = <>, <<_:BitOffs,Bin/bits>> = Orig, {Bin,Unpacked,Orig}. pack(1,Bin) -> Psz = byte_size(Bin), {<>, Bin}; pack(2,Bin) -> Psz = byte_size(Bin), {<>, Bin}; pack(4,Bin) -> Psz = byte_size(Bin), {<>, Bin}; pack(asn1,Bin) -> Ident = case random:uniform(3) of 1 -> <<17>>; 2 -> <<16#1f,16#81,17>>; 3 -> <<16#1f,16#81,16#80,16#80,17>> end, Psz = byte_size(Bin), Length = case random:uniform(4) of 1 when Psz < 128 -> <>; R when R=<2 andalso Psz < 16#10000 -> <<16#82,Psz:16>>; R when R=<3 andalso Psz < 16#1000000 -> <<16#83,Psz:24>>; _ when Psz < 16#100000000 -> <<16#84,Psz:32>> end, Res = <>, {Res,Res}; pack(sunrm,Bin) -> Psz = byte_size(Bin), Res = if Psz < 16#80000000 -> <> end, {Res,Res}; pack(cdr,Bin) -> GIOP = <<"GIOP">>, Major = random:uniform(256) - 1, Minor = random:uniform(256) - 1, MType = random:uniform(256) - 1, Psz = byte_size(Bin), Res = case random:uniform(2) of 1 -> <>; 2 -> <> end, {Res,Res}; pack(fcgi,Bin) -> Ver = 1, Type = random:uniform(256) - 1, Id = random:uniform(65536) - 1, PaddSz = random:uniform(16) - 1, Psz = byte_size(Bin), Reserv = random:uniform(256) - 1, Padd = case PaddSz of 0 -> <<>>; _ -> list_to_binary([random:uniform(256)-1 || _<- lists:seq(1,PaddSz)]) end, Res = <>, {<>, Res}; pack(tpkt,Bin) -> Ver = 3, Reserv = random:uniform(256) - 1, Size = byte_size(Bin) + 4, Res = <>, {Res, Res}; pack(ssl_tls,Bin) -> Content = case (random:uniform(256) - 1) of C when C<128 -> C; _ -> v2hello end, Major = random:uniform(256) - 1, Minor = random:uniform(256) - 1, pack_ssl(Content,Major,Minor,Bin). pack_ssl(Content, Major, Minor, Body) -> case Content of v2hello -> Size = byte_size(Body), Res = <<1:1,(Size+3):15, 1:8, Major:8, Minor:8, Body/binary>>, C = 22, Data = <<1:8, (Size+2):24, Major:8, Minor:8, Body/binary>>; C when is_integer(C) -> Size = byte_size(Body), Res = <>, Data = Body end, {Res, {ssl_tls,[],C,{Major,Minor}, Data}}. packet_size(doc) -> []; packet_size(suite) -> []; packet_size(Config) when is_list(Config) -> ?line Packet = <<101,22,203,54,175>>, ?line Rest = <<123,34,0,250>>, F = fun({Type,Max})-> ?line {Bin,Unpacked} = pack(Type,Packet,Rest), ?line case decode_pkt(Type,Bin,[{packet_size,Max}]) of {ok,Unpacked,Rest} when Max=:=0; Max>=byte_size(Packet) -> ok; {error,_} when Max ok; {error,_} when Type=:=fcgi, Max=/=0 -> %% packet includes random amount of padding ok end end, ?line lists:foreach(F, [{T,D} || T<-[1,2,4,asn1,sunrm,cdr,fcgi,tpkt,ssl_tls], D<-lists:seq(0, byte_size(Packet)*2)]), %% Test OTP-8102, "negative" 4-byte sizes. lists:foreach(fun(Size) -> ?line {error,_} = decode_pkt(4,<>) end, lists:seq(-10,-1)), ok. neg(doc) -> []; neg(suite) -> []; neg(Config) when is_list(Config) -> ?line Bin = <<"dummy">>, Fun = fun()->dummy end, BadargF = fun(T,B,Opts)-> {'EXIT',{badarg,_}} = (catch decode_pkt(T,B,Opts)) end, %% Invalid Type args lists:foreach(fun(T)-> BadargF(T,Bin,[]) end, [3,-1,5,2.0,{2},unknown,[],"line",Bin,Fun,self()]), %% Invalid Bin args lists:foreach(fun(B)-> BadargF(0,B,[]) end, [3,2.0,unknown,[],"Bin",[Bin],{Bin},Fun,self()]), %% Invalid options InvOpts = [2,false,self(),Bin,"Options",Fun, packet_size,{packet_size},{packet_size,0,false}, {packet_size,-1},{packet_size,100.0},{packet_size,false}, {line_length,-1},{line_length,100.0},{line_length,false}], lists:foreach(fun(Opt)-> BadargF(0,Bin,Opt), BadargF(0,Bin,[Opt]), BadargF(0,Bin,[Opt,{packet_size,1000}]), BadargF(0,Bin,[{packet_size,1000},Opt]) end, InvOpts), ok. http(doc) -> []; http(suite) -> []; http(Config) when is_list(Config) -> ?line <<"foo">> = http_do(http_request("foo")), ?line <<" bar">> = http_do(http_request(" bar")), ?line <<"Hello!">> = http_do(http_response("Hello!")), %% Test all known header atoms Val = "dummy value", ValB = list_to_binary(Val), Rest = <<"Rest">>, HdrF = fun(Str,N) -> ?line StrA = list_to_atom(Str), ?line StrB = list_to_binary(Str), ?line Bin = <>, ?line {ok, {http_header,N,StrA,undefined,Val}, Rest} = decode_pkt(httph,Bin), ?line {ok, {http_header,N,StrA,undefined,ValB}, Rest} = decode_pkt(httph_bin,Bin), ?line N + 1 end, ?line lists:foldl(HdrF, 1, http_hdr_strings()), %% Test all known method atoms MethF = fun(Meth) -> ?line MethA = list_to_atom(Meth), ?line MethB = list_to_binary(Meth), ?line Bin = <>, ?line {ok, {http_request,MethA,{abs_path,"/invalid/url"},{1,0}}, Rest} = decode_pkt(http,Bin), ?line {ok, {http_request,MethA,{abs_path,<<"/invalid/url">>},{1,0}}, Rest} = decode_pkt(http_bin,Bin) end, ?line lists:foreach(MethF, http_meth_strings()), %% Test all uri variants UriF = fun({Str,ResL,ResB}) -> Bin = <<"GET ",(list_to_binary(Str))/binary," HTTP/1.1\r\n",Rest/binary>>, {ok, {http_request, 'GET', ResL, {1,1}}, Rest} = decode_pkt(http,Bin), {ok, {http_request, 'GET', ResB, {1,1}}, Rest} = decode_pkt(http_bin,Bin) end, lists:foreach(UriF, http_uri_variants()), %% Response with empty phrase ?line {ok,{http_response,{1,1},200,[]},<<>>} = decode_pkt(http, <<"HTTP/1.1 200\r\n">>, []), ?line {ok,{http_response,{1,1},200,<<>>},<<>>} = decode_pkt(http_bin, <<"HTTP/1.1 200\r\n">>, []), ok. http_with_bin(http) -> http_bin; http_with_bin(httph) -> httph_bin. http_do(Tup) -> http_do(Tup,http). http_do({Bin, []}, _) -> Bin; http_do({Bin,[{_Line,PL,PB}|Tail]}, Type) -> ?line {ok, PL, Rest} = decode_pkt(Type,Bin), ?line {ok, PB, Rest} = decode_pkt(http_with_bin(Type),Bin), %% Same tests again but as SubBin PreLen = random:uniform(64), Prefix = random:uniform(1 bsl PreLen) - 1, SufLen = random:uniform(64), Suffix = random:uniform(1 bsl SufLen) - 1, Orig = <>, BinLen = bit_size(Bin), <<_:PreLen, SubBin:BinLen/bits, _/bits>> = Orig, % Make SubBin ?line SubBin = Bin, % just to make sure ?line {ok, PL, Rest} = decode_pkt(Type,SubBin), ?line {ok, PB, Rest} = decode_pkt(http_with_bin(Type),SubBin), http_do({Rest, Tail}, httph). http_request(Msg) -> QnA = [{"POST /invalid/url HTTP/1.1\r\n", {http_request, 'POST', {abs_path, "/invalid/url" }, {1,1}}, {http_request, 'POST', {abs_path,<<"/invalid/url">>}, {1,1}}}, {"Connection: close\r\n", {http_header,2,'Connection',undefined, "close"}, {http_header,2,'Connection',undefined,<<"close">>}}, {"Host\t : localhost:8000\r\n", % white space before : {http_header,14,'Host',undefined, "localhost:8000"}, {http_header,14,'Host',undefined,<<"localhost:8000">>}}, {"User-Agent: perl post\r\n", {http_header,24,'User-Agent',undefined, "perl post"}, {http_header,24,'User-Agent',undefined,<<"perl post">>}}, {"Content-Length: 4\r\n", {http_header,38,'Content-Length',undefined, "4"}, {http_header,38,'Content-Length',undefined,<<"4">>}}, {"Content-Type: text/xml; charset=utf-8\r\n", {http_header,42,'Content-Type',undefined, "text/xml; charset=utf-8"}, {http_header,42,'Content-Type',undefined,<<"text/xml; charset=utf-8">>}}, {"Other-Field: with some text\r\n", {http_header,0, "Other-Field" ,undefined, "with some text"}, {http_header,0,<<"Other-Field">>,undefined,<<"with some text">>}}, {"Multi-Line: Once upon a time in a land far far away,\r\n" " there lived a princess imprisoned in the highest tower\r\n" " of the most haunted castle.\r\n", {http_header,0, "Multi-Line" ,undefined, "Once upon a time in a land far far away,\r\n there lived a princess imprisoned in the highest tower\r\n of the most haunted castle."}, {http_header,0,<<"Multi-Line">>,undefined,<<"Once upon a time in a land far far away,\r\n there lived a princess imprisoned in the highest tower\r\n of the most haunted castle.">>}}, {"\r\n", http_eoh, http_eoh}], Bin = lists:foldl(fun({Line,_,_},Acc) -> LineBin = list_to_binary(Line), <> end, <<"">>, QnA), MsgBin = list_to_binary(Msg), {<>, QnA}. http_response(Msg) -> QnA = [{"HTTP/1.0 404 Object Not Found\r\n", {http_response, {1,0}, 404, "Object Not Found"}, {http_response, {1,0}, 404, <<"Object Not Found">>}}, {"Server: inets/4.7.16\r\n", {http_header, 30, 'Server', undefined, "inets/4.7.16"}, {http_header, 30, 'Server', undefined, <<"inets/4.7.16">>}}, {"Date: Fri, 04 Jul 2008 17:16:22 GMT\r\n", {http_header, 3, 'Date', undefined, "Fri, 04 Jul 2008 17:16:22 GMT"}, {http_header, 3, 'Date', undefined, <<"Fri, 04 Jul 2008 17:16:22 GMT">>}}, {"Content-Type: text/html\r\n", {http_header, 42, 'Content-Type', undefined, "text/html"}, {http_header, 42, 'Content-Type', undefined, <<"text/html">>}}, {"Content-Length: 207\r\n", {http_header, 38, 'Content-Length', undefined, "207"}, {http_header, 38, 'Content-Length', undefined, <<"207">>}}, {"\r\n", http_eoh, http_eoh}], Bin = lists:foldl(fun({Line,_,_},Acc) -> LineBin = list_to_binary(Line), <> end, <<"">>, QnA), MsgBin = list_to_binary(Msg), {<>, QnA}. http_hdr_strings() -> %% Must be correct order ["Cache-Control","Connection","Date","Pragma","Transfer-Encoding", "Upgrade","Via","Accept", "Accept-Charset", "Accept-Encoding", "Accept-Language", "Authorization","From","Host","If-Modified-Since", "If-Match","If-None-Match","If-Range","If-Unmodified-Since","Max-Forwards", "Proxy-Authorization","Range","Referer","User-Agent","Age","Location", "Proxy-Authenticate","Public","Retry-After","Server","Vary","Warning", "Www-Authenticate","Allow","Content-Base","Content-Encoding", "Content-Language","Content-Length","Content-Location","Content-Md5", "Content-Range","Content-Type","Etag","Expires","Last-Modified", "Accept-Ranges","Set-Cookie","Set-Cookie2","X-Forwarded-For","Cookie", "Keep-Alive","Proxy-Connection"]. http_meth_strings() -> ["OPTIONS", "GET", "HEAD", "POST", "PUT", "DELETE", "TRACE"]. http_uri_variants() -> [{"*", '*', '*'}, {"http://tools.ietf.org/html/rfc3986", {absoluteURI,http, "tools.ietf.org", undefined, "/html/rfc3986"}, {absoluteURI,http,<<"tools.ietf.org">>,undefined,<<"/html/rfc3986">>}}, {"http://otp.ericsson.se:8000/product/internal/", {absoluteURI,http, "otp.ericsson.se" ,8000, "/product/internal/"}, {absoluteURI,http,<<"otp.ericsson.se">>,8000,<<"/product/internal/">>}}, {"https://example.com:8042/over/there?name=ferret#nose", {absoluteURI,https, "example.com", 8042, "/over/there?name=ferret#nose"}, {absoluteURI,https,<<"example.com">>,8042,<<"/over/there?name=ferret#nose">>}}, {"ftp://cnn.example.com&story=breaking_news@10.0.0.1/top_story.htm", {scheme, "ftp", "//cnn.example.com&story=breaking_news@10.0.0.1/top_story.htm"}, {scheme,<<"ftp">>,<<"//cnn.example.com&story=breaking_news@10.0.0.1/top_story.htm">>}}, {"/some/absolute/path", {abs_path, "/some/absolute/path"}, {abs_path,<<"/some/absolute/path">>}}, {"something_else", "something_else", <<"something_else">>}]. line(doc) -> []; line(suite) -> []; line(Config) when is_list(Config) -> Text = <<"POST /invalid/url HTTP/1.1\r\n" "Connection: close\r\n" "Host\t : localhost:8000\r\n" "User-Agent: perl post\r\n" "Content-Length: 4\r\n" "Content-Type: text/xml; charset=utf-8\r\n" "Other-Field: with some text\r\n" "Multi-Line: Once upon a time in a land far far away,\r\n" " there lived a princess imprisoned in the highest tower\r\n" " of the most haunted castle.\r\n" "\r\nThe residue">>, lists:foreach(fun(MaxLen) -> line_do(Text,MaxLen) end, [0,7,19,29,37]), ok. line_do(Bin,MaxLen) -> Res = decode_pkt(line,Bin,[{line_length,MaxLen}]), MyRes = decode_line(Bin,MaxLen), ?line MyRes = Res, case Res of {ok,_,Rest} -> line_do(Rest,MaxLen); {more,undefined} -> ok end. % Emulates decode_packet(line,Bin,[{line_length,MaxLen}]) decode_line(Bin,MaxLen) -> ?line case find_in_binary($\n,Bin) of notfound when MaxLen>0 andalso byte_size(Bin) >= MaxLen -> {LineB,Rest} = split_binary(Bin,MaxLen), {ok,LineB,Rest}; notfound -> {more,undefined}; Pos when MaxLen>0 andalso Pos > MaxLen -> {LineB,Rest} = split_binary(Bin,MaxLen), {ok,LineB,Rest}; Pos -> {LineB,Rest} = split_binary(Bin,Pos), {ok,LineB,Rest} end. find_in_binary(Byte, Bin) -> case string:chr(binary_to_list(Bin),Byte) of 0 -> notfound; P -> P end. ssl(doc) -> []; ssl(suite) -> []; ssl(Config) when is_list(Config) -> Major = 34, Minor = 17, Body = <<234,189,73,199,1,32,4,0,254>>, Rest = <<23,123,203,12,234>>, F = fun(Content) -> {Packet,Unpacked} = pack_ssl(Content, Major, Minor, Body), Bin = <>, ?line {ok, Unpacked, Rest} = decode_pkt(ssl_tls, Bin) end, F(25), F(v2hello), ok. otp_8536(doc) -> ["Corrupt sub-binary-strings from httph_bin"]; otp_8536(Config) when is_list(Config) -> lists:foreach(fun otp_8536_do/1, lists:seq(1,50)), ok. otp_8536_do(N) -> Data = <<"some data 123">>, Letters = <<"bcdefghijklmnopqrstuvwxyzyxwvutsrqponmlkjihgfedcba">>, <> = Letters, Hdr = <<$A, HdrTail/binary>>, Bin = <>, io:format("Bin='~p'\n",[Bin]), ?line {ok,{http_header,0,Hdr2,undefined,Data2},<<"\r\n">>} = decode_pkt(httph_bin, Bin, []), %% Do something to trash the C-stack, how about another decode_packet: decode_pkt(httph_bin,<>, []), %% Now check that we got the expected binaries {Hdr, Data} = {Hdr2, Data2}. decode_pkt(Type,Bin) -> decode_pkt(Type,Bin,[]). decode_pkt(Type,Bin,Opts) -> %%io:format("decode_packet(~p,~p,~p)\n",[Type,Bin,Opts]), Res = erlang:decode_packet(Type,Bin,Opts), %%io:format(" -> ~p\n",[Res]), Res.