From 84adefa331c4159d432d22840663c38f155cd4c1 Mon Sep 17 00:00:00 2001 From: Erlang/OTP Date: Fri, 20 Nov 2009 14:54:40 +0000 Subject: The R13B03 release. --- erts/emulator/test/decode_packet_SUITE.erl | 514 +++++++++++++++++++++++++++++ 1 file changed, 514 insertions(+) create mode 100644 erts/emulator/test/decode_packet_SUITE.erl (limited to 'erts/emulator/test/decode_packet_SUITE.erl') diff --git a/erts/emulator/test/decode_packet_SUITE.erl b/erts/emulator/test/decode_packet_SUITE.erl new file mode 100644 index 0000000000..13f17e972c --- /dev/null +++ b/erts/emulator/test/decode_packet_SUITE.erl @@ -0,0 +1,514 @@ +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 2008-2009. 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("test_server.hrl"). + +-export([all/1,init_per_testcase/2,fin_per_testcase/2, + basic/1, packet_size/1, neg/1, http/1, line/1, ssl/1]). + +all(suite) -> + [basic, packet_size, neg, http, line, ssl]. + +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()), + 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. + +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. + -- cgit v1.2.3