diff options
Diffstat (limited to 'lib')
215 files changed, 13040 insertions, 6103 deletions
diff --git a/lib/asn1/c_src/Makefile b/lib/asn1/c_src/Makefile index 906c513fad..9e9cb18524 100644 --- a/lib/asn1/c_src/Makefile +++ b/lib/asn1/c_src/Makefile @@ -124,7 +124,7 @@ include $(ERL_TOP)/make/otp_release_targets.mk release_spec: opt $(INSTALL_DIR) $(RELSYSDIR)/priv/lib - $(INSTALL_DATA) $(SHARED_OBJ_FILES) $(RELSYSDIR)/priv/lib + $(INSTALL_PROGRAM) $(SHARED_OBJ_FILES) $(RELSYSDIR)/priv/lib $(INSTALL_DIR) $(RELSYSDIR)/c_src $(INSTALL_DATA) $(C_FILES) $(RELSYSDIR)/c_src diff --git a/lib/common_test/src/ct_ssh.erl b/lib/common_test/src/ct_ssh.erl index f2b25b1fcd..aebb28bc42 100644 --- a/lib/common_test/src/ct_ssh.erl +++ b/lib/common_test/src/ct_ssh.erl @@ -1,19 +1,19 @@ %% %% %CopyrightBegin% -%% -%% Copyright Ericsson AB 2009. All Rights Reserved. -%% +%% +%% Copyright Ericsson AB 2009-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% %% @@ -961,24 +961,25 @@ init(KeyOrName, {ConnType,Addr,Port}, AllOpts) -> ssh -> ssh:connect(Addr, Port, FinalOptions); sftp -> - ssh_sftp:connect(Addr, Port, FinalOptions) + ssh_sftp:start_channel(Addr, Port, FinalOptions) end, case Result of - {ok,SSHRef} -> + Error = {error,_} -> + Error; + Ok -> + SSHRef = element(2, Ok), log(heading(init,KeyOrName), "Opened ~w connection:\nHost: ~p (~p)\nUser: ~p\nPassword: ~p\n", [ConnType,Addr,Port,User,lists:duplicate(length(Password),$*)]), {ok,SSHRef,#state{ssh_ref=SSHRef, conn_type=ConnType, - target=KeyOrName}}; - Error -> - Error + target=KeyOrName}} end. %% @hidden handle_msg(sftp_connect, State) -> #state{ssh_ref=SSHRef, target=Target} = State, log(heading(sftp_connect,Target), "SSH Ref: ~p", [SSHRef]), - {ssh_sftp:connect(SSHRef),State}; + {ssh_sftp:start_channel(SSHRef),State}; handle_msg({session_open,TO}, State) -> #state{ssh_ref=SSHRef, target=Target} = State, @@ -1202,7 +1203,7 @@ terminate(SSHRef, State) -> sftp -> log(heading(disconnect_sftp,State#state.target), "SFTP Ref: ~p",[SSHRef]), - ssh_sftp:stop(SSHRef) + ssh_sftp:stop_channel(SSHRef) end. @@ -1213,7 +1214,6 @@ terminate(SSHRef, State) -> %%% do_recv_response(SSH, Chn, Data, End, Timeout) -> receive - {ssh_cm, SSH, {open,Chn,RemoteChn,{session}}} -> debug("RECVD open"), {ok,{open,Chn,RemoteChn,{session}}}; diff --git a/lib/common_test/vsn.mk b/lib/common_test/vsn.mk index ee07350c55..cdb8e1f71c 100644 --- a/lib/common_test/vsn.mk +++ b/lib/common_test/vsn.mk @@ -1,3 +1,3 @@ -COMMON_TEST_VSN = 1.4.7 +COMMON_TEST_VSN = 1.4.8 diff --git a/lib/compiler/src/Makefile b/lib/compiler/src/Makefile index 70ddd54145..0f6d2f6193 100644 --- a/lib/compiler/src/Makefile +++ b/lib/compiler/src/Makefile @@ -58,6 +58,7 @@ MODULES = \ beam_listing \ beam_opcodes \ beam_peep \ + beam_receive \ beam_trim \ beam_type \ beam_utils \ diff --git a/lib/compiler/src/beam_asm.erl b/lib/compiler/src/beam_asm.erl index 497c4fa07b..89d64834cf 100644 --- a/lib/compiler/src/beam_asm.erl +++ b/lib/compiler/src/beam_asm.erl @@ -1,19 +1,19 @@ %% %% %CopyrightBegin% -%% -%% Copyright Ericsson AB 1996-2009. All Rights Reserved. -%% +%% +%% Copyright Ericsson AB 1996-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% %% %% Purpose : Assembler for threaded Beam. @@ -23,7 +23,7 @@ -export([module/4]). -export([encode/2]). --import(lists, [map/2,member/2,keymember/3,duplicate/2,filter/2]). +-import(lists, [map/2,member/2,keymember/3,duplicate/2]). -include("beam_opcodes.hrl"). module(Code, Abst, SourceFile, Opts) -> @@ -191,11 +191,7 @@ flatten_exports(Exps) -> flatten_imports(Imps) -> list_to_binary(map(fun({M,F,A}) -> <<M:32,F:32,A:32>> end, Imps)). -build_attributes(Opts, SourceFile, Attr0, Essentials) -> - Attr = filter(fun({type,_}) -> false; - ({spec,_}) -> false; - (_) -> true - end, Attr0), +build_attributes(Opts, SourceFile, Attr, Essentials) -> Misc = case member(slim, Opts) of false -> {{Y,Mo,D},{H,Mi,S}} = erlang:universaltime(), @@ -265,7 +261,8 @@ make_op({gc_bif,Bif,Fail,Live,Args,Dest}, Dict) -> Arity = length(Args), BifOp = case Arity of 1 -> gc_bif1; - 2 -> gc_bif2 + 2 -> gc_bif2; + 3 -> gc_bif3 end, encode_op(BifOp, [Fail,Live,{extfunc,erlang,Bif,Arity}|Args++[Dest]],Dict); make_op({bs_add=Op,Fail,[Src1,Src2,Unit],Dest}, Dict) -> diff --git a/lib/compiler/src/beam_block.erl b/lib/compiler/src/beam_block.erl index 32703b4dd1..9c6f835ab0 100644 --- a/lib/compiler/src/beam_block.erl +++ b/lib/compiler/src/beam_block.erl @@ -201,7 +201,6 @@ move_allocates_2(Alloc, [], Acc) -> alloc_may_pass({set,_,_,{alloc,_,_}}) -> false; alloc_may_pass({set,_,_,{set_tuple_element,_}}) -> false; alloc_may_pass({set,_,_,put_list}) -> false; -alloc_may_pass({set,_,_,{put_tuple,_}}) -> false; alloc_may_pass({set,_,_,put}) -> false; alloc_may_pass({set,_,_,_}) -> true. diff --git a/lib/compiler/src/beam_bool.erl b/lib/compiler/src/beam_bool.erl index dcc6ad4c7c..d9ea6f5a70 100644 --- a/lib/compiler/src/beam_bool.erl +++ b/lib/compiler/src/beam_bool.erl @@ -1,19 +1,19 @@ %% %% %CopyrightBegin% -%% -%% Copyright Ericsson AB 2004-2009. All Rights Reserved. -%% +%% +%% Copyright Ericsson AB 2004-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% %% %% Purpose: Optimizes booleans in guards. @@ -631,10 +631,10 @@ fetch_reg(V, [{I,V}|_]) -> {x,I}; fetch_reg(V, [_|SRs]) -> fetch_reg(V, SRs). live_regs(Regs) -> - foldl(fun ({I,_}, _) -> I; - ([], Max) -> Max end, - -1, Regs)+1. - + foldl(fun ({I,_}, _) -> + I + end, -1, Regs)+1. + %%% %%% Convert a block to Static Single Assignment (SSA) form. @@ -748,8 +748,7 @@ initialized_regs([{bs_context_to_binary,Src}|Is], Regs) -> initialized_regs([{label,_},{func_info,_,_,Arity}|_], Regs) -> InitRegs = free_vars_regs(Arity), add_init_regs(InitRegs, Regs); -initialized_regs([_|_], Regs) -> Regs; -initialized_regs([], Regs) -> Regs. +initialized_regs([_|_], Regs) -> Regs. add_init_regs([{x,_}=X|T], Regs) -> add_init_regs(T, ordsets:add_element(X, Regs)); diff --git a/lib/compiler/src/beam_disasm.erl b/lib/compiler/src/beam_disasm.erl index c956f2f000..017ca129b0 100644 --- a/lib/compiler/src/beam_disasm.erl +++ b/lib/compiler/src/beam_disasm.erl @@ -1,19 +1,19 @@ %% %% %CopyrightBegin% -%% -%% Copyright Ericsson AB 2000-2009. All Rights Reserved. -%% +%% +%% Copyright Ericsson AB 2000-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% %%======================================================================= %% Notes: @@ -621,8 +621,7 @@ resolve_names(Fun, Imports, Str, Lbls, Lambdas, Literals, M) -> %% %% New make_fun2/4 instruction added in August 2001 (R8). -%% New put_literal/2 instruction added in Feb 2006 R11B-4. -%% We handle them specially here to avoid adding an argument to +%% We handle it specially here to avoid adding an argument to %% the clause for every instruction. %% @@ -631,8 +630,6 @@ resolve_inst({make_fun2,Args}, _, _, _, Lambdas, _, M) -> {OldIndex,{F,A,_Lbl,_Index,NumFree,OldUniq}} = lists:keyfind(OldIndex, 1, Lambdas), {make_fun2,{M,F,A},OldIndex,OldUniq,NumFree}; -resolve_inst({put_literal,[{u,Index},Dst]},_,_,_,_,Literals,_) -> - {put_literal,{literal,gb_trees:get(Index, Literals)},Dst}; resolve_inst(Instr, Imports, Str, Lbls, _Lambdas, _Literals, _M) -> %% io:format(?MODULE_STRING":resolve_inst ~p.~n", [Instr]), resolve_inst(Instr, Imports, Str, Lbls). @@ -1004,13 +1001,17 @@ resolve_inst({gc_bif2,Args},Imports,_,_) -> [F,Live,Bif,A1,A2,Reg] = resolve_args(Args), {extfunc,_Mod,BifName,_Arity} = lookup(Bif+1,Imports), {gc_bif,BifName,F,Live,[A1,A2],Reg}; +%% +%% New instruction in R14, gc_bif with 3 arguments +%% +resolve_inst({gc_bif3,Args},Imports,_,_) -> + [F,Live,Bif,A1,A2,A3,Reg] = resolve_args(Args), + {extfunc,_Mod,BifName,_Arity} = lookup(Bif+1,Imports), + {gc_bif,BifName,F,Live,[A1,A2,A3],Reg}; %% %% New instructions for creating non-byte aligned binaries. %% -resolve_inst({bs_bits_to_bytes2,[_Arg2,_Arg3]=Args},_,_,_) -> - [A2,A3] = resolve_args(Args), - {bs_bits_to_bytes2,A2,A3}; resolve_inst({bs_final2,[X,Y]},_,_,_) -> {bs_final2,X,Y}; @@ -1096,6 +1097,14 @@ resolve_inst({on_load,[]},_,_,_) -> on_load; %% +%% R14A. +%% +resolve_inst({recv_mark,[Lbl]},_,_,_) -> + {recv_mark,Lbl}; +resolve_inst({recv_set,[Lbl]},_,_,_) -> + {recv_set,Lbl}; + +%% %% Catches instructions that are not yet handled. %% resolve_inst(X,_,_,_) -> ?exit({resolve_inst,X}). diff --git a/lib/compiler/src/beam_receive.erl b/lib/compiler/src/beam_receive.erl new file mode 100644 index 0000000000..9ed44ad5d7 --- /dev/null +++ b/lib/compiler/src/beam_receive.erl @@ -0,0 +1,388 @@ +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 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% +%% + +-module(beam_receive). +-export([module/2]). +-import(lists, [foldl/3,reverse/1,reverse/2]). + +%%% +%%% In code such as: +%%% +%%% Ref = make_ref(), %Or erlang:monitor(process, Pid) +%%% . +%%% . +%%% . +%%% receive +%%% {Ref,Reply} -> Reply +%%% end. +%%% +%%% we know that none of the messages that exist in the message queue +%%% before the call to make_ref/0 can be matched out in the receive +%%% statement. Therefore we can avoid going through the entire message +%%% queue if we introduce two new instructions (here written as +%%% BIFs in pseudo-Erlang): +%%% +%%% recv_mark(SomeUniqInteger), +%%% Ref = make_ref(), +%%% . +%%% . +%%% . +%%% recv_set(SomeUniqInteger), +%%% receive +%%% {Ref,Reply} -> Reply +%%% end. +%%% +%%% The recv_mark/1 instruction will save the current position and +%%% SomeUniqInteger in the process context. The recv_set +%%% instruction will verify that SomeUniqInteger is still stored +%%% in the process context. If it is, it will set the current pointer +%%% for the message queue (the next message to be read out) to the +%%% position that was saved by recv_mark/1. +%%% +%%% The remove_message instruction must be modified to invalidate +%%% the information stored by the previous recv_mark/1, in case there +%%% is another receive executed between the calls to recv_mark/1 and +%%% recv_set/1. +%%% +%%% We use a reference to a label (i.e. a position in the loaded code) +%%% as the SomeUniqInteger. +%%% + +module({Mod,Exp,Attr,Fs0,Lc}, _Opts) -> + Fs = [function(F) || F <- Fs0], + Code = {Mod,Exp,Attr,Fs,Lc}, + {ok,Code}. + +%%% +%%% Local functions. +%%% + +function({function,Name,Arity,Entry,Is}) -> + try + D = beam_utils:index_labels(Is), + {function,Name,Arity,Entry,opt(Is, D, [])} + catch + Class:Error -> + Stack = erlang:get_stacktrace(), + io:fwrite("Function: ~w/~w\n", [Name,Arity]), + erlang:raise(Class, Error, Stack) + end. + +opt([{call_ext,Arity,{extfunc,erlang,Name,Arity}}=I|Is0], D, Acc) -> + case creates_new_ref(Name, Arity) of + true -> + %% The call creates a brand new reference. Now + %% search for a receive statement in the same + %% function that will match against the reference. + case opt_recv(Is0, D) of + no -> + opt(Is0, D, [I|Acc]); + {yes,Is,Lbl} -> + opt(Is, D, [I,{recv_mark,{f,Lbl}}|Acc]) + end; + false -> + opt(Is0, D, [I|Acc]) + end; +opt([I|Is], D, Acc) -> + opt(Is, D, [I|Acc]); +opt([], _, Acc) -> + reverse(Acc). + +%% creates_new_ref(Name, Arity) -> true|false. +%% Return 'true' if the BIF Name/Arity will create a new reference. +creates_new_ref(monitor, 2) -> true; +creates_new_ref(make_ref, 0) -> true; +creates_new_ref(_, _) -> false. + +%% opt_recv([Instruction], LabelIndex) -> no|{yes,[Instruction]} +%% Search for a receive statement that will only retrieve messages +%% that contain the newly created reference (which is currently in {x,0}). +opt_recv(Is, D) -> + R = regs_init_x0(), + L = gb_sets:empty(), + opt_recv(Is, D, R, L, []). + +opt_recv([{label,L}=Lbl,{loop_rec,{f,Fail},_}=Loop|Is], D, R0, _, Acc) -> + R = regs_kill_not_live(0, R0), + case regs_to_list(R) of + [{y,_}=RefReg] -> + %% We now have the new reference in the Y register RefReg + %% and the current instruction is the beginning of a + %% receive statement. We must now verify that only messages + %% that contain the reference will be matched. + case opt_ref_used(Is, RefReg, Fail, D) of + false -> + no; + true -> + RecvSet = {recv_set,{f,L}}, + {yes,reverse(Acc, [RecvSet,Lbl,Loop|Is]),L} + end; + [] -> + no + end; +opt_recv([I|Is], D, R0, L0, Acc) -> + {R,L} = opt_update_regs(I, R0, L0), + case regs_empty(R) of + true -> + %% The reference is no longer alive. There is no + %% point in continuing the search. + no; + false -> + opt_recv(Is, D, R, L, [I|Acc]) + end. + +opt_update_regs({block,Bl}, R, L) -> + {opt_update_regs_bl(Bl, R),L}; +opt_update_regs({call,_,_}, R, L) -> + {regs_kill_not_live(0, R),L}; +opt_update_regs({call_ext,_,_}, R, L) -> + {regs_kill_not_live(0, R),L}; +opt_update_regs({call_fun,_}, R, L) -> + {regs_kill_not_live(0, R),L}; +opt_update_regs({kill,Y}, R, L) -> + {regs_kill([Y], R),L}; +opt_update_regs(send, R, L) -> + {regs_kill_not_live(0, R),L}; +opt_update_regs({'catch',_,{f,Lbl}}, R, L) -> + {R,gb_sets:add(Lbl, L)}; +opt_update_regs({catch_end,_}, R, L) -> + {R,L}; +opt_update_regs({label,Lbl}, R, L) -> + case gb_sets:is_member(Lbl, L) of + false -> + %% We can't allow arbitrary labels (since the receive + %% could be entered without first creating the reference). + {regs_init(),L}; + true -> + %% A catch label for a previously seen catch instruction is OK. + {R,L} + end; +opt_update_regs({try_end,_}, R, L) -> + {R,L}; +opt_update_regs(_I, _R, L) -> + %% Unrecognized instruction. Abort the search. + {regs_init(),L}. + +opt_update_regs_bl([{set,Ds,_,{alloc,Live,_}}|Is], Regs0) -> + Regs1 = regs_kill_not_live(Live, Regs0), + Regs = regs_kill(Ds, Regs1), + opt_update_regs_bl(Is, Regs); +opt_update_regs_bl([{set,[Dst]=Ds,[Src],move}|Is], Regs0) -> + Regs1 = regs_kill(Ds, Regs0), + Regs = case regs_is_member(Src, Regs1) of + false -> Regs1; + true -> regs_add(Dst, Regs1) + end, + opt_update_regs_bl(Is, Regs); +opt_update_regs_bl([{set,Ds,_,_}|Is], Regs0) -> + Regs = regs_kill(Ds, Regs0), + opt_update_regs_bl(Is, Regs); +opt_update_regs_bl([], Regs) -> Regs. + +%% opt_ref_used([Instruction], RefRegister, FailLabel, LabelIndex) -> true|false +%% Return 'true' if it is certain that only messages that contain the same +%% reference as in RefRegister can be matched out. Otherwise return 'false'. +%% +%% Basically, we follow all possible paths through the receive statement. +%% If all paths are safe, we return 'true'. +%% +%% A branch to FailLabel is safe, because it exits the receive statement +%% and no further message may be matched out. +%% +%% If a path hits an comparision between RefRegister and part of the message, +%% that path is safe (any messages that may be matched further down the +%% path is guaranteed to contain the reference). +%% +%% Otherwise, if we hit a 'remove_message' instruction, we give up +%% and return 'false' (the optimization is definitely unsafe). If +%% we hit an unrecognized instruction, we also give up and return +%% 'false' (the optimization may be unsafe). + +opt_ref_used(Is, RefReg, Fail, D) -> + Done = gb_sets:singleton(Fail), + Regs = regs_init_x0(), + try + opt_ref_used_1(Is, RefReg, D, Done, Regs), + true + catch + throw:not_used -> + false + end. + +%% This functions only returns if all paths through the receive +%% statement are safe, and throws an 'not_used' term otherwise. +opt_ref_used_1([{block,Bl}|Is], RefReg, D, Done, Regs0) -> + Regs = opt_ref_used_bl(Bl, Regs0), + opt_ref_used_1(Is, RefReg, D, Done, Regs); +opt_ref_used_1([{test,is_eq_exact,{f,Fail},Args}|Is], RefReg, D, Done0, Regs) -> + Done = opt_ref_used_at(Fail, RefReg, D, Done0, Regs), + case is_ref_msg_comparison(Args, RefReg, Regs) of + false -> + opt_ref_used_1(Is, RefReg, D, Done, Regs); + true -> + %% The instructions that follow (Is) can only be executed + %% if the message contains the same reference as in RefReg. + Done + end; +opt_ref_used_1([{test,is_ne_exact,{f,Fail},Args}|Is], RefReg, D, Done0, Regs) -> + Done = opt_ref_used_1(Is, RefReg, D, Done0, Regs), + case is_ref_msg_comparison(Args, RefReg, Regs) of + false -> + opt_ref_used_at(Fail, RefReg, D, Done, Regs); + true -> + Done + end; +opt_ref_used_1([{test,_,{f,Fail},_}|Is], RefReg, D, Done0, Regs) -> + Done = opt_ref_used_at(Fail, RefReg, D, Done0, Regs), + opt_ref_used_1(Is, RefReg, D, Done, Regs); +opt_ref_used_1([{select_tuple_arity,_,{f,Fail},{list,List}}|_], RefReg, D, Done, Regs) -> + Lbls = [F || {f,F} <- List] ++ [Fail], + opt_ref_used_in_all(Lbls, RefReg, D, Done, Regs); +opt_ref_used_1([{select_val,_,{f,Fail},{list,List}}|_], RefReg, D, Done, Regs) -> + Lbls = [F || {f,F} <- List] ++ [Fail], + opt_ref_used_in_all(Lbls, RefReg, D, Done, Regs); +opt_ref_used_1([{label,Lbl}|Is], RefReg, D, Done, Regs) -> + case gb_sets:is_member(Lbl, Done) of + true -> Done; + false -> opt_ref_used_1(Is, RefReg, D, Done, Regs) + end; +opt_ref_used_1([{loop_rec_end,_}|_], _, _, Done, _) -> + Done; +opt_ref_used_1([_I|_], _RefReg, _D, _Done, _Regs) -> + %% The optimization may be unsafe. + throw(not_used). + +%% is_ref_msg_comparison(Args, RefReg, RegisterSet) -> true|false. +%% Return 'true' if Args denotes a comparison between the +%% reference and message or part of the message. +is_ref_msg_comparison([R,RefReg], RefReg, Regs) -> + regs_is_member(R, Regs); +is_ref_msg_comparison([RefReg,R], RefReg, Regs) -> + regs_is_member(R, Regs); +is_ref_msg_comparison([_,_], _, _) -> false. + +opt_ref_used_in_all([L|Ls], RefReg, D, Done0, Regs) -> + Done = opt_ref_used_at(L, RefReg, D, Done0, Regs), + opt_ref_used_in_all(Ls, RefReg, D, Done, Regs); +opt_ref_used_in_all([], _, _, Done, _) -> Done. + +opt_ref_used_at(Fail, RefReg, D, Done0, Regs) -> + case gb_sets:is_member(Fail, Done0) of + true -> + Done0; + false -> + Is = beam_utils:code_at(Fail, D), + Done = opt_ref_used_1(Is, RefReg, D, Done0, Regs), + gb_sets:add(Fail, Done) + end. + +opt_ref_used_bl([{set,[],[],remove_message}|_], _) -> + %% We have proved that a message that does not depend on the + %% reference can be matched out. + throw(not_used); +opt_ref_used_bl([{set,Ds,Ss,_}|Is], Regs0) -> + case regs_all_members(Ss, Regs0) of + false -> + %% The destination registers may be assigned values that + %% are not dependent on the message being matched. + Regs = regs_kill(Ds, Regs0), + opt_ref_used_bl(Is, Regs); + true -> + %% All the sources depend on the message directly or + %% indirectly. + Regs = regs_add_list(Ds, Regs0), + opt_ref_used_bl(Is, Regs) + end; +opt_ref_used_bl([], Regs) -> Regs. + +%%% +%%% Functions for keeping track of a set of registers. +%%% + +%% regs_init() -> RegisterSet +%% Return an empty set of registers. + +regs_init() -> + {0,0}. + +%% regs_init_x0() -> RegisterSet +%% Return a set that only contains the {x,0} register. + +regs_init_x0() -> + {1 bsl 0,0}. + +%% regs_empty(Register) -> true|false +%% Test whether the register set is empty. + +regs_empty(R) -> + R =:= {0,0}. + +%% regs_kill_not_live(Live, RegisterSet) -> RegisterSet' +%% Kill all registers indicated not live by Live. + +regs_kill_not_live(Live, {Xregs,Yregs}) -> + {Xregs band ((1 bsl Live)-1),Yregs}. + +%% regs_kill([Register], RegisterSet) -> RegisterSet' +%% Kill all registers mentioned in the list of registers. + +regs_kill([{x,N}|Rs], {Xregs,Yregs}) -> + regs_kill(Rs, {Xregs band (bnot (1 bsl N)),Yregs}); +regs_kill([{y,N}|Rs], {Xregs,Yregs}) -> + regs_kill(Rs, {Xregs,Yregs band (bnot (1 bsl N))}); +regs_kill([{fr,_}|Rs], Regs) -> + regs_kill(Rs, Regs); +regs_kill([], Regs) -> Regs. + +regs_add_list(List, Regs) -> + foldl(fun(R, A) -> regs_add(R, A) end, Regs, List). + +%% regs_add(Register, RegisterSet) -> RegisterSet' +%% Add a new register to the set of registers. + +regs_add({x,N}, {Xregs,Yregs}) -> + {Xregs bor (1 bsl N),Yregs}; +regs_add({y,N}, {Xregs,Yregs}) -> + {Xregs,Yregs bor (1 bsl N)}. + +%% regs_all_members([Register], RegisterSet) -> true|false +%% Test whether all of the registers are part of the register set. + +regs_all_members([R|Rs], Regs) -> + regs_is_member(R, Regs) andalso regs_all_members(Rs, Regs); +regs_all_members([], _) -> true. + +%% regs_is_member(Register, RegisterSet) -> true|false +%% Test whether Register is part of the register set. + +regs_is_member({x,N}, {Regs,_}) -> Regs band (1 bsl N) =/= 0; +regs_is_member({y,N}, {_,Regs}) -> Regs band (1 bsl N) =/= 0; +regs_is_member(_, _) -> false. + +%% regs_to_list(RegisterSet) -> [Register] +%% Convert the register set to an explicit list of registers. +regs_to_list({Xregs,Yregs}) -> + regs_to_list_1(Xregs, 0, x, regs_to_list_1(Yregs, 0, y, [])). + +regs_to_list_1(0, _, _, Acc) -> + Acc; +regs_to_list_1(Regs, N, Tag, Acc) when (Regs band 1) =:= 1 -> + regs_to_list_1(Regs bsr 1, N+1, Tag, [{Tag,N}|Acc]); +regs_to_list_1(Regs, N, Tag, Acc) -> + regs_to_list_1(Regs bsr 1, N+1, Tag, Acc). diff --git a/lib/compiler/src/beam_type.erl b/lib/compiler/src/beam_type.erl index 3729ccb0da..f83f73b224 100644 --- a/lib/compiler/src/beam_type.erl +++ b/lib/compiler/src/beam_type.erl @@ -76,9 +76,6 @@ simplify_basic_1([{set,[D],[{integer,Index},Reg],{bif,element,_}}=I0|Is], Ts0, A end, Ts = update(I, Ts0), simplify_basic_1(Is, Ts, [I|Acc]); -simplify_basic_1([{set,[_],[_],{bif,_,{f,0}}}=I|Is], Ts0, Acc) -> - Ts = update(I, Ts0), - simplify_basic_1(Is, Ts, [I|Acc]); simplify_basic_1([{set,[D],[TupleReg],{get_tuple_element,0}}=I|Is0], Ts0, Acc) -> case tdb_find(TupleReg, Ts0) of {tuple,_,[Contents]} -> @@ -118,7 +115,6 @@ simplify_basic_1([{test,is_record,_,[R,{atom,_}=Tag,{integer,Arity}]}=I|Is], Ts0 Ts = update(I, Ts0), simplify_basic_1(Is, Ts, [I|Acc]) end; - simplify_basic_1([I|Is], Ts0, Acc) -> Ts = update(I, Ts0), simplify_basic_1(Is, Ts, [I|Acc]); diff --git a/lib/compiler/src/beam_utils.erl b/lib/compiler/src/beam_utils.erl index ac249e6672..761d4ffec0 100644 --- a/lib/compiler/src/beam_utils.erl +++ b/lib/compiler/src/beam_utils.erl @@ -1,19 +1,19 @@ %% %% %CopyrightBegin% -%% -%% Copyright Ericsson AB 2007-2009. All Rights Reserved. -%% +%% +%% Copyright Ericsson AB 2007-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% %% %% Purpose : Common utilities used by several optimization passes. @@ -424,12 +424,6 @@ check_liveness(R, [{bs_add,{f,0},Ss,D}|Is], St) -> false when R =:= D -> {killed,St}; false -> check_liveness(R, Is, St) end; -check_liveness(R, [{bs_bits_to_bytes2,Src,Dst}|Is], St) -> - case R of - Src -> {used,St}; - Dst -> {killed,St}; - _ -> check_liveness(R, Is, St) - end; check_liveness(R, [{bs_put_binary,{f,0},Sz,_,_,Src}|Is], St) -> case member(R, [Sz,Src]) of true -> {used,St}; diff --git a/lib/compiler/src/beam_validator.erl b/lib/compiler/src/beam_validator.erl index 1fd61831e0..dc5a1068db 100644 --- a/lib/compiler/src/beam_validator.erl +++ b/lib/compiler/src/beam_validator.erl @@ -416,6 +416,11 @@ valfun_1({put,Src}, Vst) -> valfun_1({put_string,Sz,_,Dst}, Vst0) when is_integer(Sz) -> Vst = eat_heap(2*Sz, Vst0), set_type_reg(cons, Dst, Vst); +%% Instructions for optimization of selective receives. +valfun_1({recv_mark,{f,Fail}}, Vst) when is_integer(Fail) -> + Vst; +valfun_1({recv_set,{f,Fail}}, Vst) when is_integer(Fail) -> + Vst; %% Misc. valfun_1({'%live',Live}, Vst) -> verify_live(Live, Vst), @@ -752,9 +757,6 @@ valfun_4({bs_utf8_size,{f,Fail},A,Dst}, Vst) -> valfun_4({bs_utf16_size,{f,Fail},A,Dst}, Vst) -> assert_term(A, Vst), set_type_reg({integer,[]}, Dst, branch_state(Fail, Vst)); -valfun_4({bs_bits_to_bytes2,Src,Dst}, Vst) -> - assert_term(Src, Vst), - set_type_reg({integer,[]}, Dst, Vst); valfun_4({bs_bits_to_bytes,{f,Fail},Src,Dst}, Vst) -> assert_term(Src, Vst), set_type_reg({integer,[]}, Dst, branch_state(Fail, Vst)); diff --git a/lib/compiler/src/compile.erl b/lib/compiler/src/compile.erl index 5017fd2c23..08de3059c9 100644 --- a/lib/compiler/src/compile.erl +++ b/lib/compiler/src/compile.erl @@ -162,6 +162,10 @@ expand_opt(report, Os) -> [report_errors,report_warnings|Os]; expand_opt(return, Os) -> [return_errors,return_warnings|Os]; +expand_opt(r12, Os) -> + [no_recv_opt|Os]; +expand_opt(r13, Os) -> + [no_recv_opt|Os]; expand_opt({debug_info_key,_}=O, Os) -> [encrypt_debug_info,O|Os]; expand_opt(no_float_opt, Os) -> @@ -290,15 +294,6 @@ fold_comp([{Name,Pass}|Ps], Run, St0) -> end; fold_comp([], _Run, St) -> {ok,St}. -os_process_size() -> - case os:type() of - {unix, sunos} -> - Size = os:cmd("ps -o vsz -p " ++ os:getpid() ++ " | tail -1"), - list_to_integer(lib:nonl(Size)); - _ -> - 0 - end. - run_tc({Name,Fun}, St) -> Before0 = statistics(runtime), Val = (catch Fun(St)), @@ -307,9 +302,8 @@ run_tc({Name,Fun}, St) -> {After_c, _} = After0, Mem0 = erts_debug:flat_size(Val)*erlang:system_info(wordsize), Mem = lists:flatten(io_lib:format("~.1f kB", [Mem0/1024])), - Sz = lists:flatten(io_lib:format("~.1f MB", [os_process_size()/1024])), - io:format(" ~-30s: ~10.2f s ~12s ~10s\n", - [Name,(After_c-Before_c) / 1000,Mem,Sz]), + io:format(" ~-30s: ~10.2f s ~12s\n", + [Name,(After_c-Before_c) / 1000,Mem]), Val. comp_ret_ok(#compile{code=Code,warnings=Warn0,module=Mod,options=Opts}=St) -> @@ -621,6 +615,8 @@ asm_passes() -> {iff,dclean,{listing,"clean"}}, {unless,no_bsm_opt,{pass,beam_bsm}}, {iff,dbsm,{listing,"bsm"}}, + {unless,no_recv_opt,{pass,beam_receive}}, + {iff,drecv,{listing,"recv"}}, {unless,no_stack_trimming,{pass,beam_trim}}, {iff,dtrim,{listing,"trim"}}, {pass,beam_flatten}]}, diff --git a/lib/compiler/src/compiler.app.src b/lib/compiler/src/compiler.app.src index b0311365c4..4ac879c9a4 100644 --- a/lib/compiler/src/compiler.app.src +++ b/lib/compiler/src/compiler.app.src @@ -1,19 +1,19 @@ % This is an -*- erlang -*- file. %% %CopyrightBegin% -%% -%% Copyright Ericsson AB 1997-2009. All Rights Reserved. -%% +%% +%% Copyright Ericsson AB 1997-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% {application, compiler, @@ -33,6 +33,7 @@ beam_listing, beam_opcodes, beam_peep, + beam_receive, beam_trim, beam_type, beam_utils, diff --git a/lib/compiler/src/erl_bifs.erl b/lib/compiler/src/erl_bifs.erl index e87bb276de..f8128702dd 100644 --- a/lib/compiler/src/erl_bifs.erl +++ b/lib/compiler/src/erl_bifs.erl @@ -1,19 +1,19 @@ %% %% %CopyrightBegin% -%% -%% Copyright Ericsson AB 2001-2009. All Rights Reserved. -%% +%% +%% Copyright Ericsson AB 2001-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% %% %% Purpose: Information about the Erlang built-in functions. @@ -65,6 +65,8 @@ is_pure(erlang, 'xor', 2) -> true; is_pure(erlang, abs, 1) -> true; is_pure(erlang, atom_to_binary, 2) -> true; is_pure(erlang, atom_to_list, 1) -> true; +is_pure(erlang, binary_part, 2) -> true; +is_pure(erlang, binary_part, 3) -> true; is_pure(erlang, binary_to_atom, 2) -> true; is_pure(erlang, binary_to_list, 1) -> true; is_pure(erlang, binary_to_list, 3) -> true; diff --git a/lib/compiler/src/genop.tab b/lib/compiler/src/genop.tab index 47e6e72402..63527bda8f 100644 --- a/lib/compiler/src/genop.tab +++ b/lib/compiler/src/genop.tab @@ -208,7 +208,7 @@ BEAM_FORMAT_NUMBER=0 # New instructions in R10B. 109: bs_init2/6 -110: bs_bits_to_bytes/3 +110: -bs_bits_to_bytes/3 111: bs_add/5 112: apply/1 113: apply_last/2 @@ -274,3 +274,9 @@ BEAM_FORMAT_NUMBER=0 # R13B03 149: on_load/0 + +# R14A + +150: recv_mark/1 +151: recv_set/1 +152: gc_bif3/7 diff --git a/lib/compiler/src/sys_core_fold.erl b/lib/compiler/src/sys_core_fold.erl index 068478496b..6202f07479 100644 --- a/lib/compiler/src/sys_core_fold.erl +++ b/lib/compiler/src/sys_core_fold.erl @@ -1,19 +1,19 @@ %% %% %CopyrightBegin% -%% -%% Copyright Ericsson AB 1999-2009. All Rights Reserved. -%% +%% +%% Copyright Ericsson AB 1999-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% %% %% Purpose : Constant folding optimisation for Core @@ -602,15 +602,23 @@ count_bits_1(Int, Bits) -> count_bits_1(Int bsr 64, Bits+64). %% a rewritten expression consisting of a sequence of %% the arguments only is returned. -useless_call(effect, #c_call{module=#c_literal{val=Mod}, +useless_call(effect, #c_call{anno=Anno, + module=#c_literal{val=Mod}, name=#c_literal{val=Name}, args=Args}=Call) -> A = length(Args), case erl_bifs:is_safe(Mod, Name, A) of false -> case erl_bifs:is_pure(Mod, Name, A) of - true -> add_warning(Call, result_ignored); - false -> ok + true -> + case member(result_not_wanted, Anno) of + false -> + add_warning(Call, result_ignored); + true -> + ok + end; + false -> + ok end, no; true -> @@ -2806,7 +2814,8 @@ format_error({no_effect,{erlang,F,A}}) -> end, flatten(io_lib:format(Fmt, Args)); format_error(result_ignored) -> - "the result of the expression is ignored"; + "the result of the expression is ignored " + "(suppress the warning by assigning the expression to the _ variable)"; format_error(useless_building) -> "a term is constructed, but never used"; format_error(bin_opt_alias) -> diff --git a/lib/compiler/src/v3_core.erl b/lib/compiler/src/v3_core.erl index 4ac2196d79..16c5b6b415 100644 --- a/lib/compiler/src/v3_core.erl +++ b/lib/compiler/src/v3_core.erl @@ -128,8 +128,8 @@ -record(core, {vcount=0 :: non_neg_integer(), %Variable counter fcount=0 :: non_neg_integer(), %Function counter in_guard=false :: boolean(), %In guard or not. + wanted=true :: boolean(), %Result wanted or not. opts :: [compile:option()], %Options. - es=[] :: [error()], %Errors. ws=[] :: [warning()], %Warnings. file=[{file,""}]}). %File @@ -144,42 +144,37 @@ module({Mod,Exp,Forms}, Opts) -> Cexp = map(fun ({_N,_A} = NA) -> #c_var{name=NA} end, Exp), - {Kfs0,As0,Es,Ws,_File} = foldl(fun (F, Acc) -> - form(F, Acc, Opts) - end, {[],[],[],[],[]}, Forms), + {Kfs0,As0,Ws,_File} = foldl(fun (F, Acc) -> + form(F, Acc, Opts) + end, {[],[],[],[]}, Forms), Kfs = reverse(Kfs0), As = reverse(As0), - case Es of - [] -> - {ok,#c_module{name=#c_literal{val=Mod},exports=Cexp,attrs=As,defs=Kfs},Ws}; - _ -> - {error,Es,Ws} - end. + {ok,#c_module{name=#c_literal{val=Mod},exports=Cexp,attrs=As,defs=Kfs},Ws}. -form({function,_,_,_,_}=F0, {Fs,As,Es0,Ws0,File}, Opts) -> - {F,Es,Ws} = function(F0, Es0, Ws0, File, Opts), - {[F|Fs],As,Es,Ws,File}; -form({attribute,_,file,{File,_Line}}, {Fs,As,Es,Ws,_}, _Opts) -> - {Fs,As,Es,Ws,File}; -form({attribute,_,_,_}=F, {Fs,As,Es,Ws,File}, _Opts) -> - {Fs,[attribute(F)|As],Es,Ws,File}. +form({function,_,_,_,_}=F0, {Fs,As,Ws0,File}, Opts) -> + {F,Ws} = function(F0, Ws0, File, Opts), + {[F|Fs],As,Ws,File}; +form({attribute,_,file,{File,_Line}}, {Fs,As,Ws,_}, _Opts) -> + {Fs,As,Ws,File}; +form({attribute,_,_,_}=F, {Fs,As,Ws,File}, _Opts) -> + {Fs,[attribute(F)|As],Ws,File}. attribute({attribute,Line,Name,Val}) -> {#c_literal{val=Name, anno=[Line]}, #c_literal{val=Val, anno=[Line]}}. -function({function,_,Name,Arity,Cs0}, Es0, Ws0, File, Opts) -> +function({function,_,Name,Arity,Cs0}, Ws0, File, Opts) -> %%ok = io:fwrite("~p - ", [{Name,Arity}]), - St0 = #core{vcount=0,opts=Opts,es=Es0,ws=Ws0,file=[{file,File}]}, + St0 = #core{vcount=0,opts=Opts,ws=Ws0,file=[{file,File}]}, {B0,St1} = body(Cs0, Name, Arity, St0), %%ok = io:fwrite("1", []), %%ok = io:fwrite("~w:~p~n", [?LINE,B0]), {B1,St2} = ubody(B0, St1), %%ok = io:fwrite("2", []), %%ok = io:fwrite("~w:~p~n", [?LINE,B1]), - {B2,#core{es=Es,ws=Ws}} = cbody(B1, St2), + {B2,#core{ws=Ws}} = cbody(B1, St2), %%ok = io:fwrite("3~n", []), %%ok = io:fwrite("~w:~p~n", [?LINE,B2]), - {{#c_var{name={Name,Arity}},B2},Es,Ws}. + {{#c_var{name={Name,Arity}},B2},Ws}. body(Cs0, Name, Arity, St0) -> Anno = lineno_anno(element(2, hd(Cs0)), St0), @@ -580,10 +575,14 @@ expr({'fun',L,{function,F,A},{_,_,_}=Id}, St) -> {#c_var{anno=Lanno++[{id,Id}],name={F,A}},[],St}; expr({'fun',L,{clauses,Cs},Id}, St) -> fun_tq(Id, Cs, L, St); -expr({call,L,{remote,_,M,F},As0}, St0) -> +expr({call,L,{remote,_,M,F},As0}, #core{wanted=Wanted}=St0) -> {[M1,F1|As1],Aps,St1} = safe_list([M,F|As0], St0), Lanno = lineno_anno(L, St1), - {#icall{anno=#a{anno=Lanno},module=M1,name=F1,args=As1},Aps,St1}; + Anno = case Wanted of + false -> [result_not_wanted|Lanno]; + true -> Lanno + end, + {#icall{anno=#a{anno=Anno},module=M1,name=F1,args=As1},Aps,St1}; expr({call,Lc,{atom,Lf,F},As0}, St0) -> {As1,Aps,St1} = safe_list(As0, St0), Op = #c_var{anno=lineno_anno(Lf, St1),name={F,length(As1)}}, @@ -596,23 +595,28 @@ expr({call,L,FunExp,As0}, St0) -> expr({match,L,P0,E0}, St0) -> %% First fold matches together to create aliases. {P1,E1} = fold_match(E0, P0), - {E2,Eps,St1} = novars(E1, St0), + St1 = case P1 of + {var,_,'_'} -> St0#core{wanted=false}; + _ -> St0 + end, + {E2,Eps,St2} = novars(E1, St1), + St3 = St2#core{wanted=St0#core.wanted}, P2 = try - pattern(P1, St1) + pattern(P1, St3) catch throw:Thrown -> Thrown end, - {Fpat,St2} = new_var(St1), + {Fpat,St4} = new_var(St3), Fc = fail_clause([Fpat], c_tuple([#c_literal{val=badmatch},Fpat])), - Lanno = lineno_anno(L, St2), + Lanno = lineno_anno(L, St4), case P2 of nomatch -> - St = add_warning(L, nomatch, St2), + St = add_warning(L, nomatch, St4), {#icase{anno=#a{anno=Lanno}, args=[E2],clauses=[],fc=Fc},Eps,St}; Other when not is_atom(Other) -> - {#imatch{anno=#a{anno=Lanno},pat=P2,arg=E2,fc=Fc},Eps,St2} + {#imatch{anno=#a{anno=Lanno},pat=P2,arg=E2,fc=Fc},Eps,St4} end; expr({op,_,'++',{lc,Llc,E,Qs},More}, St0) -> %% Optimise '++' here because of the list comprehension algorithm. @@ -2086,20 +2090,12 @@ is_simple(#c_literal{}) -> true; is_simple(#c_cons{hd=H,tl=T}) -> is_simple(H) andalso is_simple(T); is_simple(#c_tuple{es=Es}) -> is_simple_list(Es); -is_simple(#c_binary{segments=Es}) -> is_simp_bin(Es); is_simple(_) -> false. -spec is_simple_list([cerl:cerl()]) -> boolean(). is_simple_list(Es) -> lists:all(fun is_simple/1, Es). --spec is_simp_bin([cerl:cerl()]) -> boolean(). - -is_simp_bin(Es) -> - lists:all(fun (#c_bitstr{val=E,size=S}) -> - is_simple(E) andalso is_simple(S) - end, Es). - %%% %%% Handling of warnings. %%% diff --git a/lib/compiler/src/v3_kernel.erl b/lib/compiler/src/v3_kernel.erl index 974c64a8bc..fbe4d8617e 100644 --- a/lib/compiler/src/v3_kernel.erl +++ b/lib/compiler/src/v3_kernel.erl @@ -128,14 +128,27 @@ copy_anno(Kdst, Ksrc) -> {'ok', #k_mdef{}, [warning()]}. module(#c_module{anno=A,name=M,exports=Es,attrs=As,defs=Fs}, _Options) -> + Kas = attributes(As), + Kes = map(fun (#c_var{name={_,_}=Fname}) -> Fname end, Es), St0 = #kern{lit=dict:new()}, {Kfs,St} = mapfoldl(fun function/2, St0, Fs), - Kes = map(fun (#c_var{name={_,_}=Fname}) -> Fname end, Es), - Kas = map(fun ({#c_literal{val=N},V}) -> - {N,core_lib:literal_value(V)} end, As), {ok,#k_mdef{anno=A,name=M#c_literal.val,exports=Kes,attributes=Kas, body=Kfs ++ St#kern.funs},lists:sort(St#kern.ws)}. +attributes([{#c_literal{val=Name},Val}|As]) -> + case include_attribute(Name) of + false -> + attributes(As); + true -> + [{Name,core_lib:literal_value(Val)}|attributes(As)] + end; +attributes([]) -> []. + +include_attribute(type) -> false; +include_attribute(spec) -> false; +include_attribute(opaque) -> false; +include_attribute(_) -> true. + function({#c_var{name={F,Arity}=FA},Body}, St0) -> try St1 = St0#kern{func=FA,ff=undefined,vcount=0,fcount=0,ds=sets:new()}, diff --git a/lib/compiler/src/v3_life.erl b/lib/compiler/src/v3_life.erl index 9fda37530b..a7a4d4dc91 100644 --- a/lib/compiler/src/v3_life.erl +++ b/lib/compiler/src/v3_life.erl @@ -361,8 +361,6 @@ match_fail(#k_literal{anno=Anno,val={Atom,Val}}, I, A) when is_atom(Atom) -> match_fail(#k_tuple{anno=Anno,es=[#k_atom{val=Atom},#k_literal{val=Val}]}, I, A); match_fail(#k_literal{anno=Anno,val={Atom}}, I, A) when is_atom(Atom) -> match_fail(#k_tuple{anno=Anno,es=[#k_atom{val=Atom}]}, I, A); -match_fail(#k_literal{anno=Anno,val=Atom}, I, A) when is_atom(Atom) -> - match_fail(#k_atom{anno=Anno,val=Atom}, I, A); match_fail(#k_tuple{es=[#k_atom{val=function_clause}|As]}, I, A) -> #l{ke={match_fail,{function_clause,literal_list(As, [])}},i=I,a=A}; match_fail(#k_tuple{es=[#k_atom{val=badmatch},Val]}, I, A) -> diff --git a/lib/compiler/test/andor_SUITE.erl b/lib/compiler/test/andor_SUITE.erl index a460d54239..84cfd16e60 100644 --- a/lib/compiler/test/andor_SUITE.erl +++ b/lib/compiler/test/andor_SUITE.erl @@ -1,19 +1,19 @@ %% %% %CopyrightBegin% -%% -%% Copyright Ericsson AB 2001-2009. All Rights Reserved. -%% +%% +%% Copyright Ericsson AB 2001-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% %% -module(andor_SUITE). @@ -141,6 +141,10 @@ t_and_or(Config) when is_list(Config) -> ok. +-define(GUARD(E), if E -> true; + true -> false + end). + t_andalso(Config) when is_list(Config) -> Bs = [true,false], Ps = [{X,Y} || X <- Bs, Y <- Bs], @@ -151,6 +155,11 @@ t_andalso(Config) when is_list(Config) -> ?line false = false andalso true, ?line false = false andalso false, + ?line true = ?GUARD(true andalso true), + ?line false = ?GUARD(true andalso false), + ?line false = ?GUARD(false andalso true), + ?line false = ?GUARD(false andalso false), + ?line false = false andalso glurf, ?line false = false andalso exit(exit_now), @@ -176,6 +185,11 @@ t_orelse(Config) when is_list(Config) -> ?line true = false orelse true, ?line false = false orelse false, + ?line true = ?GUARD(true orelse true), + ?line true = ?GUARD(true orelse false), + ?line true = ?GUARD(false orelse true), + ?line false = ?GUARD(false orelse false), + ?line true = true orelse glurf, ?line true = true orelse exit(exit_now), diff --git a/lib/compiler/test/bs_match_SUITE.erl b/lib/compiler/test/bs_match_SUITE.erl index 75b6f801e7..caaa587006 100644 --- a/lib/compiler/test/bs_match_SUITE.erl +++ b/lib/compiler/test/bs_match_SUITE.erl @@ -30,7 +30,8 @@ multiple_uses/1,zero_label/1,followed_by_catch/1, matching_meets_construction/1,simon/1,matching_and_andalso/1, otp_7188/1,otp_7233/1,otp_7240/1,otp_7498/1, - match_string/1,zero_width/1,bad_size/1,haystack/1]). + match_string/1,zero_width/1,bad_size/1,haystack/1, + cover_beam_bool/1]). -export([coverage_id/1]). @@ -45,7 +46,7 @@ all(suite) -> wfbm,degenerated_match,bs_sum,coverage,multiple_uses,zero_label, followed_by_catch,matching_meets_construction,simon,matching_and_andalso, otp_7188,otp_7233,otp_7240,otp_7498,match_string,zero_width,bad_size, - haystack]. + haystack,cover_beam_bool]. init_per_testcase(Case, Config) when is_atom(Case), is_list(Config) -> Dog = test_server:timetrap(?t:minutes(1)), @@ -985,6 +986,25 @@ fc(_, Args, {'EXIT',{{case_clause,ActualArgs},_}}) when ?MODULE =:= bs_match_inline_SUITE -> Args = tuple_to_list(ActualArgs). +%% Cover the clause handling bs_context to binary in +%% beam_block:initialized_regs/2. +cover_beam_bool(Config) when is_list(Config) -> + ?line ok = do_cover_beam_bool(<<>>, 3), + ?line <<19>> = do_cover_beam_bool(<<19>>, 2), + ?line <<42>> = do_cover_beam_bool(<<42>>, 1), + ?line <<17>> = do_cover_beam_bool(<<13,17>>, 0), + ok. + +do_cover_beam_bool(Bin, X) when X > 0 -> + if + X =:= 1; X =:= 2 -> + Bin; + true -> + ok + end; +do_cover_beam_bool(<<_,Bin/binary>>, X) -> + do_cover_beam_bool(Bin, X+1). + check(F, R) -> R = F(). diff --git a/lib/compiler/test/compile_SUITE.erl b/lib/compiler/test/compile_SUITE.erl index 7c3990a855..e1cc5dafb5 100644 --- a/lib/compiler/test/compile_SUITE.erl +++ b/lib/compiler/test/compile_SUITE.erl @@ -1,19 +1,19 @@ %% %% %CopyrightBegin% -%% -%% Copyright Ericsson AB 1997-2009. All Rights Reserved. -%% +%% +%% Copyright Ericsson AB 1997-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% %% -module(compile_SUITE). @@ -625,7 +625,7 @@ core(Config) when is_list(Config) -> {raw_abstract_v1,Abstr}}]}} = beam_lib:chunks(Beam, [abstract_code]), {Mod,Abstr} end || Beam <- TestBeams], - ?line Res = p_run(fun(F) -> do_core(F, Outdir) end, Abstr), + ?line Res = test_lib:p_run(fun(F) -> do_core(F, Outdir) end, Abstr), ?line test_server:timetrap_cancel(Dog), Res. @@ -661,7 +661,7 @@ asm(Config) when is_list(Config) -> ?line Wc = filename:join(filename:dirname(code:which(?MODULE)), "*.beam"), ?line TestBeams = filelib:wildcard(Wc), - ?line Res = p_run(fun(F) -> do_asm(F, Outdir) end, TestBeams), + ?line Res = test_lib:p_run(fun(F) -> do_asm(F, Outdir) end, TestBeams), ?line test_server:timetrap_cancel(Dog), Res. @@ -688,35 +688,3 @@ do_asm(Beam, Outdir) -> [M,Class,Error,erlang:get_stacktrace()]), error end. - -%% p_run(fun() -> ok|error, List) -> ok -%% Will fail the test case if there were any errors. - -p_run(Test, List) -> - N = erlang:system_info(schedulers) + 1, - p_run_loop(Test, List, N, [], 0, 0). - -p_run_loop(_, [], _, [], Errors, Ws) -> - case Errors of - 0 -> - case Ws of - 0 -> ok; - 1 -> {comment,"1 core_lint failure"}; - N -> {comment,integer_to_list(N)++" core_lint failures"} - end; - N -> ?t:fail({N,errors}) - end; -p_run_loop(Test, [H|T], N, Refs, Errors, Ws) when length(Refs) < N -> - {_,Ref} = erlang:spawn_monitor(fun() -> exit(Test(H)) end), - p_run_loop(Test, T, N, [Ref|Refs], Errors, Ws); -p_run_loop(Test, List, N, Refs0, Errors0, Ws0) -> - receive - {'DOWN',Ref,process,_,Res} -> - {Errors,Ws} = case Res of - ok -> {Errors0,Ws0}; - error -> {Errors0+1,Ws0}; - warning -> {Errors0,Ws0+1} - end, - Refs = Refs0 -- [Ref], - p_run_loop(Test, List, N, Refs, Errors, Ws) - end. diff --git a/lib/compiler/test/compiler.cover b/lib/compiler/test/compiler.cover index 5ec2408a35..69d284ea6c 100644 --- a/lib/compiler/test/compiler.cover +++ b/lib/compiler/test/compiler.cover @@ -1,3 +1,3 @@ %% -*- erlang -*- -{exclude,[sys_pre_attributes,core_parse]}. +{exclude,[sys_pre_attributes,core_scan,core_parse]}. diff --git a/lib/compiler/test/core_SUITE_data/.gitignore b/lib/compiler/test/core_SUITE_data/.gitignore new file mode 100644 index 0000000000..d11d93d37f --- /dev/null +++ b/lib/compiler/test/core_SUITE_data/.gitignore @@ -0,0 +1 @@ +!*.core diff --git a/lib/compiler/test/float_SUITE.erl b/lib/compiler/test/float_SUITE.erl index 3d2dbf47e9..b48b1daa32 100644 --- a/lib/compiler/test/float_SUITE.erl +++ b/lib/compiler/test/float_SUITE.erl @@ -1,19 +1,19 @@ %% %% %CopyrightBegin% -%% -%% Copyright Ericsson AB 2002-2009. All Rights Reserved. -%% +%% +%% Copyright Ericsson AB 2002-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% %% -module(float_SUITE). @@ -41,7 +41,7 @@ float_sub(A)-> float_mul(0, _, _)-> ok; float_mul(Iter, A, B) when is_float(A), is_float(B) -> - A*B, + _ = A*B, float_mul(Iter-1, A, B). %% Thanks to Mikael Pettersson and Tobias Lindahl (HiPE). @@ -82,6 +82,14 @@ bad_negate(X, Y) when is_float(X) -> Y1 = -Y, %BIF call. {X2, Y1}. +%% Some math functions are not implemented on all platforms. +-define(OPTIONAL(Expected, Expr), + try + Expected = Expr + catch + error:undef -> ok + end). + math_functions(Config) when is_list(Config) -> %% Mostly silly coverage. ?line 0.0 = math:tan(0), @@ -93,6 +101,14 @@ math_functions(Config) when is_list(Config) -> ?line -1.0 = math:cos(math:pi()), ?line 1.0 = math:exp(0), ?line 1.0 = math:pow(math:pi(), 0), + ?line 0.0 = math:log(1), + ?line 0.0 = math:asin(0), + ?line 0.0 = math:acos(1), + ?line ?OPTIONAL(0.0, math:asinh(0)), + ?line ?OPTIONAL(0.0, math:acosh(1)), + ?line ?OPTIONAL(0.0, math:atanh(0)), + ?line ?OPTIONAL(0.0, math:erf(0)), + ?line ?OPTIONAL(1.0, math:erfc(0)), ?line 0.0 = math:tan(id(0)), ?line 0.0 = math:atan2(id(0), 1), @@ -101,6 +117,14 @@ math_functions(Config) when is_list(Config) -> ?line 0.0 = math:tanh(id(0)), ?line 1.0 = math:log10(id(10)), ?line 1.0 = math:exp(id(0)), + ?line 0.0 = math:log(id(1)), + ?line 0.0 = math:asin(id(0)), + ?line 0.0 = math:acos(id(1)), + ?line ?OPTIONAL(0.0, math:asinh(id(0))), + ?line ?OPTIONAL(0.0, math:acosh(id(1))), + ?line ?OPTIONAL(0.0, math:atanh(id(0))), + ?line ?OPTIONAL(0.0, math:erf(id(0))), + ?line ?OPTIONAL(1.0, math:erfc(id(0))), %% Only for coverage (of beam_type.erl). ?line {'EXIT',{undef,_}} = (catch math:fnurfla(0)), diff --git a/lib/compiler/test/guard_SUITE.erl b/lib/compiler/test/guard_SUITE.erl index f3960b28c3..aa1b3b16dc 100644 --- a/lib/compiler/test/guard_SUITE.erl +++ b/lib/compiler/test/guard_SUITE.erl @@ -31,7 +31,7 @@ t_is_boolean/1,is_function_2/1, tricky/1,rel_ops/1,literal_type_tests/1, basic_andalso_orelse/1,traverse_dcd/1, - check_qlc_hrl/1,andalso_semi/1,tuple_size/1]). + check_qlc_hrl/1,andalso_semi/1,tuple_size/1,binary_part/1]). all(suite) -> test_lib:recompile(?MODULE), @@ -43,7 +43,7 @@ all(suite) -> build_in_guard,old_guard_tests,gbif, t_is_boolean,is_function_2,tricky,rel_ops,literal_type_tests, basic_andalso_orelse,traverse_dcd,check_qlc_hrl,andalso_semi, - tuple_size]. + tuple_size,binary_part]. misc(Config) when is_list(Config) -> ?line 42 = case id(42) of @@ -1362,6 +1362,146 @@ ludicrous_tuple_size(T) when tuple_size(T) =:= 16#FFFFFFFFFFFFFFFF -> ok; ludicrous_tuple_size(_) -> error. +%% +%% The binary_part/2,3 guard BIFs +%% +-define(MASK_ERROR(EXPR),mask_error((catch (EXPR)))). +mask_error({'EXIT',{Err,_}}) -> + Err; +mask_error(Else) -> + Else. + +binary_part(doc) -> + ["Tests the binary_part/2,3 guard (GC) bif's"]; +binary_part(Config) when is_list(Config) -> + %% This is more or less a copy of what the guard_SUITE in emulator + %% does to cover the guard bif's + ?line 1 = bptest(<<1,2,3>>), + ?line 2 = bptest(<<2,1,3>>), + ?line error = bptest(<<1>>), + ?line error = bptest(<<>>), + ?line error = bptest(apa), + ?line 3 = bptest(<<2,3,3>>), + % With one variable (pos) + ?line 1 = bptest(<<1,2,3>>,1), + ?line 2 = bptest(<<2,1,3>>,1), + ?line error = bptest(<<1>>,1), + ?line error = bptest(<<>>,1), + ?line error = bptest(apa,1), + ?line 3 = bptest(<<2,3,3>>,1), + % With one variable (length) + ?line 1 = bptesty(<<1,2,3>>,1), + ?line 2 = bptesty(<<2,1,3>>,1), + ?line error = bptesty(<<1>>,1), + ?line error = bptesty(<<>>,1), + ?line error = bptesty(apa,1), + ?line 3 = bptesty(<<2,3,3>>,2), + % With one variable (whole tuple) + ?line 1 = bptestx(<<1,2,3>>,{1,1}), + ?line 2 = bptestx(<<2,1,3>>,{1,1}), + ?line error = bptestx(<<1>>,{1,1}), + ?line error = bptestx(<<>>,{1,1}), + ?line error = bptestx(apa,{1,1}), + ?line 3 = bptestx(<<2,3,3>>,{1,2}), + % With two variables + ?line 1 = bptest(<<1,2,3>>,1,1), + ?line 2 = bptest(<<2,1,3>>,1,1), + ?line error = bptest(<<1>>,1,1), + ?line error = bptest(<<>>,1,1), + ?line error = bptest(apa,1,1), + ?line 3 = bptest(<<2,3,3>>,1,2), + % Direct (autoimported) call, these will be evaluated by the compiler... + ?line <<2>> = binary_part(<<1,2,3>>,1,1), + ?line <<1>> = binary_part(<<2,1,3>>,1,1), + % Compiler warnings due to constant evaluation expected (3) + ?line badarg = ?MASK_ERROR(binary_part(<<1>>,1,1)), + ?line badarg = ?MASK_ERROR(binary_part(<<>>,1,1)), + ?line badarg = ?MASK_ERROR(binary_part(apa,1,1)), + ?line <<3,3>> = binary_part(<<2,3,3>>,1,2), + % Direct call through apply + ?line <<2>> = apply(erlang,binary_part,[<<1,2,3>>,1,1]), + ?line <<1>> = apply(erlang,binary_part,[<<2,1,3>>,1,1]), + % Compiler warnings due to constant evaluation expected (3) + ?line badarg = ?MASK_ERROR(apply(erlang,binary_part,[<<1>>,1,1])), + ?line badarg = ?MASK_ERROR(apply(erlang,binary_part,[<<>>,1,1])), + ?line badarg = ?MASK_ERROR(apply(erlang,binary_part,[apa,1,1])), + ?line <<3,3>> = apply(erlang,binary_part,[<<2,3,3>>,1,2]), + % Constant propagation + ?line Bin = <<1,2,3>>, + ?line ok = if + binary_part(Bin,1,1) =:= <<2>> -> + ok; + %% Compiler warning, clause cannot match (expected) + true -> + error + end, + ?line ok = if + binary_part(Bin,{1,1}) =:= <<2>> -> + ok; + %% Compiler warning, clause cannot match (expected) + true -> + error + end, + ok. + + +bptest(B) when length(B) =:= 1337 -> + 1; +bptest(B) when binary_part(B,{1,1}) =:= <<2>> -> + 1; +bptest(B) when erlang:binary_part(B,1,1) =:= <<1>> -> + 2; +bptest(B) when erlang:binary_part(B,{1,2}) =:= <<3,3>> -> + 3; +bptest(_) -> + error. + +bptest(B,A) when length(B) =:= A -> + 1; +bptest(B,A) when binary_part(B,{A,1}) =:= <<2>> -> + 1; +bptest(B,A) when erlang:binary_part(B,A,1) =:= <<1>> -> + 2; +bptest(B,A) when erlang:binary_part(B,{A,2}) =:= <<3,3>> -> + 3; +bptest(_,_) -> + error. + +bptestx(B,A) when length(B) =:= A -> + 1; +bptestx(B,A) when binary_part(B,A) =:= <<2>> -> + 1; +bptestx(B,A) when erlang:binary_part(B,A) =:= <<1>> -> + 2; +bptestx(B,A) when erlang:binary_part(B,A) =:= <<3,3>> -> + 3; +bptestx(_,_) -> + error. + +bptesty(B,A) when length(B) =:= A -> + 1; +bptesty(B,A) when binary_part(B,{1,A}) =:= <<2>> -> + 1; +bptesty(B,A) when erlang:binary_part(B,1,A) =:= <<1>> -> + 2; +bptesty(B,A) when erlang:binary_part(B,{1,A}) =:= <<3,3>> -> + 3; +bptesty(_,_) -> + error. + +bptest(B,A,_C) when length(B) =:= A -> + 1; +bptest(B,A,C) when binary_part(B,{A,C}) =:= <<2>> -> + 1; +bptest(B,A,C) when erlang:binary_part(B,A,C) =:= <<1>> -> + 2; +bptest(B,A,C) when erlang:binary_part(B,{A,C}) =:= <<3,3>> -> + 3; +bptest(_,_,_) -> + error. + + + %% Call this function to turn off constant propagation. id(I) -> I. diff --git a/lib/compiler/test/match_SUITE.erl b/lib/compiler/test/match_SUITE.erl index 20969c0b26..fd51b777ac 100644 --- a/lib/compiler/test/match_SUITE.erl +++ b/lib/compiler/test/match_SUITE.erl @@ -1,19 +1,19 @@ %% %% %CopyrightBegin% -%% -%% Copyright Ericsson AB 2004-2009. All Rights Reserved. -%% +%% +%% Copyright Ericsson AB 2004-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% %% -module(match_SUITE). @@ -21,14 +21,14 @@ -export([all/1, pmatch/1,mixed/1,aliases/1,match_in_call/1, untuplify/1,shortcut_boolean/1,letify_guard/1, - selectify/1]). + selectify/1,underscore/1]). -include("test_server.hrl"). all(suite) -> test_lib:recompile(?MODULE), [pmatch,mixed,aliases,match_in_call,untuplify,shortcut_boolean, - letify_guard,selectify]. + letify_guard,selectify,underscore]. pmatch(Config) when is_list(Config) -> ?line ok = doit(1), @@ -112,6 +112,12 @@ aliases(Config) when is_list(Config) -> ?line {42,42,42,42} = multiple_aliases_1(42), ?line {7,7,7} = multiple_aliases_2(7), ?line {{a,b},{a,b},{a,b}} = multiple_aliases_3({a,b}), + + %% Lists/literals. + ?line {a,b} = list_alias1([a,b]), + ?line {a,b} = list_alias2([a,b]), + ?line {a,b} = list_alias3([a,b]), + ok. str_alias(V) -> @@ -206,6 +212,15 @@ multiple_aliases_2((A=B)=(A=C)) -> multiple_aliases_3((A={_,_}=B)={_,_}=C) -> {A,B,C}. +list_alias1([a,b]=[X,Y]) -> + {X,Y}. + +list_alias2([X,Y]=[a,b]) -> + {X,Y}. + +list_alias3([X,b]=[a,Y]) -> + {X,Y}. + %% OTP-7018. match_in_call(Config) when is_list(Config) -> @@ -352,4 +367,16 @@ sel_same_value2(V) when V =:= 42; V =:= 43 -> sel_same_value2(_) -> error. +underscore(Config) when is_list(Config) -> + case Config of + [] -> + %% Assignment to _ at the end of a construct. + _ = length(Config); + [_|_] -> + %% Assignment to _ at the end of a construct. + _ = list_to_tuple(Config) + end, + _ = is_list(Config), + ok. + id(I) -> I. diff --git a/lib/compiler/test/misc_SUITE.erl b/lib/compiler/test/misc_SUITE.erl index e096571d50..126a679724 100644 --- a/lib/compiler/test/misc_SUITE.erl +++ b/lib/compiler/test/misc_SUITE.erl @@ -1,19 +1,19 @@ %% %% %CopyrightBegin% -%% -%% Copyright Ericsson AB 2006-2009. All Rights Reserved. -%% +%% +%% Copyright Ericsson AB 2006-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% %% -module(misc_SUITE). @@ -24,6 +24,10 @@ -include("test_server.hrl"). +%% Include an opaque declaration to cover the stripping of +%% opaque types from attributes in v3_kernel. +-opaque misc_SUITE_test_cases() :: [atom()]. + init_per_testcase(Case, Config) when is_atom(Case), is_list(Config) -> Dog = test_server:timetrap(?t:minutes(10)), [{watchdog,Dog}|Config]. @@ -33,6 +37,8 @@ fin_per_testcase(Case, Config) when is_atom(Case), is_list(Config) -> ?t:timetrap_cancel(Dog), ok. +-spec all(any()) -> misc_SUITE_test_cases(). + all(suite) -> test_lib:recompile(?MODULE), [tobias,empty_string,md5,silly_coverage,confused_literals, @@ -92,13 +98,23 @@ md5_1(Beam) -> silly_coverage(Config) when is_list(Config) -> %% sys_core_fold, sys_core_setel, v3_kernel BadCoreErlang = {c_module,[], - name,exports,attrs, + name,[],[], [{{c_var,[],{foo,2}},seriously_bad_body}]}, ?line expect_error(fun() -> sys_core_fold:module(BadCoreErlang, []) end), ?line expect_error(fun() -> sys_core_dsetel:module(BadCoreErlang, []) end), ?line expect_error(fun() -> v3_kernel:module(BadCoreErlang, []) end), - %% v3_codgen + %% v3_life + BadKernel = {k_mdef,[],?MODULE, + [{foo,0}], + [], + [{k_fdef, + {k,[],[],[]}, + f,0,[], + seriously_bad_body}]}, + ?line expect_error(fun() -> v3_life:module(BadKernel, []) end), + + %% v3_codegen CodegenInput = {?MODULE,[{foo,0}],[],[{function,foo,0,[a|b],a,b}]}, ?line expect_error(fun() -> v3_codegen:module(CodegenInput, []) end), @@ -154,6 +170,17 @@ silly_coverage(Config) when is_list(Config) -> {test,bs_get_binary2,{f,99},0,[{x,0},{atom,all},1,[]],{x,0}}, {block,[a|b]}]}],0}, ?line expect_error(fun() -> beam_bsm:module(BsmInput, []) end), + + %% beam_receive. + ReceiveInput = {?MODULE,[{foo,0}],[], + [{function,foo,0,2, + [{label,1}, + {func_info,{atom,?MODULE},{atom,foo},0}, + {label,2}, + {call_ext,0,{extfunc,erlang,make_ref,0}}, + {block,[a|b]}]}],0}, + ?line expect_error(fun() -> beam_receive:module(ReceiveInput, []) end), + ok. expect_error(Fun) -> diff --git a/lib/compiler/test/num_bif_SUITE.erl b/lib/compiler/test/num_bif_SUITE.erl index c246f56611..912f7366dd 100644 --- a/lib/compiler/test/num_bif_SUITE.erl +++ b/lib/compiler/test/num_bif_SUITE.erl @@ -1,19 +1,19 @@ %% %% %CopyrightBegin% -%% -%% Copyright Ericsson AB 2004-2009. All Rights Reserved. -%% +%% +%% Copyright Ericsson AB 2004-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% %% -module(num_bif_SUITE). @@ -166,7 +166,7 @@ t_list_to_float_safe(Config) when is_list(Config) -> t_list_to_float_risky(Config) when is_list(Config) -> ?line Many_Ones = lists:duplicate(25000, $1), - ?line list_to_float("2."++Many_Ones), + ?line _ = list_to_float("2."++Many_Ones), ?line {'EXIT', {badarg, _}} = (catch list_to_float("2"++Many_Ones)), ok. @@ -186,7 +186,7 @@ t_list_to_integer(Config) when is_list(Config) -> %% Bignums. ?line 123456932798748738738 = list_to_integer("123456932798748738738"), - ?line list_to_integer(lists:duplicate(2000, $1)), + ?line _ = list_to_integer(lists:duplicate(2000, $1)), ok. %% Tests round/1. diff --git a/lib/compiler/test/receive_SUITE.erl b/lib/compiler/test/receive_SUITE.erl index cb8833759a..fca3f0387b 100644 --- a/lib/compiler/test/receive_SUITE.erl +++ b/lib/compiler/test/receive_SUITE.erl @@ -1,19 +1,19 @@ %% %% %CopyrightBegin% -%% -%% Copyright Ericsson AB 2004-2009. All Rights Reserved. -%% +%% +%% Copyright Ericsson AB 2004-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% %% %%% Purpose : Compiles various modules with tough code @@ -21,7 +21,7 @@ -module(receive_SUITE). -export([all/1,init_per_testcase/2,fin_per_testcase/2, - recv/1,coverage/1,otp_7980/1]). + recv/1,coverage/1,otp_7980/1,ref_opt/1]). -include("test_server.hrl"). @@ -36,7 +36,7 @@ fin_per_testcase(_Case, Config) -> all(suite) -> test_lib:recompile(?MODULE), - [recv,coverage,otp_7980]. + [recv,coverage,otp_7980,ref_opt]. -record(state, {ena = true}). @@ -157,5 +157,52 @@ otp_7980_add_clients(Count) -> end, N - 1 end, Count, [1,2,3]). - + +ref_opt(Config) when is_list(Config) -> + case ?MODULE of + receive_SUITE -> ref_opt_1(Config); + _ -> {skip,"Enough to run this case once."} + end. + +ref_opt_1(Config) -> + ?line DataDir = ?config(data_dir, Config), + ?line PrivDir = ?config(priv_dir, Config), + ?line Sources = filelib:wildcard(filename:join([DataDir,"ref_opt","*.erl"])), + ?line test_lib:p_run(fun(Src) -> + do_ref_opt(Src, PrivDir) + end, Sources), + ok. + +do_ref_opt(Source, PrivDir) -> + try + {ok,Mod} = c:c(Source, [{outdir,PrivDir}]), + ok = Mod:Mod(), + Base = filename:rootname(filename:basename(Source), ".erl"), + BeamFile = filename:join(PrivDir, Base), + {beam_file,Mod,_,_,_,Code} = beam_disasm:file(BeamFile), + case Base of + "no_"++_ -> + [] = collect_recv_opt_instrs(Code); + "yes_"++_ -> + [{recv_mark,{f,L}},{recv_set,{f,L}}] = + collect_recv_opt_instrs(Code) + end, + ok + catch Class:Error -> + io:format("~s: ~p ~p\n~p\n", + [Source,Class,Error,erlang:get_stacktrace()]), + error + end. + +collect_recv_opt_instrs(Code) -> + L = [ [I || I <- Is, + begin + case I of + {recv_mark,{f,_}} -> true; + {recv_set,{f,_}} -> true; + _ -> false + end + end] || {function,_,_,_,Is} <- Code], + lists:append(L). + id(I) -> I. diff --git a/lib/compiler/test/receive_SUITE_data/ref_opt/no_1.erl b/lib/compiler/test/receive_SUITE_data/ref_opt/no_1.erl new file mode 100644 index 0000000000..bc63dac437 --- /dev/null +++ b/lib/compiler/test/receive_SUITE_data/ref_opt/no_1.erl @@ -0,0 +1,99 @@ +-module(no_1). +-compile(export_all). + +?MODULE() -> + ok. + +f1(X) -> + Ref = make_ref(), + receive + _ when [X] =:= Ref -> + ok + end. + +f2(X, Y) -> + _Ref = make_ref(), + receive + _ when X =:= Y -> + ok + end. + +f3(X) -> + Ref = make_ref(), + receive + _ when X =:= Ref -> + ok + end. + +f4(X) -> + Ref = make_ref(), + receive + {X,_} when not X =:= Ref -> + ok + end. + +f5(X) -> + Ref = make_ref(), + receive + {Y,_} when X =:= Y; Y =:= Ref -> + ok + end. + +f6(X) -> + Ref = make_ref(), + receive + {Y,_} when Y =:= Ref; Ref =:= X -> + ok + end. + +f7(X) -> + Ref = make_ref(), + receive + {Y,_} when Y =:= Ref; not (X =:= Ref) -> + ok + end. + +f8(X) -> + Ref = make_ref(), + receive + {Y,_} when not (X =:= Ref); Y =:= Ref -> + ok + end. + +f9(X) -> + Ref = make_ref(), + receive + {Y,_} when (not (X =:= Ref)) or (Y =:= Ref) -> + ok + end. + +f10(X, Y) -> + Ref = make_ref(), + receive + {Z,_} when not (X =:= Y andalso Z =:= Ref) -> + ok + end. + +f11(X, Y) -> + Ref = make_ref(), + receive + {Z,_} when not ((X =:= Y) and (Z =:= Ref)) -> + ok + end. + +f12(X, Y) -> + Ref = make_ref(), + receive + {Z,_} when not ((Z =:= Ref) and (X =:= Y)) -> + ok + end. + +f13() -> + Ref = make_ref(), + RefCopy = id(Ref), + receive + _ when hd([RefCopy]) =:= Ref -> + ok + end. + +id(I) -> I. diff --git a/lib/compiler/test/receive_SUITE_data/ref_opt/no_2.erl b/lib/compiler/test/receive_SUITE_data/ref_opt/no_2.erl new file mode 100644 index 0000000000..bc8d30c2ac --- /dev/null +++ b/lib/compiler/test/receive_SUITE_data/ref_opt/no_2.erl @@ -0,0 +1,26 @@ +-module(no_2). +-compile(export_all). + +?MODULE() -> + ok. + +f1() -> + Ref = make_ref(), + receive + {'DOWN',Ref} -> + ok; + {'DOWN',_} -> + ok + end. + +f2(Pid, Msg) -> + Ref = erlang:monitor(process, Pid), + Pid ! Msg, + receive + {ok,Ref,Reply} -> + {ok,Reply}; + {error,Ref,Reply} -> + {error,Reply}; + {error,A,B} -> + {error,A,B} + end. diff --git a/lib/compiler/test/receive_SUITE_data/ref_opt/no_3.erl b/lib/compiler/test/receive_SUITE_data/ref_opt/no_3.erl new file mode 100644 index 0000000000..44cf8d7f71 --- /dev/null +++ b/lib/compiler/test/receive_SUITE_data/ref_opt/no_3.erl @@ -0,0 +1,14 @@ +-module(no_3). +-compile(export_all). + +?MODULE() -> + ok. + +f(X) -> + Ref = case X of + false -> ref; + true -> make_ref() + end, + receive + Ref -> ok + end. diff --git a/lib/compiler/test/receive_SUITE_data/ref_opt/yes_1.erl b/lib/compiler/test/receive_SUITE_data/ref_opt/yes_1.erl new file mode 100644 index 0000000000..e2ebe234c1 --- /dev/null +++ b/lib/compiler/test/receive_SUITE_data/ref_opt/yes_1.erl @@ -0,0 +1,12 @@ +-module(yes_1). +-compile(export_all). + +?MODULE() -> + ok. + +f() -> + Ref = make_ref(), + receive + {Ref,Reply} -> + Reply + end. diff --git a/lib/compiler/test/receive_SUITE_data/ref_opt/yes_2.erl b/lib/compiler/test/receive_SUITE_data/ref_opt/yes_2.erl new file mode 100644 index 0000000000..6077cdcab9 --- /dev/null +++ b/lib/compiler/test/receive_SUITE_data/ref_opt/yes_2.erl @@ -0,0 +1,13 @@ +-module(yes_2). +-compile(export_all). + +?MODULE() -> + ok. + +f(Pid, Msg) -> + Ref = make_ref(), + Pid ! Msg, + receive + {Ref,Reply} -> + Reply + end. diff --git a/lib/compiler/test/receive_SUITE_data/ref_opt/yes_3.erl b/lib/compiler/test/receive_SUITE_data/ref_opt/yes_3.erl new file mode 100644 index 0000000000..28efc542ae --- /dev/null +++ b/lib/compiler/test/receive_SUITE_data/ref_opt/yes_3.erl @@ -0,0 +1,16 @@ +-module(yes_3). +-compile(export_all). + +?MODULE() -> + ok. + +f(Pid, Msg) -> + Ref = make_ref(), + do_send(Pid, Msg), + receive + {Ref,Reply} -> + Reply + end. + +do_send(Pid, Msg) -> + Pid ! Msg. diff --git a/lib/compiler/test/receive_SUITE_data/ref_opt/yes_4.erl b/lib/compiler/test/receive_SUITE_data/ref_opt/yes_4.erl new file mode 100644 index 0000000000..d1ba4832c7 --- /dev/null +++ b/lib/compiler/test/receive_SUITE_data/ref_opt/yes_4.erl @@ -0,0 +1,16 @@ +-module(yes_4). +-compile(export_all). + +?MODULE() -> + ok. + +f(Pid, Msg) -> + Ref = make_ref(), + catch do_send(Pid, Msg), + receive + {Ref,Reply} -> + Reply + end. + +do_send(Pid, Msg) -> + Pid ! Msg. diff --git a/lib/compiler/test/receive_SUITE_data/ref_opt/yes_5.erl b/lib/compiler/test/receive_SUITE_data/ref_opt/yes_5.erl new file mode 100644 index 0000000000..3f02fba6a6 --- /dev/null +++ b/lib/compiler/test/receive_SUITE_data/ref_opt/yes_5.erl @@ -0,0 +1,46 @@ +-module(yes_5). +-compile(export_all). + +?MODULE() -> + ok. + +do_call(Process, Label, Request, Timeout) -> + Node = case Process of + {_S, N} when is_atom(N) -> + N; + _ when is_pid(Process) -> + node(Process) + end, + try erlang:monitor(process, Process) of + Mref -> + catch erlang:send(Process, {Label, {self(), Mref}, Request}, + [noconnect]), + receive + {Mref, Reply} -> + erlang:demonitor(Mref, [flush]), + {ok, Reply}; + {'DOWN', Mref, _, _, noconnection} -> + exit({nodedown, Node}); + {'DOWN', Mref, _, _, Reason} -> + exit(Reason) + after Timeout -> + erlang:demonitor(Mref), + receive + {'DOWN', Mref, _, _, _} -> true + after 0 -> true + end, + exit(timeout) + end + catch + error:_ -> + monitor_node(Node, true), + receive + {nodedown, Node} -> + monitor_node(Node, false), + exit({nodedown, Node}) + after 0 -> + Tag = make_ref(), + Process ! {Label, {self(), Tag}, Request}, + ?MODULE:wait_resp(Node, Tag, Timeout) + end + end. diff --git a/lib/compiler/test/receive_SUITE_data/ref_opt/yes_6.erl b/lib/compiler/test/receive_SUITE_data/ref_opt/yes_6.erl new file mode 100644 index 0000000000..c54b636aa6 --- /dev/null +++ b/lib/compiler/test/receive_SUITE_data/ref_opt/yes_6.erl @@ -0,0 +1,15 @@ +-module(yes_6). +-compile(export_all). + +?MODULE() -> + ok. + +f(Pid, Msg) -> + Ref = erlang:monitor(process, Pid), + Pid ! Msg, + receive + {ok,Ref,Reply} -> + {ok,Reply}; + {error,Ref,Reply} -> + {error,Reply} + end. diff --git a/lib/compiler/test/receive_SUITE_data/ref_opt/yes_7.erl b/lib/compiler/test/receive_SUITE_data/ref_opt/yes_7.erl new file mode 100644 index 0000000000..849eab1746 --- /dev/null +++ b/lib/compiler/test/receive_SUITE_data/ref_opt/yes_7.erl @@ -0,0 +1,12 @@ +-module(yes_7). +-compile(export_all). + +?MODULE() -> + ok. + +f(X, Y) -> + Ref = make_ref(), + receive + {Z,_} when X =:= Y, Ref =:= Z -> + ok + end. diff --git a/lib/compiler/test/receive_SUITE_data/ref_opt/yes_8.erl b/lib/compiler/test/receive_SUITE_data/ref_opt/yes_8.erl new file mode 100644 index 0000000000..a47fe8cfbf --- /dev/null +++ b/lib/compiler/test/receive_SUITE_data/ref_opt/yes_8.erl @@ -0,0 +1,15 @@ +-module(yes_8). +-compile(export_all). + +?MODULE() -> + ok. + +%% Cover use of floating point registers. + +f(Pid, X) when is_float(X) -> + Ref = make_ref(), + Pid ! {X+3}, + receive + Ref -> + ok + end. diff --git a/lib/compiler/test/receive_SUITE_data/ref_opt/yes_9.erl b/lib/compiler/test/receive_SUITE_data/ref_opt/yes_9.erl new file mode 100644 index 0000000000..97fce5e734 --- /dev/null +++ b/lib/compiler/test/receive_SUITE_data/ref_opt/yes_9.erl @@ -0,0 +1,13 @@ +-module(yes_9). +-compile(export_all). + +?MODULE() -> + ok. + +f(Fun) -> + Ref = make_ref(), + Fun(), + receive + {Ref,Reply} -> + Reply + end. diff --git a/lib/compiler/test/test_lib.erl b/lib/compiler/test/test_lib.erl index 844bbfc4b9..05236ee010 100644 --- a/lib/compiler/test/test_lib.erl +++ b/lib/compiler/test/test_lib.erl @@ -20,7 +20,7 @@ -include("test_server.hrl"). --export([recompile/1,opt_opts/1,get_data_dir/1,smoke_disasm/1]). +-export([recompile/1,opt_opts/1,get_data_dir/1,smoke_disasm/1,p_run/2]). recompile(Mod) when is_atom(Mod) -> case whereis(cover_server) of @@ -72,3 +72,35 @@ get_data_dir(Config) -> {ok,Data2,_} = regexp:sub(Data1, "_post_opt_SUITE", "_SUITE"), {ok,Data,_} = regexp:sub(Data2, "_inline_SUITE", "_SUITE"), Data. + +%% p_run(fun(Data) -> ok|error, List) -> ok +%% Will fail the test case if there were any errors. + +p_run(Test, List) -> + N = erlang:system_info(schedulers) + 1, + p_run_loop(Test, List, N, [], 0, 0). + +p_run_loop(_, [], _, [], Errors, Ws) -> + case Errors of + 0 -> + case Ws of + 0 -> ok; + 1 -> {comment,"1 warning"}; + N -> {comment,integer_to_list(N)++" warnings"} + end; + N -> ?t:fail({N,errors}) + end; +p_run_loop(Test, [H|T], N, Refs, Errors, Ws) when length(Refs) < N -> + {_,Ref} = erlang:spawn_monitor(fun() -> exit(Test(H)) end), + p_run_loop(Test, T, N, [Ref|Refs], Errors, Ws); +p_run_loop(Test, List, N, Refs0, Errors0, Ws0) -> + receive + {'DOWN',Ref,process,_,Res} -> + {Errors,Ws} = case Res of + ok -> {Errors0,Ws0}; + error -> {Errors0+1,Ws0}; + warning -> {Errors0,Ws0+1} + end, + Refs = Refs0 -- [Ref], + p_run_loop(Test, List, N, Refs, Errors, Ws) + end. diff --git a/lib/compiler/test/warnings_SUITE.erl b/lib/compiler/test/warnings_SUITE.erl index 6e60ab88cb..5ed8836c70 100644 --- a/lib/compiler/test/warnings_SUITE.erl +++ b/lib/compiler/test/warnings_SUITE.erl @@ -1,19 +1,19 @@ %% %% %CopyrightBegin% -%% -%% Copyright Ericsson AB 2003-2009. All Rights Reserved. -%% +%% +%% Copyright Ericsson AB 2003-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% %% -module(warnings_SUITE). @@ -375,7 +375,12 @@ effect(Config) when is_list(Config) -> comp_op -> X =:= 2; cookie -> - erlang:get_cookie() + erlang:get_cookie(); + result_ignore -> + _ = list_to_integer(X); + warn_lc_4 -> + %% No warning because of assignment to _. + [_ = abs(Z) || Z <- [1,2,3]] end, ok. diff --git a/lib/crypto/c_src/Makefile.in b/lib/crypto/c_src/Makefile.in index 18040a3b26..e728db18eb 100644 --- a/lib/crypto/c_src/Makefile.in +++ b/lib/crypto/c_src/Makefile.in @@ -68,13 +68,13 @@ RELSYSDIR = $(RELEASE_PATH)/lib/crypto-$(VSN) # ---------------------------------------------------- # Misc Macros # ---------------------------------------------------- -OBJS = $(OBJDIR)/crypto_drv.o -DRV_MAKEFILE = $(PRIVDIR)/Makefile +OBJS = $(OBJDIR)/crypto.o +NIF_MAKEFILE = $(PRIVDIR)/Makefile ifeq ($(findstring win32,$(TARGET)), win32) -DYN_DRIVER = $(LIBDIR)/crypto_drv.dll +NIF_LIB = $(LIBDIR)/crypto.dll else -DYN_DRIVER = $(LIBDIR)/crypto_drv.so +NIF_LIB = $(LIBDIR)/crypto.so endif ifeq ($(HOST_OS),) @@ -94,7 +94,7 @@ endif # Targets # ---------------------------------------------------- -debug opt valgrind: $(OBJDIR) $(LIBDIR) $(DYN_DRIVER) +debug opt valgrind: $(OBJDIR) $(LIBDIR) $(NIF_LIB) $(OBJDIR): -@mkdir -p $(OBJDIR) @@ -106,16 +106,16 @@ $(OBJDIR)/%.o: %.c $(INSTALL_DIR) $(OBJDIR) $(CC) -c -o $@ $(ALL_CFLAGS) $< -$(LIBDIR)/crypto_drv.so: $(OBJS) +$(LIBDIR)/crypto.so: $(OBJS) $(INSTALL_DIR) $(LIBDIR) $(LD) $(LDFLAGS) -o $@ $^ $(LDLIBS) $(CRYPTO_LINK_LIB) -$(LIBDIR)/crypto_drv.dll: $(OBJS) +$(LIBDIR)/crypto.dll: $(OBJS) $(INSTALL_DIR) $(LIBDIR) $(LD) $(LDFLAGS) -o $@ $(SSL_DED_LD_RUNTIME_LIBRARY_PATH) -L$(SSL_LIBDIR) $(OBJS) -llibeay32 clean: - rm -f $(DYN_DRIVER) $(OBJS) + rm -f $(NIF_LIB) $(OBJS) rm -f core *~ docs: @@ -128,9 +128,9 @@ include $(ERL_TOP)/make/otp_release_targets.mk release_spec: opt $(INSTALL_DIR) $(RELSYSDIR)/priv/obj $(INSTALL_DIR) $(RELSYSDIR)/priv/lib - $(INSTALL_DATA) $(DRV_MAKEFILE) $(RELSYSDIR)/priv/obj + $(INSTALL_DATA) $(NIF_MAKEFILE) $(RELSYSDIR)/priv/obj $(INSTALL_PROGRAM) $(OBJS) $(RELSYSDIR)/priv/obj - $(INSTALL_PROGRAM) $(DYN_DRIVER) $(RELSYSDIR)/priv/lib + $(INSTALL_PROGRAM) $(NIF_LIB) $(RELSYSDIR)/priv/lib release_docs_spec: diff --git a/lib/crypto/c_src/crypto.c b/lib/crypto/c_src/crypto.c new file mode 100644 index 0000000000..a71df1d7fd --- /dev/null +++ b/lib/crypto/c_src/crypto.c @@ -0,0 +1,1531 @@ +/* + * %CopyrightBegin% + * + * Copyright Ericsson AB 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% + */ + +/* + * Purpose: Dynamically loadable NIF library for cryptography. + * Based on OpenSSL. + */ + +#ifdef __WIN32__ + #include <windows.h> +#endif + +#include <stdlib.h> +#include <stdio.h> +#include <string.h> + +#include "erl_nif.h" + +#define OPENSSL_THREAD_DEFINES +#include <openssl/opensslconf.h> + +#include <openssl/crypto.h> +#include <openssl/des.h> +/* #include <openssl/idea.h> This is not supported on the openssl OTP requires */ +#include <openssl/dsa.h> +#include <openssl/rsa.h> +#include <openssl/aes.h> +#include <openssl/md5.h> +#include <openssl/md4.h> +#include <openssl/sha.h> +#include <openssl/bn.h> +#include <openssl/objects.h> +#include <openssl/rc4.h> +#include <openssl/rc2.h> +#include <openssl/blowfish.h> +#include <openssl/rand.h> + +#ifdef VALGRIND + # include <valgrind/memcheck.h> + +/* libcrypto mixes supplied buffer contents into its entropy pool, + which makes valgrind complain about the use of uninitialized data. + We use this valgrind "request" to make sure that no such seemingly + undefined data is returned. +*/ + # define ERL_VALGRIND_MAKE_MEM_DEFINED(ptr,size) \ + VALGRIND_MAKE_MEM_DEFINED(ptr,size) + + # define ERL_VALGRIND_ASSERT_MEM_DEFINED(ptr,size) \ + ((void) ((VALGRIND_CHECK_MEM_IS_DEFINED(ptr,size) == 0) ? 1 : \ + (fprintf(stderr,"\r\n####### VALGRIND_ASSSERT(%p,%d) failed at %s:%d\r\n",\ + (ptr),(size), __FILE__, __LINE__), abort(), 0))) +#else + # define ERL_VALGRIND_MAKE_MEM_DEFINED(ptr,size) + # define ERL_VALGRIND_ASSERT_MEM_DEFINED(ptr,size) +#endif + +#ifdef DEBUG + # define ASSERT(e) \ + ((void) ((e) ? 1 : (fprintf(stderr,"Assert '%s' failed at %s:%d\n",\ + #e, __FILE__, __LINE__), abort(), 0))) +#else + # define ASSERT(e) ((void) 1) +#endif + +#ifdef __GNUC__ + # define INLINE __inline__ +#elif defined(__WIN32__) + # define INLINE __forceinline +#else + # define INLINE +#endif + + +#define get_int32(s) ((((unsigned char*) (s))[0] << 24) | \ + (((unsigned char*) (s))[1] << 16) | \ + (((unsigned char*) (s))[2] << 8) | \ + (((unsigned char*) (s))[3])) + +#define put_int32(s,i) \ +{ (s)[0] = (char)(((i) >> 24) & 0xff);\ + (s)[1] = (char)(((i) >> 16) & 0xff);\ + (s)[2] = (char)(((i) >> 8) & 0xff);\ + (s)[3] = (char)((i) & 0xff);\ +} + +/* NIF interface declarations */ +static int load(ErlNifEnv* env, void** priv_data, ERL_NIF_TERM load_info); +static int reload(ErlNifEnv* env, void** priv_data, ERL_NIF_TERM load_info); +static int upgrade(ErlNifEnv* env, void** priv_data, void** old_priv_data, ERL_NIF_TERM load_info); +static void unload(ErlNifEnv* env, void* priv_data); + +/* The NIFs: */ +static ERL_NIF_TERM info_lib(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]); +static ERL_NIF_TERM md5(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]); +static ERL_NIF_TERM md5_init(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]); +static ERL_NIF_TERM md5_update(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]); +static ERL_NIF_TERM md5_final(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]); +static ERL_NIF_TERM sha(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]); +static ERL_NIF_TERM sha_init(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]); +static ERL_NIF_TERM sha_update(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]); +static ERL_NIF_TERM sha_final(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]); +static ERL_NIF_TERM md4(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]); +static ERL_NIF_TERM md4_init(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]); +static ERL_NIF_TERM md4_update(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]); +static ERL_NIF_TERM md4_final(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]); +static ERL_NIF_TERM md5_mac_n(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]); +static ERL_NIF_TERM sha_mac_n(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]); +static ERL_NIF_TERM des_cbc_crypt(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]); +static ERL_NIF_TERM des_ecb_crypt(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]); +static ERL_NIF_TERM des_ede3_cbc_crypt(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]); +static ERL_NIF_TERM aes_cfb_128_crypt(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]); +static ERL_NIF_TERM rand_bytes_1(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]); +static ERL_NIF_TERM rand_bytes_3(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]); +static ERL_NIF_TERM rand_uniform_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]); +static ERL_NIF_TERM mod_exp_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]); +static ERL_NIF_TERM dss_verify(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]); +static ERL_NIF_TERM rsa_verify(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]); +static ERL_NIF_TERM aes_cbc_crypt(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]); +static ERL_NIF_TERM exor(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]); +static ERL_NIF_TERM rc4_encrypt(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]); +static ERL_NIF_TERM rc4_set_key(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]); +static ERL_NIF_TERM rc4_encrypt_with_state(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]); +static ERL_NIF_TERM rc2_40_cbc_crypt(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]); +static ERL_NIF_TERM rsa_sign_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]); +static ERL_NIF_TERM dss_sign_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]); +static ERL_NIF_TERM rsa_public_crypt(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]); +static ERL_NIF_TERM rsa_private_crypt(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]); +static ERL_NIF_TERM dh_generate_parameters_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]); +static ERL_NIF_TERM dh_check(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]); +static ERL_NIF_TERM dh_generate_key_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]); +static ERL_NIF_TERM dh_compute_key_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]); +static ERL_NIF_TERM bf_cfb64_crypt(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]); +static ERL_NIF_TERM bf_cbc_crypt(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]); +static ERL_NIF_TERM bf_ecb_crypt(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]); +static ERL_NIF_TERM blowfish_ofb64_encrypt(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]); + + +/* openssl callbacks */ +#ifdef OPENSSL_THREADS +static void locking_function(int mode, int n, const char *file, int line); +static unsigned long id_function(void); +static struct CRYPTO_dynlock_value* dyn_create_function(const char *file, + int line); +static void dyn_lock_function(int mode, struct CRYPTO_dynlock_value* ptr, + const char *file, int line); +static void dyn_destroy_function(struct CRYPTO_dynlock_value *ptr, + const char *file, int line); +#endif /* OPENSSL_THREADS */ + +/* helpers */ +static void hmac_md5(unsigned char *key, int klen, + unsigned char *dbuf, int dlen, + unsigned char *hmacbuf); +static void hmac_sha1(unsigned char *key, int klen, + unsigned char *dbuf, int dlen, + unsigned char *hmacbuf); + +static int library_refc = 0; /* number of users of this dynamic library */ + +static ErlNifFunc nif_funcs[] = { + {"info_lib", 0, info_lib}, + {"md5", 1, md5}, + {"md5_init", 0, md5_init}, + {"md5_update", 2, md5_update}, + {"md5_final", 1, md5_final}, + {"sha", 1, sha}, + {"sha_init", 0, sha_init}, + {"sha_update", 2, sha_update}, + {"sha_final", 1, sha_final}, + {"md4", 1, md4}, + {"md4_init", 0, md4_init}, + {"md4_update", 2, md4_update}, + {"md4_final", 1, md4_final}, + {"md5_mac_n", 3, md5_mac_n}, + {"sha_mac_n", 3, sha_mac_n}, + {"des_cbc_crypt", 4, des_cbc_crypt}, + {"des_ecb_crypt", 3, des_ecb_crypt}, + {"des_ede3_cbc_crypt", 6, des_ede3_cbc_crypt}, + {"aes_cfb_128_crypt", 4, aes_cfb_128_crypt}, + {"rand_bytes", 1, rand_bytes_1}, + {"rand_bytes", 3, rand_bytes_3}, + {"rand_uniform_nif", 2, rand_uniform_nif}, + {"mod_exp_nif", 3, mod_exp_nif}, + {"dss_verify", 3, dss_verify}, + {"rsa_verify", 4, rsa_verify}, + {"aes_cbc_crypt", 4, aes_cbc_crypt}, + {"exor", 2, exor}, + {"rc4_encrypt", 2, rc4_encrypt}, + {"rc4_set_key", 1, rc4_set_key}, + {"rc4_encrypt_with_state", 2, rc4_encrypt_with_state}, + {"rc2_40_cbc_crypt", 4, rc2_40_cbc_crypt}, + {"rsa_sign_nif", 3, rsa_sign_nif}, + {"dss_sign_nif", 2, dss_sign_nif}, + {"rsa_public_crypt", 4, rsa_public_crypt}, + {"rsa_private_crypt", 4, rsa_private_crypt}, + {"dh_generate_parameters_nif", 2, dh_generate_parameters_nif}, + {"dh_check", 1, dh_check}, + {"dh_generate_key_nif", 2, dh_generate_key_nif}, + {"dh_compute_key_nif", 3, dh_compute_key_nif}, + {"bf_cfb64_crypt", 4, bf_cfb64_crypt}, + {"bf_cbc_crypt", 4, bf_cbc_crypt}, + {"bf_ecb_crypt", 3, bf_ecb_crypt}, + {"blowfish_ofb64_encrypt", 3, blowfish_ofb64_encrypt} +}; + +ERL_NIF_INIT(crypto,nif_funcs,load,reload,upgrade,unload) + + +#define MD5_CTX_LEN (sizeof(MD5_CTX)) +#define MD5_LEN 16 +#define MD5_LEN_96 12 +#define MD4_CTX_LEN (sizeof(MD4_CTX)) +#define MD4_LEN 16 +#define SHA_CTX_LEN (sizeof(SHA_CTX)) +#define SHA_LEN 20 +#define SHA_LEN_96 12 +#define HMAC_INT_LEN 64 + +#define HMAC_IPAD 0x36 +#define HMAC_OPAD 0x5c + + +static ErlNifRWLock** lock_vec = NULL; /* Static locks used by openssl */ +static ERL_NIF_TERM atom_true; +static ERL_NIF_TERM atom_false; +static ERL_NIF_TERM atom_sha; +static ERL_NIF_TERM atom_md5; +static ERL_NIF_TERM atom_error; +static ERL_NIF_TERM atom_rsa_pkcs1_padding; +static ERL_NIF_TERM atom_rsa_pkcs1_oaep_padding; +static ERL_NIF_TERM atom_rsa_no_padding; +static ERL_NIF_TERM atom_undefined; + +static ERL_NIF_TERM atom_ok; +static ERL_NIF_TERM atom_not_prime; +static ERL_NIF_TERM atom_not_strong_prime; +static ERL_NIF_TERM atom_unable_to_check_generator; +static ERL_NIF_TERM atom_not_suitable_generator; +static ERL_NIF_TERM atom_check_failed; +static ERL_NIF_TERM atom_unknown; + + +static int is_ok_load_info(ErlNifEnv* env, ERL_NIF_TERM load_info) +{ + int i; + return enif_get_int(env,load_info,&i) && i == 101; +} +static void* crypto_alloc(size_t size) +{ + return enif_alloc(NULL, size); +} +static void* crypto_realloc(void* ptr, size_t size) +{ + return enif_realloc(NULL, ptr, size); +} +static void crypto_free(void* ptr) +{ + enif_free(NULL, ptr); +} + +static int load(ErlNifEnv* env, void** priv_data, ERL_NIF_TERM load_info) +{ + ErlNifSysInfo sys_info; + CRYPTO_set_mem_functions(crypto_alloc, crypto_realloc, crypto_free); + + if (!is_ok_load_info(env, load_info)) { + return -1; + } + +#ifdef OPENSSL_THREADS + enif_system_info(&sys_info, sizeof(sys_info)); + + if (sys_info.scheduler_threads > 1) { + int i; + lock_vec = enif_alloc(env,CRYPTO_num_locks()*sizeof(*lock_vec)); + if (lock_vec==NULL) return -1; + memset(lock_vec,0,CRYPTO_num_locks()*sizeof(*lock_vec)); + + for (i=CRYPTO_num_locks()-1; i>=0; --i) { + lock_vec[i] = enif_rwlock_create("crypto_stat"); + if (lock_vec[i]==NULL) return -1; + } + CRYPTO_set_locking_callback(locking_function); + CRYPTO_set_id_callback(id_function); + CRYPTO_set_dynlock_create_callback(dyn_create_function); + CRYPTO_set_dynlock_lock_callback(dyn_lock_function); + CRYPTO_set_dynlock_destroy_callback(dyn_destroy_function); + } + /* else no need for locks */ +#endif /* OPENSSL_THREADS */ + + atom_true = enif_make_atom(env,"true"); + atom_false = enif_make_atom(env,"false"); + atom_sha = enif_make_atom(env,"sha"); + atom_md5 = enif_make_atom(env,"md5"); + atom_error = enif_make_atom(env,"error"); + atom_rsa_pkcs1_padding = enif_make_atom(env,"rsa_pkcs1_padding"); + atom_rsa_pkcs1_oaep_padding = enif_make_atom(env,"rsa_pkcs1_oaep_padding"); + atom_rsa_no_padding = enif_make_atom(env,"rsa_no_padding"); + atom_undefined = enif_make_atom(env,"undefined"); + atom_ok = enif_make_atom(env,"ok"); + atom_not_prime = enif_make_atom(env,"not_prime"); + atom_not_strong_prime = enif_make_atom(env,"not_strong_prime"); + atom_unable_to_check_generator = enif_make_atom(env,"unable_to_check_generator"); + atom_not_suitable_generator = enif_make_atom(env,"not_suitable_generator"); + atom_check_failed = enif_make_atom(env,"check_failed"); + atom_unknown = enif_make_atom(env,"unknown"); + + *priv_data = NULL; + library_refc++; + return 0; +} + +static int reload(ErlNifEnv* env, void** priv_data, ERL_NIF_TERM load_info) +{ + if (*priv_data != NULL) { + return -1; /* Don't know how to do that */ + } + if (library_refc == 0) { + /* No support for real library upgrade. The tricky thing is to know + when to (re)set the callbacks for allocation and locking. */ + return -2; + } + if (!is_ok_load_info(env, load_info)) { + return -1; + } + return 0; +} + +static int upgrade(ErlNifEnv* env, void** priv_data, void** old_priv_data, + ERL_NIF_TERM load_info) +{ + int i; + if (*old_priv_data != NULL) { + return -1; /* Don't know how to do that */ + } + i = reload(env,priv_data,load_info); + if (i != 0) { + return i; + } + library_refc++; + return 0; +} + +static void unload(ErlNifEnv* env, void* priv_data) +{ + if (--library_refc <= 0) { + CRYPTO_cleanup_all_ex_data(); + + if (lock_vec != NULL) { + int i; + for (i=CRYPTO_num_locks()-1; i>=0; --i) { + if (lock_vec[i] != NULL) { + enif_rwlock_destroy(lock_vec[i]); + } + } + enif_free(env,lock_vec); + } + } + /*else NIF library still used by other (new) module code */ +} + +static ERL_NIF_TERM info_lib(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]) +{ + /* [{<<"OpenSSL">>,9470143,<<"OpenSSL 0.9.8k 25 Mar 2009">>}] */ + + static const char libname[] = "OpenSSL"; + unsigned name_sz = strlen(libname); + const char* ver = SSLeay_version(SSLEAY_VERSION); + unsigned ver_sz = strlen(ver); + ERL_NIF_TERM name_term, ver_term; + + memcpy(enif_make_new_binary(env, name_sz, &name_term), libname, name_sz); + memcpy(enif_make_new_binary(env, ver_sz, &ver_term), ver, ver_sz); + + return enif_make_list1(env, enif_make_tuple3(env, name_term, + enif_make_int(env, SSLeay()), + ver_term)); +} + +static ERL_NIF_TERM md5(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]) +{/* (Data) */ + ErlNifBinary ibin; + ERL_NIF_TERM ret; + + if (!enif_inspect_iolist_as_binary(env, argv[0], &ibin)) { + return enif_make_badarg(env); + } + MD5((unsigned char *) ibin.data, ibin.size, + enif_make_new_binary(env,MD5_LEN, &ret)); + return ret; +} +static ERL_NIF_TERM md5_init(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]) +{/* () */ + ERL_NIF_TERM ret; + MD5_Init((MD5_CTX *) enif_make_new_binary(env, MD5_CTX_LEN, &ret)); + return ret; +} +static ERL_NIF_TERM md5_update(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]) +{/* (Context, Data) */ + MD5_CTX* new_ctx; + ErlNifBinary ctx_bin, data_bin; + ERL_NIF_TERM ret; + if (!enif_inspect_binary(env, argv[0], &ctx_bin) + || ctx_bin.size != MD5_CTX_LEN + || !enif_inspect_iolist_as_binary(env, argv[1], &data_bin)) { + return enif_make_badarg(env); + } + new_ctx = (MD5_CTX*) enif_make_new_binary(env,MD5_CTX_LEN, &ret); + memcpy(new_ctx, ctx_bin.data, MD5_CTX_LEN); + MD5_Update(new_ctx, data_bin.data, data_bin.size); + return ret; +} +static ERL_NIF_TERM md5_final(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]) +{/* (Context) */ + ErlNifBinary ctx_bin; + MD5_CTX ctx_clone; + ERL_NIF_TERM ret; + if (!enif_inspect_binary(env, argv[0], &ctx_bin) || ctx_bin.size != MD5_CTX_LEN) { + return enif_make_badarg(env); + } + memcpy(&ctx_clone, ctx_bin.data, MD5_CTX_LEN); /* writable */ + MD5_Final(enif_make_new_binary(env, MD5_LEN, &ret), &ctx_clone); + return ret; +} + +static ERL_NIF_TERM sha(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]) +{/* (Data) */ + ErlNifBinary ibin; + ERL_NIF_TERM ret; + + if (!enif_inspect_iolist_as_binary(env, argv[0], &ibin)) { + return enif_make_badarg(env); + } + SHA1((unsigned char *) ibin.data, ibin.size, + enif_make_new_binary(env,SHA_LEN, &ret)); + return ret; +} +static ERL_NIF_TERM sha_init(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]) +{/* () */ + ERL_NIF_TERM ret; + SHA1_Init((SHA_CTX *) enif_make_new_binary(env, SHA_CTX_LEN, &ret)); + return ret; +} +static ERL_NIF_TERM sha_update(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]) +{/* (Context, Data) */ + SHA_CTX* new_ctx; + ErlNifBinary ctx_bin, data_bin; + ERL_NIF_TERM ret; + if (!enif_inspect_binary(env, argv[0], &ctx_bin) || ctx_bin.size != SHA_CTX_LEN + || !enif_inspect_iolist_as_binary(env, argv[1], &data_bin)) { + return enif_make_badarg(env); + } + new_ctx = (SHA_CTX*) enif_make_new_binary(env,SHA_CTX_LEN, &ret); + memcpy(new_ctx, ctx_bin.data, SHA_CTX_LEN); + SHA1_Update(new_ctx, data_bin.data, data_bin.size); + return ret; +} +static ERL_NIF_TERM sha_final(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]) +{/* (Context) */ + ErlNifBinary ctx_bin; + SHA_CTX ctx_clone; + ERL_NIF_TERM ret; + if (!enif_inspect_binary(env, argv[0], &ctx_bin) || ctx_bin.size != SHA_CTX_LEN) { + return enif_make_badarg(env); + } + memcpy(&ctx_clone, ctx_bin.data, SHA_CTX_LEN); /* writable */ + SHA1_Final(enif_make_new_binary(env, SHA_LEN, &ret), &ctx_clone); + return ret; +} + +static ERL_NIF_TERM md4(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]) +{/* (Data) */ + ErlNifBinary ibin; + ERL_NIF_TERM ret; + + if (!enif_inspect_iolist_as_binary(env, argv[0], &ibin)) { + return enif_make_badarg(env); + } + MD4((unsigned char *) ibin.data, ibin.size, + enif_make_new_binary(env,MD4_LEN, &ret)); + return ret; +} +static ERL_NIF_TERM md4_init(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]) +{/* () */ + ERL_NIF_TERM ret; + MD4_Init((MD4_CTX *) enif_make_new_binary(env, MD4_CTX_LEN, &ret)); + return ret; +} +static ERL_NIF_TERM md4_update(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]) +{/* (Context, Data) */ + MD4_CTX* new_ctx; + ErlNifBinary ctx_bin, data_bin; + ERL_NIF_TERM ret; + if (!enif_inspect_binary(env, argv[0], &ctx_bin) || ctx_bin.size != MD4_CTX_LEN + || !enif_inspect_iolist_as_binary(env, argv[1], &data_bin)) { + return enif_make_badarg(env); + } + new_ctx = (MD4_CTX*) enif_make_new_binary(env,MD4_CTX_LEN, &ret); + memcpy(new_ctx, ctx_bin.data, MD4_CTX_LEN); + MD4_Update(new_ctx, data_bin.data, data_bin.size); + return ret; +} +static ERL_NIF_TERM md4_final(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]) +{/* (Context) */ + ErlNifBinary ctx_bin; + MD4_CTX ctx_clone; + ERL_NIF_TERM ret; + if (!enif_inspect_binary(env, argv[0], &ctx_bin) || ctx_bin.size != MD4_CTX_LEN) { + return enif_make_badarg(env); + } + memcpy(&ctx_clone, ctx_bin.data, MD4_CTX_LEN); /* writable */ + MD4_Final(enif_make_new_binary(env, MD4_LEN, &ret), &ctx_clone); + return ret; +} + +static ERL_NIF_TERM md5_mac_n(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]) +{/* (Key, Data, MacSize) */ + unsigned char hmacbuf[SHA_DIGEST_LENGTH]; + ErlNifBinary key, data; + unsigned mac_sz; + ERL_NIF_TERM ret; + + if (!enif_inspect_iolist_as_binary(env, argv[0], &key) + || !enif_inspect_iolist_as_binary(env, argv[1], &data) + || !enif_get_uint(env,argv[2],&mac_sz) || mac_sz > MD5_LEN) { + return enif_make_badarg(env); + } + hmac_md5(key.data, key.size, data.data, data.size, hmacbuf); + memcpy(enif_make_new_binary(env, mac_sz, &ret), hmacbuf, mac_sz); + return ret; +} + +static ERL_NIF_TERM sha_mac_n(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]) +{/* (Key, Data, MacSize) */ + unsigned char hmacbuf[SHA_DIGEST_LENGTH]; + ErlNifBinary key, data; + unsigned mac_sz; + ERL_NIF_TERM ret; + + if (!enif_inspect_iolist_as_binary(env, argv[0], &key) + || !enif_inspect_iolist_as_binary(env, argv[1], &data) + || !enif_get_uint(env,argv[2],&mac_sz) || mac_sz > SHA_LEN) { + return enif_make_badarg(env); + } + hmac_sha1(key.data, key.size, data.data, data.size, hmacbuf); + memcpy(enif_make_new_binary(env, mac_sz, &ret), + hmacbuf, mac_sz); + return ret; +} + +static ERL_NIF_TERM des_cbc_crypt(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]) +{/* (Key, Ivec, Text, IsEncrypt) */ + ErlNifBinary key, ivec, text; + DES_key_schedule schedule; + DES_cblock ivec_clone; /* writable copy */ + ERL_NIF_TERM ret; + + if (!enif_inspect_iolist_as_binary(env, argv[0], &key) || key.size != 8 + || !enif_inspect_binary(env, argv[1], &ivec) || ivec.size != 8 + || !enif_inspect_iolist_as_binary(env, argv[2], &text) + || text.size % 8 != 0) { + return enif_make_badarg(env); + } + memcpy(&ivec_clone, ivec.data, 8); + DES_set_key((const_DES_cblock*)key.data, &schedule); + DES_ncbc_encrypt(text.data, enif_make_new_binary(env, text.size, &ret), + text.size, &schedule, &ivec_clone, (argv[3] == atom_true)); + return ret; +} + +static ERL_NIF_TERM des_ecb_crypt(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]) +{/* (Key, Text/Cipher, IsEncrypt) */ + ErlNifBinary key, text; + DES_key_schedule schedule; + ERL_NIF_TERM ret; + if (!enif_inspect_iolist_as_binary(env, argv[0], &key) || key.size != 8 || + !enif_inspect_iolist_as_binary(env, argv[1], &text) || text.size != 8) { + return enif_make_badarg(env); + } + DES_set_key((const_DES_cblock*)key.data, &schedule); + DES_ecb_encrypt((const_DES_cblock*)text.data, + (DES_cblock*)enif_make_new_binary(env, 8, &ret), + &schedule, (argv[2] == atom_true)); + return ret; +} + +static ERL_NIF_TERM des_ede3_cbc_crypt(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]) +{/* (Key1, Key2, Key3, IVec, Text/Cipher, IsEncrypt) */ + ErlNifBinary key1, key2, key3, ivec, text; + DES_key_schedule schedule1, schedule2, schedule3; + DES_cblock ivec_clone; /* writable copy */ + ERL_NIF_TERM ret; + + if (!enif_inspect_iolist_as_binary(env, argv[0], &key1) || key1.size != 8 + || !enif_inspect_iolist_as_binary(env, argv[1], &key2) || key2.size != 8 + || !enif_inspect_iolist_as_binary(env, argv[2], &key3) || key3.size != 8 + || !enif_inspect_binary(env, argv[3], &ivec) || ivec.size != 8 + || !enif_inspect_iolist_as_binary(env, argv[4], &text) + || text.size % 8 != 0) { + return enif_make_badarg(env); + } + + memcpy(&ivec_clone, ivec.data, 8); + DES_set_key((const_DES_cblock*)key1.data, &schedule1); + DES_set_key((const_DES_cblock*)key2.data, &schedule2); + DES_set_key((const_DES_cblock*)key3.data, &schedule3); + DES_ede3_cbc_encrypt(text.data, enif_make_new_binary(env,text.size,&ret), + text.size, &schedule1, &schedule2, &schedule3, + &ivec_clone, (argv[5] == atom_true)); + return ret; +} + +static ERL_NIF_TERM aes_cfb_128_crypt(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]) +{/* (Key, IVec, Data, IsEncrypt) */ + ErlNifBinary key, ivec, text; + AES_KEY aes_key; + unsigned char ivec_clone[16]; /* writable copy */ + int new_ivlen = 0; + ERL_NIF_TERM ret; + + if (!enif_inspect_iolist_as_binary(env, argv[0], &key) || key.size != 16 + || !enif_inspect_binary(env, argv[1], &ivec) || ivec.size != 16 + || !enif_inspect_iolist_as_binary(env, argv[2], &text) + || text.size % 16 != 0) { + return enif_make_badarg(env); + } + + memcpy(ivec_clone, ivec.data, 16); + AES_set_encrypt_key(key.data, 128, &aes_key); + AES_cfb128_encrypt((unsigned char *) text.data, + enif_make_new_binary(env, text.size, &ret), + text.size, &aes_key, ivec_clone, &new_ivlen, + (argv[3] == atom_true)); + return ret; +} + +static ERL_NIF_TERM rand_bytes_1(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]) +{/* (Bytes) */ + unsigned bytes; + unsigned char* data; + ERL_NIF_TERM ret; + if (!enif_get_uint(env, argv[0], &bytes)) { + return enif_make_badarg(env); + } + data = enif_make_new_binary(env, bytes, &ret); + RAND_pseudo_bytes(data, bytes); + ERL_VALGRIND_MAKE_MEM_DEFINED(data, bytes); + return ret; +} +static ERL_NIF_TERM rand_bytes_3(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]) +{/* (Bytes, TopMask, BottomMask) */ + unsigned bytes; + unsigned char* data; + unsigned top_mask, bot_mask; + ERL_NIF_TERM ret; + if (!enif_get_uint(env, argv[0], &bytes) + || !enif_get_uint(env, argv[1], &top_mask) + || !enif_get_uint(env, argv[2], &bot_mask)) { + return enif_make_badarg(env); + } + data = enif_make_new_binary(env, bytes, &ret); + RAND_pseudo_bytes(data, bytes); + ERL_VALGRIND_MAKE_MEM_DEFINED(data, bytes); + if (bytes > 0) { + data[bytes-1] |= top_mask; + data[0] |= bot_mask; + } + return ret; +} + +static int get_bn_from_mpint(ErlNifEnv* env, ERL_NIF_TERM term, BIGNUM** bnp) +{ + ErlNifBinary bin; + int sz; + if (!enif_inspect_binary(env,term,&bin)) { + return 0; + } + ERL_VALGRIND_ASSERT_MEM_DEFINED(bin.data, bin.size); + sz = bin.size - 4; + if (sz < 0 || get_int32(bin.data) != sz) { + return 0; + } + *bnp = BN_bin2bn(bin.data+4, sz, NULL); + return 1; +} + +static ERL_NIF_TERM rand_uniform_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]) +{/* (Lo,Hi) */ + BIGNUM *bn_from, *bn_to, *bn_rand; + unsigned char* data; + unsigned dlen; + ERL_NIF_TERM ret; + if (!get_bn_from_mpint(env, argv[0], &bn_from) + || !get_bn_from_mpint(env, argv[1], &bn_rand)) { + return enif_make_badarg(env); + } + + bn_to = BN_new(); + BN_sub(bn_to, bn_rand, bn_from); + BN_pseudo_rand_range(bn_rand, bn_to); + BN_add(bn_rand, bn_rand, bn_from); + dlen = BN_num_bytes(bn_rand); + data = enif_make_new_binary(env, dlen+4, &ret); + put_int32(data, dlen); + BN_bn2bin(bn_rand, data+4); + ERL_VALGRIND_MAKE_MEM_DEFINED(data+4, dlen); + BN_free(bn_rand); + BN_free(bn_from); + BN_free(bn_to); + return ret; +} + +static ERL_NIF_TERM mod_exp_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]) +{/* (Base,Exponent,Modulo) */ + BIGNUM *bn_base=NULL, *bn_exponent=NULL, *bn_modulo, *bn_result; + BN_CTX *bn_ctx; + unsigned char* ptr; + unsigned dlen; + ERL_NIF_TERM ret; + + if (!get_bn_from_mpint(env, argv[0], &bn_base) + || !get_bn_from_mpint(env, argv[1], &bn_exponent) + || !get_bn_from_mpint(env, argv[2], &bn_modulo)) { + + if (bn_base) BN_free(bn_base); + if (bn_exponent) BN_free(bn_exponent); + return enif_make_badarg(env); + } + bn_result = BN_new(); + bn_ctx = BN_CTX_new(); + BN_mod_exp(bn_result, bn_base, bn_exponent, bn_modulo, bn_ctx); + dlen = BN_num_bytes(bn_result); + ptr = enif_make_new_binary(env, dlen+4, &ret); + put_int32(ptr, dlen); + BN_bn2bin(bn_result, ptr+4); + BN_free(bn_result); + BN_CTX_free(bn_ctx); + BN_free(bn_modulo); + BN_free(bn_exponent); + BN_free(bn_base); + return ret; +} + +static int inspect_mpint(ErlNifEnv* env, ERL_NIF_TERM term, ErlNifBinary* bin) +{ + return enif_inspect_binary(env, term, bin) && + bin->size >= 4 && get_int32(bin->data) == bin->size-4; +} + +static ERL_NIF_TERM dss_verify(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]) +{/* (Data,Signature,Key=[P, Q, G, Y]) */ + ErlNifBinary data_bin, sign_bin; + BIGNUM *dsa_p, *dsa_q, *dsa_g, *dsa_y; + unsigned char hmacbuf[SHA_DIGEST_LENGTH]; + ERL_NIF_TERM head, tail; + DSA *dsa; + int i; + + if (!inspect_mpint(env,argv[0],&data_bin) + || !inspect_mpint(env,argv[1],&sign_bin) + || !enif_get_list_cell(env, argv[2], &head, &tail) + || !get_bn_from_mpint(env, head, &dsa_p) + || !enif_get_list_cell(env, tail, &head, &tail) + || !get_bn_from_mpint(env, head, &dsa_q) + || !enif_get_list_cell(env, tail, &head, &tail) + || !get_bn_from_mpint(env, head, &dsa_g) + || !enif_get_list_cell(env, tail, &head, &tail) + || !get_bn_from_mpint(env, head, &dsa_y) + || !enif_is_empty_list(env,tail)) { + + return enif_make_badarg(env); + } + SHA1(data_bin.data+4, data_bin.size-4, hmacbuf); + + dsa = DSA_new(); + dsa->p = dsa_p; + dsa->q = dsa_q; + dsa->g = dsa_g; + dsa->priv_key = NULL; + dsa->pub_key = dsa_y; + i = DSA_verify(0, hmacbuf, SHA_DIGEST_LENGTH, + sign_bin.data+4, sign_bin.size-4, dsa); + DSA_free(dsa); + return(i > 0) ? atom_true : atom_false; +} + +static ERL_NIF_TERM rsa_verify(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]) +{/* (Type, Data, Signature, Key=[E,N]) */ + ErlNifBinary data_bin, sign_bin; + unsigned char hmacbuf[SHA_DIGEST_LENGTH]; + ERL_NIF_TERM head, tail, ret; + int i, is_sha; + RSA* rsa = RSA_new(); + + if (argv[0] == atom_sha) is_sha = 1; + else if (argv[0] == atom_md5) is_sha = 0; + else goto badarg; + + if (!inspect_mpint(env, argv[1], &data_bin) + || !inspect_mpint(env, argv[2], &sign_bin) + || !enif_get_list_cell(env, argv[3], &head, &tail) + || !get_bn_from_mpint(env, head, &rsa->e) + || !enif_get_list_cell(env, tail, &head, &tail) + || !get_bn_from_mpint(env, head, &rsa->n) + || !enif_is_empty_list(env, tail)) { + badarg: + ret = enif_make_badarg(env); + } + else { + if (is_sha) { + SHA1(data_bin.data+4, data_bin.size-4, hmacbuf); + i = RSA_verify(NID_sha1, hmacbuf, SHA_DIGEST_LENGTH, + sign_bin.data+4, sign_bin.size-4, rsa); + } + else { + MD5(data_bin.data+4, data_bin.size-4, hmacbuf); + i = RSA_verify(NID_md5, hmacbuf, MD5_DIGEST_LENGTH, + sign_bin.data+4, sign_bin.size-4, rsa); + } + ret = (i==1 ? atom_true : atom_false); + } + RSA_free(rsa); + return ret; +} + +static ERL_NIF_TERM aes_cbc_crypt(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]) +{/* (Key, IVec, Data, IsEncrypt) */ + ErlNifBinary key_bin, ivec_bin, data_bin; + AES_KEY aes_key; + unsigned char ivec[16]; + int i; + unsigned char* ret_ptr; + ERL_NIF_TERM ret; + + if (!enif_inspect_iolist_as_binary(env, argv[0], &key_bin) + || (key_bin.size != 16 && key_bin.size != 32) + || !enif_inspect_binary(env, argv[1], &ivec_bin) + || ivec_bin.size != 16 + || !enif_inspect_iolist_as_binary(env, argv[2], &data_bin) + || data_bin.size % 16 != 0) { + + return enif_make_badarg(env); + } + + if (argv[3] == atom_true) { + i = AES_ENCRYPT; + AES_set_encrypt_key(key_bin.data, key_bin.size*8, &aes_key); + } + else { + i = AES_DECRYPT; + AES_set_decrypt_key(key_bin.data, key_bin.size*8, &aes_key); + } + + ret_ptr = enif_make_new_binary(env, data_bin.size, &ret); + memcpy(ivec, ivec_bin.data, 16); /* writable copy */ + AES_cbc_encrypt(data_bin.data, ret_ptr, data_bin.size, &aes_key, ivec, i); + return ret; +} + +static ERL_NIF_TERM exor(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]) +{/* (Data1, Data2) */ + ErlNifBinary d1, d2; + unsigned char* ret_ptr; + int i; + ERL_NIF_TERM ret; + + if (!enif_inspect_iolist_as_binary(env,argv[0], &d1) + || !enif_inspect_iolist_as_binary(env,argv[1], &d2) + || d1.size != d2.size) { + return enif_make_badarg(env); + } + ret_ptr = enif_make_new_binary(env, d1.size, &ret); + + for (i=0; i<d1.size; i++) { + ret_ptr[i] = d1.data[i] ^ d2.data[i]; + } + return ret; +} + +static ERL_NIF_TERM rc4_encrypt(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]) +{/* (Key, Data) */ + ErlNifBinary key, data; + RC4_KEY rc4_key; + ERL_NIF_TERM ret; + + if (!enif_inspect_iolist_as_binary(env,argv[0], &key) + || !enif_inspect_iolist_as_binary(env,argv[1], &data)) { + return enif_make_badarg(env); + } + RC4_set_key(&rc4_key, key.size, key.data); + RC4(&rc4_key, data.size, data.data, + enif_make_new_binary(env, data.size, &ret)); + return ret; +} + +static ERL_NIF_TERM rc4_set_key(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]) +{/* (Key) */ + ErlNifBinary key; + ERL_NIF_TERM ret; + + if (!enif_inspect_iolist_as_binary(env,argv[0], &key)) { + return enif_make_badarg(env); + } + RC4_set_key((RC4_KEY*)enif_make_new_binary(env, sizeof(RC4_KEY), &ret), + key.size, key.data); + return ret; +} + +static ERL_NIF_TERM rc4_encrypt_with_state(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]) +{/* (State, Data) */ + + ErlNifBinary state, data; + RC4_KEY* rc4_key; + ERL_NIF_TERM new_state, new_data; + + if (!enif_inspect_iolist_as_binary(env,argv[0], &state) + || state.size != sizeof(RC4_KEY) + || !enif_inspect_iolist_as_binary(env,argv[1], &data)) { + return enif_make_badarg(env); + } + rc4_key = (RC4_KEY*)enif_make_new_binary(env, sizeof(RC4_KEY), &new_state); + memcpy(rc4_key, state.data, sizeof(RC4_KEY)); + RC4(rc4_key, data.size, data.data, + enif_make_new_binary(env, data.size, &new_data)); + + return enif_make_tuple2(env,argv[0],new_data); +} + +static ERL_NIF_TERM rc2_40_cbc_crypt(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]) +{/* (Key,IVec,Data,IsEncrypt) */ + ErlNifBinary key_bin, ivec_bin, data_bin; + RC2_KEY rc2_key; + ERL_NIF_TERM ret; + + if (!enif_inspect_iolist_as_binary(env, argv[0], &key_bin) + || key_bin.size != 5 + || !enif_inspect_binary(env, argv[1], &ivec_bin) + || ivec_bin.size != 8 + || !enif_inspect_iolist_as_binary(env, argv[2], &data_bin)) { + + return enif_make_badarg(env); + } + + RC2_set_key(&rc2_key, 5, key_bin.data, 40); + RC2_cbc_encrypt(data_bin.data, + enif_make_new_binary(env, data_bin.size, &ret), + data_bin.size, &rc2_key, + ivec_bin.data, + (argv[3] == atom_true)); + + return ret; +} + +static ERL_NIF_TERM rsa_sign_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]) +{/* (Type,Data,Key=[E,N,D]) */ + ErlNifBinary data_bin, ret_bin; + ERL_NIF_TERM head, tail; + unsigned char hmacbuf[SHA_DIGEST_LENGTH]; + unsigned rsa_s_len; + RSA *rsa = RSA_new(); + int i, is_sha; + + if (argv[0] == atom_sha) is_sha = 1; + else if (argv[0] == atom_md5) is_sha = 0; + else goto badarg; + + if (!inspect_mpint(env,argv[1],&data_bin) + || !enif_get_list_cell(env, argv[2], &head, &tail) + || !get_bn_from_mpint(env, head, &rsa->e) + || !enif_get_list_cell(env, tail, &head, &tail) + || !get_bn_from_mpint(env, head, &rsa->n) + || !enif_get_list_cell(env, tail, &head, &tail) + || !get_bn_from_mpint(env, head, &rsa->d) + || !enif_is_empty_list(env,tail)) { + badarg: + RSA_free(rsa); + return enif_make_badarg(env); + } + enif_alloc_binary(env, RSA_size(rsa), &ret_bin); + if (is_sha) { + SHA1(data_bin.data+4, data_bin.size-4, hmacbuf); + ERL_VALGRIND_ASSERT_MEM_DEFINED(hmacbuf, SHA_DIGEST_LENGTH); + i = RSA_sign(NID_sha1, hmacbuf, SHA_DIGEST_LENGTH, + ret_bin.data, &rsa_s_len, rsa); + } + else { + MD5(data_bin.data+4, data_bin.size-4, hmacbuf); + ERL_VALGRIND_ASSERT_MEM_DEFINED(hmacbuf, MD5_DIGEST_LENGTH); + i = RSA_sign(NID_md5, hmacbuf,MD5_DIGEST_LENGTH, + ret_bin.data, &rsa_s_len, rsa); + } + RSA_free(rsa); + if (i) { + ERL_VALGRIND_MAKE_MEM_DEFINED(ret_bin.data, rsa_s_len); + if (rsa_s_len != data_bin.size) { + enif_realloc_binary(env, &ret_bin, rsa_s_len); + ERL_VALGRIND_ASSERT_MEM_DEFINED(ret_bin.data, rsa_s_len); + } + return enif_make_binary(env,&ret_bin); + } + else { + enif_release_binary(env, &ret_bin); + return atom_error; + } +} + +static ERL_NIF_TERM dss_sign_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]) +{/* (Data,Key=[P,Q,G,PrivKey]) */ + ErlNifBinary data_bin, ret_bin; + ERL_NIF_TERM head, tail; + unsigned char hmacbuf[SHA_DIGEST_LENGTH]; + unsigned int dsa_s_len; + DSA* dsa = DSA_new(); + int i; + + dsa->pub_key = NULL; + if (!inspect_mpint(env, argv[0], &data_bin) + || !enif_get_list_cell(env, argv[1], &head, &tail) + || !get_bn_from_mpint(env, head, &dsa->p) + || !enif_get_list_cell(env, tail, &head, &tail) + || !get_bn_from_mpint(env, head, &dsa->q) + || !enif_get_list_cell(env, tail, &head, &tail) + || !get_bn_from_mpint(env, head, &dsa->g) + || !enif_get_list_cell(env, tail, &head, &tail) + || !get_bn_from_mpint(env, head, &dsa->priv_key) + || !enif_is_empty_list(env,tail)) { + + DSA_free(dsa); + return enif_make_badarg(env); + } + + SHA1(data_bin.data+4, data_bin.size-4, hmacbuf); + + enif_alloc_binary(env, DSA_size(dsa), &ret_bin); + i = DSA_sign(NID_sha1, hmacbuf, SHA_DIGEST_LENGTH, + ret_bin.data, &dsa_s_len, dsa); + DSA_free(dsa); + if (i) { + if (dsa_s_len != ret_bin.size) { + enif_realloc_binary(env, &ret_bin, dsa_s_len); + } + return enif_make_binary(env, &ret_bin); + } + else { + return atom_error; + } +} + +static int rsa_pad(ERL_NIF_TERM term, int* padding) +{ + if (term == atom_rsa_pkcs1_padding) { + *padding = RSA_PKCS1_PADDING; + } + else if (term == atom_rsa_pkcs1_oaep_padding) { + *padding = RSA_PKCS1_OAEP_PADDING; + } + else if (term == atom_rsa_no_padding) { + *padding = RSA_NO_PADDING; + } + else { + return 0; + } + return 1; +} + +static ERL_NIF_TERM rsa_public_crypt(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]) +{/* (Data, PublKey=[E,N], Padding, IsEncrypt) */ + ErlNifBinary data_bin, ret_bin; + ERL_NIF_TERM head, tail; + int padding, i; + RSA* rsa = RSA_new(); + + if (!enif_inspect_binary(env, argv[0], &data_bin) + || !enif_get_list_cell(env, argv[1], &head, &tail) + || !get_bn_from_mpint(env, head, &rsa->e) + || !enif_get_list_cell(env, tail, &head, &tail) + || !get_bn_from_mpint(env, head, &rsa->n) + || !enif_is_empty_list(env,tail) + || !rsa_pad(argv[2], &padding)) { + + RSA_free(rsa); + return enif_make_badarg(env); + } + + enif_alloc_binary(env, RSA_size(rsa), &ret_bin); + + if (argv[3] == atom_true) { + ERL_VALGRIND_ASSERT_MEM_DEFINED(buf+i,data_len); + i = RSA_public_encrypt(data_bin.size, data_bin.data, + ret_bin.data, rsa, padding); + if (i > 0) { + ERL_VALGRIND_MAKE_MEM_DEFINED(ret_bin.data, i); + } + } + else { + i = RSA_public_decrypt(data_bin.size, data_bin.data, + ret_bin.data, rsa, padding); + if (i > 0) { + ERL_VALGRIND_MAKE_MEM_DEFINED(ret_bin.data, i); + enif_realloc_binary(env, &ret_bin, i); + } + } + RSA_free(rsa); + if (i > 0) { + return enif_make_binary(env,&ret_bin); + } + else { + return atom_error; + } +} + +static ERL_NIF_TERM rsa_private_crypt(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]) +{/* (Data, PublKey=[E,N,D], Padding, IsEncrypt) */ + ErlNifBinary data_bin, ret_bin; + ERL_NIF_TERM head, tail; + int padding, i; + RSA* rsa = RSA_new(); + + if (!enif_inspect_binary(env, argv[0], &data_bin) + || !enif_get_list_cell(env, argv[1], &head, &tail) + || !get_bn_from_mpint(env, head, &rsa->e) + || !enif_get_list_cell(env, tail, &head, &tail) + || !get_bn_from_mpint(env, head, &rsa->n) + || !enif_get_list_cell(env, tail, &head, &tail) + || !get_bn_from_mpint(env, head, &rsa->d) + || !enif_is_empty_list(env,tail) + || !rsa_pad(argv[2], &padding)) { + + RSA_free(rsa); + return enif_make_badarg(env); + } + + enif_alloc_binary(env, RSA_size(rsa), &ret_bin); + + if (argv[3] == atom_true) { + ERL_VALGRIND_ASSERT_MEM_DEFINED(buf+i,data_len); + i = RSA_private_encrypt(data_bin.size, data_bin.data, + ret_bin.data, rsa, padding); + if (i > 0) { + ERL_VALGRIND_MAKE_MEM_DEFINED(ret_bin.data, i); + } + } + else { + i = RSA_private_decrypt(data_bin.size, data_bin.data, + ret_bin.data, rsa, padding); + if (i > 0) { + ERL_VALGRIND_MAKE_MEM_DEFINED(ret_bin.data, i); + enif_realloc_binary(env, &ret_bin, i); + } + } + RSA_free(rsa); + if (i > 0) { + return enif_make_binary(env,&ret_bin); + } + else { + return atom_error; + } +} + +static ERL_NIF_TERM dh_generate_parameters_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]) +{/* (PrimeLen, Generator) */ + int prime_len, generator; + DH* dh_params; + int p_len, g_len; + unsigned char *p_ptr, *g_ptr; + ERL_NIF_TERM ret_p, ret_g; + + if (!enif_get_int(env, argv[0], &prime_len) + || !enif_get_int(env, argv[1], &generator)) { + + return enif_make_badarg(env); + } + dh_params = DH_generate_parameters(prime_len, generator, NULL, NULL); + if (dh_params == NULL) { + return atom_error; + } + p_len = BN_num_bytes(dh_params->p); + g_len = BN_num_bytes(dh_params->g); + p_ptr = enif_make_new_binary(env, p_len+4, &ret_p); + g_ptr = enif_make_new_binary(env, g_len+4, &ret_g); + put_int32(p_ptr, p_len); + put_int32(g_ptr, g_len); + BN_bn2bin(dh_params->p, p_ptr+4); + BN_bn2bin(dh_params->g, g_ptr+4); + ERL_VALGRIND_MAKE_MEM_DEFINED(p_ptr+4, p_len); + ERL_VALGRIND_MAKE_MEM_DEFINED(g_ptr+4, g_len); + DH_free(dh_params); + return enif_make_list2(env, ret_p, ret_g); +} + +static ERL_NIF_TERM dh_check(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]) +{/* ([PrimeLen, Generator]) */ + DH* dh_params = DH_new(); + int i; + ERL_NIF_TERM ret, head, tail; + + if (!enif_get_list_cell(env, argv[0], &head, &tail) + || !get_bn_from_mpint(env, head, &dh_params->p) + || !enif_get_list_cell(env, tail, &head, &tail) + || !get_bn_from_mpint(env, head, &dh_params->g) + || !enif_is_empty_list(env,tail)) { + + DH_free(dh_params); + return enif_make_badarg(env); + } + if (DH_check(dh_params, &i)) { + if (i == 0) ret = atom_ok; + else if (i & DH_CHECK_P_NOT_PRIME) ret = atom_not_prime; + else if (i & DH_CHECK_P_NOT_SAFE_PRIME) ret = atom_not_strong_prime; + else if (i & DH_UNABLE_TO_CHECK_GENERATOR) ret = atom_unable_to_check_generator; + else if (i & DH_NOT_SUITABLE_GENERATOR) ret = atom_not_suitable_generator; + else ret = enif_make_tuple2(env, atom_unknown, enif_make_uint(env, i)); + } + else { /* Check Failed */ + ret = enif_make_tuple2(env, atom_error, atom_check_failed); + } + DH_free(dh_params); + return ret; +} + +static ERL_NIF_TERM dh_generate_key_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]) +{/* (PrivKey, DHParams=[P,G]) */ + DH* dh_params = DH_new(); + int pub_len, prv_len; + unsigned char *pub_ptr, *prv_ptr; + ERL_NIF_TERM ret, ret_pub, ret_prv, head, tail; + + if (!(get_bn_from_mpint(env, argv[0], &dh_params->priv_key) + || argv[0] == atom_undefined) + || !enif_get_list_cell(env, argv[1], &head, &tail) + || !get_bn_from_mpint(env, head, &dh_params->p) + || !enif_get_list_cell(env, tail, &head, &tail) + || !get_bn_from_mpint(env, head, &dh_params->g) + || !enif_is_empty_list(env, tail)) { + + return enif_make_badarg(env); + } + + if (DH_generate_key(dh_params)) { + pub_len = BN_num_bytes(dh_params->pub_key); + prv_len = BN_num_bytes(dh_params->priv_key); + pub_ptr = enif_make_new_binary(env, pub_len+4, &ret_pub); + prv_ptr = enif_make_new_binary(env, prv_len+4, &ret_prv); + put_int32(pub_ptr, pub_len); + put_int32(prv_ptr, prv_len); + BN_bn2bin(dh_params->pub_key, pub_ptr+4); + BN_bn2bin(dh_params->priv_key, prv_ptr+4); + ERL_VALGRIND_MAKE_MEM_DEFINED(pub_ptr+4, pub_len); + ERL_VALGRIND_MAKE_MEM_DEFINED(prv_ptr+4, prv_len); + ret = enif_make_tuple2(env, ret_pub, ret_prv); + } + else { + ret = atom_error; + } + DH_free(dh_params); + return ret; +} + +static ERL_NIF_TERM dh_compute_key_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]) +{/* (OthersPublicKey, MyPrivateKey, DHParams=[P,G]) */ + DH* dh_params = DH_new(); + BIGNUM* pubkey; + int i; + ErlNifBinary ret_bin; + ERL_NIF_TERM ret, head, tail; + + if (!get_bn_from_mpint(env, argv[0], &pubkey) + || !get_bn_from_mpint(env, argv[1], &dh_params->priv_key) + || !enif_get_list_cell(env, argv[2], &head, &tail) + || !get_bn_from_mpint(env, head, &dh_params->p) + || !enif_get_list_cell(env, tail, &head, &tail) + || !get_bn_from_mpint(env, head, &dh_params->g) + || !enif_is_empty_list(env, tail)) { + + ret = enif_make_badarg(env); + } + else { + enif_alloc_binary(env, DH_size(dh_params), &ret_bin); + i = DH_compute_key(ret_bin.data, pubkey, dh_params); + if (i > 0) { + if (i != ret_bin.size) { + enif_realloc_binary(env, &ret_bin, i); + } + ret = enif_make_binary(env, &ret_bin); + } + else { + ret = atom_error; + } + } + DH_free(dh_params); + return ret; +} + +static ERL_NIF_TERM bf_cfb64_crypt(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]) +{/* (Key, Ivec, Data, IsEncrypt) */ + ErlNifBinary key_bin, ivec_bin, data_bin; + BF_KEY bf_key; /* blowfish key 8 */ + unsigned char bf_tkey[8]; /* blowfish ivec */ + int bf_n = 0; /* blowfish ivec pos */ + ERL_NIF_TERM ret; + + if (!enif_inspect_iolist_as_binary(env, argv[0], &key_bin) + || !enif_inspect_binary(env, argv[1], &ivec_bin) + || ivec_bin.size != 8 + || !enif_inspect_iolist_as_binary(env, argv[2], &data_bin)) { + return enif_make_badarg(env); + } + + BF_set_key(&bf_key, key_bin.size, key_bin.data); + memcpy(bf_tkey, ivec_bin.data, 8); + BF_cfb64_encrypt(data_bin.data, enif_make_new_binary(env,data_bin.size,&ret), + data_bin.size, &bf_key, bf_tkey, &bf_n, + (argv[3] == atom_true ? BF_ENCRYPT : BF_DECRYPT)); + return ret; +} + +static ERL_NIF_TERM bf_cbc_crypt(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]) +{/* (Key, Ivec, Data, IsEncrypt) */ + ErlNifBinary key_bin, ivec_bin, data_bin; + BF_KEY bf_key; /* blowfish key 8 */ + unsigned char bf_tkey[8]; /* blowfish ivec */ + ERL_NIF_TERM ret; + + if (!enif_inspect_iolist_as_binary(env, argv[0], &key_bin) + || !enif_inspect_binary(env, argv[1], &ivec_bin) + || ivec_bin.size != 8 + || !enif_inspect_iolist_as_binary(env, argv[2], &data_bin) + || data_bin.size % 8 != 0) { + return enif_make_badarg(env); + } + + BF_set_key(&bf_key, key_bin.size, key_bin.data); + memcpy(bf_tkey, ivec_bin.data, 8); + BF_cbc_encrypt(data_bin.data, enif_make_new_binary(env,data_bin.size,&ret), + data_bin.size, &bf_key, bf_tkey, + (argv[3] == atom_true ? BF_ENCRYPT : BF_DECRYPT)); + return ret; +} + +static ERL_NIF_TERM bf_ecb_crypt(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]) +{/* (Key, Data, IsEncrypt) */ + ErlNifBinary key_bin, data_bin; + BF_KEY bf_key; /* blowfish key 8 */ + ERL_NIF_TERM ret; + + if (!enif_inspect_iolist_as_binary(env, argv[0], &key_bin) + || !enif_inspect_iolist_as_binary(env, argv[1], &data_bin) + || data_bin.size < 8) { + return enif_make_badarg(env); + } + BF_set_key(&bf_key, key_bin.size, key_bin.data); + BF_ecb_encrypt(data_bin.data, enif_make_new_binary(env,data_bin.size,&ret), + &bf_key, (argv[2] == atom_true ? BF_ENCRYPT : BF_DECRYPT)); + return ret; +} + +static ERL_NIF_TERM blowfish_ofb64_encrypt(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]) +{/* (Key, IVec, Data) */ + ErlNifBinary key_bin, ivec_bin, data_bin; + BF_KEY bf_key; /* blowfish key 8 */ + unsigned char bf_tkey[8]; /* blowfish ivec */ + int bf_n = 0; /* blowfish ivec pos */ + ERL_NIF_TERM ret; + + if (!enif_inspect_iolist_as_binary(env, argv[0], &key_bin) + || !enif_inspect_binary(env, argv[1], &ivec_bin) + || ivec_bin.size != 8 + || !enif_inspect_iolist_as_binary(env, argv[2], &data_bin)) { + return enif_make_badarg(env); + } + + BF_set_key(&bf_key, key_bin.size, key_bin.data); + memcpy(bf_tkey, ivec_bin.data, 8); + BF_ofb64_encrypt(data_bin.data, enif_make_new_binary(env,data_bin.size,&ret), + data_bin.size, &bf_key, bf_tkey, &bf_n); + return ret; +} + + + +#ifdef OPENSSL_THREADS /* vvvvvvvvvvvvvvv OPENSSL_THREADS vvvvvvvvvvvvvvvv */ + +static INLINE void locking(int mode, ErlNifRWLock* lock) +{ + switch (mode) { + case CRYPTO_LOCK|CRYPTO_READ: + enif_rwlock_rlock(lock); + break; + case CRYPTO_LOCK|CRYPTO_WRITE: + enif_rwlock_rwlock(lock); + break; + case CRYPTO_UNLOCK|CRYPTO_READ: + enif_rwlock_runlock(lock); + break; + case CRYPTO_UNLOCK|CRYPTO_WRITE: + enif_rwlock_rwunlock(lock); + break; + default: + ASSERT(!"Invalid lock mode"); + } +} + +/* Callback from openssl for static locking + */ +static void locking_function(int mode, int n, const char *file, int line) +{ + ASSERT(n>=0 && n<CRYPTO_num_locks()); + + locking(mode, lock_vec[n]); +} + +/* Callback from openssl for thread id + */ +static unsigned long id_function(void) +{ + return(unsigned long) enif_thread_self(); +} + +/* Callbacks for dynamic locking, not used by current openssl version (0.9.8) + */ +static struct CRYPTO_dynlock_value* dyn_create_function(const char *file, int line) { + return(struct CRYPTO_dynlock_value*) enif_rwlock_create("crypto_dyn"); +} +static void dyn_lock_function(int mode, struct CRYPTO_dynlock_value* ptr,const char *file, int line) +{ + locking(mode, (ErlNifRWLock*)ptr); +} +static void dyn_destroy_function(struct CRYPTO_dynlock_value *ptr, const char *file, int line) +{ + enif_rwlock_destroy((ErlNifRWLock*)ptr); +} + +#endif /* ^^^^^^^^^^^^^^^^^^^^^^ OPENSSL_THREADS ^^^^^^^^^^^^^^^^^^^^^^ */ + +/* HMAC */ + +static void hmac_md5(unsigned char *key, int klen, unsigned char *dbuf, int dlen, + unsigned char *hmacbuf) +{ + MD5_CTX ctx; + char ipad[HMAC_INT_LEN]; + char opad[HMAC_INT_LEN]; + unsigned char nkey[MD5_LEN]; + int i; + + /* Change key if longer than 64 bytes */ + if (klen > HMAC_INT_LEN) { + MD5(key, klen, nkey); + key = nkey; + klen = MD5_LEN; + } + + memset(ipad, '\0', sizeof(ipad)); + memset(opad, '\0', sizeof(opad)); + memcpy(ipad, key, klen); + memcpy(opad, key, klen); + + for (i = 0; i < HMAC_INT_LEN; i++) { + ipad[i] ^= HMAC_IPAD; + opad[i] ^= HMAC_OPAD; + } + + /* inner MD5 */ + MD5_Init(&ctx); + MD5_Update(&ctx, ipad, HMAC_INT_LEN); + MD5_Update(&ctx, dbuf, dlen); + MD5_Final((unsigned char *) hmacbuf, &ctx); + /* outer MD5 */ + MD5_Init(&ctx); + MD5_Update(&ctx, opad, HMAC_INT_LEN); + MD5_Update(&ctx, hmacbuf, MD5_LEN); + MD5_Final((unsigned char *) hmacbuf, &ctx); +} + +static void hmac_sha1(unsigned char *key, int klen, + unsigned char *dbuf, int dlen, + unsigned char *hmacbuf) +{ + SHA_CTX ctx; + char ipad[HMAC_INT_LEN]; + char opad[HMAC_INT_LEN]; + unsigned char nkey[SHA_LEN]; + int i; + + /* Change key if longer than 64 bytes */ + if (klen > HMAC_INT_LEN) { + SHA1(key, klen, nkey); + key = nkey; + klen = SHA_LEN; + } + + memset(ipad, '\0', sizeof(ipad)); + memset(opad, '\0', sizeof(opad)); + memcpy(ipad, key, klen); + memcpy(opad, key, klen); + + for (i = 0; i < HMAC_INT_LEN; i++) { + ipad[i] ^= HMAC_IPAD; + opad[i] ^= HMAC_OPAD; + } + + /* inner SHA */ + SHA1_Init(&ctx); + SHA1_Update(&ctx, ipad, HMAC_INT_LEN); + SHA1_Update(&ctx, dbuf, dlen); + SHA1_Final((unsigned char *) hmacbuf, &ctx); + /* outer SHA */ + SHA1_Init(&ctx); + SHA1_Update(&ctx, opad, HMAC_INT_LEN); + SHA1_Update(&ctx, hmacbuf, SHA_LEN); + SHA1_Final((unsigned char *) hmacbuf, &ctx); +} + diff --git a/lib/crypto/c_src/crypto_drv.c b/lib/crypto/c_src/crypto_drv.c deleted file mode 100644 index 8c1356c4cf..0000000000 --- a/lib/crypto/c_src/crypto_drv.c +++ /dev/null @@ -1,1817 +0,0 @@ -/* - * %CopyrightBegin% - * - * Copyright Ericsson AB 1999-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% - */ - -/* - * Purpose: Dynamically loadable driver for cryptography libraries. - * Based on OpenSSL. - */ - -#ifdef __WIN32__ -#include <windows.h> -#endif - -#include <stdlib.h> -#include <stdio.h> -#include <string.h> -#include "erl_driver.h" - -#define OPENSSL_THREAD_DEFINES -#include <openssl/opensslconf.h> -#ifndef OPENSSL_THREADS -# ifdef __GNUC__ -# warning No thread support by openssl. Driver will use coarse grain locking. -# endif -#endif - -#include <openssl/crypto.h> -#include <openssl/des.h> -/* #include <openssl/idea.h> This is not supported on the openssl OTP requires */ -#include <openssl/dsa.h> -#include <openssl/rsa.h> -#include <openssl/aes.h> -#include <openssl/md5.h> -#include <openssl/md4.h> -#include <openssl/sha.h> -#include <openssl/bn.h> -#include <openssl/objects.h> -#include <openssl/rc4.h> -#include <openssl/rc2.h> -#include <openssl/blowfish.h> -#include <openssl/rand.h> - -#ifdef VALGRIND -# include <valgrind/memcheck.h> - -/* libcrypto mixes supplied buffer contents into its entropy pool, - which makes valgrind complain about the use of uninitialized data. - We use this valgrind "request" to make sure that no such seemingly - undefined data escapes the driver. -*/ -# define ERL_VALGRIND_MAKE_MEM_DEFINED(ptr,size) \ - VALGRIND_MAKE_MEM_DEFINED(ptr,size) - -# define ERL_VALGRIND_ASSERT_MEM_DEFINED(ptr,size) \ - ((void) ((VALGRIND_CHECK_MEM_IS_DEFINED(ptr,size) == 0) ? 1 : \ - (fprintf(stderr,"\r\n####### VALGRIND_ASSSERT(%p,%d) failed at %s:%d\r\n",\ - (ptr),(size), __FILE__, __LINE__), abort(), 0))) -#else -# define ERL_VALGRIND_MAKE_MEM_DEFINED(ptr,size) -# define ERL_VALGRIND_ASSERT_MEM_DEFINED(ptr,size) -#endif - -#ifdef DEBUG -# define ASSERT(e) \ - ((void) ((e) ? 1 : (fprintf(stderr,"Assert '%s' failed at %s:%d\n",\ - #e, __FILE__, __LINE__), abort(), 0))) -#else -# define ASSERT(e) ((void) 1) -#endif - -#ifdef __GNUC__ -# define INLINE __inline__ -#elif defined(__WIN32__) -# define INLINE __forceinline -#else -# define INLINE -#endif - - -#define get_int32(s) ((((unsigned char*) (s))[0] << 24) | \ - (((unsigned char*) (s))[1] << 16) | \ - (((unsigned char*) (s))[2] << 8) | \ - (((unsigned char*) (s))[3])) - -#define put_int32(s,i) \ -{ (s)[0] = (char)(((i) >> 24) & 0xff);\ - (s)[1] = (char)(((i) >> 16) & 0xff);\ - (s)[2] = (char)(((i) >> 8) & 0xff);\ - (s)[3] = (char)((i) & 0xff);\ -} - -/* Driver interface declarations */ -static int init(void); -static void finish(void); -static ErlDrvData start(ErlDrvPort port, char *command); -static void stop(ErlDrvData drv_data); -static int crypto_control(ErlDrvData drv_data, unsigned int command, char *buf, - int len, char **rbuf, int rlen); - -/* openssl callbacks */ -#ifdef OPENSSL_THREADS -static void locking_function(int mode, int n, const char *file, int line); -static unsigned long id_function(void); -static struct CRYPTO_dynlock_value* dyn_create_function(const char *file, - int line); -static void dyn_lock_function(int mode, struct CRYPTO_dynlock_value* ptr, - const char *file, int line); -static void dyn_destroy_function(struct CRYPTO_dynlock_value *ptr, - const char *file, int line); -#endif /* OPENSSL_THREADS */ - -/* helpers */ -static void hmac_md5(char *key, int klen, char *dbuf, int dlen, - char *hmacbuf); -static void hmac_sha1(char *key, int klen, char *dbuf, int dlen, - char *hmacbuf); - -static ErlDrvEntry crypto_driver_entry = { - init, - start, - stop, - NULL, /* output */ - NULL, /* ready_input */ - NULL, /* ready_output */ - "crypto_drv", - finish, - NULL, /* handle */ - crypto_control, - NULL, /* timeout */ - NULL, /* outputv */ - - NULL, /* ready_async */ - NULL, /* flush */ - NULL, /* call */ - NULL, /* event */ - ERL_DRV_EXTENDED_MARKER, - ERL_DRV_EXTENDED_MAJOR_VERSION, - ERL_DRV_EXTENDED_MINOR_VERSION, -#ifdef OPENSSL_THREADS - ERL_DRV_FLAG_USE_PORT_LOCKING, -#else - 0, -#endif - NULL, /* handle2 */ - NULL /* process_exit */ -}; - - -/* Keep the following definitions in alignment with the FUNC_LIST - * in crypto.erl. - */ - -#define DRV_INFO 0 -#define DRV_MD5 1 -#define DRV_MD5_INIT 2 -#define DRV_MD5_UPDATE 3 -#define DRV_MD5_FINAL 4 -#define DRV_SHA 5 -#define DRV_SHA_INIT 6 -#define DRV_SHA_UPDATE 7 -#define DRV_SHA_FINAL 8 -#define DRV_MD5_MAC 9 -#define DRV_MD5_MAC_96 10 -#define DRV_SHA_MAC 11 -#define DRV_SHA_MAC_96 12 -#define DRV_CBC_DES_ENCRYPT 13 -#define DRV_CBC_DES_DECRYPT 14 -#define DRV_EDE3_CBC_DES_ENCRYPT 15 -#define DRV_EDE3_CBC_DES_DECRYPT 16 -#define DRV_AES_CFB_128_ENCRYPT 17 -#define DRV_AES_CFB_128_DECRYPT 18 -#define DRV_RAND_BYTES 19 -#define DRV_RAND_UNIFORM 20 -#define DRV_MOD_EXP 21 -#define DRV_DSS_VERIFY 22 -#define DRV_RSA_VERIFY_SHA 23 -/* #define DRV_RSA_VERIFY_MD5 35 */ -#define DRV_CBC_AES128_ENCRYPT 24 -#define DRV_CBC_AES128_DECRYPT 25 -#define DRV_XOR 26 -#define DRV_RC4_ENCRYPT 27 /* no decrypt needed; symmetric */ -#define DRV_RC4_SETKEY 28 -#define DRV_RC4_ENCRYPT_WITH_STATE 29 -#define DRV_CBC_RC2_40_ENCRYPT 30 -#define DRV_CBC_RC2_40_DECRYPT 31 -#define DRV_CBC_AES256_ENCRYPT 32 -#define DRV_CBC_AES256_DECRYPT 33 -#define DRV_INFO_LIB 34 -/* #define DRV_RSA_VERIFY_SHA 23 */ -#define DRV_RSA_VERIFY_MD5 35 -#define DRV_RSA_SIGN_SHA 36 -#define DRV_RSA_SIGN_MD5 37 -#define DRV_DSS_SIGN 38 -#define DRV_RSA_PUBLIC_ENCRYPT 39 -#define DRV_RSA_PRIVATE_DECRYPT 40 -#define DRV_RSA_PRIVATE_ENCRYPT 41 -#define DRV_RSA_PUBLIC_DECRYPT 42 -#define DRV_DH_GENERATE_PARAMS 43 -#define DRV_DH_CHECK 44 -#define DRV_DH_GENERATE_KEY 45 -#define DRV_DH_COMPUTE_KEY 46 -#define DRV_MD4 47 -#define DRV_MD4_INIT 48 -#define DRV_MD4_UPDATE 49 -#define DRV_MD4_FINAL 50 - -#define SSL_VERSION_0_9_8 0 -#if SSL_VERSION_0_9_8 -#define DRV_SHA256 51 -#define DRV_SHA256_INIT 52 -#define DRV_SHA256_UPDATE 53 -#define DRV_SHA256_FINAL 54 -#define DRV_SHA512 55 -#define DRV_SHA512_INIT 56 -#define DRV_SHA512_UPDATE 57 -#define DRV_SHA512_FINAL 58 -#endif - -#define DRV_BF_CFB64_ENCRYPT 59 -#define DRV_BF_CFB64_DECRYPT 60 -#define DRV_BF_ECB_ENCRYPT 61 -#define DRV_BF_ECB_DECRYPT 62 -#define DRV_BF_OFB64_ENCRYPT 63 -#define DRV_BF_CBC_ENCRYPT 64 -#define DRV_BF_CBC_DECRYPT 65 - -#define DRV_ECB_DES_ENCRYPT 66 -#define DRV_ECB_DES_DECRYPT 67 - -/* #define DRV_CBC_IDEA_ENCRYPT 34 */ -/* #define DRV_CBC_IDEA_DECRYPT 35 */ - -/* Not DRV_DH_GENERATE_PARAMS DRV_DH_CHECK - * Calc RSA_VERIFY_* and RSA_SIGN once */ -#define NUM_CRYPTO_FUNCS 48 - -#define MD5_CTX_LEN (sizeof(MD5_CTX)) -#define MD5_LEN 16 -#define MD5_LEN_96 12 -#define MD4_CTX_LEN (sizeof(MD4_CTX)) -#define MD4_LEN 16 -#define SHA_CTX_LEN (sizeof(SHA_CTX)) -#define SHA_LEN 20 -#define SHA_LEN_96 12 -#define HMAC_INT_LEN 64 - -#define HMAC_IPAD 0x36 -#define HMAC_OPAD 0x5c - -#if SSL_VERSION_0_9_8 -#define SHA256_CTX_LEN (sizeof(SHA256_CTX)) -#define SHA256_LEN 32 - -#define SHA512_CTX_LEN (sizeof(SHA512_CTX)) -#define SHA512_LEN 64 -#endif - -/* INITIALIZATION AFTER LOADING */ - -/* - * This is the init function called after this driver has been loaded. - * It must *not* be declared static. Must return the address to - * the driver entry. - */ - -#if !defined(__WIN32__) -DRIVER_INIT(crypto_drv); -#endif - -DRIVER_INIT(crypto_drv) -{ - return &crypto_driver_entry; -} - -static ErlDrvRWLock** lock_vec = NULL; /* Static locks used by openssl */ - -/* DRIVER INTERFACE */ - -static int init(void) -{ - ErlDrvSysInfo sys_info; - int i; - - CRYPTO_set_mem_functions(driver_alloc, driver_realloc, driver_free); - -#ifdef OPENSSL_THREADS - driver_system_info(&sys_info, sizeof(sys_info)); - - if(sys_info.scheduler_threads > 1) { - lock_vec = driver_alloc(CRYPTO_num_locks()*sizeof(*lock_vec)); - if (lock_vec==NULL) return -1; - memset(lock_vec,0,CRYPTO_num_locks()*sizeof(*lock_vec)); - - for(i=CRYPTO_num_locks()-1; i>=0; --i) { - lock_vec[i] = erl_drv_rwlock_create("crypto_drv_stat"); - if (lock_vec[i]==NULL) return -1; - } - CRYPTO_set_locking_callback(locking_function); - CRYPTO_set_id_callback(id_function); - CRYPTO_set_dynlock_create_callback(dyn_create_function); - CRYPTO_set_dynlock_lock_callback(dyn_lock_function); - CRYPTO_set_dynlock_destroy_callback(dyn_destroy_function); - } - /* else no need for locks */ -#endif /* OPENSSL_THREADS */ - - return 0; -} - -static void finish(void) -{ - /* Moved here from crypto_control() as it's not thread safe */ - CRYPTO_cleanup_all_ex_data(); - - if(lock_vec != NULL) { - int i; - for(i=CRYPTO_num_locks()-1; i>=0; --i) { - if (lock_vec[i] != NULL) { - erl_drv_rwlock_destroy(lock_vec[i]); - } - } - driver_free(lock_vec); - } -} - -static ErlDrvData start(ErlDrvPort port, char *command) -{ - set_port_control_flags(port, PORT_CONTROL_FLAG_BINARY); - return 0; /* not used */ -} - -static void stop(ErlDrvData drv_data) -{ - return; -} - -/* Helper functions for 'crypto_control' -*/ -static INLINE unsigned char* return_binary(char **rbuf, int rlen, int len) -{ - if (len <= rlen) { - return (unsigned char *) *rbuf; - } - else { - ErlDrvBinary* bin; - *rbuf = (char*) (bin = driver_alloc_binary(len)); - return (bin==NULL) ? NULL : (unsigned char *) bin->orig_bytes; - } -} - -static INLINE unsigned char* return_binary_shrink(char **rbuf, int rlen, unsigned char* data, int len) -{ - if ((char *) data == *rbuf) { /* default buffer */ - ASSERT(len <= rlen); - return (unsigned char *) data; - } - else { - ErlDrvBinary* bin = (ErlDrvBinary*) *rbuf; - *rbuf = (char*) (bin=driver_realloc_binary(bin, len)); - return (bin==NULL) ? NULL : (unsigned char *) bin->orig_bytes; - } -} - -/* Nowadays (R13) it does matter what value control returns - * as it may return data in default buffer. - */ -static int crypto_control(ErlDrvData drv_data, unsigned int command, char *buf, - int len, char **rbuf, int rlen) -{ - int klen, dlen, macsize, from_len, to_len, i; - int base_len, exponent_len, modulo_len; - int data_len, dsa_p_len, dsa_q_len; - int dsa_s_len, dsa_g_len, dsa_y_len; - int rsa_e_len, rsa_n_len, rsa_d_len, padding; - int or_mask; - int prime_len, generator; - int privkey_len, pubkey_len, dh_p_len, dh_g_len; - unsigned int rsa_s_len, j; - char *key, *key2, *dbuf; - unsigned char *p; - const_DES_cblock *des_key, *des_key2, *des_key3; - const unsigned char *des_dbuf; - BIGNUM *bn_from, *bn_to, *bn_rand, *bn_result; - BIGNUM *bn_base, *bn_exponent, *bn_modulo; - BIGNUM *dsa_p, *dsa_q, *dsa_g, *dsa_y; - BIGNUM *rsa_n, *rsa_e, *rsa_d; - BIGNUM *dh_p, *dh_g, *privkey, *pubkey; - DES_cblock *des_ivec; - unsigned char* bin; - DES_key_schedule schedule, schedule2, schedule3; - DH *dh_params; -/* IDEA_KEY_SCHEDULE idea, idea2; */ - char hmacbuf[SHA_DIGEST_LENGTH]; - unsigned char *rsa_s, *dsa_s; - /* char hmacbuf[SHA_LEN]; */ -#if SSL_VERSION_0_9_8 - SHA256_CTX sha256_ctx; - SHA512_CTX sha512_ctx; -#endif - MD5_CTX md5_ctx; - MD4_CTX md4_ctx; - SHA_CTX sha_ctx; - int new_ivlen = 0; - BN_CTX *bn_ctx; - DSA *dsa; - RSA *rsa; - AES_KEY aes_key; - RC4_KEY rc4_key; - RC2_KEY rc2_key; - - switch(command) { - - case DRV_INFO: - bin = return_binary(rbuf,rlen,NUM_CRYPTO_FUNCS); - if (bin==NULL) return -1; - - for (i = 0; i < NUM_CRYPTO_FUNCS; i++) { - bin[i] = i + 1; - } - return NUM_CRYPTO_FUNCS; - - case DRV_MD5: - bin = return_binary(rbuf,rlen,MD5_LEN); - if (bin==NULL) return -1; - MD5((unsigned char *) buf, len, bin); - return MD5_LEN; - - case DRV_MD5_INIT: - bin = return_binary(rbuf,rlen,MD5_CTX_LEN); - if (bin==NULL) return -1; - MD5_Init((MD5_CTX *)bin); - return MD5_CTX_LEN; - - case DRV_MD5_UPDATE: - if (len < MD5_CTX_LEN) - return -1; - bin = return_binary(rbuf,rlen,MD5_CTX_LEN); - if (bin==NULL) return -1; - memcpy(bin, buf, MD5_CTX_LEN); - MD5_Update((MD5_CTX *)bin, buf + MD5_CTX_LEN, - len - MD5_CTX_LEN); - return MD5_CTX_LEN; - - case DRV_MD5_FINAL: - if (len != MD5_CTX_LEN) - return -1; - memcpy(&md5_ctx, buf, MD5_CTX_LEN); /* XXX Use buf only? */ - bin = return_binary(rbuf,rlen,MD5_LEN); - if (bin==NULL) return -1; - MD5_Final(bin, &md5_ctx); - return MD5_LEN; - - case DRV_SHA: - bin = return_binary(rbuf,rlen,SHA_LEN); - if (bin==NULL) return -1; - SHA1((unsigned char *) buf, len, bin); - return SHA_LEN; - - case DRV_SHA_INIT: - bin = return_binary(rbuf,rlen,SHA_CTX_LEN); - if (bin==NULL) return -1; - SHA1_Init((SHA_CTX*)bin); - return SHA_CTX_LEN; - - case DRV_SHA_UPDATE: - if (len < SHA_CTX_LEN) - return -1; - bin = return_binary(rbuf,rlen,SHA_CTX_LEN); - if (bin==NULL) return -1; - memcpy(bin, buf, SHA_CTX_LEN); - SHA1_Update((SHA_CTX*)bin, buf + SHA_CTX_LEN, len - SHA_CTX_LEN); - return SHA_CTX_LEN; - - case DRV_SHA_FINAL: - if (len != SHA_CTX_LEN) - return -1; - memcpy(&sha_ctx, buf, SHA_CTX_LEN); /* XXX Use buf only? */ - bin = return_binary(rbuf,rlen,SHA_LEN); - if (bin==NULL) return -1; - SHA1_Final(bin, &sha_ctx); - return SHA_LEN; - - case DRV_MD5_MAC: - case DRV_MD5_MAC_96: - /* buf = klen[4] key data */ - klen = get_int32(buf); - key = buf + 4; - dlen = len - klen - 4; - dbuf = key + klen; - hmac_md5(key, klen, dbuf, dlen, hmacbuf); - macsize = (command == DRV_MD5_MAC) ? MD5_LEN : MD5_LEN_96; - bin = return_binary(rbuf,rlen,macsize); - if (bin==NULL) return -1; - memcpy(bin, hmacbuf, macsize); - return macsize; - - case DRV_SHA_MAC: - case DRV_SHA_MAC_96: - /* buf = klen[4] key data */ - klen = get_int32(buf); - key = buf + 4; - dlen = len - klen - 4; - dbuf = key + klen; - hmac_sha1(key, klen, dbuf, dlen, hmacbuf); - macsize = (command == DRV_SHA_MAC) ? SHA_LEN : SHA_LEN_96; - bin = return_binary(rbuf,rlen,macsize); - if (bin==NULL) return -1; - memcpy(bin, (unsigned char *) hmacbuf, macsize); - return macsize; - - case DRV_CBC_DES_ENCRYPT: - case DRV_CBC_DES_DECRYPT: - /* buf = key[8] ivec[8] data */ - dlen = len - 16; - if (dlen < 0) - return -1; - if (dlen % 8 != 0) - return -1; - des_key = (const_DES_cblock*) buf; - des_ivec = (DES_cblock*)(buf + 8); - des_dbuf = (unsigned char *) (buf + 16); - bin = return_binary(rbuf,rlen,dlen); - if (bin==NULL) return -1; - DES_set_key(des_key, &schedule); - DES_ncbc_encrypt(des_dbuf, bin, dlen, &schedule, des_ivec, - (command == DRV_CBC_DES_ENCRYPT)); - return dlen; - - case DRV_ECB_DES_ENCRYPT: - case DRV_ECB_DES_DECRYPT: - /* buf = key[8] data */ - dlen = len - 8; - if (dlen != 8) - return -1; - des_key = (const_DES_cblock*) buf; - des_dbuf = (unsigned char *) (buf + 8); - bin = return_binary(rbuf,rlen,dlen); - if (bin==NULL) return -1; - DES_set_key(des_key, &schedule); - DES_ecb_encrypt((const_DES_cblock*) des_dbuf, (DES_cblock*) bin, &schedule, - (command == DRV_ECB_DES_ENCRYPT)); - return dlen; - - case DRV_BF_ECB_ENCRYPT: - case DRV_BF_ECB_DECRYPT: - { - /* buf = klen[4] key data */ - int bf_direction; - const unsigned char *ukey; - const unsigned char *bf_dbuf; /* blowfish input data */ - BF_KEY bf_key; /* blowfish key 8 */ - - klen = get_int32(buf); - ukey = (unsigned char *) buf + 4; - bf_dbuf = ukey + klen; - dlen = len - 4 - klen; - if (dlen < 0) return -1; - BF_set_key(&bf_key, klen, ukey); - bin = return_binary(rbuf,rlen,dlen); - if (bin==NULL) return -1; - bf_direction = command == DRV_BF_ECB_ENCRYPT ? BF_ENCRYPT : BF_DECRYPT; - BF_ecb_encrypt(bf_dbuf, bin, &bf_key, bf_direction); - return dlen; - } - - case DRV_BF_CBC_ENCRYPT: - case DRV_BF_CBC_DECRYPT: - { - /* buf = klen[4] key ivec[8] data */ - unsigned char *ukey; - unsigned char* ivec; - unsigned char bf_tkey[8]; /* blowfish ivec */ - int bf_direction; - const unsigned char *bf_dbuf; /* blowfish input data */ - BF_KEY bf_key; /* blowfish key 8 */ - - klen = get_int32(buf); - ukey = (unsigned char *)buf + 4; - ivec = ukey + klen; - bf_dbuf = ivec + 8; - dlen = len - 4 - klen - 8; - if (dlen < 0) return -1; - BF_set_key(&bf_key, klen, ukey); - memcpy(bf_tkey, ivec, 8); - bin = return_binary(rbuf,rlen,dlen); - if (bin==NULL) return -1; - bf_direction = command == DRV_BF_CBC_ENCRYPT ? BF_ENCRYPT : BF_DECRYPT; - BF_cbc_encrypt(bf_dbuf, bin, dlen, &bf_key, bf_tkey, bf_direction); - return dlen; - } - - case DRV_BF_OFB64_ENCRYPT: - { - /* buf = klen[4] key ivec[8] data */ - unsigned char *ukey; - unsigned char* ivec; - unsigned char bf_tkey[8]; /* blowfish ivec */ - int bf_n; /* blowfish ivec pos */ - const unsigned char *bf_dbuf; /* blowfish input data */ - BF_KEY bf_key; /* blowfish key 8 */ - - klen = get_int32(buf); - ukey = (unsigned char *)buf + 4; - ivec = ukey + klen; - bf_dbuf = ivec + 8; - dlen = len - 4 - klen - 8; - if (dlen < 0) return -1; - BF_set_key(&bf_key, klen, ukey); - memcpy(bf_tkey, ivec, 8); - bin = return_binary(rbuf,rlen,dlen); - if (bin==NULL) return -1; - bf_n = 0; - BF_ofb64_encrypt(bf_dbuf, bin, dlen, &bf_key, bf_tkey, &bf_n); - return dlen; - } - - case DRV_BF_CFB64_ENCRYPT: - case DRV_BF_CFB64_DECRYPT: - { - /* buf = klen[4] key ivec[8] data */ - unsigned char* ivec; - unsigned char bf_tkey[8]; /* blowfish ivec */ - int bf_n; /* blowfish ivec pos */ - int bf_direction; - const unsigned char *bf_dbuf; /* blowfish input data */ - BF_KEY bf_key; /* blowfish key 8 */ - - klen = get_int32(buf); - key = buf + 4; - ivec = (unsigned char *) (key + klen); - bf_dbuf = ivec + 8; - dlen = len - 4 - klen - 8; - if (dlen < 0) return -1; - BF_set_key(&bf_key, klen, (unsigned char *) key); - memcpy(bf_tkey, ivec, 8); - bin = return_binary(rbuf,rlen,dlen); - if (bin==NULL) return -1; - bf_direction = command == DRV_BF_CFB64_ENCRYPT ? BF_ENCRYPT : BF_DECRYPT; - bf_n = 0; - BF_cfb64_encrypt(bf_dbuf, bin, dlen, &bf_key, bf_tkey, &bf_n, bf_direction); - return dlen; - } - -/* case DRV_CBC_IDEA_ENCRYPT: */ -/* case DRV_CBC_IDEA_DECRYPT: */ - /* buf = key[16] ivec[8] data */ -/* dlen = len - 24; */ -/* if (dlen < 0) */ -/* return -1; */ -/* if (dlen % 8 != 0) */ -/* return -1; */ -/* bin = return_binary(rbuf,rlen,dlen); */ -/* idea_set_encrypt_key(buf, &idea); */ -/* if (command == DRV_CBC_IDEA_DECRYPT) { */ -/* idea_set_decrypt_key(&idea, &idea2); */ -/* memcpy(&idea, &idea2, sizeof(idea)); */ -/* } */ -/* idea_cbc_encrypt(buf + 24, bin, dlen, &idea, buf + 8, */ -/* (command == DRV_CBC_IDEA_ENCRYPT)); */ -/* return dlen; */ - - case DRV_CBC_RC2_40_ENCRYPT: - case DRV_CBC_RC2_40_DECRYPT: - /* buf = key[5] ivec[8] data */ - dlen = len - 13; - if (dlen < 0) - return -1; - bin = return_binary(rbuf,rlen,dlen); - if (bin==NULL) return -1; - RC2_set_key(&rc2_key, 5, (unsigned char *) buf, 40); - RC2_cbc_encrypt((unsigned char *) (buf + 13), bin, dlen, &rc2_key, - (unsigned char *) (buf + 5), - (command == DRV_CBC_RC2_40_ENCRYPT)); - return dlen; - - case DRV_EDE3_CBC_DES_ENCRYPT: - case DRV_EDE3_CBC_DES_DECRYPT: - dlen = len - 32; - if (dlen < 0) - return -1; - des_key = (const_DES_cblock*) buf; - des_key2 = (const_DES_cblock*) (buf + 8); - des_key3 = (const_DES_cblock*) (buf + 16); - des_ivec = (DES_cblock*) (buf + 24); - des_dbuf = (unsigned char *) (buf + 32); - bin = return_binary(rbuf,rlen,dlen); - if (bin==NULL) return -1; - DES_set_key(des_key, &schedule); - DES_set_key(des_key2, &schedule2); - DES_set_key(des_key3, &schedule3); - DES_ede3_cbc_encrypt(des_dbuf, bin, dlen, &schedule, - &schedule2, &schedule3, des_ivec, - (command == DRV_EDE3_CBC_DES_ENCRYPT)); - return dlen; - - case DRV_AES_CFB_128_ENCRYPT: - case DRV_AES_CFB_128_DECRYPT: - /* buf = key[16] ivec[16] data */ - dlen = len - 32; - if (dlen < 0) - return -1; - bin = return_binary(rbuf,rlen,dlen); - if (bin==NULL) return -1; - AES_set_encrypt_key((unsigned char *) buf, 128, &aes_key); - AES_cfb128_encrypt((unsigned char *) (buf+32), bin, dlen, &aes_key, - (unsigned char *) (buf+16), &new_ivlen, - (command == DRV_AES_CFB_128_ENCRYPT)); - return dlen; - - case DRV_RC4_ENCRYPT: - /* buf = klen[4] key data */ - klen = get_int32(buf); - key = buf + 4; - dlen = len - klen - 4; - dbuf = key + klen; - bin = return_binary(rbuf,rlen,dlen); - if (bin==NULL) return -1; - RC4_set_key(&rc4_key, klen, (unsigned char *) key); - RC4(&rc4_key, dlen, (unsigned char *) dbuf, bin); - return dlen; - - case DRV_RC4_SETKEY: - /* buf = key */ - dlen = sizeof(rc4_key); - bin = return_binary(rbuf,rlen,dlen); - if (bin==NULL) return -1; - RC4_set_key(&rc4_key, len, (unsigned char *) buf); - memcpy(bin, &rc4_key, dlen); - return dlen; - - case DRV_RC4_ENCRYPT_WITH_STATE: - /* buf = statelength[4] state data, return statelength[4] state data */ - klen = get_int32(buf); - key = buf + 4; - dlen = len - klen - 4; - dbuf = key + klen; - bin = return_binary(rbuf,rlen,len); - if (bin==NULL) return -1; - memcpy(&rc4_key, key, klen); - RC4(&rc4_key, dlen, (unsigned char *) dbuf, bin + klen + 4); - memcpy(bin, buf, 4); - memcpy(bin + 4, &rc4_key, klen); - return len; - - case DRV_RAND_BYTES: - /* buf = <<rlen:32/integer,topmask:8/integer,bottommask:8/integer>> */ - - if (len != 6) - return -1; - dlen = get_int32(buf); - bin = return_binary(rbuf,rlen,dlen); - if (bin==NULL) return -1; - RAND_pseudo_bytes(bin,dlen); - ERL_VALGRIND_MAKE_MEM_DEFINED(bin, dlen); - or_mask = ((unsigned char*)buf)[4]; - bin[dlen-1] |= or_mask; /* topmask */ - or_mask = ((unsigned char*)buf)[5]; - bin[0] |= or_mask; /* bottommask */ - return dlen; - - case DRV_RAND_UNIFORM: - /* buf = <<from_len:32/integer,bn_from:from_len/binary, * - * to_len:32/integer,bn_to:to_len/binary>> */ - if (len < 8) - return -1; - from_len = get_int32(buf); - if (len < (8 + from_len)) - return -1; - to_len = get_int32(buf + 4 + from_len); - if (len != (8 + from_len + to_len)) - return -1; - ERL_VALGRIND_ASSERT_MEM_DEFINED(buf, 4 + from_len + 4 + to_len); - bn_from = BN_new(); - BN_bin2bn((unsigned char *)(buf + 4), from_len, bn_from); - bn_rand = BN_new(); - BN_bin2bn((unsigned char *)(buf + 8 + from_len), to_len, bn_rand); - bn_to = BN_new(); - BN_sub(bn_to, bn_rand, bn_from); - BN_pseudo_rand_range(bn_rand, bn_to); - BN_add(bn_rand, bn_rand, bn_from); - dlen = BN_num_bytes(bn_rand); - bin = return_binary(rbuf,rlen,dlen + 4); - if (bin==NULL) return -1; - put_int32(bin, dlen); - BN_bn2bin(bn_rand,(unsigned char*)(bin + 4)); - ERL_VALGRIND_MAKE_MEM_DEFINED(bin+4, dlen); - BN_free(bn_rand); - BN_free(bn_from); - BN_free(bn_to); - return dlen + 4; - - case DRV_MOD_EXP: - /* buf = <<base_len:32/integer,base/binary, * - * exponent_len:32/integer,exponent/binary, * - * modulo_len:32/integer, modulo/binary>> */ - if (len < 12) - return -1; - base_len = get_int32(buf); - if (len < (12 + base_len)) - return -1; - exponent_len = get_int32(buf + 4 + base_len); - if (len < (12 + base_len + exponent_len)) - return -1; - modulo_len = get_int32(buf + 8 + base_len + exponent_len); - if (len != (12 + base_len + exponent_len + modulo_len)) - return -1; - bn_base = BN_new(); - BN_bin2bn((unsigned char *)(buf + 4), - base_len, bn_base); - bn_exponent = BN_new(); - BN_bin2bn((unsigned char *)(buf + 8 + base_len), - exponent_len, bn_exponent); - bn_modulo = BN_new(); - BN_bin2bn((unsigned char *)(buf + 12 + base_len + exponent_len), - modulo_len, bn_modulo); - bn_result = BN_new(); - bn_ctx = BN_CTX_new(); - BN_mod_exp(bn_result, bn_base, bn_exponent, - bn_modulo, bn_ctx); - dlen = BN_num_bytes(bn_result); - bin = return_binary(rbuf,rlen,dlen + 4); - if (bin==NULL) return -1; - put_int32(bin, dlen); - BN_bn2bin(bn_result,(unsigned char*)(bin + 4)); - BN_free(bn_result); - BN_free(bn_modulo); - BN_free(bn_exponent); - BN_free(bn_base); - BN_CTX_free(bn_ctx); - return dlen + 4; - - case DRV_DSS_VERIFY: - /* buf = <<data_len:32/integer, data:data_len/binary, - * dsa_s_len:32/integer, dsa_s:dsa_s_len/binary, - * dsa_p_len:32/integer, dsa_p:dsa_p_len/binary, - * dsa_q_len:32/integer, dsa_q:dsa_q_len/binary, - * dsa_g_len:32/integer, dsa_g:dsa_g_len/binary, - * dsa_y_len:32/integer, dsa_y:dsa_y_len/binary>> */ - i = 0; - j = 0; - if (len < 24) - return -1; - data_len = get_int32(buf + i + j); - j += data_len; i += 4; - if (len < (24 + j)) - return -1; - dsa_s_len = get_int32(buf + i + j); - j += dsa_s_len; i += 4; - if (len < (24 + j)) - return -1; - dsa_p_len = get_int32(buf + i + j); - j += dsa_p_len; i += 4; - if (len < (24 + j)) - return -1; - dsa_q_len = get_int32(buf + i + j); - j += dsa_q_len; i += 4; - if (len < (24 + j)) - return -1; - dsa_g_len = get_int32(buf + i + j); - j += dsa_g_len; i += 4; - if (len < (24 + j)) - return -1; - dsa_y_len = get_int32(buf + i + j); - j += dsa_y_len; - if (len != (24 + j)) - return -1; - i = 4; - SHA1((unsigned char *) (buf + i), data_len, (unsigned char *) hmacbuf); - i += data_len + 4; - dsa_s = (unsigned char *)(buf + i); - i += (dsa_s_len + 4); - dsa_p = BN_new(); - BN_bin2bn((unsigned char *)(buf + i), dsa_p_len, dsa_p); - i += (dsa_p_len + 4); - dsa_q = BN_new(); - BN_bin2bn((unsigned char *)(buf + i), dsa_q_len, dsa_q); - i += (dsa_q_len + 4); - dsa_g = BN_new(); - BN_bin2bn((unsigned char *)(buf + i), dsa_g_len, dsa_g); - i += (dsa_g_len + 4); - dsa_y = BN_new(); - BN_bin2bn((unsigned char *)(buf + i), dsa_y_len, dsa_y); - dsa = DSA_new(); - dsa->p = dsa_p; - dsa->q = dsa_q; - dsa->g = dsa_g; - dsa->priv_key = NULL; - dsa->pub_key = dsa_y; - i = DSA_verify(0, (unsigned char *) hmacbuf, SHA_DIGEST_LENGTH, - dsa_s, dsa_s_len, dsa); - bin = return_binary(rbuf,rlen,1); - if (bin==NULL) return -1; - - DSA_free(dsa); - bin[0] = (i > 0) ? 1 : 0; - return 1; - - case DRV_DSS_SIGN: - /* buf = <<data_len:32/integer, data:data_len/binary, - * dsa_p_len:32/integer, dsa_p:dsa_p_len/binary, - * dsa_q_len:32/integer, dsa_q:dsa_q_len/binary, - * dsa_g_len:32/integer, dsa_g:dsa_g_len/binary, - * dsa_y_len:32/integer, dsa_y:dsa_y_len/binary, - * dsa_x_len:32/integer, dsa_s:dsa_x_len/binary>> */ - i = 0; - j = 0; - if (len < 20) - return -1; - data_len = get_int32(buf + i + j); - j += data_len; i += 4; - if (len < (20 + j)) - return -1; - dsa_p_len = get_int32(buf + i + j); - j += dsa_p_len; i += 4; - if (len < (20 + j)) - return -1; - dsa_q_len = get_int32(buf + i + j); - j += dsa_q_len; i += 4; - if (len < (20 + j)) - return -1; - dsa_g_len = get_int32(buf + i + j); - j += dsa_g_len; i += 4; - if (len < (20 + j)) - return -1; - dsa_y_len = get_int32(buf + i + j); - j += dsa_y_len; - if (len < (20 + j)) - return -1; - if (len != (20 + j)) - return -1; - - i = 4; - SHA1((unsigned char *) (buf + i), data_len, (unsigned char *) hmacbuf); - i += data_len + 4; - dsa_p = BN_new(); - BN_bin2bn((unsigned char *)(buf + i), dsa_p_len, dsa_p); - i += (dsa_p_len + 4); - dsa_q = BN_new(); - BN_bin2bn((unsigned char *)(buf + i), dsa_q_len, dsa_q); - i += (dsa_q_len + 4); - dsa_g = BN_new(); - BN_bin2bn((unsigned char *)(buf + i), dsa_g_len, dsa_g); - i += (dsa_g_len + 4); - dsa_y = BN_new(); - BN_bin2bn((unsigned char *)(buf + i), dsa_y_len, dsa_y); - /* i += (dsa_y_len + 4); */ - - dsa = DSA_new(); - dsa->p = dsa_p; - dsa->q = dsa_q; - dsa->g = dsa_g; - dsa->priv_key = dsa_y; - dsa->pub_key = NULL; - dlen = DSA_size(dsa); - bin = return_binary(rbuf,rlen, dlen+1); - if (bin==NULL) return -1; - i = DSA_sign(NID_sha1, - (unsigned char *) hmacbuf,SHA_DIGEST_LENGTH, - (unsigned char *) &bin[1], - (unsigned int *) &dsa_s_len, dsa); - DSA_free(dsa); - if (i) { - if (dsa_s_len != dlen) { - bin = return_binary_shrink(rbuf,rlen,bin,dsa_s_len+1); - } - bin[0] = 1; - return dsa_s_len + 1; - } - else { - bin[0] = 0; - return 1; - } - - case DRV_RSA_VERIFY_MD5: - case DRV_RSA_VERIFY_SHA: - /* buf = <<data_len:32/integer, data:data_len/binary, - * rsa_s_len:32/integer, rsa_s:rsa_s_len/binary, - * rsa_e_len:32/integer, rsa_e:rsa_e_len/binary, - * rsa_n_len:32/integer, rsa_n:rsa_n_len/binary>> */ - i = 0; - j = 0; - if (len < 16) - return -1; - data_len = get_int32(buf + i + j); - j += data_len; i += 4; - if (len < (16 + j)) - return -1; - rsa_s_len = get_int32(buf + i + j); - j += rsa_s_len; i += 4; - if (len < (16 + j)) - return -1; - rsa_e_len = get_int32(buf + i + j); - j += rsa_e_len; i += 4; - if (len < (16 + j)) - return -1; - rsa_n_len = get_int32(buf + i + j); - j += rsa_n_len; i += 4; - if (len != (16 + j)) - return -1; - i = 4; - i += (data_len + 4); - rsa_s = (unsigned char *)(buf + i); - i += (rsa_s_len + 4); - rsa_e = BN_new(); - BN_bin2bn((unsigned char *)(buf + i), rsa_e_len, rsa_e); - i += (rsa_e_len + 4); - rsa_n = BN_new(); - BN_bin2bn((unsigned char *)(buf + i), rsa_n_len, rsa_n); - rsa = RSA_new(); - rsa->n = rsa_n; - rsa->e = rsa_e; - i = 4; - if(command == DRV_RSA_VERIFY_SHA) { - SHA1((unsigned char *) (buf + i), data_len, - (unsigned char *) hmacbuf); - i = RSA_verify(NID_sha1, (unsigned char *) hmacbuf, SHA_DIGEST_LENGTH, - rsa_s, rsa_s_len, rsa); - } else { - MD5((unsigned char *) (buf + i), data_len, (unsigned char *) hmacbuf); - i = RSA_verify(NID_md5, (unsigned char *) hmacbuf, MD5_DIGEST_LENGTH, - rsa_s, rsa_s_len, rsa); - } - - bin = return_binary(rbuf,rlen,1); - if (bin==NULL) return -1; - bin[0] = (char)(i & 0xff); - RSA_free(rsa); - return 1; - - case DRV_RSA_SIGN_MD5: - case DRV_RSA_SIGN_SHA: - /* buf = <<data_len:32/integer, data:data_len/binary, - * rsa_e_len:32/integer, rsa_e:rsa_e_len/binary, - * rsa_n_len:32/integer, rsa_n:rsa_n_len/binary, - * rsa_d_len:32/integer, rsa_d:rsa_d_len/binary>> */ - - ERL_VALGRIND_ASSERT_MEM_DEFINED(buf,len); - - i = 0; - j = 0; - - if (len < 16) - return -1; - data_len = get_int32(buf + i + j); - j += data_len; i += 4; - if (len < (16 + j)) - return -1; - rsa_e_len = get_int32(buf + i + j); - j += rsa_e_len; i += 4; - if (len < (16 + j)) - return -1; - rsa_n_len = get_int32(buf + i + j); - j += rsa_n_len; i += 4; - if (len < (16 + j)) - return -1; - rsa_d_len = get_int32(buf + i + j); - j += rsa_d_len; i += 4; - if (len != (16 + j)) - return -1; - - i = 4; - i += (data_len + 4); - rsa_e = BN_new(); - BN_bin2bn((unsigned char *)(buf + i), rsa_e_len, rsa_e); - i += (rsa_e_len + 4); - rsa_n = BN_new(); - BN_bin2bn((unsigned char *)(buf + i), rsa_n_len, rsa_n); - i += (rsa_n_len + 4); - rsa_d = BN_new(); - BN_bin2bn((unsigned char *)(buf + i), rsa_d_len, rsa_d); - i += (rsa_d_len + 4); - - rsa = RSA_new(); - rsa->e = rsa_e; - rsa->n = rsa_n; - rsa->d = rsa_d; - - dlen = RSA_size(rsa); - bin = return_binary(rbuf,rlen,dlen+1); - if (bin==NULL) return -1; - i = 4; - if (command == DRV_RSA_SIGN_MD5) { - MD5((unsigned char *) (buf + i), data_len, (unsigned char *) hmacbuf); - ERL_VALGRIND_ASSERT_MEM_DEFINED(hmacbuf, MD5_DIGEST_LENGTH); - i = RSA_sign(NID_md5, - (unsigned char *) hmacbuf,MD5_DIGEST_LENGTH, - (unsigned char *) &bin[1], - &rsa_s_len, rsa); - } else { - SHA1((unsigned char *) (buf + i), data_len, - (unsigned char *) hmacbuf); - ERL_VALGRIND_ASSERT_MEM_DEFINED(hmacbuf, SHA_DIGEST_LENGTH); - i = RSA_sign(NID_sha1, - (unsigned char *) hmacbuf,SHA_DIGEST_LENGTH, - (unsigned char *) &bin[1], - &rsa_s_len, rsa); - } - RSA_free(rsa); - if (i) { - ERL_VALGRIND_MAKE_MEM_DEFINED(bin+1, rsa_s_len); - if (rsa_s_len != dlen) { - bin = return_binary_shrink(rbuf,rlen,bin,rsa_s_len+1); - ERL_VALGRIND_ASSERT_MEM_DEFINED(bin+1, rsa_s_len); - } - bin[0] = 1; - return rsa_s_len + 1; - } - else { - bin[0] = 0; - return 1; - } - - case DRV_RSA_PRIVATE_DECRYPT: - case DRV_RSA_PRIVATE_ENCRYPT: - /* buf = <<data_len:32/integer, data:data_len/binary, - * rsa_e_len:32/integer, rsa_e:rsa_e_len/binary, - * rsa_n_len:32/integer, rsa_n:rsa_n_len/binary, - * rsa_d_len:32/integer, rsa_d:rsa_d_len/binary, - * pad:8/integer >> */ - - ERL_VALGRIND_ASSERT_MEM_DEFINED(buf,len); - i = 0; - j = 0; - - if (len < 17) - return -1; - data_len = get_int32(buf + i + j); - j += data_len; i += 4; - if (len < (17 + j)) - return -1; - rsa_e_len = get_int32(buf + i + j); - j += rsa_e_len; i += 4; - if (len < (17 + j)) - return -1; - rsa_n_len = get_int32(buf + i + j); - j += rsa_n_len; i += 4; - if (len < (17 + j)) - return -1; - rsa_d_len = get_int32(buf + i + j); - j += rsa_d_len; i += 4; - padding = *(unsigned char *) (buf+i+j); - if (len != (17 + j)) - return -1; - - i = 4; - i += (data_len + 4); - rsa_e = BN_new(); - ERL_VALGRIND_ASSERT_MEM_DEFINED(buf+i,rsa_e_len); - BN_bin2bn((unsigned char *)(buf + i), rsa_e_len, rsa_e); - i += (rsa_e_len + 4); - rsa_n = BN_new(); - ERL_VALGRIND_ASSERT_MEM_DEFINED(buf+i,rsa_n_len); - BN_bin2bn((unsigned char *)(buf + i), rsa_n_len, rsa_n); - i += (rsa_n_len + 4); - rsa_d = BN_new(); - ERL_VALGRIND_ASSERT_MEM_DEFINED(buf+i,rsa_d_len); - BN_bin2bn((unsigned char *)(buf + i), rsa_d_len, rsa_d); - i += (rsa_d_len + 4); - - switch(padding) { - case 0: - padding = RSA_NO_PADDING; - break; - case 1: - padding = RSA_PKCS1_PADDING; - break; - case 2: - padding = RSA_PKCS1_OAEP_PADDING; - break; - case 3: - padding = RSA_SSLV23_PADDING; - break; - default: - return -1; - } - - rsa = RSA_new(); - rsa->e = rsa_e; - rsa->n = rsa_n; - rsa->d = rsa_d; - - dlen = RSA_size(rsa) + 1; - bin = return_binary(rbuf,rlen,dlen); - if (bin==NULL) return -1; - i = 4; - ERL_VALGRIND_ASSERT_MEM_DEFINED(buf+i,data_len); - if(command == DRV_RSA_PRIVATE_DECRYPT) { - i = RSA_private_decrypt(data_len, (unsigned char *) (buf+i), - (unsigned char *) &bin[1], - rsa, padding); - if(i > 0) { - ERL_VALGRIND_MAKE_MEM_DEFINED(&bin[1],i); - bin = return_binary_shrink(rbuf,rlen, bin, i+1); - if (bin==NULL) return -1; - } - } else { - i = RSA_private_encrypt(data_len, (unsigned char *) (buf+i), - (unsigned char *) &bin[1], - rsa, padding); - if(i > 0) { - ERL_VALGRIND_MAKE_MEM_DEFINED(&bin[1],i); - } - } - RSA_free(rsa); - if(i > 0) { - bin[0] = 1; - return i + 1; - } else { - bin[0] = 0; - return 1; - } - break; - - case DRV_RSA_PUBLIC_ENCRYPT: - case DRV_RSA_PUBLIC_DECRYPT: - /* buf = <<data_len:32/integer, data:data_len/binary, - * rsa_e_len:32/integer, rsa_e:rsa_e_len/binary, - * rsa_n_len:32/integer, rsa_n:rsa_n_len/binary, - * pad:8/integer >> */ - - ERL_VALGRIND_ASSERT_MEM_DEFINED(buf,len); - i = 0; - j = 0; - - if (len < 13) - return -1; - data_len = get_int32(buf + i + j); - j += data_len; i += 4; - if (len < (13 + j)) - return -1; - rsa_e_len = get_int32(buf + i + j); - j += rsa_e_len; i += 4; - if (len < (13 + j)) - return -1; - rsa_n_len = get_int32(buf + i + j); - j += rsa_n_len; i += 4; - if (len < (13 + j)) - return -1; - padding = *(unsigned char *) (buf + i + j); - if (len != (13 + j)) - return -1; - - i = 4; - i += (data_len + 4); - rsa_e = BN_new(); - ERL_VALGRIND_ASSERT_MEM_DEFINED(buf+i,rsa_e_len); - BN_bin2bn((unsigned char *)(buf + i), rsa_e_len, rsa_e); - i += (rsa_e_len + 4); - rsa_n = BN_new(); - ERL_VALGRIND_ASSERT_MEM_DEFINED(buf+i,rsa_n_len); - BN_bin2bn((unsigned char *)(buf + i), rsa_n_len, rsa_n); - i += (rsa_n_len + 4); - - switch(padding) { - case 0: - padding = RSA_NO_PADDING; - break; - case 1: - padding = RSA_PKCS1_PADDING; - break; - case 2: - padding = RSA_PKCS1_OAEP_PADDING; - break; - case 3: - padding = RSA_SSLV23_PADDING; - break; - default: - return -1; - } - - rsa = RSA_new(); - rsa->e = rsa_e; - rsa->n = rsa_n; - - dlen = RSA_size(rsa) + 1; - bin = return_binary(rbuf,rlen,dlen); - if (bin==NULL) return -1; - i = 4; - if(command == DRV_RSA_PUBLIC_ENCRYPT) { - ERL_VALGRIND_ASSERT_MEM_DEFINED(buf+i,data_len); - i = RSA_public_encrypt(data_len, (unsigned char *) (buf+i), - (unsigned char *) &bin[1], - rsa, padding); - if (i > 0) { - ERL_VALGRIND_MAKE_MEM_DEFINED(bin+1, i); - } - } else { - i = RSA_public_decrypt(data_len, (unsigned char *) (buf+i), - (unsigned char *) &bin[1], - rsa, padding); - if(i > 0) { - ERL_VALGRIND_MAKE_MEM_DEFINED(bin+1, i); - bin = return_binary_shrink(rbuf,rlen,bin, i+1); - if (bin==NULL) return -1; - } - } - - RSA_free(rsa); - if(i > 0) { - bin[0] = 1; - return i + 1; - } else { -/* ERR_load_crypto_strings(); */ -/* fprintf(stderr, "%d: %s \r\n", __LINE__, ERR_reason_error_string(ERR_get_error())); */ - bin[0] = 0; - return 1; - } - break; - - case DRV_CBC_AES128_ENCRYPT: - case DRV_CBC_AES256_ENCRYPT: - case DRV_CBC_AES128_DECRYPT: - case DRV_CBC_AES256_DECRYPT: - /* buf = key[klen] ivec[klen] data */ - if (command == DRV_CBC_AES256_ENCRYPT || command == DRV_CBC_AES256_DECRYPT) - klen = 32; - else - klen = 16; - dlen = len - klen - 16; - if (dlen < 0) - return -1; - if (dlen % 16 != 0) - return -1; - if (command == DRV_CBC_AES128_ENCRYPT || command == DRV_CBC_AES256_ENCRYPT) { - i = AES_ENCRYPT; - AES_set_encrypt_key((unsigned char *) buf, klen*8, &aes_key); - } else { - i = AES_DECRYPT; - AES_set_decrypt_key((unsigned char *) buf, klen*8, &aes_key); - } - bin = return_binary(rbuf,rlen,dlen); - if (bin==NULL) return -1; - AES_cbc_encrypt((unsigned char *) (buf + klen+16), - (unsigned char *) bin, - dlen, - &aes_key, - (unsigned char *) (buf + klen), - i); - return dlen; - -/* case DRV_CBC_AES128_DECRYPT: */ -/* case DRV_CBC_AES256_DECRYPT: */ -/* /\* buf = key[klen] ivec[16] data *\/ */ -/* if (command == DRV_CBC_AES256_DECRYPT) */ -/* klen = 32; */ -/* else */ -/* klen = 16; */ -/* dlen = len - klen - 16; */ -/* if (dlen < 0) */ -/* return -1; */ -/* *rbuf = (char *)(bin = driver_alloc_binary(dlen)); */ -/* AES_set_decrypt_key((unsigned char *) buf, klen*8, &aes_key); */ -/* AES_cbc_encrypt((unsigned char *) (buf + klen+16), */ -/* (unsigned char *) bin->orig_bytes, */ -/* dlen, */ -/* &aes_key, */ -/* (unsigned char *) (buf + klen), */ -/* AES_DECRYPT); */ -/* return dlen; */ -/* break; */ - - case DRV_XOR: - /* buf = data1, data2 with same size */ - dlen = len / 2; - if (len != dlen * 2) - return -1; - bin = return_binary(rbuf,rlen,dlen); - if (bin==NULL) return -1; - p = bin, - dbuf = buf + dlen; - for (key = buf, key2 = dbuf; key != dbuf; ++key, ++key2, ++p) - *p = *key ^ *key2; - return dlen; - - case DRV_DH_GENERATE_PARAMS: - /* buf = <<PrimeLen:32 Generator:32>> */ - if (len != 8) - return -1; - ERL_VALGRIND_ASSERT_MEM_DEFINED(buf,len); - prime_len = get_int32(buf); - generator = get_int32(buf+4); - dh_params = DH_generate_parameters(prime_len, generator, NULL, NULL); - - if(dh_params) { - dh_p_len = BN_num_bytes(dh_params->p); - dh_g_len = BN_num_bytes(dh_params->g); - dlen = 1 + 4 + 4 + dh_g_len + dh_p_len; - bin = return_binary(rbuf,rlen,dlen); - if (bin==NULL) return -1; - bin[0] = 1; - put_int32(bin+1, dh_p_len); - BN_bn2bin(dh_params->p, bin+5); - ERL_VALGRIND_MAKE_MEM_DEFINED(bin+5,dh_p_len); - put_int32(bin+5+dh_p_len, dh_g_len); - BN_bn2bin(dh_params->g, bin+5+dh_p_len+4); - ERL_VALGRIND_MAKE_MEM_DEFINED(bin+5+dh_p_len+4,dh_g_len); - } else { - dlen = 1; - bin = return_binary(rbuf,rlen,dlen); - if (bin==NULL) return -1; - bin[0] = 0; - } - DH_free(dh_params); - return dlen; - - case DRV_DH_CHECK: - /* buf = <<dh_p_len:32/integer, dh_p:dh_p_len/binary, - * dh_g_len:32/integer, dh_g:dh_g_len/binary>> */ - i = 0; - j = 0; - if(len < 8) return -1; - dh_p_len = get_int32(buf + i + j); - j += dh_p_len; i += 4; - if (len < (8 + j)) return -1; - dh_g_len = get_int32(buf + i + j); - j += dh_g_len; i += 4; - if(len != (8+j)) return -1; - i=4; - dh_p = BN_new(); - BN_bin2bn((unsigned char *)(buf + i), dh_p_len, dh_p); - i += (dh_p_len + 4); - dh_g = BN_new(); - BN_bin2bn((unsigned char *)(buf + i), dh_g_len, dh_g); - /* i += (dsa_g_len + 4); */ - - dh_params = DH_new(); - dh_params->p = dh_p; - dh_params->g = dh_g; - - i=0; - bin = return_binary(rbuf,rlen,4); - if (bin==NULL) return -1; - if(DH_check(dh_params, &i)) { - put_int32(bin, i); - } else { - /* Check Failed */ - put_int32(bin, -1); - } - DH_free(dh_params); - return 4; - - case DRV_DH_GENERATE_KEY: - /* buf = <<key_len:32, key:key_len/binary, * - * dh_p_len:32/integer, dh_p:dh_p_len/binary, * - * dh_g_len:32/integer, dh_g:dh_g_len/binary>> */ - ERL_VALGRIND_ASSERT_MEM_DEFINED(buf,len); - i = 0; - j = 0; - if(len < 12) return -1; - base_len = get_int32(buf + i + j); - j += base_len; i += 4; - if (len < (12 + j)) return -1; - dh_p_len = get_int32(buf + i + j); - j += dh_p_len; i += 4; - if (len < (12 + j)) return -1; - dh_g_len = get_int32(buf + i + j); - j += dh_g_len; i += 4; - if(len != (12 + j)) return -1; - i=4; - i += (base_len + 4); - dh_p = BN_new(); - BN_bin2bn((unsigned char *)(buf + i), dh_p_len, dh_p); - i += (dh_p_len + 4); - dh_g = BN_new(); - BN_bin2bn((unsigned char *)(buf + i), dh_g_len, dh_g); - /* i += (dsa_g_len + 4); */ - - dh_params = DH_new(); - dh_params->p = dh_p; - dh_params->g = dh_g; - if(base_len > 0) { - dh_params->priv_key = BN_new(); - BN_bin2bn((unsigned char *)(buf + i), base_len, - dh_params->priv_key); - } - i=0; - if(DH_generate_key(dh_params)) { - privkey_len = BN_num_bytes(dh_params->priv_key); - pubkey_len = BN_num_bytes(dh_params->pub_key); - dlen = 1 + 4 + 4 + pubkey_len + privkey_len; - bin = return_binary(rbuf,rlen, dlen); - if (bin==NULL) return -1; - bin[0] = 1; - put_int32(bin+1, pubkey_len); - BN_bn2bin(dh_params->pub_key, bin+5); - ERL_VALGRIND_MAKE_MEM_DEFINED(bin+5, pubkey_len); - put_int32(bin+5+pubkey_len, privkey_len); - BN_bn2bin(dh_params->priv_key, bin+5+pubkey_len+4); - ERL_VALGRIND_MAKE_MEM_DEFINED(bin+5+pubkey_len+4, privkey_len); - } else { - dlen = 1; - bin = return_binary(rbuf,rlen,dlen); - if (bin==NULL) return -1; - bin[0] = 0; - } - DH_free(dh_params); - return dlen; - - case DRV_DH_COMPUTE_KEY: - /* buf = <<pubkey_len:32, pubkey:pubkey_len/binary, * - * privkey_len:32, privkey:privkey_len/binary, * - * dh_p_len:32/integer, dh_p:dh_p_len/binary, * - * dh_g_len:32/integer, dh_g:dh_g_len/binary>> */ - i = 0; - j = 0; - if(len < 16) return -1; - pubkey_len = get_int32(buf + i + j); - j += pubkey_len; i += 4; - if (len < (16 + j)) return -1; - privkey_len = get_int32(buf + i + j); - j += privkey_len; i += 4; - if (len < (16 + j)) return -1; - dh_p_len = get_int32(buf + i + j); - j += dh_p_len; i += 4; - if (len < (16 + j)) return -1; - dh_g_len = get_int32(buf + i + j); - j += dh_g_len; i += 4; - if(len != (16 + j)) return -1; - i=4; - pubkey = BN_new(); - BN_bin2bn((unsigned char *)(buf + i), pubkey_len, pubkey); - i += (pubkey_len + 4); - privkey = BN_new(); - BN_bin2bn((unsigned char *)(buf + i), privkey_len, privkey); - i += (privkey_len + 4); - dh_p = BN_new(); - BN_bin2bn((unsigned char *)(buf + i), dh_p_len, dh_p); - i += (dh_p_len + 4); - dh_g = BN_new(); - BN_bin2bn((unsigned char *)(buf + i), dh_g_len, dh_g); - /* i += (dsa_g_len + 4); */ - - dh_params = DH_new(); - dh_params->p = dh_p; - dh_params->g = dh_g; - dh_params->priv_key = privkey; - - klen = DH_size(dh_params); - bin = return_binary(rbuf,rlen,1+klen); - if (bin==NULL) return -1; - i = DH_compute_key(&bin[1], pubkey, dh_params); - DH_free(dh_params); - if (i > 0) { - if (i != klen) { - bin = return_binary_shrink(rbuf,rlen,bin,1+i); - } - bin[0] = 1; - return i + 1; - } - else { - bin[0] = 0; - return 1; - } - - case DRV_MD4: - bin = return_binary(rbuf,rlen,MD4_LEN); - MD4((unsigned char *)buf, len, (unsigned char *)bin); - return MD4_LEN; - - case DRV_MD4_INIT: - bin = return_binary(rbuf,rlen,MD4_CTX_LEN); - MD4_Init((MD4_CTX *) bin); - return MD4_CTX_LEN; - - case DRV_MD4_UPDATE: - if (len < MD4_CTX_LEN) - return -1; - bin = return_binary(rbuf,rlen,MD4_CTX_LEN); - memcpy(bin, buf, MD4_CTX_LEN); - MD4_Update((MD4_CTX *) bin, buf + MD4_CTX_LEN, len - MD4_CTX_LEN); - return MD4_CTX_LEN; - - case DRV_MD4_FINAL: - if (len != MD4_CTX_LEN) - return -1; - memcpy(&md4_ctx, buf, MD4_CTX_LEN); /* XXX Use buf only? */ - bin = return_binary(rbuf,rlen,MD4_LEN); - MD4_Final((unsigned char *)bin, &md4_ctx); - return MD4_LEN; - -#if SSL_VERSION_0_9_8 - case DRV_SHA256: - bin = return_binary(rbuf,rlen,SHA256_LEN); - SHA256(buf, len, bin); - return SHA256_LEN; - - case DRV_SHA256_INIT: - bin = return_binary(rbuf,rlen,SHA256_CTX_LEN); - SHA256_Init((SHA256_CTX *)bin); - return SHA256_CTX_LEN; - - case DRV_SHA256_UPDATE: - if (len < SHA256_CTX_LEN) - return -1; - bin = return_binary(rbuf,rlen,SHA256_CTX_LEN); - memcpy(bin, buf, SHA256_CTX_LEN); - SHA256_Update((SHA256_CTX *)bin, buf + SHA256_CTX_LEN, - len - SHA256_CTX_LEN); - return SHA256_CTX_LEN; - - case DRV_SHA256_FINAL: - if (len != SHA256_CTX_LEN) - return -1; - memcpy(&sha256_ctx, buf, SHA256_CTX_LEN); /* XXX Use buf only? */ - bin = return_binary(rbuf,rlen,SHA256_LEN); - SHA256_Final(bin, &sha256_ctx); - return SHA256_LEN; - - case DRV_SHA512: - bin = return_binary(rbuf,rlen,SHA512_LEN); - SHA512(buf, len, bin); - return SHA512_LEN; - - case DRV_SHA512_INIT: - bin = return_binary(rbuf,rlen,SHA512_CTX_LEN); - SHA512_Init((SHA512_CTX *)bin); - return SHA512_CTX_LEN; - - case DRV_SHA512_UPDATE: - if (len < SHA512_CTX_LEN) - return -1; - bin = return_binary(rbuf,rlen,SHA512_CTX_LEN); - memcpy(bin, buf, SHA512_CTX_LEN); - SHA512_Update((SHA512_CTX *)bin, buf + SHA512_CTX_LEN, - len - SHA512_CTX_LEN); - return SHA512_CTX_LEN; - - case DRV_SHA512_FINAL: - if (len != SHA512_CTX_LEN) - return -1; - memcpy(&sha512_ctx, buf, SHA512_CTX_LEN); /* XXX Use buf only? */ - bin = return_binary(rbuf,rlen,SHA512_LEN)); - SHA512_Final(bin, &sha512_ctx); - return SHA512_LEN; -#endif - - case DRV_INFO_LIB: - {/* <<DrvVer:8, NameSize:8, Name:NameSize/binary, VerNum:32, VerStr/binary>> */ - static const char libname[] = "OpenSSL"; - unsigned name_sz = strlen(libname); - const char* ver = SSLeay_version(SSLEAY_VERSION); - unsigned ver_sz = strlen(ver); - dlen = 1+1+name_sz+4+ver_sz; - bin = return_binary(rbuf, rlen, dlen); - if (bin==NULL) return -1; - p = bin; - *p++ = 0; /* "driver version" for future use */ - *p++ = name_sz; - memcpy(p, libname, name_sz); - p += name_sz; - put_int32(p,SSLeay()); /* OPENSSL_VERSION_NUMBER */ - p += 4; - memcpy(p, ver, ver_sz); - } - return dlen; - - default: - break; - } - return -1; -} - - -#ifdef OPENSSL_THREADS /* vvvvvvvvvvvvvvv OPENSSL_THREADS vvvvvvvvvvvvvvvv */ - -static INLINE void locking(int mode, ErlDrvRWLock* lock) -{ - switch(mode) { - case CRYPTO_LOCK|CRYPTO_READ: - erl_drv_rwlock_rlock(lock); - break; - case CRYPTO_LOCK|CRYPTO_WRITE: - erl_drv_rwlock_rwlock(lock); - break; - case CRYPTO_UNLOCK|CRYPTO_READ: - erl_drv_rwlock_runlock(lock); - break; - case CRYPTO_UNLOCK|CRYPTO_WRITE: - erl_drv_rwlock_rwunlock(lock); - break; - default: - ASSERT(!"Invalid lock mode"); - } -} - -/* Callback from openssl for static locking - */ -static void locking_function(int mode, int n, const char *file, int line) -{ - ASSERT(n>=0 && n<CRYPTO_num_locks()); - - locking(mode, lock_vec[n]); -} - -/* Callback from openssl for thread id - */ -static unsigned long id_function(void) -{ - return (unsigned long) erl_drv_thread_self(); -} - -/* Callbacks for dynamic locking, not used by current openssl version (0.9.8) - */ -static struct CRYPTO_dynlock_value* dyn_create_function(const char *file, int line) -{ - return (struct CRYPTO_dynlock_value*) erl_drv_rwlock_create("crypto_drv_dyn"); -} -static void dyn_lock_function(int mode, struct CRYPTO_dynlock_value* ptr,const char *file, int line) -{ - locking(mode, (ErlDrvRWLock*)ptr); -} -static void dyn_destroy_function(struct CRYPTO_dynlock_value *ptr, const char *file, int line) -{ - erl_drv_rwlock_destroy((ErlDrvRWLock*)ptr); -} - -#endif /* ^^^^^^^^^^^^^^^^^^^^^^ OPENSSL_THREADS ^^^^^^^^^^^^^^^^^^^^^^ */ - -/* HMAC */ - -static void hmac_md5(char *key, int klen, char *dbuf, int dlen, char *hmacbuf) -{ - MD5_CTX ctx; - char ipad[HMAC_INT_LEN]; - char opad[HMAC_INT_LEN]; - unsigned char nkey[MD5_LEN]; - int i; - - /* Change key if longer than 64 bytes */ - if (klen > HMAC_INT_LEN) { - MD5_CTX kctx; - - MD5_Init(&kctx); - MD5_Update(&kctx, key, klen); - MD5_Final(nkey, &kctx); - key = (char *) nkey; - klen = MD5_LEN; - } - - memset(ipad, '\0', sizeof(ipad)); - memset(opad, '\0', sizeof(opad)); - memcpy(ipad, key, klen); - memcpy(opad, key, klen); - - for (i = 0; i < HMAC_INT_LEN; i++) { - ipad[i] ^= HMAC_IPAD; - opad[i] ^= HMAC_OPAD; - } - - /* inner MD5 */ - MD5_Init(&ctx); - MD5_Update(&ctx, ipad, HMAC_INT_LEN); - MD5_Update(&ctx, dbuf, dlen); - MD5_Final((unsigned char *) hmacbuf, &ctx); - /* outer MD5 */ - MD5_Init(&ctx); - MD5_Update(&ctx, opad, HMAC_INT_LEN); - MD5_Update(&ctx, hmacbuf, MD5_LEN); - MD5_Final((unsigned char *) hmacbuf, &ctx); -} - -static void hmac_sha1(char *key, int klen, char *dbuf, int dlen, - char *hmacbuf) -{ - SHA_CTX ctx; - char ipad[HMAC_INT_LEN]; - char opad[HMAC_INT_LEN]; - unsigned char nkey[SHA_LEN]; - int i; - - /* Change key if longer than 64 bytes */ - if (klen > HMAC_INT_LEN) { - SHA_CTX kctx; - - SHA1_Init(&kctx); - SHA1_Update(&kctx, key, klen); - SHA1_Final(nkey, &kctx); - key = (char *) nkey; - klen = SHA_LEN; - } - - memset(ipad, '\0', sizeof(ipad)); - memset(opad, '\0', sizeof(opad)); - memcpy(ipad, key, klen); - memcpy(opad, key, klen); - - for (i = 0; i < HMAC_INT_LEN; i++) { - ipad[i] ^= HMAC_IPAD; - opad[i] ^= HMAC_OPAD; - } - - /* inner SHA */ - SHA1_Init(&ctx); - SHA1_Update(&ctx, ipad, HMAC_INT_LEN); - SHA1_Update(&ctx, dbuf, dlen); - SHA1_Final((unsigned char *) hmacbuf, &ctx); - /* outer SHA */ - SHA1_Init(&ctx); - SHA1_Update(&ctx, opad, HMAC_INT_LEN); - SHA1_Update(&ctx, hmacbuf, SHA_LEN); - SHA1_Final((unsigned char *) hmacbuf, &ctx); -} diff --git a/lib/crypto/priv/Makefile b/lib/crypto/priv/Makefile index b8acdacc00..0989f14c94 100644 --- a/lib/crypto/priv/Makefile +++ b/lib/crypto/priv/Makefile @@ -18,21 +18,21 @@ # ---------------------------------------------------- # THIS MAKEFILE SERVES AS AN EXAMPLE OF -# HOW TO RELINK THE CRYPTO DRIVER +# HOW TO RELINK THE CRYPTO NIF LIBRARY # ---------------------------------------------------- # ---------------------------------------------------- -# Variables for linking a .so driver on unix. +# Variables for linking a .so library on unix. # Note: These may differ between systems. # ---------------------------------------------------- SO_LD = gcc SO_LDFLAGS = -G SO_SSL_LIBDIR = /usr/local/lib -SO_DRIVER = $(LIBDIR)/$(DRIVER_NAME).so +SO_NIFLIB = $(LIBDIR)/$(LIB_NAME).so # ---------------------------------------------------- -# Variables for linking a win32 .dll driver. +# Variables for linking a win32 .dll library. # Note: These may differ between systems. # ---------------------------------------------------- @@ -42,9 +42,9 @@ DLL_LIBDIR = "c:\\OpenSSL\\lib\\VC" DLL_LIBS = libeay32.lib MSVCRT.LIB kernel32.lib \ advapi32.lib gdi32.lib user32.lib \ comctl32.lib comdlg32.lib shell32.lib -DLL_DRIVER = $(LIBDIR)/$(DRIVER_NAME).dll -DLL_EXP = $(LIBDIR)/$(DRIVER_NAME).exp -DLL_LIB = $(LIBDIR)/$(DRIVER_NAME).lib +DLL_NIFLIB = $(LIBDIR)/$(LIB_NAME).dll +DLL_EXP = $(LIBDIR)/$(LIB_NAME).exp +DLL_LIB = $(LIBDIR)/$(LIB_NAME).lib # ---------------------------------------------------- # Common variables @@ -52,27 +52,27 @@ DLL_LIB = $(LIBDIR)/$(DRIVER_NAME).lib OBJDIR = ./ LIBDIR = ../lib -DRIVER_NAME = crypto_drv -OBJS = $(OBJDIR)/crypto_drv.o +LIB_NAME = crypto +OBJS = $(OBJDIR)/crypto.o # ---------------------------------------------------- # Targets # ---------------------------------------------------- -$(SO_DRIVER): $(OBJS) +$(SO_NIFLIB): $(OBJS) $(SO_LD) $(SO_LDFLAGS) -L$(SO_SSL_LIBDIR) -Wl,-R$(SO_SSL_LIBDIR) \ -o $@ $^ -lcrypto -$(DLL_DRIVER): $(OBJS) +$(DLL_NIFLIB): $(OBJS) $(DLL_LD) $(DLL_LDFLAGS) -out:$@ -libpath:$(DLL_LIBDIR) $(OBJS) \ $(DLL_LIBS) -so: $(SO_DRIVER) +so: $(SO_NIFLIB) -dll: $(DLL_DRIVER) +dll: $(DLL_NIFLIB) clean: - rm -f $(SO_DRIVER) $(DLL_DRIVER) + rm -f $(SO_NIFLIB) $(DLL_NIFLIB) rm -f $(DLL_EXP) $(DLL_LIB) rm -f core *~ diff --git a/lib/crypto/src/Makefile b/lib/crypto/src/Makefile index 51092d16a5..0e886ce8bf 100644 --- a/lib/crypto/src/Makefile +++ b/lib/crypto/src/Makefile @@ -1,19 +1,19 @@ # # %CopyrightBegin% -# -# Copyright Ericsson AB 1999-2009. All Rights Reserved. -# +# +# Copyright Ericsson AB 1999-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% # include $(ERL_TOP)/make/target.mk @@ -57,7 +57,7 @@ APPUP_TARGET= $(EBIN)/$(APPUP_FILE) # ---------------------------------------------------- # FLAGS # ---------------------------------------------------- -ERL_COMPILE_FLAGS += +warn_obsolete_guard +ERL_COMPILE_FLAGS += +warn_obsolete_guard -DCRYPTO_VSN=\"$(VSN)\" # ---------------------------------------------------- # Targets diff --git a/lib/crypto/src/crypto.erl b/lib/crypto/src/crypto.erl index 8cb750759f..5b1ce96caf 100644 --- a/lib/crypto/src/crypto.erl +++ b/lib/crypto/src/crypto.erl @@ -21,7 +21,7 @@ -module(crypto). --export([start/0, stop/0, info/0, info_lib/0]). +-export([start/0, stop/0, info/0, info_lib/0, version/0]). -export([md4/1, md4_init/0, md4_update/2, md4_final/1]). -export([md5/1, md5_init/0, md5_update/2, md5_final/1]). -export([sha/1, sha_init/0, sha_update/2, sha_final/1]). @@ -54,82 +54,6 @@ -export([dh_generate_parameters/2, dh_check/1]). %% Testing see below --define(INFO, 0). --define(MD5, 1). --define(MD5_INIT, 2). --define(MD5_UPDATE, 3). --define(MD5_FINAL, 4). --define(SHA, 5). --define(SHA_INIT, 6). --define(SHA_UPDATE, 7). --define(SHA_FINAL, 8). --define(MD5_MAC, 9). --define(MD5_MAC_96, 10). --define(SHA_MAC, 11). --define(SHA_MAC_96, 12). --define(DES_CBC_ENCRYPT, 13). --define(DES_CBC_DECRYPT, 14). --define(DES_EDE3_CBC_ENCRYPT, 15). --define(DES_EDE3_CBC_DECRYPT, 16). --define(AES_CFB_128_ENCRYPT, 17). --define(AES_CFB_128_DECRYPT, 18). --define(RAND_BYTES, 19). --define(RAND_UNIFORM, 20). --define(MOD_EXP, 21). --define(DSS_VERIFY, 22). --define(RSA_VERIFY_SHA, 23). -%-define(RSA_VERIFY_MD5, 35). --define(AES_CBC_128_ENCRYPT, 24). --define(AES_CBC_128_DECRYPT, 25). --define(XOR, 26). --define(RC4_ENCRYPT, 27). --define(RC4_SET_KEY, 28). --define(RC4_ENCRYPT_WITH_STATE, 29). --define(RC2_40_CBC_ENCRYPT, 30). --define(RC2_40_CBC_DECRYPT, 31). --define(AES_CBC_256_ENCRYPT, 32). --define(AES_CBC_256_DECRYPT, 33). --define(INFO_LIB,34). -%-define(RSA_VERIFY_SHA, 23). --define(RSA_VERIFY_MD5, 35). --define(RSA_SIGN_SHA, 36). --define(RSA_SIGN_MD5, 37). --define(DSS_SIGN, 38). --define(RSA_PUBLIC_ENCRYPT, 39). --define(RSA_PRIVATE_DECRYPT, 40). --define(RSA_PRIVATE_ENCRYPT, 41). --define(RSA_PUBLIC_DECRYPT, 42). --define(DH_GENERATE_PARAMS, 43). --define(DH_CHECK, 44). --define(DH_GENERATE_KEY, 45). --define(DH_COMPUTE_KEY, 46). --define(MD4, 47). --define(MD4_INIT, 48). --define(MD4_UPDATE, 49). --define(MD4_FINAL, 50). - -%% -define(SHA256, 51). -%% -define(SHA256_INIT, 52). -%% -define(SHA256_UPDATE, 53). -%% -define(SHA256_FINAL, 54). -%% -define(SHA512, 55). -%% -define(SHA512_INIT, 56). -%% -define(SHA512_UPDATE, 57). -%% -define(SHA512_FINAL, 58). - --define(BF_CFB64_ENCRYPT, 59). --define(BF_CFB64_DECRYPT, 60). --define(BF_ECB_ENCRYPT, 61). --define(BF_ECB_DECRYPT, 62). --define(BF_OFB64_ENCRYPT, 63). --define(BF_CBC_ENCRYPT, 64). --define(BF_CBC_DECRYPT, 65). - --define(DES_ECB_ENCRYPT, 66). --define(DES_ECB_DECRYPT, 67). - -%% -define(IDEA_CBC_ENCRYPT, 34). -%% -define(IDEA_CBC_DECRYPT, 35). -define(FUNC_LIST, [md4, md4_init, md4_update, md4_final, md5, md5_init, md5_update, md5_final, @@ -158,6 +82,44 @@ aes_cbc_256_encrypt, aes_cbc_256_decrypt, info_lib]). +-define(nif_stub,nif_stub_error(?LINE)). + +-on_load(on_load/0). + +-define(CRYPTO_NIF_VSN,101). + +on_load() -> + LibName = "crypto", + PrivDir = code:priv_dir(crypto), + Lib1 = filename:join([PrivDir, "lib", LibName]), + Status = case erlang:load_nif(Lib1, ?CRYPTO_NIF_VSN) of + ok -> ok; + {error, {load_failed, _}}=Error1 -> + LibDir2 = + filename:join([PrivDir, "lib", + erlang:system_info(system_architecture)]), + Candidate = + filelib:wildcard(filename:join([LibDir2,LibName ++ "*" ])), + case Candidate of + [] -> Error1; + _ -> + Lib2 = filename:join([LibDir2, LibName]), + erlang:load_nif(Lib2, ?CRYPTO_NIF_VSN) + end; + Error1 -> Error1 + end, + case Status of + ok -> ok; + {error, {E, Str}} -> + error_logger:error_msg("Unable to load crypto library. Failed with error:~n\"~p, ~s\"~n" + "OpenSSL might not be installed on this system.~n",[E,Str]), + Status + end. + + +nif_stub_error(Line) -> + erlang:error({nif_not_loaded,module,?MODULE,line,Line}). + start() -> application:start(crypto). @@ -165,15 +127,15 @@ stop() -> application:stop(crypto). info() -> - lists:map(fun(I) -> - lists:nth(I, ?FUNC_LIST) - end, binary_to_list(control(?INFO, []))). + ?FUNC_LIST. -info_lib() -> - <<_DrvVer:8, NameSize:8, Name:NameSize/binary, - VerNum:32, VerStr/binary>> = control(?INFO_LIB,[]), - [{Name,VerNum,VerStr}]. +info_lib() -> ?nif_stub. +%% Crypto app version history: +%% (no version): Driver implementation +%% 2.0 : NIF implementation, requires OTP R14 +version() -> ?CRYPTO_VSN. + %% Below Key and Data are binaries or IO-lists. IVec is a binary. %% Output is always a binary. Context is a binary. @@ -184,73 +146,27 @@ info_lib() -> %% %% MD5 %% -md5(Data) -> - control(?MD5, Data). - -md5_init() -> - control(?MD5_INIT, []). - -md5_update(Context, Data) -> - control(?MD5_UPDATE, [Context, Data]). - -md5_final(Context) -> - control(?MD5_FINAL, Context). +md5(_Data) -> ?nif_stub. +md5_init() -> ?nif_stub. +md5_update(_Context, _Data) -> ?nif_stub. +md5_final(_Context) -> ?nif_stub. %% %% MD4 %% -md4(Data) -> - control(?MD4, Data). - -md4_init() -> - control(?MD4_INIT, []). - -md4_update(Context, Data) -> - control(?MD4_UPDATE, [Context, Data]). - -md4_final(Context) -> - control(?MD4_FINAL, Context). +md4(_Data) -> ?nif_stub. +md4_init() -> ?nif_stub. +md4_update(_Context, _Data) -> ?nif_stub. +md4_final(_Context) -> ?nif_stub. %% %% SHA %% -sha(Data) -> - control(?SHA, Data). - -sha_init() -> - control(?SHA_INIT, []). - -sha_update(Context, Data) -> - control(?SHA_UPDATE, [Context, Data]). - -sha_final(Context) -> - control(?SHA_FINAL, Context). +sha(_Data) -> ?nif_stub. +sha_init() -> ?nif_stub. +sha_update(_Context, _Data) -> ?nif_stub. +sha_final(_Context) -> ?nif_stub. -%% sha256 and sha512 requires openssl-0.9.8 removed for now - -%% sha256(Data) -> -%% control(?SHA256, Data). - -%% sha256_init() -> -%% control(?SHA256_INIT, []). - -%% sha256_update(Context, Data) -> -%% control(?SHA256_UPDATE, [Context, Data]). - -%% sha256_final(Context) -> -%% control(?SHA256_FINAL, Context). - -%% sha512(Data) -> -%% control(?SHA512, Data). - -%% sha512_init() -> -%% control(?SHA512_INIT, []). - -%% sha512_update(Context, Data) -> -%% control(?SHA512_UPDATE, [Context, Data]). - -%% sha512_final(Context) -> -%% control(?SHA512_FINAL, Context). %% %% MESSAGE AUTHENTICATION CODES @@ -260,20 +176,24 @@ sha_final(Context) -> %% MD5_MAC %% md5_mac(Key, Data) -> - control_bin(?MD5_MAC, Key, Data). + md5_mac_n(Key,Data,16). md5_mac_96(Key, Data) -> - control_bin(?MD5_MAC_96, Key, Data). + md5_mac_n(Key,Data,12). +md5_mac_n(_Key,_Data,_MacSz) -> ?nif_stub. + %% %% SHA_MAC %% sha_mac(Key, Data) -> - control_bin(?SHA_MAC, Key, Data). + sha_mac_n(Key,Data,20). sha_mac_96(Key, Data) -> - control_bin(?SHA_MAC_96, Key, Data). + sha_mac_n(Key,Data,12). +sha_mac_n(_Key,_Data,_MacSz) -> ?nif_stub. + %% %% CRYPTO FUNCTIONS %% @@ -282,10 +202,12 @@ sha_mac_96(Key, Data) -> %% DES - in cipher block chaining mode (CBC) %% des_cbc_encrypt(Key, IVec, Data) -> - control(?DES_CBC_ENCRYPT, [Key, IVec, Data]). + des_cbc_crypt(Key, IVec, Data, true). des_cbc_decrypt(Key, IVec, Data) -> - control(?DES_CBC_DECRYPT, [Key, IVec, Data]). + des_cbc_crypt(Key, IVec, Data, false). + +des_cbc_crypt(_Key, _IVec, _Data, _IsEncrypt) -> ?nif_stub. %% %% dec_cbc_ivec(Data) -> binary() @@ -303,10 +225,10 @@ des_cbc_ivec(Data) when is_list(Data) -> %% DES - in electronic codebook mode (ECB) %% des_ecb_encrypt(Key, Data) -> - control(?DES_ECB_ENCRYPT, [Key, Data]). - + des_ecb_crypt(Key, Data, true). des_ecb_decrypt(Key, Data) -> - control(?DES_ECB_DECRYPT, [Key, Data]). + des_ecb_crypt(Key, Data, false). +des_ecb_crypt(_Key, _Data, _IsEncrypt) -> ?nif_stub. %% %% DES3 - in cipher block chaining mode (CBC) @@ -314,71 +236,64 @@ des_ecb_decrypt(Key, Data) -> des3_cbc_encrypt(Key1, Key2, Key3, IVec, Data) -> des_ede3_cbc_encrypt(Key1, Key2, Key3, IVec, Data). des_ede3_cbc_encrypt(Key1, Key2, Key3, IVec, Data) -> - %%io:format("des_ede3_cbc_encrypt: size(Data)=~p\n", [size(list_to_binary([Data]))]), - control(?DES_EDE3_CBC_ENCRYPT, [Key1, Key2, Key3, IVec, Data]). + des_ede3_cbc_crypt(Key1, Key2, Key3, IVec, Data, true). des3_cbc_decrypt(Key1, Key2, Key3, IVec, Data) -> des_ede3_cbc_decrypt(Key1, Key2, Key3, IVec, Data). des_ede3_cbc_decrypt(Key1, Key2, Key3, IVec, Data) -> - control(?DES_EDE3_CBC_DECRYPT, [Key1, Key2, Key3, IVec, Data]). + des_ede3_cbc_crypt(Key1, Key2, Key3, IVec, Data, false). + +des_ede3_cbc_crypt(_Key1, _Key2, _Key3, _IVec, _Data, _IsEncrypt) -> ?nif_stub. %% %% Blowfish %% -blowfish_ecb_encrypt(Key, Data) when byte_size(Data) >= 8 -> - control_bin(?BF_ECB_ENCRYPT, Key, list_to_binary([Data])). +blowfish_ecb_encrypt(Key, Data) -> + bf_ecb_crypt(Key,Data, true). -blowfish_ecb_decrypt(Key, Data) when byte_size(Data) >= 8 -> - control_bin(?BF_ECB_DECRYPT, Key, list_to_binary([Data])). +blowfish_ecb_decrypt(Key, Data) -> + bf_ecb_crypt(Key,Data, false). -blowfish_cbc_encrypt(Key, IVec, Data) when byte_size(Data) rem 8 =:= 0 -> - control_bin(?BF_CBC_ENCRYPT, Key, list_to_binary([IVec, Data])). +bf_ecb_crypt(_Key,_Data,_IsEncrypt) -> ?nif_stub. -blowfish_cbc_decrypt(Key, IVec, Data) when byte_size(Data) rem 8 =:= 0 -> - control_bin(?BF_CBC_DECRYPT, Key, list_to_binary([IVec, Data])). +blowfish_cbc_encrypt(Key, IVec, Data) -> + bf_cbc_crypt(Key,IVec,Data,true). -blowfish_cfb64_encrypt(Key, IVec, Data) when byte_size(IVec) =:= 8 -> - control_bin(?BF_CFB64_ENCRYPT, Key, list_to_binary([IVec, Data])). +blowfish_cbc_decrypt(Key, IVec, Data) -> + bf_cbc_crypt(Key,IVec,Data,false). -blowfish_cfb64_decrypt(Key, IVec, Data) when byte_size(IVec) =:= 8 -> - control_bin(?BF_CFB64_DECRYPT, Key, list_to_binary([IVec, Data])). +bf_cbc_crypt(_Key,_IVec,_Data,_IsEncrypt) -> ?nif_stub. -blowfish_ofb64_encrypt(Key, IVec, Data) when byte_size(IVec) =:= 8 -> - control_bin(?BF_OFB64_ENCRYPT, Key, list_to_binary([IVec, Data])). +blowfish_cfb64_encrypt(Key, IVec, Data) -> + bf_cfb64_crypt(Key, IVec, Data, true). + +blowfish_cfb64_decrypt(Key, IVec, Data) -> + bf_cfb64_crypt(Key, IVec, Data, false). + +bf_cfb64_crypt(_Key, _IVec, _Data, _IsEncrypt) -> ?nif_stub. + +blowfish_ofb64_encrypt(_Key, _IVec, _Data) -> ?nif_stub. %% %% AES in cipher feedback mode (CFB) %% aes_cfb_128_encrypt(Key, IVec, Data) -> - control(?AES_CFB_128_ENCRYPT, [Key, IVec, Data]). + aes_cfb_128_crypt(Key, IVec, Data, true). aes_cfb_128_decrypt(Key, IVec, Data) -> - control(?AES_CFB_128_DECRYPT, [Key, IVec, Data]). - + aes_cfb_128_crypt(Key, IVec, Data, false). -%% %% -%% %% IDEA - in cipher block chaining mode (CBC) -%% %% -%% idea_cbc_encrypt(Key, IVec, Data) -> -%% control(?IDEA_CBC_ENCRYPT, [Key, IVec, Data]). - -%% idea_cbc_decrypt(Key, IVec, Data) -> -%% control(?IDEA_CBC_DECRYPT, [Key, IVec, Data]). +aes_cfb_128_crypt(_Key, _IVec, _Data, _IsEncrypt) -> ?nif_stub. %% %% RAND - pseudo random numbers using RN_ functions in crypto lib %% - -rand_bytes(Bytes) -> - rand_bytes(Bytes, 0, 0). -rand_bytes(Bytes, Topmask, Bottommask) -> - control(?RAND_BYTES,[<<Bytes:32/integer, - Topmask:8/integer, - Bottommask:8/integer>>]). +rand_bytes(_Bytes) -> ?nif_stub. +rand_bytes(_Bytes, _Topmask, _Bottommask) -> ?nif_stub. rand_uniform(From,To) when is_binary(From), is_binary(To) -> - case control(?RAND_UNIFORM,[From,To]) of + case rand_uniform_nif(From,To) of <<Len:32/integer, MSB, Rest/binary>> when MSB > 127 -> <<(Len + 1):32/integer, 0, MSB, Rest/binary>>; Whatever -> @@ -394,6 +309,8 @@ rand_uniform(From,To) when is_integer(From),is_integer(To) -> Other end. +rand_uniform_nif(_From,_To) -> ?nif_stub. + %% %% mod_exp - utility for rsa generation %% @@ -402,55 +319,51 @@ mod_exp(Base, Exponent, Modulo) erlint(mod_exp(mpint(Base), mpint(Exponent), mpint(Modulo))); mod_exp(Base, Exponent, Modulo) -> - case control(?MOD_EXP,[Base,Exponent,Modulo]) of + case mod_exp_nif(Base,Exponent,Modulo) of <<Len:32/integer, MSB, Rest/binary>> when MSB > 127 -> <<(Len + 1):32/integer, 0, MSB, Rest/binary>>; Whatever -> Whatever end. +mod_exp_nif(_Base,_Exp,_Mod) -> ?nif_stub. + %% %% DSS, RSA - verify %% %% Key = [P,Q,G,Y] P,Q,G=DSSParams Y=PublicKey -dss_verify(Data,Signature,Key) -> - control(?DSS_VERIFY, [Data,Signature,Key]) == <<1>>. +dss_verify(_Data,_Signature,_Key) -> ?nif_stub. % Key = [E,N] E=PublicExponent N=PublicModulus rsa_verify(Data,Signature,Key) -> rsa_verify(sha, Data,Signature,Key). -rsa_verify(Type,Data,Signature,Key) -> - control(rsa_verify_digest_type(Type), [Data,Signature,Key]) == <<1>>. +rsa_verify(_Type,_Data,_Signature,_Key) -> ?nif_stub. -rsa_verify_digest_type(md5) -> ?RSA_VERIFY_MD5; -rsa_verify_digest_type(sha) -> ?RSA_VERIFY_SHA; -rsa_verify_digest_type(Bad) -> erlang:error(badarg, [Bad]). %% %% DSS, RSA - sign %% %% Key = [P,Q,G,X] P,Q,G=DSSParams X=PrivateKey dss_sign(Data, Key) -> - <<Ret:8, Signature/binary>> = control(?DSS_SIGN, [Data,Key]), - case Ret of - 1 -> Signature; - 0 -> erlang:error(badkey, [Data, Key]) + case dss_sign_nif(Data,Key) of + error -> erlang:error(badkey, [Data, Key]); + Sign -> Sign end. +dss_sign_nif(_Data,_Key) -> ?nif_stub. + %% Key = [E,N,D] E=PublicExponent N=PublicModulus D=PrivateExponent rsa_sign(Data,Key) -> rsa_sign(sha, Data, Key). rsa_sign(Type, Data, Key) -> - <<Ret:8, Signature/binary>> = control(rsa_sign_digest_type(Type), [Data,Key]), - case Ret of - 1 -> Signature; - 0 -> erlang:error(badkey, [Type,Data,Key]) + case rsa_sign_nif(Type,Data,Key) of + error -> erlang:error(badkey, [Type,Data,Key]); + Sign -> Sign end. -rsa_sign_digest_type(md5) -> ?RSA_SIGN_MD5; -rsa_sign_digest_type(sha) -> ?RSA_SIGN_SHA; -rsa_sign_digest_type(Bad) -> erlang:error(badarg, [Bad]). +rsa_sign_nif(_Type,_Data,_Key) -> ?nif_stub. + %% %% rsa_public_encrypt @@ -458,48 +371,39 @@ rsa_sign_digest_type(Bad) -> erlang:error(badarg, [Bad]). %% Binary, Key = [E,N] rsa_public_encrypt(BinMesg, Key, Padding) -> - Size = iolist_size(BinMesg), - <<Ret:8, Signature/binary>> = - control(?RSA_PUBLIC_ENCRYPT, [<<Size:32>>,BinMesg,Key,rsa_pad(Padding)]), - case Ret of - 1 -> Signature; - 0 -> erlang:error(encrypt_failed, [BinMesg,Key, Padding]) - end. + case rsa_public_crypt(BinMesg, Key, Padding, true) of + error -> + erlang:error(encrypt_failed, [BinMesg,Key, Padding]); + Sign -> Sign + end. + +rsa_public_crypt(_BinMsg, _Key, _Padding, _IsEncrypt) -> ?nif_stub. %% Binary, Key = [E,N,D] rsa_private_decrypt(BinMesg, Key, Padding) -> - Size = iolist_size(BinMesg), - <<Ret:8, Signature/binary>> = - control(?RSA_PRIVATE_DECRYPT, [<<Size:32>>,BinMesg,Key,rsa_pad(Padding)]), - case Ret of - 1 -> Signature; - 0 -> erlang:error(decrypt_failed, [BinMesg,Key, Padding]) - end. - -rsa_pad(rsa_pkcs1_padding) -> 1; -rsa_pad(rsa_pkcs1_oaep_padding) -> 2; -%% rsa_pad(rsa_sslv23_padding) -> 3; -rsa_pad(rsa_no_padding) -> 0; -rsa_pad(Bad) -> erlang:error(badarg, [Bad]). + case rsa_private_crypt(BinMesg, Key, Padding, false) of + error -> + erlang:error(decrypt_failed, [BinMesg,Key, Padding]); + Sign -> Sign + end. + +rsa_private_crypt(_BinMsg, _Key, _Padding, _IsEncrypt) -> ?nif_stub. + %% Binary, Key = [E,N,D] rsa_private_encrypt(BinMesg, Key, Padding) -> - Size = iolist_size(BinMesg), - <<Ret:8, Signature/binary>> = - control(?RSA_PRIVATE_ENCRYPT, [<<Size:32>>,BinMesg,Key,rsa_pad(Padding)]), - case Ret of - 1 -> Signature; - 0 -> erlang:error(encrypt_failed, [BinMesg,Key, Padding]) - end. + case rsa_private_crypt(BinMesg, Key, Padding, true) of + error -> + erlang:error(encrypt_failed, [BinMesg,Key, Padding]); + Sign -> Sign + end. %% Binary, Key = [E,N] rsa_public_decrypt(BinMesg, Key, Padding) -> - Size = iolist_size(BinMesg), - <<Ret:8, Signature/binary>> = - control(?RSA_PUBLIC_DECRYPT, [<<Size:32>>,BinMesg,Key,rsa_pad(Padding)]), - case Ret of - 1 -> Signature; - 0 -> erlang:error(decrypt_failed, [BinMesg,Key, Padding]) + case rsa_public_crypt(BinMesg, Key, Padding, false) of + error -> + erlang:error(decrypt_failed, [BinMesg,Key, Padding]); + Sign -> Sign end. %% @@ -507,16 +411,18 @@ rsa_public_decrypt(BinMesg, Key, Padding) -> %% aes_cbc_128_encrypt(Key, IVec, Data) -> - control(?AES_CBC_128_ENCRYPT, [Key, IVec, Data]). + aes_cbc_crypt(Key, IVec, Data, true). aes_cbc_128_decrypt(Key, IVec, Data) -> - control(?AES_CBC_128_DECRYPT, [Key, IVec, Data]). + aes_cbc_crypt(Key, IVec, Data, false). aes_cbc_256_encrypt(Key, IVec, Data) -> - control(?AES_CBC_256_ENCRYPT, [Key, IVec, Data]). + aes_cbc_crypt(Key, IVec, Data, true). aes_cbc_256_decrypt(Key, IVec, Data) -> - control(?AES_CBC_256_DECRYPT, [Key, IVec, Data]). + aes_cbc_crypt(Key, IVec, Data, false). + +aes_cbc_crypt(_Key, _IVec, _Data, _IsEncrypt) -> ?nif_stub. %% %% aes_cbc_ivec(Data) -> binary() @@ -537,31 +443,25 @@ aes_cbc_ivec(Data) when is_list(Data) -> %% NB doesn't check that they are the same size, just concatenates %% them and sends them to the driver %% -exor(A, B) -> - control(?XOR, [A, B]). +exor(_A, _B) -> ?nif_stub. %% %% RC4 - symmetric stream cipher %% -rc4_encrypt(Key, Data) -> - control_bin(?RC4_ENCRYPT, Key, Data). - -rc4_set_key(Key) -> - control(?RC4_SET_KEY, Key). - -rc4_encrypt_with_state(State, Data) -> - <<Sz:32/integer-big-unsigned, S:Sz/binary, D/binary>> = - control_bin(?RC4_ENCRYPT_WITH_STATE, State, Data), - {S, D}. +rc4_encrypt(_Key, _Data) -> ?nif_stub. +rc4_set_key(_Key) -> ?nif_stub. +rc4_encrypt_with_state(_State, _Data) -> ?nif_stub. %% %% RC2 - 40 bits block cipher %% rc2_40_cbc_encrypt(Key, IVec, Data) -> - control(?RC2_40_CBC_ENCRYPT, [Key, IVec, Data]). + rc2_40_cbc_crypt(Key,IVec,Data,true). rc2_40_cbc_decrypt(Key, IVec, Data) -> - control(?RC2_40_CBC_DECRYPT, [Key, IVec, Data]). + rc2_40_cbc_crypt(Key,IVec,Data,false). + +rc2_40_cbc_crypt(_Key, _IVec, _Data, _IsEncrypt) -> ?nif_stub. %% %% DH Diffie-Hellman functions @@ -576,87 +476,44 @@ rc2_40_cbc_decrypt(Key, IVec, Data) -> %% %% usage: dh_generate_parameters(1024, 2 or 5) -> %% [Prime=mpint(), SharedGenerator=mpint()] -dh_generate_parameters(PrimeLen, Generator) - when is_integer(PrimeLen), is_integer(Generator) -> - case control(?DH_GENERATE_PARAMS, <<PrimeLen:32, Generator:32>>) of - <<0:8, _/binary>> -> - erlang:error(generation_failed, [PrimeLen,Generator]); - <<1:8, PLen0:32, _:PLen0/binary, GLen0:32,_:GLen0/binary>> = Bin -> - PLen = PLen0+4, - GLen = GLen0+4, - <<_:8, PBin:PLen/binary,GBin:GLen/binary>> = Bin, - [PBin, GBin] - end. +dh_generate_parameters(PrimeLen, Generator) -> + case dh_generate_parameters_nif(PrimeLen, Generator) of + error -> erlang:error(generation_failed, [PrimeLen,Generator]); + Ret -> Ret + end. + +dh_generate_parameters_nif(_PrimeLen, _Generator) -> ?nif_stub. %% Checks that the DHParameters are ok. %% DHParameters = [P (Prime)= mpint(), G(Generator) = mpint()] -dh_check(DHParameters) -> - case control(?DH_CHECK, DHParameters) of - <<0:32>> -> ok; - <<_:24,_:1,_:1,_:1,1:1>> -> not_prime; - <<_:24,_:1,_:1,1:1,0:1>> -> not_strong_prime; - <<_:24,_:1,1:1,0:1,0:1>> -> unable_to_check_generator; - <<_:24,1:1,0:1,0:1,0:1>> -> not_suitable_generator; - <<16#FFFF:32>> -> {error, check_failed}; - <<X:32>> -> {unknown, X} - end. +dh_check([_Prime,_Gen]) -> ?nif_stub. %% DHParameters = [P (Prime)= mpint(), G(Generator) = mpint()] %% PrivKey = mpint() dh_generate_key(DHParameters) -> - dh_generate_key(<<0:32>>, DHParameters). + dh_generate_key(undefined, DHParameters). dh_generate_key(PrivateKey, DHParameters) -> - case control(?DH_GENERATE_KEY, [PrivateKey, DHParameters]) of - <<0:8, _/binary>> -> - erlang:error(generation_failed, [PrivateKey,DHParameters]); - Bin = <<1:8, PubLen0:32, _:PubLen0/binary, PrivLen0:32, _:PrivLen0/binary>> -> - PubLen = PubLen0+4, - PrivLen = PrivLen0+4, - <<_:8, PubBin:PubLen/binary,PrivBin:PrivLen/binary>> = Bin, - {PubBin, PrivBin} + case dh_generate_key_nif(PrivateKey, DHParameters) of + error -> erlang:error(generation_failed, [PrivateKey,DHParameters]); + Res -> Res end. +dh_generate_key_nif(_PrivateKey, _DHParameters) -> ?nif_stub. + %% DHParameters = [P (Prime)= mpint(), G(Generator) = mpint()] %% MyPrivKey, OthersPublicKey = mpint() dh_compute_key(OthersPublicKey, MyPrivateKey, DHParameters) -> - case control(?DH_COMPUTE_KEY, [OthersPublicKey, MyPrivateKey, DHParameters]) of - <<0:8, _/binary>> -> - erlang:error(computation_failed, [OthersPublicKey,MyPrivateKey,DHParameters]); - <<1:8, Binary/binary>> -> Binary + case dh_compute_key_nif(OthersPublicKey,MyPrivateKey,DHParameters) of + error -> erlang:error(computation_failed, [OthersPublicKey,MyPrivateKey,DHParameters]); + Ret -> Ret end. +dh_compute_key_nif(_OthersPublicKey, _MyPrivateKey, _DHParameters) -> ?nif_stub. + %% %% LOCAL FUNCTIONS %% -control_bin(Cmd, Key, Data) -> - Sz = iolist_size(Key), - control(Cmd, [<<Sz:32/integer-unsigned>>, Key, Data]). - -control(Cmd, Data) -> - Port = crypto_server:client_port(), - erlang:port_control(Port, Cmd, Data). - - -%% sizehdr(N) -> -%% [(N bsr 24) band 255, -%% (N bsr 16) band 255, -%% (N bsr 8) band 255, -%% N band 255]. - -%% Flat length of IOlist (or binary) -%% flen(L) when binary(L) -> -%% size(L); -%% flen(L) -> -%% flen(L, 0). - -%% flen([H| T], N) when list(H) -> -%% flen(H, flen(T, N)); -%% flen([H| T], N) when binary(H) -> -%% flen(T, N + size(H)); -%% flen([H| T], N) when integer(H), 0 =< H, H =< 255 -> -%% flen(T, N + 1); -%% flen([], N) -> -%% N. + %% large integer in a binary with 32bit length %% MP representaion (SSH2) diff --git a/lib/crypto/src/crypto_server.erl b/lib/crypto/src/crypto_server.erl index 0b1e5c9b02..89650a9f06 100644 --- a/lib/crypto/src/crypto_server.erl +++ b/lib/crypto/src/crypto_server.erl @@ -1,19 +1,19 @@ %% %% %CopyrightBegin% -%% -%% Copyright Ericsson AB 1999-2009. All Rights Reserved. -%% +%% +%% Copyright Ericsson AB 1999-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% %% @@ -23,14 +23,12 @@ -behaviour(gen_server). --export([start_link/0,client_port/0]). +-export([start_link/0]). %% Internal exports, call-back functions. -export([init/1,handle_call/3,handle_cast/2,handle_info/2,code_change/3, terminate/2]). -%% Measurements shows that inlining port_names/0 is worth doing. --compile({inline,[{port_names,0}]}). %%% -------------------------------------------------------- %%% Interface Functions. @@ -40,66 +38,8 @@ start_link() -> gen_server:start_link({local, crypto_server}, crypto_server, [], []). init([]) -> - process_flag(trap_exit, true), - erl_ddll:start(), - PrivDir = code:priv_dir(crypto), - LibDir1 = filename:join([PrivDir, "lib"]), - {Status, LibDir} = - case erl_ddll:load_driver(LibDir1, crypto_drv) of - ok -> {ok,LibDir1}; - {error,Error1} -> - LibDir2 = - filename:join(LibDir1, - erlang:system_info(system_architecture)), - Candidate = - filelib:wildcard(filename:join([LibDir2,"crypto_drv*"])), - case Candidate of - [] -> - {{error,Error1},LibDir1}; - _ -> - case erl_ddll:load_driver(LibDir2, crypto_drv) of - ok -> - {ok,LibDir2}; - {error, Error2} -> - {{error,Error2},LibDir2} - end - end - end, - case Status of - ok -> - Cmd = "crypto_drv elibcrypto " ++ - filename:join([LibDir, "elibcrypto"]), - open_ports(Cmd,size(port_names())); - {error, E} -> - Str = erl_ddll:format_error(E), - error_logger:error_msg("Unable to load crypto_drv. Failed with error:~n\"~s\"~nOpenSSL might not be installed on this system.~n",[Str]), - {stop,nodriver} - end. - -open_ports(_,0) -> - {ok, []}; -open_ports(Cmd,N) -> - Port = open_port({spawn, Cmd}, []), - %% check that driver is loaded, linked and working - %% since crypto_drv links towards libcrypto, this is a good thing - %% since libcrypto is known to be bad with backwards compatibility - case catch port_control(Port, 0, []) of - {'EXIT', _} -> - {stop, nodriver}; - _ -> - register(element(N,port_names()), Port), - open_ports(Cmd,N-1) - end. - -port_names() -> - { crypto_drv01, crypto_drv02, crypto_drv03, crypto_drv04, - crypto_drv05, crypto_drv06, crypto_drv07, crypto_drv08, - crypto_drv09, crypto_drv10, crypto_drv11, crypto_drv12, - crypto_drv13, crypto_drv14, crypto_drv15, crypto_drv16 }. - -client_port() -> - element(erlang:system_info(scheduler_id) rem size(port_names()) + 1, - port_names()). + {ok,[]}. + %%% -------------------------------------------------------- @@ -112,11 +52,6 @@ handle_call(_, _, State) -> handle_cast(_, State) -> {noreply, State}. -handle_info({'EXIT', Pid, _Reason}, State) when is_pid(Pid) -> - {noreply, State}; - -handle_info({'EXIT', Port, Reason}, State) when is_port(Port) -> - {stop, {port_died, Reason}, State}; handle_info(_, State) -> {noreply, State}. @@ -124,13 +59,8 @@ code_change(_OldVsn, State, _Extra) -> {ok, State}. terminate(_Reason, _State) -> - close_ports(size(port_names())). + []. -close_ports(0) -> - ok; -close_ports(N) -> - element(N,port_names()) ! {self(), close}, - close_ports(N-1). diff --git a/lib/crypto/test/blowfish_SUITE.erl b/lib/crypto/test/blowfish_SUITE.erl index d4cc167ea9..d117e7cc3d 100644 --- a/lib/crypto/test/blowfish_SUITE.erl +++ b/lib/crypto/test/blowfish_SUITE.erl @@ -1,19 +1,19 @@ %% %% %CopyrightBegin% -%% -%% Copyright Ericsson AB 2009. All Rights Reserved. -%% +%% +%% Copyright Ericsson AB 2009-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% %% @@ -116,7 +116,8 @@ all(suite) -> ecb_test(KeyBytes, ClearBytes, CipherBytes) -> {Key, Clear, Cipher} = {to_bin(KeyBytes), to_bin(ClearBytes), to_bin(CipherBytes)}, - crypto:blowfish_ecb_encrypt(Key, Clear) =:= Cipher. + ?line m(crypto:blowfish_ecb_encrypt(Key, Clear), Cipher), + true. ecb(doc) -> "Test that ECB mode is OK"; @@ -208,3 +209,5 @@ to_bin([], Acc) -> iolist_to_binary(lists:reverse(Acc)); to_bin([C1, C2 | Rest], Acc) -> to_bin(Rest, [(dehex(C1) bsl 4) bor dehex(C2) | Acc]). + +m(X,X) -> ok. diff --git a/lib/crypto/test/crypto_SUITE.erl b/lib/crypto/test/crypto_SUITE.erl index ee0e5c0dae..08d7a0ce99 100644 --- a/lib/crypto/test/crypto_SUITE.erl +++ b/lib/crypto/test/crypto_SUITE.erl @@ -119,7 +119,7 @@ link_test(Config) when is_list(Config) -> link_test_1() -> ?line CryptoPriv = code:priv_dir(crypto), - ?line Wc = filename:join([CryptoPriv,"lib","crypto_drv.*"]), + ?line Wc = filename:join([CryptoPriv,"lib","crypto.*"]), ?line case filelib:wildcard(Wc) of [] -> {skip,"Didn't find the crypto driver"}; [Drv] -> link_test_2(Drv) @@ -843,16 +843,16 @@ dsa_sign_test(Config) when is_list(Config) -> ParamG = 18320614775012672475365915366944922415598782131828709277168615511695849821411624805195787607930033958243224786899641459701930253094446221381818858674389863050420226114787005820357372837321561754462061849169568607689530279303056075793886577588606958623645901271866346406773590024901668622321064384483571751669, Params = [crypto:mpint(ParamP), crypto:mpint(ParamQ), crypto:mpint(ParamG)], - ?line Sig1 = crypto:dss_sign(sized_binary(Msg), [Params, crypto:mpint(PrivKey)]), + ?line Sig1 = crypto:dss_sign(sized_binary(Msg), Params ++ [crypto:mpint(PrivKey)]), ?line m(crypto:dss_verify(sized_binary(Msg), sized_binary(Sig1), - [Params, crypto:mpint(PubKey)]), true), + Params ++ [crypto:mpint(PubKey)]), true), ?line m(crypto:dss_verify(sized_binary(one_bit_wrong(Msg)), sized_binary(Sig1), - [Params, crypto:mpint(PubKey)]), false), + Params ++ [crypto:mpint(PubKey)]), false), ?line m(crypto:dss_verify(sized_binary(Msg), sized_binary(one_bit_wrong(Sig1)), - [Params, crypto:mpint(PubKey)]), false), + Params ++ [crypto:mpint(PubKey)]), false), %%?line Bad = crypto:dss_sign(sized_binary(Msg), [Params, crypto:mpint(PubKey)]), diff --git a/lib/crypto/vsn.mk b/lib/crypto/vsn.mk index 68eecfe759..d04736fc2b 100644 --- a/lib/crypto/vsn.mk +++ b/lib/crypto/vsn.mk @@ -1 +1 @@ -CRYPTO_VSN = 1.6.4 +CRYPTO_VSN = 2.0 diff --git a/lib/erl_interface/test/ei_tmo_SUITE_data/ei_tmo_test.c b/lib/erl_interface/test/ei_tmo_SUITE_data/ei_tmo_test.c index 2cc9af975d..db90b1810e 100644 --- a/lib/erl_interface/test/ei_tmo_SUITE_data/ei_tmo_test.c +++ b/lib/erl_interface/test/ei_tmo_SUITE_data/ei_tmo_test.c @@ -1,19 +1,19 @@ /* * %CopyrightBegin% - * - * Copyright Ericsson AB 2003-2009. All Rights Reserved. - * + * + * Copyright Ericsson AB 2003-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% */ @@ -65,7 +65,7 @@ static void debugf_open(int number) { char filename[1024]; sprintf(filename,"ei_tmo_test%d.debug",number); -#if !defined(VXWORKS) && !defined(__WIN32__) && !defined(_OSE_) +#if !defined(VXWORKS) && !defined(__WIN32__) close(2); #endif debugfile = fopen(filename,"a"); diff --git a/lib/hipe/cerl/erl_bif_types.erl b/lib/hipe/cerl/erl_bif_types.erl index 213f98dcc0..be3073c0e6 100644 --- a/lib/hipe/cerl/erl_bif_types.erl +++ b/lib/hipe/cerl/erl_bif_types.erl @@ -1066,11 +1066,19 @@ type(erlang, list_to_pid, 1, Xs) -> strict(arg_types(erlang, list_to_pid, 1), Xs, fun (_) -> t_pid() end); type(erlang, list_to_tuple, 1, Xs) -> strict(arg_types(erlang, list_to_tuple, 1), Xs, fun (_) -> t_tuple() end); -type(erlang, loaded, 0, _) -> - t_list(t_atom()); type(erlang, load_module, 2, Xs) -> strict(arg_types(erlang, load_module, 2), Xs, fun ([Mod,_Bin]) -> t_code_load_return(Mod) end); +type(erlang, load_nif, 2, Xs) -> + strict(arg_types(erlang, load_nif, 2), Xs, + fun (_) -> + Reason = t_atoms(['load_failed', 'bad_lib', 'load', + 'reload', 'upgrade', 'old_code']), + RsnPair = t_tuple([Reason, t_string()]), + t_sup(t_atom('ok'), t_tuple([t_atom('error'), RsnPair])) + end); +type(erlang, loaded, 0, _) -> + t_list(t_atom()); type(erlang, localtime, 0, Xs) -> type(erlang, universaltime, 0, Xs); % same type(erlang, localtime_to_universaltime, 1, Xs) -> @@ -3572,10 +3580,12 @@ arg_types(erlang, list_to_pid, 1) -> [t_string()]; arg_types(erlang, list_to_tuple, 1) -> [t_list()]; -arg_types(erlang, loaded, 0) -> - []; arg_types(erlang, load_module, 2) -> [t_atom(), t_binary()]; +arg_types(erlang, load_nif, 2) -> + [t_string(), t_any()]; +arg_types(erlang, loaded, 0) -> + []; arg_types(erlang, localtime, 0) -> []; arg_types(erlang, localtime_to_universaltime, 1) -> diff --git a/lib/hipe/icode/hipe_beam_to_icode.erl b/lib/hipe/icode/hipe_beam_to_icode.erl index 3923e98673..1f8be4040e 100644 --- a/lib/hipe/icode/hipe_beam_to_icode.erl +++ b/lib/hipe/icode/hipe_beam_to_icode.erl @@ -1,20 +1,20 @@ %% -*- erlang-indent-level: 2 -*- %% %% %CopyrightBegin% -%% -%% Copyright Ericsson AB 2001-2009. All Rights Reserved. -%% +%% +%% Copyright Ericsson AB 2001-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% %% %%======================================================================= @@ -22,8 +22,6 @@ %% Author : Kostis Sagonas %% Description : Translates symbolic BEAM code to Icode %%======================================================================= -%% $Id$ -%%======================================================================= %% @doc %% This file translates symbolic BEAM code to Icode which is HiPE's %% intermediate code representation. Either the code of an entire @@ -431,6 +429,11 @@ trans_fun([{wait_timeout,{_,Lbl},Reg}|Instructions], Env) -> SuspTmout = hipe_icode:mk_if(suspend_msg_timeout,[], map_label(Lbl),hipe_icode:label_name(DoneLbl)), Movs ++ [SetTmout, SuspTmout, DoneLbl | trans_fun(Instructions,Env1)]; +%%--- recv_mark/1 & recv_set/1 --- XXX: Handle better?? +trans_fun([{recv_mark,{f,_}}|Instructions], Env) -> + trans_fun(Instructions,Env); +trans_fun([{recv_set,{f,_}}|Instructions], Env) -> + trans_fun(Instructions,Env); %%-------------------------------------------------------------------- %%--- Translation of arithmetics {bif,ArithOp, ...} --- %%-------------------------------------------------------------------- @@ -892,11 +895,6 @@ trans_fun([{bs_init_bits,{f,Lbl},Size,_Words,_LiveRegs,{field_flags,Flags0},X}| end, trans_bin_call({hipe_bs_primop,Name}, Lbl, Args, [Dst, Base, Offset], Base, Offset, Env, Instructions); -trans_fun([{bs_bits_to_bytes2, Bits, Bytes}|Instructions], Env) -> - Src = trans_arg(Bits), - Dst = mk_var(Bytes), - [hipe_icode:mk_primop([Dst], 'bsl', [Src, hipe_icode:mk_const(3)])| - trans_fun(Instructions,Env)]; trans_fun([{bs_add, {f,Lbl}, [Old,New,Unit], Res}|Instructions], Env) -> Dst = mk_var(Res), Temp = mk_var(new), @@ -1126,13 +1124,6 @@ trans_fun([{gc_bif,Name,Fail,_Live,SrcRs,DstR}|Instructions], Env) -> trans_fun([{bif,Name,Fail,SrcRs,DstR}|Instructions], Env) end; %%-------------------------------------------------------------------- -%% Instruction for constant pool added in February 2007 for R11B-4. -%%-------------------------------------------------------------------- -trans_fun([{put_literal,{literal,Literal},DstR}|Instructions], Env) -> - DstV = mk_var(DstR), - Move = hipe_icode:mk_move(DstV, hipe_icode:mk_const(Literal)), - [Move | trans_fun(Instructions, Env)]; -%%-------------------------------------------------------------------- %% New test instruction added in July 2007 for R12. %%-------------------------------------------------------------------- %%--- is_bitstr --- diff --git a/lib/hipe/icode/hipe_icode.erl b/lib/hipe/icode/hipe_icode.erl index a4614d7237..3e211bf385 100644 --- a/lib/hipe/icode/hipe_icode.erl +++ b/lib/hipe/icode/hipe_icode.erl @@ -1,20 +1,20 @@ %% -*- erlang-indent-level: 2 -*- %% %% %CopyrightBegin% -%% -%% Copyright Ericsson AB 2001-2009. All Rights Reserved. -%% +%% +%% Copyright Ericsson AB 2001-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% %% %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% @@ -1578,27 +1578,19 @@ redirect_jmp(Jmp, ToOld, ToNew) -> _ -> Jmp end end, - simplify_branch(NewI). - -%% -%% @doc Turns a branch into a goto if it has only one successor and it -%% is safe to do so. -%% - --spec simplify_branch(icode_instr()) -> icode_instr(). - -simplify_branch(I) -> - case ordsets:from_list(successors(I)) of + %% Turn a branch into a goto if it has only one successor and it is + %% safe to do so. + case ordsets:from_list(successors(NewI)) of [Label] -> Goto = mk_goto(Label), - case I of - #icode_type{} -> Goto; + case NewI of #icode_if{} -> Goto; #icode_switch_tuple_arity{} -> Goto; #icode_switch_val{} -> Goto; - _ -> I + #icode_type{} -> Goto; + _ -> NewI end; - _ -> I + _ -> NewI end. %% diff --git a/lib/ic/doc/src/Makefile b/lib/ic/doc/src/Makefile index 26d0932a95..8eda436a24 100644 --- a/lib/ic/doc/src/Makefile +++ b/lib/ic/doc/src/Makefile @@ -1,19 +1,19 @@ # # %CopyrightBegin% -# -# Copyright Ericsson AB 1998-2009. All Rights Reserved. -# +# +# Copyright Ericsson AB 1998-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% # # @@ -211,7 +211,11 @@ $(HTMLDIR)/%.gif: %.gif ifdef DOCSUPPORT +ifneq (,$(JAVA)) docs: pdf html man $(JAVADOC_GENERATED_FILES) +else +docs: pdf html man +endif $(TOP_PDF_FILE): $(XML_FILES) @@ -301,6 +305,7 @@ release_docs_spec: docs $(INSTALL_DATA) $(GIF_FILES) $(EXTRA_FILES) $(HTML_FILES) \ $(RELSYSDIR)/doc/html $(INSTALL_DATA) $(INFO_FILE) $(RELSYSDIR) +ifneq (,$(JAVA)) $(INSTALL_DIR) $(RELSYSDIR)/doc/html/java $(INSTALL_DIR) $(RELSYSDIR)/doc/html/java/resources $(INSTALL_DIR) $(RELSYSDIR)/doc/html/java/com @@ -313,6 +318,7 @@ release_docs_spec: docs $(RELSYSDIR)/doc/html/java/resources $(INSTALL_DATA) $(JAVADOC_PACK_HTML_FILES) \ $(RELSYSDIR)/doc/html/java/com/ericsson/otp/ic +endif $(INSTALL_DIR) $(RELEASE_PATH)/man/man3 $(INSTALL_DATA) $(MAN3_FILES) $(RELEASE_PATH)/man/man3 diff --git a/lib/ic/doc/src/notes.xml b/lib/ic/doc/src/notes.xml index dbafde7b4b..6684547572 100644 --- a/lib/ic/doc/src/notes.xml +++ b/lib/ic/doc/src/notes.xml @@ -4,7 +4,7 @@ <chapter> <header> <copyright> - <year>1998</year><year>2009</year> + <year>1998</year><year>2010</year> <holder>Ericsson AB. All Rights Reserved.</holder> </copyright> <legalnotice> @@ -13,12 +13,12 @@ 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. - + </legalnotice> <title>IDL Compiler Release Notes</title> @@ -31,6 +31,22 @@ </header> <section> + <title>IC 4.2.25</title> + + <section> + <title>Improvements and New Features</title> + <list type="bulleted"> + <item> + <p> + The documentation can now be built and installed without Java.</p> + <p> + Own Id: OTP-8639 Aux Id:</p> + </item> + </list> + </section> + </section> + + <section> <title>IC 4.2.24</title> <section> diff --git a/lib/ic/vsn.mk b/lib/ic/vsn.mk index e0fccf4889..4aa2a04b60 100644 --- a/lib/ic/vsn.mk +++ b/lib/ic/vsn.mk @@ -1,6 +1,8 @@ -IC_VSN = 4.2.24 +IC_VSN = 4.2.25 -TICKETS = OTP-8307 \ +TICKETS = OTP-8639 + +TICKETS_4.2.24 = OTP-8307 \ OTP-8353 \ OTP-8354 \ OTP-8355 diff --git a/lib/inets/doc/src/notes.xml b/lib/inets/doc/src/notes.xml index 09a81122c2..3216b0c2cd 100644 --- a/lib/inets/doc/src/notes.xml +++ b/lib/inets/doc/src/notes.xml @@ -71,6 +71,13 @@ <p>Lev Walkin</p> </item> + <item> + <p>[httpc] - https requests with default port (443) not handled + properly. </p> + <p>Own Id: OTP-8607</p> + <p>jebu ittiachen</p> + </item> + </list> </section> diff --git a/lib/inets/src/http_client/httpc.erl b/lib/inets/src/http_client/httpc.erl index 5205605e0a..6deeab6948 100644 --- a/lib/inets/src/http_client/httpc.erl +++ b/lib/inets/src/http_client/httpc.erl @@ -432,7 +432,7 @@ handle_request(Method, Url, Options = request_options(Options0), Sync = proplists:get_value(sync, Options), Stream = proplists:get_value(stream, Options), - Host2 = header_host(Host, Port), + Host2 = header_host(Scheme, Host, Port), HeadersRecord = header_record(NewHeaders, Host2, HTTPOptions), Receiver = proplists:get_value(receiver, Options), SocketOpts = proplists:get_value(socket_opts, Options), @@ -895,9 +895,11 @@ bad_option(Option, BadValue) -> throw({error, {bad_option, Option, BadValue}}). -header_host(Host, 80 = _Port) -> +header_host(https, Host, 443 = _Port) -> Host; -header_host(Host, Port) -> +header_host(http, Host, 80 = _Port) -> + Host; +header_host(_Scheme, Host, Port) -> Host ++ ":" ++ integer_to_list(Port). diff --git a/lib/inets/src/inets_app/inets.appup.src b/lib/inets/src/inets_app/inets.appup.src index 7e2306d0c6..dfdfb41373 100644 --- a/lib/inets/src/inets_app/inets.appup.src +++ b/lib/inets/src/inets_app/inets.appup.src @@ -20,12 +20,14 @@ [ {"5.3.1", [ + {load_module, httpc, soft_purge, soft_purge, []}, {update, httpc_handler, soft, soft_purge, soft_purge, [httpc_manager]}, {update, httpc_manager, soft, soft_purge, soft_purge, []} ] }, {"5.3", [ + {load_module, httpc, soft_purge, soft_purge, []}, {update, httpc_handler, soft, soft_purge, soft_purge, [httpc_manager]}, {update, httpc_manager, soft, soft_purge, soft_purge, []}, {load_module, mod_esi, soft_purge, soft_purge, []} @@ -50,12 +52,14 @@ [ {"5.3.1", [ + {load_module, httpc, soft_purge, soft_purge, []}, {update, httpc_handler, soft, soft_purge, soft_purge, [httpc_manager]}, {update, httpc_manager, soft, soft_purge, soft_purge, []} ] }, {"5.3", [ + {load_module, httpc, soft_purge, soft_purge, []}, {update, httpc_handler, soft, soft_purge, soft_purge, [httpc_manager]}, {update, httpc_manager, soft, soft_purge, soft_purge, []}, {load_module, mod_esi, soft_purge, soft_purge, []} diff --git a/lib/inets/vsn.mk b/lib/inets/vsn.mk index ba808a2415..7776bef0a5 100644 --- a/lib/inets/vsn.mk +++ b/lib/inets/vsn.mk @@ -22,7 +22,7 @@ INETS_VSN = 5.3.2 PRE_VSN = APP_VSN = "$(APPLICATION)-$(INETS_VSN)$(PRE_VSN)" -TICKETS = OTP-8542 +TICKETS = OTP-8542 OTP-8607 TICKETS_5_3_1 = \ OTP-8508 \ diff --git a/lib/kernel/doc/src/file.xml b/lib/kernel/doc/src/file.xml index 50f9722a1c..382262d1ee 100644 --- a/lib/kernel/doc/src/file.xml +++ b/lib/kernel/doc/src/file.xml @@ -62,6 +62,25 @@ time() = {{Year, Month, Day}, {Hour, Minute, Second}} </section> <funcs> <func> + <name>advise(IoDevice, Offset, Length, Advise) -> ok | {error, Reason}</name> + <fsummary>Predeclare an access pattern for file data</fsummary> + <type> + <v>IoDevice = io_device()</v> + <v>Offset = int()</v> + <v>Length = int()</v> + <v>Advise = posix_file_advise()</v> + <v>posix_file_advise() = normal | sequential | random | no_reuse + | will_need | dont_need</v> + <v>Reason = ext_posix()</v> + </type> + <desc> + <p><c>advise/4</c> can be used to announce an intention to access file + data in a specific pattern in the future, thus allowing the + operating system to perform appropriate optimizations.</p> + <p>On some platforms, this function might have no effect.</p> + </desc> + </func> + <func> <name>change_group(Filename, Gid) -> ok | {error, Reason}</name> <fsummary>Change group of a file</fsummary> <type> @@ -1641,6 +1660,33 @@ f.txt: {person, "kalle", 25}. </desc> </func> <func> + <name>datasync(IoDevice) -> ok | {error, Reason}</name> + <fsummary>Synchronizes the in-memory data of a file, ignoring most of its metadata, with that on the physical medium</fsummary> + <type> + <v>IoDevice = io_device()</v> + <v>Reason = ext_posix() | terminated</v> + </type> + <desc> + <p>Makes sure that any buffers kept by the operating system + (not by the Erlang runtime system) are written to disk. In + many ways it's resembles fsync but it not requires to update + some of file's metadata such as the access time. On + some platforms, this function might have no effect.</p> + <p>Applications that access databases or log files often write + a tiny data fragment (e.g., one line in a log file) and then + call fsync() immediately in order to ensure that the written + data is physically stored on the harddisk. Unfortunately, fsync() + will always initiate two write operations: one for the newly + written data and another one in order to update the modification + time stored in the inode. If the modification time is not a part + of the transaction concept fdatasync() can be used to avoid + unnecessary inode disk write operations.</p> + <p>Available only in some POSIX systems. This call results in a + call to fsync(), or has no effect, in systems not implementing + the fdatasync syscall.</p> + </desc> + </func> + <func> <name>truncate(IoDevice) -> ok | {error, Reason}</name> <fsummary>Truncate a file</fsummary> <type> diff --git a/lib/kernel/src/application_controller.erl b/lib/kernel/src/application_controller.erl index 5277472ea6..42f527f400 100644 --- a/lib/kernel/src/application_controller.erl +++ b/lib/kernel/src/application_controller.erl @@ -40,7 +40,7 @@ -export([test_change_apps/2]). -import(lists, [zf/2, map/2, foreach/2, foldl/3, - keysearch/3, keydelete/3, keyreplace/4]). + keyfind/3, keydelete/3, keyreplace/4]). -include("application_master.hrl"). @@ -524,7 +524,9 @@ init(Init, Kernel) -> end. -%% Check the syntax of the .config file [{ApplicationName, [{Parameter, Value}]}]. +%% Check the syntax of the .config file +%% [{ApplicationName, [{Parameter, Value}]}]. + check_conf_data([]) -> ok; check_conf_data(ConfData) when is_list(ConfData) -> @@ -568,8 +570,8 @@ check_para_kernel([]) -> ok; check_para_kernel([{distributed, Apps} | ParaList]) when is_list(Apps) -> case check_distributed(Apps) of - {error, ErrorMsg} -> - {error, ErrorMsg}; + {error, _ErrorMsg} = Error -> + Error; _ -> check_para_kernel(ParaList) end; @@ -633,9 +635,9 @@ handle_call({load_application, Application}, From, S) -> false -> {reply, ok, NewS} end; - {error, Error} -> - {reply, {error, Error}, S}; - {'EXIT',R} -> + {error, _} = Error -> + {reply, Error, S}; + {'EXIT', R} -> {reply, {error, R}, S} end; @@ -660,7 +662,7 @@ handle_call({start_application, AppName, RestartType}, From, S) -> %% Incase of erroneous variables do not start the application, %% if the application is permanent crash the node. %% Check if the application is already starting. - case lists:keysearch(AppName, 1, Start_req) of + case lists:keyfind(AppName, 1, Start_req) of false -> case catch check_start_cond(AppName, RestartType, Started, Running) of {ok, Appl} -> @@ -689,13 +691,12 @@ handle_call({start_application, AppName, RestartType}, From, S) -> {reply, ok, SS} end end; - {error, R} -> - {reply, {error, R}, S} + {error, _R} = Error -> + {reply, Error, S} end; - {value, {AppName, _FromX}} -> + {AppName, _FromX} -> SS = S#state{start_req = [{AppName, From} | Start_req]}, {noreply, SS} - end; handle_call({permit_application, AppName, Bool}, From, S) -> @@ -769,11 +770,11 @@ handle_call({permit_application, AppName, Bool}, From, S) -> {noreply, SS}; %%========================== - %% unpermit the applicaition + %% unpermit the application %%========================== %% running {false, _, _, _, _, {value, {_AppName, Id}}} -> - {value, {_AppName2, Type}} = keysearch(AppName, 1, Started), + {_AppName2, Type} = lists:keyfind(AppName, 1, Started), stop_appl(AppName, Id, Type), NRunning = keydelete(AppName, 1, Running), {reply, ok, S#state{running = NRunning}}; @@ -803,9 +804,9 @@ handle_call({permit_application, AppName, Bool}, From, S) -> handle_call({stop_application, AppName}, _From, S) -> #state{running = Running, started = Started} = S, - case keysearch(AppName, 1, Running) of - {value, {_AppName, Id}} -> - {value, {_AppName2, Type}} = keysearch(AppName, 1, Started), + case lists:keyfind(AppName, 1, Running) of + {_AppName, Id} -> + {_AppName2, Type} = lists:keyfind(AppName, 1, Started), stop_appl(AppName, Id, Type), NRunning = keydelete(AppName, 1, Running), NStarted = keydelete(AppName, 1, Started), @@ -831,8 +832,8 @@ handle_call({change_application_data, Applications, Config}, _From, S) -> end, []), case catch do_change_apps(Applications, Config, OldAppls) of - {error, R} -> - {reply, {error, R}, S}; + {error, _} = Error -> + {reply, Error, S}; {'EXIT', R} -> {reply, {error, R}, S}; NewAppls -> @@ -886,10 +887,10 @@ handle_call({control_application, AppName}, {Pid, _Tag}, S) -> handle_call({start_type, AppName}, _From, S) -> Starting = S#state.starting, - StartType = case keysearch(AppName, 1, Starting) of + StartType = case lists:keyfind(AppName, 1, Starting) of false -> local; - {value, {_AppName, _RestartType, Type, _F}} -> + {_AppName, _RestartType, Type, _F} -> Type end, {reply, StartType, S}; @@ -913,7 +914,7 @@ handle_application_started(AppName, Res, S) -> #state{starting = Starting, running = Running, started = Started, start_req = Start_req} = S, Start_reqN = reply_to_requester(AppName, Start_req, Res), - {value, {_AppName, RestartType, _Type, _From}} = keysearch(AppName, 1, Starting), + {_AppName, RestartType, _Type, _From} = lists:keyfind(AppName, 1, Starting), case Res of {ok, Id} -> case AppName of @@ -928,7 +929,6 @@ handle_application_started(AppName, Res, S) -> running = NRunning, started = NStarted, start_req = Start_reqN}, - %% The permission may have been changed during start Perm = application:get_env(kernel, permissions), case {Perm, Id} of @@ -939,10 +939,10 @@ handle_application_started(AppName, Res, S) -> case lists:member({AppName, false}, Perms) of true -> #state{running = StopRunning, started = StopStarted} = NewS, - case keysearch(AppName, 1, StopRunning) of - {value, {_AppName, Id}} -> - {value, {_AppName2, Type}} = - keysearch(AppName, 1, StopStarted), + case lists:keyfind(AppName, 1, StopRunning) of + {_AppName, Id} -> + {_AppName2, Type} = + lists:keyfind(AppName, 1, StopStarted), stop_appl(AppName, Id, Type), NStopRunning = keydelete(AppName, 1, StopRunning), cntrl(AppName, NewS, {ac_application_stopped, AppName}), @@ -957,12 +957,8 @@ handle_application_started(AppName, Res, S) -> _ -> {noreply, NewS} end; - - - - - {error, R} when RestartType =:= temporary -> - notify_cntrl_started(AppName, undefined, S, {error, R}), + {error, R} = Error when RestartType =:= temporary -> + notify_cntrl_started(AppName, undefined, S, Error), info_exited(AppName, R, RestartType), {noreply, S#state{starting = keydelete(AppName, 1, Starting), start_req = Start_reqN}}; @@ -987,8 +983,8 @@ handle_application_started(AppName, Res, S) -> Reason = {application_start_failure, AppName, R}, {stop, to_string(Reason), S} end; - {error, R} -> %% permanent - notify_cntrl_started(AppName, undefined, S, {error, R}), + {error, R} = Error -> %% permanent + notify_cntrl_started(AppName, undefined, S, Error), info_exited(AppName, R, RestartType), Reason = {application_start_failure, AppName, R}, {stop, to_string(Reason), S}; @@ -1018,12 +1014,12 @@ handle_info({ac_load_application_reply, AppName, Res}, S) -> handle_info({ac_start_application_reply, AppName, Res}, S) -> Start_req = S#state.start_req, - case keysearch(AppName, 1, Starting = S#state.starting) of - {value, {_AppName, RestartType, Type, From}} -> + case lists:keyfind(AppName, 1, Starting = S#state.starting) of + {_AppName, RestartType, Type, From} -> case Res of start_it -> {true, Appl} = get_loaded(AppName), - spawn_starter(From, Appl, S, Type), + spawn_starter(From, Appl, S, Type), {noreply, S}; {started, Node} -> handle_application_started(AppName, @@ -1037,23 +1033,19 @@ handle_info({ac_start_application_reply, AppName, Res}, S) -> S#state{starting = keydelete(AppName, 1, Starting), started = [{AppName, RestartType} | Started], start_req = Start_reqN}}; - {takeover, Node} -> + {takeover, _Node} = Takeover -> {true, Appl} = get_loaded(AppName), - spawn_starter(From, Appl, S, {takeover, Node}), + spawn_starter(From, Appl, S, Takeover), NewStarting1 = keydelete(AppName, 1, Starting), - NewStarting = [{AppName, RestartType, {takeover, Node}, From} | NewStarting1], + NewStarting = [{AppName, RestartType, Takeover, From} | NewStarting1], {noreply, S#state{starting = NewStarting}}; - {error, Reason} when RestartType =:= permanent -> - Start_reqN = - reply_to_requester(AppName, Start_req, - {error, Reason}), + {error, Reason} = Error when RestartType =:= permanent -> + Start_reqN = reply_to_requester(AppName, Start_req, Error), {stop, to_string(Reason), S#state{start_req = Start_reqN}}; - {error, Reason} -> - Start_reqN = - reply_to_requester(AppName, Start_req, - {error, Reason}), + {error, _Reason} = Error -> + Start_reqN = reply_to_requester(AppName, Start_req, Error), {noreply, S#state{starting = - keydelete(AppName, 1, Starting), + keydelete(AppName, 1, Starting), start_req = Start_reqN}} end; false -> @@ -1064,8 +1056,8 @@ handle_info({ac_change_application_req, AppName, Msg}, S) -> Running = S#state.running, Started = S#state.started, Starting = S#state.starting, - case {keysearch(AppName, 1, Running), keysearch(AppName, 1, Started)} of - {{value, {AppName, Id}}, {value, {_AppName2, Type}}} -> + case {keyfind(AppName, 1, Running), keyfind(AppName, 1, Started)} of + {{AppName, Id}, {_AppName2, Type}} -> case Msg of {started, Node} -> stop_appl(AppName, Id, Type), @@ -1158,17 +1150,17 @@ handle_info({'EXIT', Pid, Reason}, S) -> ets:match_delete(ac_tab, {{application_master, '_'}, Pid}), NRunning = keydelete(Pid, 2, S#state.running), NewS = S#state{running = NRunning}, - case keysearch(Pid, 2, S#state.running) of - {value, {AppName, _AmPid}} -> + case lists:keyfind(Pid, 2, S#state.running) of + {AppName, _AmPid} -> cntrl(AppName, S, {ac_application_stopped, AppName}), - case keysearch(AppName, 1, S#state.started) of - {value, {_AppName, temporary}} -> + case lists:keyfind(AppName, 1, S#state.started) of + {_AppName, temporary} -> info_exited(AppName, Reason, temporary), {noreply, NewS}; - {value, {_AppName, transient}} when Reason =:= normal -> + {_AppName, transient} when Reason =:= normal -> info_exited(AppName, Reason, transient), {noreply, NewS}; - {value, {_AppName, Type}} -> + {_AppName, Type} -> info_exited(AppName, Reason, Type), {stop, to_string({application_terminated, AppName, Reason}), NewS} end; @@ -1209,8 +1201,8 @@ code_change(_OldVsn, State, _Extra) -> %%% Internal functions %%%----------------------------------------------------------------- cntrl(AppName, #state{control = Control}, Msg) -> - case keysearch(AppName, 1, Control) of - {value, {_AppName, Pid}} -> + case lists:keyfind(AppName, 1, Control) of + {_AppName, Pid} -> Pid ! Msg, true; false -> @@ -1310,8 +1302,8 @@ check_start_cond(AppName, RestartType, Started, Running) -> end. do_start(AppName, RT, Type, From, S) -> - RestartType = case keysearch(AppName, 1, S#state.started) of - {value, {_AppName2, OldRT}} -> + RestartType = case lists:keyfind(AppName, 1, S#state.started) of + {_AppName2, OldRT} -> get_restart_type(RT, OldRT); false -> RT @@ -1323,12 +1315,12 @@ do_start(AppName, RT, Type, From, S) -> {true, Appl} = get_loaded(AppName), Start_req = S#state.start_req, spawn_starter(undefined, Appl, S, Type), - Starting = case keysearch(AppName, 1, S#state.starting) of + Starting = case lists:keymember(AppName, 1, S#state.starting) of false -> %% UW: don't know if this is necessary [{AppName, RestartType, Type, From} | S#state.starting]; - _ -> + true -> S#state.starting end, S#state{starting = Starting, @@ -1368,10 +1360,10 @@ start_appl(Appl, S, Type) -> end end, Appl#appl.apps), case application_master:start_link(ApplData, Type) of - {ok, Pid} -> - {ok, Pid}; - {error, Reason} -> - throw({error, Reason}) + {ok, _Pid} = Ok -> + Ok; + {error, _Reason} = Error -> + throw(Error) end end. @@ -1463,15 +1455,15 @@ prim_parse(Tokens, Acc) -> case erl_parse:parse_term(Tokens2 ++ [Dot]) of {ok, Term} -> prim_parse(Rest, [Term | Acc]); - {error, Reason} -> - {error, Reason} + {error, _R} = Error -> + Error end; {Tokens2, []} -> case erl_parse:parse_term(Tokens2) of {ok, Term} -> {ok, lists:reverse([Term | Acc])}; - {error, Reason} -> - {error, Reason} + {error, _R} = Error -> + Error end end. @@ -1484,7 +1476,7 @@ make_appl_i({application, Name, Opts}) when is_atom(Name), is_list(Opts) -> Apps = get_opt(applications, Opts, []), Mod = case get_opt(mod, Opts, []) of - {M,A} when is_atom(M) -> {M,A}; + {M,_A}=MA when is_atom(M) -> MA; [] -> []; Other -> throw({error, {badstartspec, Other}}) end, @@ -1493,8 +1485,8 @@ make_appl_i({application, Name, Opts}) when is_atom(Name), is_list(Opts) -> MaxP = get_opt(maxP, Opts, infinity), MaxT = get_opt(maxT, Opts, infinity), IncApps = get_opt(included_applications, Opts, []), - {#appl_data{name = Name, regs = Regs, mod = Mod, phases = Phases, mods = Mods, - inc_apps = IncApps, maxP = MaxP, maxT = MaxT}, + {#appl_data{name = Name, regs = Regs, mod = Mod, phases = Phases, + mods = Mods, inc_apps = IncApps, maxP = MaxP, maxT = MaxT}, Env, IncApps, Descr, Id, Vsn, Apps}; make_appl_i({application, Name, Opts}) when is_list(Opts) -> throw({error,{invalid_name,Name}}); @@ -1573,12 +1565,12 @@ do_change_appl({ok, {ApplData, Env, IncApps, Descr, Id, Vsn, Apps}}, vsn=Vsn, inc_apps=IncApps, apps=Apps}; -do_change_appl({error, R}, _Appl, _ConfData) -> - throw({error, R}). +do_change_appl({error, _R} = Error, _Appl, _ConfData) -> + throw(Error). get_opt(Key, List, Default) -> - case keysearch(Key, 1, List) of - {value, {_Key, Val}} -> Val; + case lists:keyfind(Key, 1, List) of + {_Key, Val} -> Val; _ -> Default end. @@ -1612,8 +1604,8 @@ make_term(Str) -> end. get_env_i(Name, #state{conf_data = ConfData}) when is_list(ConfData) -> - case keysearch(Name, 1, ConfData) of - {value, {_Name, Env}} -> Env; + case lists:keyfind(Name, 1, ConfData) of + {_Name, Env} -> Env; _ -> [] end; get_env_i(_Name, _) -> []. @@ -1633,9 +1625,6 @@ merge_env([{App, AppEnv1} | T], Env2, Res) -> merge_env([], Env2, Res) -> Env2 ++ Res. - - - %% Merges envs for an application. Env2 overrides Env1 merge_app_env(Env1, Env2) -> merge_app_env(Env1, Env2, []). @@ -1699,13 +1688,12 @@ do_config_change([], _EnvBefore, Errors) -> {error, Errors}; do_config_change([{App, _Id} | Apps], EnvBefore, Errors) -> AppEnvNow = lists:sort(application:get_all_env(App)), - AppEnvBefore = case lists:keysearch(App, 1, EnvBefore) of + AppEnvBefore = case lists:keyfind(App, 1, EnvBefore) of false -> []; - {value, {App, AppEnvBeforeT}} -> + {App, AppEnvBeforeT} -> lists:sort(AppEnvBeforeT) end, - Res = case AppEnvNow of AppEnvBefore -> @@ -1725,12 +1713,12 @@ do_config_change([{App, _Id} | Apps], EnvBefore, Errors) -> %% if the cb-function is not defined {'EXIT', {undef, _}} -> ok; - {error, Error} -> - {error, Error}; + {error, _} = Error -> + Error; Else -> {error, Else} end; - {ok,[]} -> + {ok, []} -> {error, {module_not_defined, App}}; undefined -> {error, {application_not_found, App}} @@ -1744,9 +1732,7 @@ do_config_change([{App, _Id} | Apps], EnvBefore, Errors) -> {error, NewError} -> do_config_change(Apps, EnvBefore,[NewError | Errors]) end. - - - + %%----------------------------------------------------------------- %% Check if the configuration is changed in anyway. @@ -1760,21 +1746,17 @@ do_config_diff([], AppEnvBefore, {Changed, New}) -> do_config_diff(AppEnvNow, [], {Changed, New}) -> {Changed, AppEnvNow++New, []}; do_config_diff([{Env, Value} | AppEnvNow], AppEnvBefore, {Changed, New}) -> - case lists:keysearch(Env, 1, AppEnvBefore) of - {value, {Env, Value}} -> + case lists:keyfind(Env, 1, AppEnvBefore) of + {Env, Value} -> do_config_diff(AppEnvNow, lists:keydelete(Env,1,AppEnvBefore), {Changed, New}); - {value, {Env, _OtherValue}} -> + {Env, _OtherValue} -> do_config_diff(AppEnvNow, lists:keydelete(Env,1,AppEnvBefore), {[{Env, Value} | Changed], New}); false -> do_config_diff(AppEnvNow, AppEnvBefore, {Changed, [{Env, Value}|New]}) end. - - - - %%----------------------------------------------------------------- %% Read the .config files. %%----------------------------------------------------------------- @@ -1929,14 +1911,13 @@ reply_to_requester(AppName, Start_req, Res) -> %% Update the environment variable permission for an application. %%----------------------------------------------------------------- update_permissions(AppName, Bool) -> - case ets:lookup(ac_tab, {env, kernel, permissions}) of + T = {env, kernel, permissions}, + case ets:lookup(ac_tab, T) of [] -> - ets:insert(ac_tab, {{env, kernel, permissions}, - [{AppName, Bool}]}); + ets:insert(ac_tab, {T, [{AppName, Bool}]}); [{_, Perm}] -> Perm2 = lists:keydelete(AppName, 1, Perm), - ets:insert(ac_tab, {{env, kernel, permissions}, - [{AppName, Bool}| Perm2]}) + ets:insert(ac_tab, {T, [{AppName, Bool}|Perm2]}) end. %%----------------------------------------------------------------- diff --git a/lib/kernel/src/application_starter.erl b/lib/kernel/src/application_starter.erl index 8d839e4662..564366f304 100644 --- a/lib/kernel/src/application_starter.erl +++ b/lib/kernel/src/application_starter.erl @@ -1,19 +1,19 @@ %% %% %CopyrightBegin% -%% -%% Copyright Ericsson AB 1998-2009. All Rights Reserved. -%% +%% +%% Copyright Ericsson AB 1998-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% %% %% ---------------------------------------------------------------------- @@ -42,8 +42,8 @@ start([], _Type, _Apps) -> ok; start([{Phase,_PhaseArgs}|Phases], Type, Apps) -> case start_apps(Phase, Type, Apps) of - {error, Error} -> - {error, Error}; + {error, _} = Error -> + Error; _ -> start(Phases, Type, Apps) end. @@ -56,8 +56,8 @@ start_apps(_Phase, _Type, []) -> ok; start_apps(Phase, Type, [App | Apps]) -> case catch run_start_phase(Phase, Type, App) of - {error, Error} -> - {error, Error}; + {error, _} = Error -> + Error; _ -> start_apps(Phase, Type, Apps) end. @@ -91,10 +91,10 @@ run_the_phase(Phase, Type, App, Mod) -> {ok, Sp} -> Sp end, - case lists:keysearch(Phase, 1, Start_phases) of + case lists:keyfind(Phase, 1, Start_phases) of false -> ok; - {value, {Phase, PhaseArgs}} -> + {Phase, PhaseArgs} -> case catch Mod:start_phase(Phase, Type, PhaseArgs) of ok -> ok; diff --git a/lib/kernel/src/auth.erl b/lib/kernel/src/auth.erl index 31ee1d1ef4..7fe30ae828 100644 --- a/lib/kernel/src/auth.erl +++ b/lib/kernel/src/auth.erl @@ -119,8 +119,8 @@ sync_cookie() -> -spec print(Node :: node(), Format :: string(), Args :: [_]) -> 'ok'. -print(Node,Format,Args) -> - (catch gen_server:cast({auth,Node},{print,Format,Args})). +print(Node, Format, Args) -> + (catch gen_server:cast({auth, Node}, {print, Format, Args})). %%--gen_server callbacks------------------------------------------------ @@ -154,7 +154,7 @@ handle_call({set_cookie, Node, Cookie}, {_From,_Tag}, State) %% %% Happens when the distribution is brought up and -%% Someone wight have set up the cookie for our new nodename. +%% someone might have set up the cookie for our new node name. %% handle_call({set_cookie, Node, Cookie}, {_From,_Tag}, State) -> @@ -162,9 +162,9 @@ handle_call({set_cookie, Node, Cookie}, {_From,_Tag}, State) -> {reply, true, State}; handle_call(sync_cookie, _From, State) -> - case ets:lookup(State#state.other_cookies,node()) of + case ets:lookup(State#state.other_cookies, node()) of [{_N,C}] -> - ets:delete(State#state.other_cookies,node()), + ets:delete(State#state.other_cookies, node()), {reply, true, State#state{our_cookie = C}}; [] -> {reply, true, State} @@ -182,7 +182,7 @@ handle_call(echo, _From, O) -> handle_cast({print,What,Args}, O) -> %% always allow print outs - error_logger:error_msg(What,Args), + error_logger:error_msg(What, Args), {noreply, O}. %% A series of bad messages that may come (from older distribution versions). @@ -206,10 +206,10 @@ handle_info({_From,badcookie,ddd_server,_Mess}, O) -> {noreply, O}; handle_info({From,badcookie,rex,_Msg}, O) -> auth:print(getnode(From), - "~n** Unauthorized rpc attempt to ~w **~n",[node()]), + "~n** Unauthorized rpc attempt to ~w **~n", [node()]), disconnect_node(node(From)), {noreply, O}; -%% These two messages has to do with the old auth:is_auth() call (net_adm:ping) +%% These two messages have to do with the old auth:is_auth() call (net_adm:ping) handle_info({From,badcookie,net_kernel,{'$gen_call',{From,Tag},{is_auth,_Node}}}, O) -> %% ho ho From ! {Tag, no}, {noreply, O}; @@ -233,7 +233,7 @@ handle_info({From,badcookie,Name,Mess}, Opened) -> end end, {noreply, Opened}; -handle_info(_, O)-> % Ignore anything else especially EXIT signals +handle_info(_, O) -> % Ignore anything else especially EXIT signals {noreply, O}. -spec code_change(term(), state(), term()) -> {'ok', state()}. @@ -282,7 +282,7 @@ init_cookie() -> end; _Other -> #state{our_cookie = nocookie, - other_cookies = ets:new(cookies,[?COOKIE_ETS_PROTECTION])} + other_cookies = ets:new(cookies, [?COOKIE_ETS_PROTECTION])} end. read_cookie() -> diff --git a/lib/kernel/src/code.erl b/lib/kernel/src/code.erl index db05c1d234..affa5fc0fd 100644 --- a/lib/kernel/src/code.erl +++ b/lib/kernel/src/code.erl @@ -425,8 +425,8 @@ where_is_file(Path, File) when is_list(Path), is_list(File) -> FileInfo :: #file_info{}) -> 'ok' | {'error', atom()}. -set_primary_archive(ArchiveFile0, ArchiveBin, FileInfo) - when is_list(ArchiveFile0), is_binary(ArchiveBin), is_record(FileInfo, file_info) -> +set_primary_archive(ArchiveFile0, ArchiveBin, #file_info{} = FileInfo) + when is_list(ArchiveFile0), is_binary(ArchiveBin) -> ArchiveFile = filename:absname(ArchiveFile0), case call({set_primary_archive, ArchiveFile, ArchiveBin, FileInfo}) of {ok, []} -> diff --git a/lib/kernel/src/code_server.erl b/lib/kernel/src/code_server.erl index 2bc93b8238..4a1fc7df34 100644 --- a/lib/kernel/src/code_server.erl +++ b/lib/kernel/src/code_server.erl @@ -66,8 +66,8 @@ init(Ref, Parent, [Root,Mode0]) -> Mode = case Mode0 of - minimal -> interactive; - _ -> Mode0 + minimal -> interactive; + _ -> Mode0 end, IPath = @@ -75,7 +75,7 @@ init(Ref, Parent, [Root,Mode0]) -> interactive -> LibDir = filename:append(Root, "lib"), {ok,Dirs} = erl_prim_loader:list_dir(LibDir), - {Paths,_Libs} = make_path(LibDir,Dirs), + {Paths,_Libs} = make_path(LibDir, Dirs), UserLibPaths = get_user_lib_dirs(), ["."] ++ UserLibPaths ++ Paths; _ -> @@ -98,7 +98,7 @@ init(Ref, Parent, [Root,Mode0]) -> end, Parent ! {Ref,{ok,self()}}, - loop(State#state{supervisor=Parent}). + loop(State#state{supervisor = Parent}). get_user_lib_dirs() -> case os:getenv("ERL_LIBS") of @@ -170,8 +170,8 @@ loop(#state{supervisor=Supervisor}=State0) -> %%%%%%%%%%%%%%%%%%%%%%%%%%% %% System upgrade -handle_system_msg(SysState,Msg,From,Parent,Misc) -> - case do_sys_cmd(SysState,Msg,Parent, Misc) of +handle_system_msg(SysState, Msg, From, Parent, Misc) -> + case do_sys_cmd(SysState, Msg, Parent, Misc) of {suspended, Reply, NMisc} -> gen_reply(From, Reply), suspend_loop(suspended, Parent, NMisc); @@ -208,7 +208,7 @@ do_sys_cmd(SysState, {debug, _What}, _Parent, Misc) -> do_sys_cmd(suspended, {change_code, Module, Vsn, Extra}, _Parent, Misc0) -> {Res, Misc} = case catch ?MODULE:system_code_change(Misc0, Module, Vsn, Extra) of - {ok, Misc1} -> {ok, Misc1}; + {ok, _} = Ok -> Ok; Else -> {{error, Else}, Misc0} end, {suspended, Res, Misc}; @@ -219,7 +219,7 @@ system_continue(_Parent, _Debug, State) -> loop(State). system_terminate(_Reason, _Parent, _Debug, _State) -> -% error_msg("~p terminating: ~p~n ",[?MODULE,Reason]), + %% error_msg("~p terminating: ~p~n ", [?MODULE, Reason]), exit(shutdown). -spec system_code_change(state(), module(), term(), term()) -> {'ok', state()}. @@ -242,7 +242,7 @@ handle_call({stick_mod,Mod}, {_From,_Tag}, S) -> handle_call({unstick_mod,Mod}, {_From,_Tag}, S) -> {reply,stick_mod(Mod, false, S),S}; -handle_call({dir,Dir},{_From,_Tag}, S) -> +handle_call({dir,Dir}, {_From,_Tag}, S) -> Root = S#state.root, Resp = do_dir(Root,Dir,S#state.namedb), {reply,Resp,S}; @@ -255,43 +255,47 @@ handle_call({load_file,Mod}, Caller, St) -> load_file(Mod, Caller, St) end; -handle_call({add_path,Where,Dir0}, {_From,_Tag}, S=#state{cache=Cache0}) -> +handle_call({add_path,Where,Dir0}, {_From,_Tag}, + #state{cache=Cache0,namedb=Namedb,path=Path0}=S) -> case Cache0 of no_cache -> - {Resp,Path} = add_path(Where, Dir0, S#state.path, S#state.namedb), + {Resp,Path} = add_path(Where, Dir0, Path0, Namedb), {reply,Resp,S#state{path=Path}}; _ -> Dir = absname(Dir0), %% Cache always expands the path - {Resp,Path} = add_path(Where, Dir, S#state.path, S#state.namedb), - Cache=update_cache([Dir],Where,Cache0), + {Resp,Path} = add_path(Where, Dir, Path0, Namedb), + Cache = update_cache([Dir], Where, Cache0), {reply,Resp,S#state{path=Path,cache=Cache}} end; -handle_call({add_paths,Where,Dirs0}, {_From,_Tag}, S=#state{cache=Cache0}) -> +handle_call({add_paths,Where,Dirs0}, {_From,_Tag}, + #state{cache=Cache0,namedb=Namedb,path=Path0}=S) -> case Cache0 of no_cache -> - {Resp,Path} = add_paths(Where,Dirs0,S#state.path,S#state.namedb), - {reply,Resp, S#state{path=Path}}; + {Resp,Path} = add_paths(Where, Dirs0, Path0, Namedb), + {reply,Resp,S#state{path=Path}}; _ -> %% Cache always expands the path Dirs = [absname(Dir) || Dir <- Dirs0], - {Resp,Path} = add_paths(Where, Dirs, S#state.path, S#state.namedb), + {Resp,Path} = add_paths(Where, Dirs, Path0, Namedb), Cache=update_cache(Dirs,Where,Cache0), {reply,Resp,S#state{cache=Cache,path=Path}} end; -handle_call({set_path,PathList}, {_From,_Tag}, S) -> - Path = S#state.path, - {Resp, NewPath,NewDb} = set_path(PathList, Path, S#state.namedb), - {reply,Resp,rehash_cache(S#state{path = NewPath, namedb=NewDb})}; +handle_call({set_path,PathList}, {_From,_Tag}, + #state{path=Path0,namedb=Namedb}=S) -> + {Resp,Path,NewDb} = set_path(PathList, Path0, Namedb), + {reply,Resp,rehash_cache(S#state{path=Path,namedb=NewDb})}; -handle_call({del_path,Name}, {_From,_Tag}, S) -> - {Resp,Path} = del_path(Name,S#state.path,S#state.namedb), - {reply,Resp,rehash_cache(S#state{path = Path})}; +handle_call({del_path,Name}, {_From,_Tag}, + #state{path=Path0,namedb=Namedb}=S) -> + {Resp,Path} = del_path(Name, Path0, Namedb), + {reply,Resp,rehash_cache(S#state{path=Path})}; -handle_call({replace_path,Name,Dir}, {_From,_Tag}, S) -> - {Resp,Path} = replace_path(Name,Dir,S#state.path,S#state.namedb), - {reply,Resp,rehash_cache(S#state{path = Path})}; +handle_call({replace_path,Name,Dir}, {_From,_Tag}, + #state{path=Path0,namedb=Namedb}=S) -> + {Resp,Path} = replace_path(Name, Dir, Path0, Namedb), + {reply,Resp,rehash_cache(S#state{path=Path})}; handle_call(rehash, {_From,_Tag}, S0) -> S = create_cache(S0), @@ -313,12 +317,12 @@ handle_call({load_binary,Mod,File,Bin}, Caller, S) -> do_load_binary(Mod, File, Bin, Caller, S); handle_call({load_native_partial,Mod,Bin}, {_From,_Tag}, S) -> - Result = (catch hipe_unified_loader:load(Mod,Bin)), + Result = (catch hipe_unified_loader:load(Mod, Bin)), Status = hipe_result_to_status(Result), {reply,Status,S}; handle_call({load_native_sticky,Mod,Bin,WholeModule}, {_From,_Tag}, S) -> - Result = (catch hipe_unified_loader:load_module(Mod,Bin,WholeModule)), + Result = (catch hipe_unified_loader:load_module(Mod, Bin, WholeModule)), Status = hipe_result_to_status(Result), {reply,Status,S}; @@ -390,8 +394,8 @@ handle_call({set_primary_archive, File, ArchiveBin, FileInfo}, {_From,_Tag}, S=# case erl_prim_loader:set_primary_archive(File, ArchiveBin, FileInfo) of {ok, Files} -> {reply, {ok, Mode, Files}, S}; - {error, Reason} -> - {reply, {error, Reason}, S} + {error, _Reason} = Error -> + {reply, Error, S} end; handle_call({is_cached,File}, {_From,_Tag}, S=#state{cache=Cache}) -> @@ -471,8 +475,8 @@ locate_mods([], _, _, Cache, Path) -> filter_mods([File|Rest], Where, Exts, Dir, Cache) -> Ext = filename:extension(File), Root = list_to_atom(filename:rootname(File, Ext)), - case lists:keysearch(Ext, 2, Exts) of - {value,{Type,_}} -> + case lists:keyfind(Ext, 2, Exts) of + {Type, _} -> Key = {Type,Root}, case Where of first -> @@ -489,7 +493,6 @@ filter_mods([File|Rest], Where, Exts, Dir, Cache) -> ok end, filter_mods(Rest, Where, Exts, Dir, Cache); - filter_mods([], _, _, _, Cache) -> Cache. @@ -500,27 +503,27 @@ filter_mods([], _, _, _, Cache) -> %% %% Create the initial path. %% -make_path(BundleDir,Bundles0) -> +make_path(BundleDir, Bundles0) -> Bundles = choose_bundles(Bundles0), - make_path(BundleDir,Bundles,[],[]). + make_path(BundleDir, Bundles, [], []). choose_bundles(Bundles) -> ArchiveExt = archive_extension(), - Bs = lists:sort([create_bundle(B,ArchiveExt) || B <- Bundles]), + Bs = lists:sort([create_bundle(B, ArchiveExt) || B <- Bundles]), [FullName || {_Name,_NumVsn,FullName} <- choose(lists:reverse(Bs), [], ArchiveExt)]. -create_bundle(FullName,ArchiveExt) -> - BaseName = filename:basename(FullName,ArchiveExt), +create_bundle(FullName, ArchiveExt) -> + BaseName = filename:basename(FullName, ArchiveExt), case split(BaseName, "-") of - Toks when length(Toks) > 1 -> + [_, _|_] = Toks -> VsnStr = lists:last(Toks), case vsn_to_num(VsnStr) of {ok, VsnNum} -> - Name = join(lists:sublist(Toks,length(Toks)-1),"-"), + Name = join(lists:sublist(Toks, length(Toks)-1),"-"), {Name,VsnNum,FullName}; false -> - {FullName, [0], FullName} + {FullName,[0],FullName} end; _ -> {FullName,[0],FullName} @@ -571,8 +574,8 @@ join([], _) -> []. choose([{Name,NumVsn,NewFullName}=New|Bs], Acc, ArchiveExt) -> - case lists:keysearch(Name,1,Acc) of - {value, {_, NV, OldFullName}} when NV =:= NumVsn -> + case lists:keyfind(Name, 1, Acc) of + {_, NV, OldFullName} when NV =:= NumVsn -> case filename:extension(OldFullName) =:= ArchiveExt of false -> choose(Bs,Acc, ArchiveExt); @@ -580,7 +583,7 @@ choose([{Name,NumVsn,NewFullName}=New|Bs], Acc, ArchiveExt) -> Acc2 = lists:keystore(Name, 1, Acc, New), choose(Bs,Acc2, ArchiveExt) end; - {value, {_, _, _}} -> + {_, _, _} -> choose(Bs,Acc, ArchiveExt); false -> choose(Bs,[{Name,NumVsn,NewFullName}|Acc], ArchiveExt) @@ -604,8 +607,8 @@ make_path(BundleDir,[Bundle|Tail],Res,Bs) -> Ebin2 = filename:join([filename:dirname(Dir), Base ++ Ext, Base, "ebin"]), Ebins = case split(Base, "-") of - Toks when length(Toks) > 1 -> - AppName = join(lists:sublist(Toks,length(Toks)-1),"-"), + [_, _|_] = Toks -> + AppName = join(lists:sublist(Toks, length(Toks)-1),"-"), Ebin3 = filename:join([filename:dirname(Dir), Base ++ Ext, AppName, "ebin"]), [Ebin3, Ebin2, Dir]; _ -> @@ -837,30 +840,25 @@ add_path(_,_,Path,_) -> %% then the table is created :-) %% do_add(first,Dir,Path,NameDb) -> - update(Dir,NameDb), + update(Dir, NameDb), [Dir|lists:delete(Dir,Path)]; do_add(last,Dir,Path,NameDb) -> case lists:member(Dir,Path) of true -> Path; false -> - maybe_update(Dir,NameDb), + maybe_update(Dir, NameDb), Path ++ [Dir] end. %% Do not update if the same name already exists ! -maybe_update(Dir,NameDb) -> - case lookup_name(get_name(Dir),NameDb) of - false -> update(Dir,NameDb); - _ -> false - end. +maybe_update(Dir, NameDb) -> + (lookup_name(get_name(Dir), NameDb) =:= false) andalso update(Dir, NameDb). update(_Dir, false) -> - ok; -update(Dir,NameDb) -> - replace_name(Dir,NameDb). - - + true; +update(Dir, NameDb) -> + replace_name(Dir, NameDb). %% %% Set a completely new path. @@ -948,8 +946,8 @@ all_archive_subdirs(AppDir) -> Base = filename:basename(AppDir), Dirs = case split(Base, "-") of - Toks when length(Toks) > 1 -> - Base2 = join(lists:sublist(Toks,length(Toks)-1),"-"), + [_, _|_] = Toks -> + Base2 = join(lists:sublist(Toks, length(Toks)-1), "-"), [Base2, Base]; _ -> [Base] @@ -1062,7 +1060,6 @@ check_pars(Name,Dir) -> {error,bad_name} end. - del_ebin(Dir) -> case filename:basename(Dir) of "ebin" -> @@ -1081,8 +1078,6 @@ del_ebin(Dir) -> Dir end. - - replace_name(Dir, Db) -> case get_name(Dir) of Dir -> @@ -1189,15 +1184,7 @@ get_mods([File|Tail], Extension) -> get_mods([], _) -> []. is_sticky(Mod, Db) -> - case erlang:module_loaded(Mod) of - true -> - case ets:lookup(Db, {sticky,Mod}) of - [] -> false; - _ -> true - end; - false -> - false - end. + erlang:module_loaded(Mod) andalso (ets:lookup(Db, {sticky, Mod}) =/= []). add_paths(Where,[Dir|Tail],Path,NameDb) -> {_,NPath} = add_path(Where,Dir,Path,NameDb), @@ -1205,7 +1192,6 @@ add_paths(Where,[Dir|Tail],Path,NameDb) -> add_paths(_,_,Path,_) -> {ok,Path}. - do_load_binary(Module, File, Binary, Caller, St) -> case modp(Module) andalso modp(File) andalso is_binary(Binary) of true -> @@ -1222,7 +1208,6 @@ modp(Atom) when is_atom(Atom) -> true; modp(List) when is_list(List) -> int_list(List); modp(_) -> false. - load_abs(File, Mod0, Caller, St) -> Ext = objfile_extension(), FileName0 = lists:concat([File, Ext]), @@ -1265,20 +1250,20 @@ try_load_module_1(File, Mod, Bin, Caller, #state{moddb=Db}=St) -> {reply,{error,sticky_directory},St}; false -> case catch load_native_code(Mod, Bin) of - {module,Mod} -> + {module,Mod} = Module -> ets:insert(Db, {Mod,File}), - {reply,{module,Mod},St}; + {reply,Module,St}; no_native -> case erlang:load_module(Mod, Bin) of - {module,Mod} -> + {module,Mod} = Module -> ets:insert(Db, {Mod,File}), post_beam_load(Mod), - {reply,{module,Mod},St}; + {reply,Module,St}; {error,on_load} -> handle_on_load(Mod, File, Caller, St); - {error,What} -> + {error,What} = Error -> error_msg("Loading of ~s failed: ~p\n", [File, What]), - {reply,{error,What},St} + {reply,Error,St} end; Error -> error_msg("Native loading of ~s failed: ~p\n", diff --git a/lib/kernel/src/erl_boot_server.erl b/lib/kernel/src/erl_boot_server.erl index c5a4305731..b4c5f5e27c 100644 --- a/lib/kernel/src/erl_boot_server.erl +++ b/lib/kernel/src/erl_boot_server.erl @@ -179,15 +179,15 @@ init(Slaves) -> Pid ! {Ref, L}, %% We trap exit inorder to restart boot_init and udp_port process_flag(trap_exit, true), - {ok, #state {priority = 0, - version = erlang:system_info(version), - udp_sock = U, - udp_port = UPort, - listen_sock = L, - listen_port = Port, - slaves = ordsets:from_list(Slaves), - bootp = Pid - }}. + {ok, #state{priority = 0, + version = erlang:system_info(version), + udp_sock = U, + udp_port = UPort, + listen_sock = L, + listen_port = Port, + slaves = ordsets:from_list(Slaves), + bootp = Pid + }}. -spec handle_call('which' | {'add',atom()} | {'delete',atom()}, _, state()) -> {'reply', 'ok' | [atom()], state()}. diff --git a/lib/kernel/src/erl_epmd.erl b/lib/kernel/src/erl_epmd.erl index c4ff4c7281..4a22637304 100644 --- a/lib/kernel/src/erl_epmd.erl +++ b/lib/kernel/src/erl_epmd.erl @@ -141,8 +141,8 @@ handle_call({register, Name, PortNo}, _From, State) -> end; handle_call(client_info_req, _From, State) -> - Reply = {ok,{r4,State#state.name,State#state.port_no}}, - {reply,Reply,State}; + Reply = {ok,{r4,State#state.name,State#state.port_no}}, + {reply, Reply, State}; handle_call(stop, _From, State) -> {stop, shutdown, ok, State}. diff --git a/lib/kernel/src/error_handler.erl b/lib/kernel/src/error_handler.erl index 5f2507fc08..17dd02acd4 100644 --- a/lib/kernel/src/error_handler.erl +++ b/lib/kernel/src/error_handler.erl @@ -1,19 +1,19 @@ %% %% %CopyrightBegin% -%% -%% Copyright Ericsson AB 1996-2009. All Rights Reserved. -%% +%% +%% Copyright Ericsson AB 1996-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% %% -module(error_handler). @@ -117,13 +117,13 @@ stub_function(Mod, Func, Args) -> check_inheritance(Module, Args) -> Attrs = erlang:get_module_info(Module, attributes), - case lists:keysearch(extends, 1, Attrs) of - {value,{extends,[Base]}} when is_atom(Base), Base =/= Module -> + case lists:keyfind(extends, 1, Attrs) of + {extends, [Base]} when is_atom(Base), Base =/= Module -> %% This is just a heuristic for detecting abstract modules %% with inheritance so they can be handled; it would be %% much better to do it in the emulator runtime - case lists:keysearch(abstract, 1, Attrs) of - {value,{abstract,[true]}} -> + case lists:keyfind(abstract, 1, Attrs) of + {abstract, [true]} -> case lists:reverse(Args) of [M|Rs] when tuple_size(M) > 1, element(1,M) =:= Module, diff --git a/lib/kernel/src/file.erl b/lib/kernel/src/file.erl index 46ffa9d708..a694ed0708 100644 --- a/lib/kernel/src/file.erl +++ b/lib/kernel/src/file.erl @@ -36,11 +36,11 @@ %% Specialized -export([ipread_s32bu_p32bu/3]). %% Generic file contents. --export([open/2, close/1, +-export([open/2, close/1, advise/4, read/2, write/2, pread/2, pread/3, pwrite/2, pwrite/3, read_line/1, - position/2, truncate/1, sync/1, + position/2, truncate/1, datasync/1, sync/1, copy/2, copy/3]). %% High level operations -export([consult/1, path_consult/2]). @@ -89,6 +89,8 @@ -type date() :: {pos_integer(), pos_integer(), pos_integer()}. -type time() :: {non_neg_integer(), non_neg_integer(), non_neg_integer()}. -type date_time() :: {date(), time()}. +-type posix_file_advise() :: 'normal' | 'sequential' | 'random' | 'no_reuse' | + 'will_need' | 'dont_need'. %%%----------------------------------------------------------------- %%% General functions @@ -352,6 +354,18 @@ close(#file_descriptor{module = Module} = Handle) -> close(_) -> {error, badarg}. +-spec advise(File :: io_device(), Offset :: integer(), + Length :: integer(), Advise :: posix_file_advise()) -> + 'ok' | {'error', posix()}. + +advise(File, Offset, Length, Advise) when is_pid(File) -> + R = file_request(File, {advise, Offset, Length, Advise}), + wait_file_reply(File, R); +advise(#file_descriptor{module = Module} = Handle, Offset, Length, Advise) -> + Module:advise(Handle, Offset, Length, Advise); +advise(_, _, _, _) -> + {error, badarg}. + -spec read(File :: io_device(), Size :: non_neg_integer()) -> 'eof' | {'ok', [char()] | binary()} | {'error', posix()}. @@ -472,6 +486,16 @@ pwrite(#file_descriptor{module = Module} = Handle, Offs, Bytes) -> pwrite(_, _, _) -> {error, badarg}. +-spec datasync(File :: io_device()) -> 'ok' | {'error', posix()}. + +datasync(File) when is_pid(File) -> + R = file_request(File, datasync), + wait_file_reply(File, R); +datasync(#file_descriptor{module = Module} = Handle) -> + Module:datasync(Handle); +datasync(_) -> + {error, badarg}. + -spec sync(File :: io_device()) -> 'ok' | {'error', posix()}. sync(File) when is_pid(File) -> diff --git a/lib/kernel/src/file_io_server.erl b/lib/kernel/src/file_io_server.erl index 37e803c493..39dc32bb79 100644 --- a/lib/kernel/src/file_io_server.erl +++ b/lib/kernel/src/file_io_server.erl @@ -1,19 +1,19 @@ %% %% %CopyrightBegin% -%% -%% Copyright Ericsson AB 2000-2009. All Rights Reserved. -%% +%% +%% Copyright Ericsson AB 2000-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% %% -module(file_io_server). @@ -106,21 +106,21 @@ do_start(Spawn, Owner, FileName, ModeList) -> parse_options(List) -> parse_options(expand_encoding(List), list, latin1, []). -parse_options([],list,Uni,Acc) -> +parse_options([], list, Uni, Acc) -> {list,Uni,[binary|lists:reverse(Acc)]}; -parse_options([],binary,Uni,Acc) -> +parse_options([], binary, Uni, Acc) -> {binary,Uni,lists:reverse(Acc)}; -parse_options([{encoding, Encoding}|T],RMode,_,Acc) -> +parse_options([{encoding, Encoding}|T], RMode, _, Acc) -> case valid_enc(Encoding) of {ok, ExpandedEnc} -> - parse_options(T,RMode,ExpandedEnc,Acc); - {error,Reason} -> - {error,Reason} + parse_options(T, RMode, ExpandedEnc, Acc); + {error,_Reason} = Error -> + Error end; -parse_options([binary|T],_,Uni,Acc) -> - parse_options(T,binary,Uni,[binary|Acc]); -parse_options([H|T],R,U,Acc) -> - parse_options(T,R,U,[H|Acc]). +parse_options([binary|T], _, Uni, Acc) -> + parse_options(T, binary, Uni, [binary|Acc]); +parse_options([H|T], R, U, Acc) -> + parse_options(T, R, U, [H|Acc]). expand_encoding([]) -> []; @@ -153,7 +153,6 @@ valid_enc(_Other) -> {error,badarg}. - server_loop(#state{mref = Mref} = State) -> receive {file_request, From, ReplyAs, Request} when is_pid(From) -> @@ -199,6 +198,14 @@ io_reply(From, ReplyAs, Reply) -> %%%----------------------------------------------------------------- %%% file requests +file_request({advise,Offset,Length,Advise}, + #state{handle=Handle}=State) -> + case ?PRIM_FILE:advise(Handle, Offset, Length, Advise) of + {error,_}=Reply -> + {stop,normal,Reply,State}; + Reply -> + {reply,Reply,State} + end; file_request({pread,At,Sz}, #state{handle=Handle,buf=Buf,read_mode=ReadMode}=State) -> case position(Handle, At, Buf) of @@ -220,6 +227,14 @@ file_request({pwrite,At,Data}, Reply -> std_reply(Reply, State) end; +file_request(datasync, + #state{handle=Handle}=State) -> + case ?PRIM_FILE:datasync(Handle) of + {error,_}=Reply -> + {stop,normal,Reply,State}; + Reply -> + {reply,Reply,State} + end; file_request(sync, #state{handle=Handle}=State) -> case ?PRIM_FILE:sync(Handle) of @@ -326,7 +341,6 @@ io_request(Unknown, {error,{error,Reason},State}. - %% Process a list of requests as long as the results are ok. io_request_loop([], Result) -> @@ -342,7 +356,6 @@ io_request_loop([Request|Tail], io_request_loop(Tail, io_request(Request, State)). - %% I/O request put_chars %% put_chars(Chars, latin1, #state{handle=Handle, unic=latin1}=State) -> @@ -653,20 +666,14 @@ do_setopts(Opts, State) -> end. getopts(#state{read_mode=RM, unic=Unic} = State) -> - Bin = {binary, case RM of - binary -> - true; - _ -> - false - end}, + Bin = {binary, RM =:= binary}, Uni = {encoding, Unic}, {reply,[Bin,Uni],State}. - %% Concatenate two binaries and convert the result to list or binary -cat(B1, B2, binary,latin1,latin1) -> +cat(B1, B2, binary, latin1, latin1) -> list_to_binary([B1,B2]); -cat(B1, B2, binary,InEncoding,OutEncoding) -> +cat(B1, B2, binary, InEncoding, OutEncoding) -> case unicode:characters_to_binary([B1,B2],InEncoding,OutEncoding) of Good when is_binary(Good) -> Good; diff --git a/lib/kernel/src/group.erl b/lib/kernel/src/group.erl index a45ba34eae..f92c6f7208 100644 --- a/lib/kernel/src/group.erl +++ b/lib/kernel/src/group.erl @@ -1,19 +1,19 @@ %% %% %CopyrightBegin% -%% -%% Copyright Ericsson AB 1996-2009. All Rights Reserved. -%% +%% +%% Copyright Ericsson AB 1996-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% %% -module(group). @@ -477,15 +477,15 @@ get_line(Chars, Pbs, Drv, Encoding) -> get_line1(edlin:edit_line(Chars, Cont), Drv, new_stack(get(line_buffer)), Encoding). -get_line1({done,Line,Rest,Rs}, Drv, _Ls, _Encoding) -> +get_line1({done,Line,Rest,Rs}, Drv, Ls, _Encoding) -> send_drv_reqs(Drv, Rs), - put(line_buffer, [Line|lists:delete(Line, get(line_buffer))]), + save_line_buffer(Line, get_lines(Ls)), {done,Line,Rest}; get_line1({undefined,{_A,Mode,Char},Cs,Cont,Rs}, Drv, Ls0, Encoding) when ((Mode =:= none) and (Char =:= $\^P)) or ((Mode =:= meta_left_sq_bracket) and (Char =:= $A)) -> send_drv_reqs(Drv, Rs), - case up_stack(Ls0) of + case up_stack(save_line(Ls0, edlin:current_line(Cont))) of {none,_Ls} -> send_drv(Drv, beep), get_line1(edlin:edit_line(Cs, Cont), Drv, Ls0, Encoding); @@ -498,14 +498,14 @@ get_line1({undefined,{_A,Mode,Char},Cs,Cont,Rs}, Drv, Ls0, Encoding) Drv, Ls, Encoding) end; -get_line1({undefined,{_A,Mode,Char},_Cs,Cont,Rs}, Drv, Ls0, Encoding) +get_line1({undefined,{_A,Mode,Char},Cs,Cont,Rs}, Drv, Ls0, Encoding) when ((Mode =:= none) and (Char =:= $\^N)) or ((Mode =:= meta_left_sq_bracket) and (Char =:= $B)) -> send_drv_reqs(Drv, Rs), - case down_stack(Ls0) of - {none,Ls} -> - send_drv_reqs(Drv, edlin:erase_line(Cont)), - get_line1(edlin:start(edlin:prompt(Cont)), Drv, Ls, Encoding); + case down_stack(save_line(Ls0, edlin:current_line(Cont))) of + {none,_Ls} -> + send_drv(Drv, beep), + get_line1(edlin:edit_line(Cs, Cont), Drv, Ls0, Encoding); {Lcs,Ls} -> send_drv_reqs(Drv, edlin:erase_line(Cont)), {more_chars,Ncont,Nrs} = edlin:start(edlin:prompt(Cont)), @@ -627,6 +627,28 @@ down_stack({stack,U,{},[]}) -> down_stack({stack,U,C,D}) -> down_stack({stack,[C|U],{},D}). +save_line({stack, U, {}, []}, Line) -> + {stack, U, {}, [Line]}; +save_line({stack, U, _L, D}, Line) -> + {stack, U, Line, D}. + +get_lines({stack, U, {}, []}) -> + U; +get_lines({stack, U, {}, D}) -> + tl(lists:reverse(D, U)); +get_lines({stack, U, L, D}) -> + get_lines({stack, U, {}, [L|D]}). + +save_line_buffer("\n", Lines) -> + save_line_buffer(Lines); +save_line_buffer(Line, [Line|_Lines]=Lines) -> + save_line_buffer(Lines); +save_line_buffer(Line, Lines) -> + save_line_buffer([Line|Lines]). + +save_line_buffer(Lines) -> + put(line_buffer, Lines). + %% This is get_line without line editing (except for backspace) and %% without echo. get_password_line(Chars, Drv) -> diff --git a/lib/kernel/src/heart.erl b/lib/kernel/src/heart.erl index bad0950fca..e78acfc7a6 100644 --- a/lib/kernel/src/heart.erl +++ b/lib/kernel/src/heart.erl @@ -1,19 +1,19 @@ %% %% %CopyrightBegin% -%% -%% Copyright Ericsson AB 1996-2009. All Rights Reserved. -%% +%% +%% Copyright Ericsson AB 1996-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% %% -module(heart). @@ -61,8 +61,8 @@ start() -> wait_for_init_ack(From) -> receive - {ok, From} -> - {ok, From}; + {ok, From} = Ok -> + Ok; {no_heart, From} -> ignore; {Error, From} -> @@ -119,8 +119,7 @@ wait() -> start_portprogram() -> check_start_heart(), - HeartCmd = "heart -pid " ++ os:getpid() ++ " " ++ - get_heart_timeouts(), + HeartCmd = "heart -pid " ++ os:getpid() ++ " " ++ get_heart_timeouts(), try open_port({spawn, HeartCmd}, [{packet, 2}]) of Port when is_port(Port) -> case wait_ack(Port) of @@ -175,7 +174,7 @@ wait_ack(Port) -> loop(Parent, Port, Cmd) -> send_heart_beat(Port), receive - {From, set_cmd, NewCmd} when is_list(NewCmd), length(NewCmd) < 2047 -> + {From, set_cmd, NewCmd} when length(NewCmd) < 2047 -> send_heart_cmd(Port, NewCmd), wait_ack(Port), From ! {heart, ok}, diff --git a/lib/kernel/src/inet_db.erl b/lib/kernel/src/inet_db.erl index ec95620cc0..d4749b9756 100644 --- a/lib/kernel/src/inet_db.erl +++ b/lib/kernel/src/inet_db.erl @@ -102,14 +102,14 @@ start() -> case gen_server:start({local, inet_db}, inet_db, [], []) of - {ok,Pid} -> inet_config:init(), {ok,Pid}; + {ok, _Pid}=Ok -> inet_config:init(), Ok; Error -> Error end. start_link() -> case gen_server:start_link({local, inet_db}, inet_db, [], []) of - {ok,Pid} -> inet_config:init(), {ok,Pid}; + {ok, _Pid}=Ok -> inet_config:init(), Ok; Error -> Error end. @@ -140,7 +140,6 @@ add_hosts(File) -> Error -> Error end. - add_host(IP, Names) -> call({add_host, IP, Names}). del_host(IP) -> call({del_host, IP}). @@ -482,10 +481,7 @@ res_check_option_absfile(F) -> res_check_list([], _Fun) -> true; res_check_list([H|T], Fun) -> - case Fun(H) of - true -> res_check_list(T, Fun); - false -> false - end; + Fun(H) andalso res_check_list(T, Fun); res_check_list(_, _Fun) -> false. res_check_ns({{A,B,C,D,E,F,G,H}, Port}) @@ -497,12 +493,12 @@ res_check_ns(_) -> false. res_check_search("") -> true; res_check_search(Dom) -> inet_parse:visible_string(Dom). -socks_option(server) -> db_get(socks5_server); -socks_option(port) -> db_get(socks5_port); -socks_option(methods) -> db_get(socks5_methods); -socks_option(noproxy) -> db_get(socks5_noproxy). +socks_option(server) -> db_get(socks5_server); +socks_option(port) -> db_get(socks5_port); +socks_option(methods) -> db_get(socks5_methods); +socks_option(noproxy) -> db_get(socks5_noproxy). -gethostname() -> db_get(hostname). +gethostname() -> db_get(hostname). res_update_conf() -> res_update(res_resolv_conf, res_resolv_conf_tm, res_resolv_conf_info, @@ -591,15 +587,13 @@ getbyname(Name, Type) -> getbysearch(Name, Dot, [Dom | Ds], Type, _) -> case hostent_by_domain(Name ++ Dot ++ Dom, Type) of - {ok, HEnt} -> {ok, HEnt}; - Error -> - getbysearch(Name, Dot, Ds, Type, Error) + {ok, _HEnt}=Ok -> Ok; + Error -> getbysearch(Name, Dot, Ds, Type, Error) end; getbysearch(_Name, _Dot, [], _Type, Error) -> Error. - %% %% get_searchlist %% @@ -610,7 +604,6 @@ get_searchlist() -> end. - make_hostent(Name, Addrs, Aliases, ?S_A) -> #hostent { h_name = Name, @@ -1146,7 +1139,6 @@ handle_call(Request, From, #state{db=Db}=State) -> {reply, error, State} end. - %%---------------------------------------------------------------------- %% Func: handle_cast/2 %% Returns: {noreply, State} | @@ -1359,16 +1351,15 @@ do_add_rr(RR, Db, State) -> TM = times(), case alloc_entry(Db, CacheDb, TM) of true -> - cache_rr(Db, CacheDb, RR#dns_rr { tm = TM, - cnt = TM }); + cache_rr(Db, CacheDb, RR#dns_rr{tm = TM, cnt = TM}); _ -> false end. cache_rr(_Db, Cache, RR) -> %% delete possible old entry - ets:match_delete(Cache, RR#dns_rr { cnt = '_', tm = '_', ttl = '_', - bm = '_', func = '_'}), + ets:match_delete(Cache, RR#dns_rr{cnt = '_', tm = '_', ttl = '_', + bm = '_', func = '_'}), ets:insert(Cache, RR). times() -> @@ -1378,9 +1369,9 @@ times() -> %% lookup and remove old entries do_lookup_rr(Domain, Class, Type) -> - match_rr(#dns_rr { domain = tolower(Domain), class = Class,type = Type, - cnt = '_', tm = '_', ttl = '_', - bm = '_', func = '_', data = '_'}). + match_rr(#dns_rr{domain = tolower(Domain), class = Class,type = Type, + cnt = '_', tm = '_', ttl = '_', + bm = '_', func = '_', data = '_'}). match_rr(RR) -> filter_rr(ets:match_object(inet_cache, RR), times()). @@ -1431,7 +1422,7 @@ dn_in_addr_arpa(A,B,C,D) -> integer_to_list(A) ++ ".in-addr.arpa". dnib(X) -> - [ hex(X), $., hex(X bsr 4), $., hex(X bsr 8), $., hex(X bsr 12), $.]. + [hex(X), $., hex(X bsr 4), $., hex(X bsr 8), $., hex(X bsr 12), $.]. hex(X) -> X4 = (X band 16#f), @@ -1526,12 +1517,7 @@ alloc_entry(CacheDb, OldSize, TM, N) -> delete_n_oldest(CacheDb, TM, OldestTM, N) -> DelTM = trunc((TM - OldestTM) * 0.3) + OldestTM, - case delete_older(CacheDb, DelTM, N) of - 0 -> - false; - _ -> - true - end. + delete_older(CacheDb, DelTM, N) =/= 0. %% Delete entries with latest access time older than TM. %% Delete max N number of entries. diff --git a/lib/kernel/src/inet_gethost_native.erl b/lib/kernel/src/inet_gethost_native.erl index b7b3007b99..db3e44ce6f 100644 --- a/lib/kernel/src/inet_gethost_native.erl +++ b/lib/kernel/src/inet_gethost_native.erl @@ -154,7 +154,7 @@ run_once() -> {Port, {data, <<1:32, BinReply/binary>>}} -> Pid ! {R, {ok, BinReply}} after Timeout -> - Pid ! {R,{error,timeout}} + Pid ! {R, {error, timeout}} end. -spec terminate(term(), pid()) -> 'ok'. @@ -342,14 +342,14 @@ pick_client(State,RID,Clid) -> {last, SoleClient}; % Note, not removed, the caller % should cleanup request data CList -> - case lists:keysearch(Clid,1,CList) of - {value, Client} -> + case lists:keyfind(Clid,1,CList) of + false -> + false; + Client -> NCList = lists:keydelete(Clid,1,CList), ets:insert(State#state.requests, R#request{clients = NCList}), - {more, Client}; - false -> - false + {more, Client} end end end. @@ -387,8 +387,7 @@ restart_port(#state{port = Port, requests = Requests}) -> end, Requests), NewPort. - - + do_open_port(Poolsize, ExtraArgs) -> try diff --git a/lib/kernel/src/kernel_config.erl b/lib/kernel/src/kernel_config.erl index cdad354876..b1daf655c9 100644 --- a/lib/kernel/src/kernel_config.erl +++ b/lib/kernel/src/kernel_config.erl @@ -92,9 +92,9 @@ code_change(_OldVsn, State, _Extra) -> %%----------------------------------------------------------------- sync_nodes() -> case catch get_sync_data() of - {error, Reason} -> + {error, Reason} = Error -> error_logger:format("~p", [Reason]), - {error, Reason}; + Error; {infinity, MandatoryNodes, OptionalNodes} -> case wait_nodes(MandatoryNodes, OptionalNodes) of ok -> diff --git a/lib/kernel/src/ram_file.erl b/lib/kernel/src/ram_file.erl index d996650948..48ea871433 100644 --- a/lib/kernel/src/ram_file.erl +++ b/lib/kernel/src/ram_file.erl @@ -1,19 +1,19 @@ %% %% %CopyrightBegin% -%% -%% Copyright Ericsson AB 1997-2009. All Rights Reserved. -%% +%% +%% Copyright Ericsson AB 1997-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% %% -module(ram_file). @@ -24,11 +24,11 @@ -export([open/2, close/1]). -export([write/2, read/2, copy/3, pread/2, pread/3, pwrite/2, pwrite/3, - position/2, truncate/1, sync/1]). + position/2, truncate/1, datasync/1, sync/1]). %% Specialized file operations -export([get_size/1, get_file/1, set_file/2, get_file_close/1]). --export([compress/1, uncompress/1, uuencode/1, uudecode/1]). +-export([compress/1, uncompress/1, uuencode/1, uudecode/1, advise/4]). -export([open_mode/1]). %% used by ftp-file @@ -60,6 +60,7 @@ -define(RAM_FILE_TRUNCATE, 14). -define(RAM_FILE_PREAD, 17). -define(RAM_FILE_PWRITE, 18). +-define(RAM_FILE_FDATASYNC, 19). %% Other operations -define(RAM_FILE_GET, 30). @@ -70,6 +71,7 @@ -define(RAM_FILE_UUENCODE, 35). -define(RAM_FILE_UUDECODE, 36). -define(RAM_FILE_SIZE, 37). +-define(RAM_FILE_ADVISE, 38). %% Open modes for RAM_FILE_OPEN -define(RAM_FILE_MODE_READ, 1). @@ -90,6 +92,14 @@ -define(RAM_FILE_RESP_NUMBER, 3). -define(RAM_FILE_RESP_INFO, 4). +%% POSIX file advises +-define(POSIX_FADV_NORMAL, 0). +-define(POSIX_FADV_RANDOM, 1). +-define(POSIX_FADV_SEQUENTIAL, 2). +-define(POSIX_FADV_WILLNEED, 3). +-define(POSIX_FADV_DONTNEED, 4). +-define(POSIX_FADV_NOREUSE, 5). + %% -------------------------------------------------------------------------- %% Generic file contents operations. %% @@ -167,6 +177,8 @@ copy(#file_descriptor{module = ?MODULE} = Source, %% XXX Should be moved down to the driver for optimization. file:copy_opened(Source, Dest, Length). +datasync(#file_descriptor{module = ?MODULE, data = Port}) -> + call_port(Port, <<?RAM_FILE_FDATASYNC>>). sync(#file_descriptor{module = ?MODULE, data = Port}) -> call_port(Port, <<?RAM_FILE_FSYNC>>). @@ -349,6 +361,28 @@ uudecode(#file_descriptor{module = ?MODULE, data = Port}) -> uudecode(#file_descriptor{}) -> {error, enotsup}. +advise(#file_descriptor{module = ?MODULE, data = Port}, Offset, + Length, Advise) -> + Cmd0 = <<?RAM_FILE_ADVISE, Offset:64/signed, Length:64/signed>>, + case Advise of + normal -> + call_port(Port, <<Cmd0/binary, ?POSIX_FADV_NORMAL:32/signed>>); + random -> + call_port(Port, <<Cmd0/binary, ?POSIX_FADV_RANDOM:32/signed>>); + sequential -> + call_port(Port, <<Cmd0/binary, ?POSIX_FADV_SEQUENTIAL:32/signed>>); + will_need -> + call_port(Port, <<Cmd0/binary, ?POSIX_FADV_WILLNEED:32/signed>>); + dont_need -> + call_port(Port, <<Cmd0/binary, ?POSIX_FADV_DONTNEED:32/signed>>); + no_reuse -> + call_port(Port, <<Cmd0/binary, ?POSIX_FADV_NOREUSE:32/signed>>); + _ -> + {error, einval} + end; +advise(#file_descriptor{}, _Offset, _Length, _Advise) -> + {error, enotsup}. + %%%----------------------------------------------------------------- diff --git a/lib/kernel/src/rpc.erl b/lib/kernel/src/rpc.erl index 43a987f313..e09acb5024 100644 --- a/lib/kernel/src/rpc.erl +++ b/lib/kernel/src/rpc.erl @@ -56,7 +56,7 @@ -export([safe_multi_server_call/2,safe_multi_server_call/3]). %% gen_server exports --export([init/1,handle_call/3,handle_cast/2,handle_info/2, +-export([init/1, handle_call/3, handle_cast/2, handle_info/2, terminate/2, code_change/3]). %% Internals @@ -73,12 +73,12 @@ -spec start() -> {'ok', pid()} | 'ignore' | {'error', term()}. start() -> - gen_server:start({local,?NAME},?MODULE,[],[]). + gen_server:start({local,?NAME}, ?MODULE, [], []). -spec start_link() -> {'ok', pid()} | 'ignore' | {'error', term()}. start_link() -> - gen_server:start_link({local,?NAME},?MODULE,[],[]). + gen_server:start_link({local,?NAME}, ?MODULE, [], []). -spec stop() -> term(). @@ -121,12 +121,11 @@ handle_call(_, _To, S) -> -spec handle_cast(term(), state()) -> {'noreply', state()}. handle_cast({cast, Mod, Fun, Args, Gleader}, S) -> - spawn( - fun() -> - set_group_leader(Gleader), - apply(Mod, Fun, Args) - end), - {noreply, S}; + spawn(fun() -> + set_group_leader(Gleader), + apply(Mod, Fun, Args) + end), + {noreply, S}; handle_cast(_, S) -> {noreply, S}. % Ignore ! @@ -163,7 +162,7 @@ handle_info({From, {sbcast, Name, Msg}}, S) -> _ -> From ! {?NAME, node(), node()} end, - {noreply,S}; + {noreply, S}; handle_info({From, {send, Name, Msg}}, S) -> case catch Name ! {From, Msg} of %% use catch to get the printout {'EXIT', _} -> @@ -171,12 +170,12 @@ handle_info({From, {send, Name, Msg}}, S) -> _ -> ok %% It's up to Name to respond !!!!! end, - {noreply,S}; + {noreply, S}; handle_info({From, {call,Mod,Fun,Args,Gleader}}, S) -> %% Special for hidden C node's, uugh ... handle_call_call(Mod, Fun, Args, Gleader, {From,?NAME}, S); handle_info(_, S) -> - {noreply,S}. + {noreply, S}. -spec terminate(term(), state()) -> 'ok'. @@ -231,7 +230,7 @@ proxy_user() -> case whereis(rex_proxy_user) of Pid when is_pid(Pid) -> Pid; undefined -> - Pid = spawn(fun()-> proxy_user_loop() end), + Pid = spawn(fun() -> proxy_user_loop() end), try register(rex_proxy_user,Pid) of true -> Pid catch error:_ -> % spawn race, kill and try again diff --git a/lib/kernel/src/standard_error.erl b/lib/kernel/src/standard_error.erl index 98a44d1ee9..e41dcd01fc 100644 --- a/lib/kernel/src/standard_error.erl +++ b/lib/kernel/src/standard_error.erl @@ -24,8 +24,6 @@ -define(NAME, standard_error). -define(PROCNAME_SUP, standard_error_sup). -%% Internal exports --export([server/1, server/2]). %% Defines for control ops -define(CTRL_OP_GET_WINSIZE,100). @@ -54,18 +52,11 @@ init([]) -> {error,no_stderror} end. - start_port(PortSettings) -> - Id = spawn(?MODULE,server,[{fd,2,2},PortSettings]), - register(?NAME,Id), + Id = spawn(fun () -> server({fd,2,2}, PortSettings) end), + register(?NAME, Id), Id. - -server(Pid) when is_pid(Pid) -> - process_flag(trap_exit, true), - link(Pid), - run(Pid). - server(PortName,PortSettings) -> process_flag(trap_exit, true), Port = open_port(PortName,PortSettings), @@ -88,17 +79,15 @@ server_loop(Port) -> server_loop(Port) end. - get_fd_geometry(Port) -> case (catch port_control(Port,?CTRL_OP_GET_WINSIZE,[])) of - List when is_list(List), length(List) =:= 8 -> + List when length(List) =:= 8 -> <<W:32/native,H:32/native>> = list_to_binary(List), {W,H}; _ -> error end. - %% NewSaveBuffer = io_request(Request, FromPid, ReplyAs, Port, SaveBuffer) do_io_request(Req, From, ReplyAs, Port) -> @@ -227,12 +216,7 @@ do_setopts(Opts, _Port) -> {ok,ok}. getopts(_Port) -> - Uni = {unicode, case get(unicode) of - true -> - true; - _ -> - false - end}, + Uni = {unicode, get(unicode) =:= true}, {ok,[Uni]}. wrap_characters_to_binary(Chars,From,To) -> diff --git a/lib/kernel/src/user.erl b/lib/kernel/src/user.erl index 17dc5a56a2..88f32df20b 100644 --- a/lib/kernel/src/user.erl +++ b/lib/kernel/src/user.erl @@ -26,9 +26,6 @@ -define(NAME, user). -%% Internal exports --export([server/1, server/2]). - %% Defines for control ops -define(CTRL_OP_GET_WINSIZE,100). @@ -43,7 +40,7 @@ start([Mod,Fun|Args]) -> %% Mod,Fun,Args should return a pid. That process is supposed to act %% as the io port. Pid = apply(Mod, Fun, Args), % This better work! - Id = spawn(?MODULE, server, [Pid]), + Id = spawn(fun() -> server(Pid) end), register(?NAME, Id), Id. @@ -52,8 +49,8 @@ start_out() -> start_port([out,binary]). start_port(PortSettings) -> - Id = spawn(?MODULE,server,[{fd,0,1},PortSettings]), - register(?NAME,Id), + Id = spawn(fun() -> server({fd,0,1}, PortSettings) end), + register(?NAME, Id), Id. %% Return the pid of the shell process. @@ -72,7 +69,6 @@ interfaces(User) -> [] end. - server(Pid) when is_pid(Pid) -> process_flag(trap_exit, true), link(Pid), @@ -104,7 +100,7 @@ catch_loop(Port, Shell, Q) -> new_shell -> exit(Shell, kill), catch_loop(Port, start_new_shell()); - {unknown_exit,{Shell,Reason},_} -> % shell has exited + {unknown_exit,{Shell,Reason},_} -> % shell has exited case Reason of normal -> put_chars("*** ", Port, []); @@ -172,7 +168,7 @@ server_loop(Port, Q) -> get_fd_geometry(Port) -> case (catch port_control(Port,?CTRL_OP_GET_WINSIZE,[])) of - List when is_list(List), length(List) =:= 8 -> + List when length(List) =:= 8 -> <<W:32/native,H:32/native>> = list_to_binary(List), {W,H}; _ -> @@ -373,12 +369,7 @@ do_setopts(Opts, _Port, Q) -> end. getopts(_Port,Q) -> - Bin = {binary, case get(read_mode) of - binary -> - true; - _ -> - false - end}, + Bin = {binary, get(read_mode) =:= binary}, Uni = {encoding, case get(unicode) of true -> unicode; diff --git a/lib/kernel/test/file_SUITE.erl b/lib/kernel/test/file_SUITE.erl index d01e1f1fcf..1d652679b0 100644 --- a/lib/kernel/test/file_SUITE.erl +++ b/lib/kernel/test/file_SUITE.erl @@ -52,7 +52,7 @@ old_modes/1, new_modes/1, path_open/1, open_errors/1]). -export([file_info/1, file_info_basic_file/1, file_info_basic_directory/1, file_info_bad/1, file_info_times/1, file_write_file_info/1]). --export([rename/1, access/1, truncate/1, sync/1, +-export([rename/1, access/1, truncate/1, datasync/1, sync/1, read_write/1, pread_write/1, append/1]). -export([errors/1, e_delete/1, e_rename/1, e_make_dir/1, e_del_dir/1]). -export([otp_5814/1]). @@ -82,6 +82,8 @@ -export([read_line_1/1, read_line_2/1, read_line_3/1,read_line_4/1]). +-export([advise/1]). + %% Debug exports -export([create_file_slow/2, create_file/2, create_bin/2]). -export([verify_file/2, verify_bin/3]). @@ -270,7 +272,10 @@ make_del_dir(Config) when is_list(Config) -> %% Try deleting some bad directories %% Deleting the parent directory to the current, sounds dangerous, huh? %% Don't worry ;-) the parent directory should never be empty, right? - ?line {error, eexist} = ?FILE_MODULE:del_dir('..'), + case ?FILE_MODULE:del_dir('..') of + {error, eexist} -> ok; + {error, einval} -> ok %FreeBSD + end, ?line {error, enoent} = ?FILE_MODULE:del_dir(""), ?line {error, badarg} = ?FILE_MODULE:del_dir([3,2,1,{}]), @@ -374,7 +379,9 @@ win_cur_dir_1(_Config) -> %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -files(suite) -> [open,pos,file_info,consult,eval,script,truncate,sync]. +files(suite) -> + [open,pos,file_info,consult,eval,script,truncate, + sync,datasync,advise]. open(suite) -> [open1,old_modes,new_modes,path_open,close,access,read_write, pread_write,append,open_errors]. @@ -1352,6 +1359,30 @@ truncate(Config) when is_list(Config) -> ok. +datasync(suite) -> []; +datasync(doc) -> "Tests that ?FILE_MODULE:datasync/1 at least doesn't crash."; +datasync(Config) when is_list(Config) -> + ?line Dog = test_server:timetrap(test_server:seconds(5)), + ?line PrivDir = ?config(priv_dir, Config), + ?line Sync = filename:join(PrivDir, + atom_to_list(?MODULE) + ++"_sync.fil"), + + %% Raw open. + ?line {ok, Fd} = ?FILE_MODULE:open(Sync, [write, raw]), + ?line ok = ?FILE_MODULE:datasync(Fd), + ?line ok = ?FILE_MODULE:close(Fd), + + %% Ordinary open. + ?line {ok, Fd2} = ?FILE_MODULE:open(Sync, [write]), + ?line ok = ?FILE_MODULE:datasync(Fd2), + ?line ok = ?FILE_MODULE:close(Fd2), + + ?line [] = flush(), + ?line test_server:timetrap_cancel(Dog), + ok. + + sync(suite) -> []; sync(doc) -> "Tests that ?FILE_MODULE:sync/1 at least doesn't crash."; sync(Config) when is_list(Config) -> @@ -1375,6 +1406,77 @@ sync(Config) when is_list(Config) -> ?line test_server:timetrap_cancel(Dog), ok. +advise(suite) -> []; +advise(doc) -> "Tests that ?FILE_MODULE:advise/4 at least doesn't crash."; +advise(Config) when is_list(Config) -> + ?line Dog = test_server:timetrap(test_server:seconds(5)), + ?line PrivDir = ?config(priv_dir, Config), + ?line Advise = filename:join(PrivDir, + atom_to_list(?MODULE) + ++"_advise.fil"), + + Line1 = "Hello\n", + Line2 = "World!\n", + + ?line {ok, Fd} = ?FILE_MODULE:open(Advise, [write]), + ?line ok = ?FILE_MODULE:advise(Fd, 0, 0, normal), + ?line ok = io:format(Fd, "~s", [Line1]), + ?line ok = io:format(Fd, "~s", [Line2]), + ?line ok = ?FILE_MODULE:close(Fd), + + ?line {ok, Fd2} = ?FILE_MODULE:open(Advise, [write]), + ?line ok = ?FILE_MODULE:advise(Fd2, 0, 0, random), + ?line ok = io:format(Fd2, "~s", [Line1]), + ?line ok = io:format(Fd2, "~s", [Line2]), + ?line ok = ?FILE_MODULE:close(Fd2), + + ?line {ok, Fd3} = ?FILE_MODULE:open(Advise, [write]), + ?line ok = ?FILE_MODULE:advise(Fd3, 0, 0, sequential), + ?line ok = io:format(Fd3, "~s", [Line1]), + ?line ok = io:format(Fd3, "~s", [Line2]), + ?line ok = ?FILE_MODULE:close(Fd3), + + ?line {ok, Fd4} = ?FILE_MODULE:open(Advise, [write]), + ?line ok = ?FILE_MODULE:advise(Fd4, 0, 0, will_need), + ?line ok = io:format(Fd4, "~s", [Line1]), + ?line ok = io:format(Fd4, "~s", [Line2]), + ?line ok = ?FILE_MODULE:close(Fd4), + + ?line {ok, Fd5} = ?FILE_MODULE:open(Advise, [write]), + ?line ok = ?FILE_MODULE:advise(Fd5, 0, 0, dont_need), + ?line ok = io:format(Fd5, "~s", [Line1]), + ?line ok = io:format(Fd5, "~s", [Line2]), + ?line ok = ?FILE_MODULE:close(Fd5), + + ?line {ok, Fd6} = ?FILE_MODULE:open(Advise, [write]), + ?line ok = ?FILE_MODULE:advise(Fd6, 0, 0, no_reuse), + ?line ok = io:format(Fd6, "~s", [Line1]), + ?line ok = io:format(Fd6, "~s", [Line2]), + ?line ok = ?FILE_MODULE:close(Fd6), + + ?line {ok, Fd7} = ?FILE_MODULE:open(Advise, [write]), + ?line {error, einval} = ?FILE_MODULE:advise(Fd7, 0, 0, bad_advise), + ?line ok = ?FILE_MODULE:close(Fd7), + + %% test write without advise, then a read after an advise + ?line {ok, Fd8} = ?FILE_MODULE:open(Advise, [write]), + ?line ok = io:format(Fd8, "~s", [Line1]), + ?line ok = io:format(Fd8, "~s", [Line2]), + ?line ok = ?FILE_MODULE:close(Fd8), + ?line {ok, Fd9} = ?FILE_MODULE:open(Advise, [read]), + Offset = 0, + %% same as a 0 length in some implementations + Length = length(Line1) + length(Line2), + ?line ok = ?FILE_MODULE:advise(Fd9, Offset, Length, sequential), + ?line {ok, Line1} = ?FILE_MODULE:read_line(Fd9), + ?line {ok, Line2} = ?FILE_MODULE:read_line(Fd9), + ?line eof = ?FILE_MODULE:read_line(Fd9), + ?line ok = ?FILE_MODULE:close(Fd9), + + ?line [] = flush(), + ?line test_server:timetrap_cancel(Dog), + ok. + %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% diff --git a/lib/kernel/test/inet_sockopt_SUITE_data/sockopt_helper.c b/lib/kernel/test/inet_sockopt_SUITE_data/sockopt_helper.c index fb3c622909..f24c93edf5 100644 --- a/lib/kernel/test/inet_sockopt_SUITE_data/sockopt_helper.c +++ b/lib/kernel/test/inet_sockopt_SUITE_data/sockopt_helper.c @@ -1,4 +1,4 @@ -#if defined(VXWORKS) || defined(__OSE__) +#if defined(VXWORKS) #include <stdio.h> #include <stdlib.h> #include <string.h> diff --git a/lib/kernel/test/prim_file_SUITE.erl b/lib/kernel/test/prim_file_SUITE.erl index 860aeecbf4..21bdc06fdc 100644 --- a/lib/kernel/test/prim_file_SUITE.erl +++ b/lib/kernel/test/prim_file_SUITE.erl @@ -1,19 +1,19 @@ %% %% %CopyrightBegin% -%% -%% Copyright Ericsson AB 2000-2009. All Rights Reserved. -%% +%% +%% Copyright Ericsson AB 2000-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% %% -module(prim_file_SUITE). @@ -34,7 +34,7 @@ file_info_times_a/1, file_info_times_b/1, file_write_file_info_a/1, file_write_file_info_b/1]). -export([rename_a/1, rename_b/1, - access/1, truncate/1, sync/1, + access/1, truncate/1, datasync/1, sync/1, read_write/1, pread_write/1, append/1]). -export([errors/1, e_delete/1, e_rename/1, e_make_dir/1, e_del_dir/1]). @@ -48,6 +48,8 @@ symlinks_a/1, symlinks_b/1, list_dir_limit/1]). +-export([advise/1]). + -include("test_server.hrl"). -include_lib("kernel/include/file.hrl"). @@ -243,7 +245,10 @@ make_del_dir(Config, Handle, Suffix) -> %% Try deleting some bad directories %% Deleting the parent directory to the current, sounds dangerous, huh? %% Don't worry ;-) the parent directory should never be empty, right? - ?line {error, eexist} = ?PRIM_FILE_call(del_dir, Handle, [".."]), + case ?PRIM_FILE_call(del_dir, Handle, [".."]) of + {error, eexist} -> ok; + {error, einval} -> ok %FreeBSD + end, ?line {error, enoent} = ?PRIM_FILE_call(del_dir, Handle, [""]), ?line {error, badarg} = ?PRIM_FILE_call(del_dir, Handle, [[3,2,1,{}]]), @@ -377,7 +382,7 @@ win_cur_dir_1(_Config, Handle) -> %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -files(suite) -> [open,pos,file_info,truncate,sync]. +files(suite) -> [open,pos,file_info,truncate,sync,datasync,advise]. open(suite) -> [open1,modes,close,access,read_write, pread_write,append]. @@ -1061,6 +1066,24 @@ truncate(Config) when is_list(Config) -> ok. +datasync(suite) -> []; +datasync(doc) -> "Tests that ?PRIM_FILE:datasync/1 at least doesn't crash."; +datasync(Config) when is_list(Config) -> + ?line Dog = test_server:timetrap(test_server:seconds(5)), + ?line PrivDir = ?config(priv_dir, Config), + ?line Sync = filename:join(PrivDir, + atom_to_list(?MODULE) + ++"_sync.fil"), + + %% Raw open. + ?line {ok, Fd} = ?PRIM_FILE:open(Sync, [write]), + ?line ok = ?PRIM_FILE:datasync(Fd), + ?line ok = ?PRIM_FILE:close(Fd), + + ?line test_server:timetrap_cancel(Dog), + ok. + + sync(suite) -> []; sync(doc) -> "Tests that ?PRIM_FILE:sync/1 at least doesn't crash."; sync(Config) when is_list(Config) -> @@ -1079,6 +1102,77 @@ sync(Config) when is_list(Config) -> ok. +advise(suite) -> []; +advise(doc) -> "Tests that ?PRIM_FILE:advise/4 at least doesn't crash."; +advise(Config) when is_list(Config) -> + ?line Dog = test_server:timetrap(test_server:seconds(5)), + ?line PrivDir = ?config(priv_dir, Config), + ?line Advise = filename:join(PrivDir, + atom_to_list(?MODULE) + ++"_advise.fil"), + + Line1 = "Hello\n", + Line2 = "World!\n", + + ?line {ok, Fd} = ?PRIM_FILE:open(Advise, [write]), + ?line ok = ?PRIM_FILE:advise(Fd, 0, 0, normal), + ?line ok = ?PRIM_FILE:write(Fd, Line1), + ?line ok = ?PRIM_FILE:write(Fd, Line2), + ?line ok = ?PRIM_FILE:close(Fd), + + ?line {ok, Fd2} = ?PRIM_FILE:open(Advise, [write]), + ?line ok = ?PRIM_FILE:advise(Fd2, 0, 0, random), + ?line ok = ?PRIM_FILE:write(Fd2, Line1), + ?line ok = ?PRIM_FILE:write(Fd2, Line2), + ?line ok = ?PRIM_FILE:close(Fd2), + + ?line {ok, Fd3} = ?PRIM_FILE:open(Advise, [write]), + ?line ok = ?PRIM_FILE:advise(Fd3, 0, 0, sequential), + ?line ok = ?PRIM_FILE:write(Fd3, Line1), + ?line ok = ?PRIM_FILE:write(Fd3, Line2), + ?line ok = ?PRIM_FILE:close(Fd3), + + ?line {ok, Fd4} = ?PRIM_FILE:open(Advise, [write]), + ?line ok = ?PRIM_FILE:advise(Fd4, 0, 0, will_need), + ?line ok = ?PRIM_FILE:write(Fd4, Line1), + ?line ok = ?PRIM_FILE:write(Fd4, Line2), + ?line ok = ?PRIM_FILE:close(Fd4), + + ?line {ok, Fd5} = ?PRIM_FILE:open(Advise, [write]), + ?line ok = ?PRIM_FILE:advise(Fd5, 0, 0, dont_need), + ?line ok = ?PRIM_FILE:write(Fd5, Line1), + ?line ok = ?PRIM_FILE:write(Fd5, Line2), + ?line ok = ?PRIM_FILE:close(Fd5), + + ?line {ok, Fd6} = ?PRIM_FILE:open(Advise, [write]), + ?line ok = ?PRIM_FILE:advise(Fd6, 0, 0, no_reuse), + ?line ok = ?PRIM_FILE:write(Fd6, Line1), + ?line ok = ?PRIM_FILE:write(Fd6, Line2), + ?line ok = ?PRIM_FILE:close(Fd6), + + ?line {ok, Fd7} = ?PRIM_FILE:open(Advise, [write]), + ?line {error, einval} = ?PRIM_FILE:advise(Fd7, 0, 0, bad_advise), + ?line ok = ?PRIM_FILE:close(Fd7), + + %% test write without advise, then a read after an advise + ?line {ok, Fd8} = ?PRIM_FILE:open(Advise, [write]), + ?line ok = ?PRIM_FILE:write(Fd8, Line1), + ?line ok = ?PRIM_FILE:write(Fd8, Line2), + ?line ok = ?PRIM_FILE:close(Fd8), + ?line {ok, Fd9} = ?PRIM_FILE:open(Advise, [read]), + Offset = 0, + %% same as a 0 length in some implementations + Length = length(Line1) + length(Line2), + ?line ok = ?PRIM_FILE:advise(Fd9, Offset, Length, sequential), + ?line {ok, Line1} = ?PRIM_FILE:read_line(Fd9), + ?line {ok, Line2} = ?PRIM_FILE:read_line(Fd9), + ?line eof = ?PRIM_FILE:read_line(Fd9), + ?line ok = ?PRIM_FILE:close(Fd9), + + ?line test_server:timetrap_cancel(Dog), + ok. + + %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% delete_a(suite) -> []; diff --git a/lib/megaco/doc/src/megaco_user.xml b/lib/megaco/doc/src/megaco_user.xml index 6a0de29385..7332fa684d 100644 --- a/lib/megaco/doc/src/megaco_user.xml +++ b/lib/megaco/doc/src/megaco_user.xml @@ -471,7 +471,7 @@ protocol_version() = integer() ]]></code> <v>transaction_result() = action_reps()</v> <v>segment_result() = {segment_no(), last_segment(), action_reps()}</v> <v>action_reps() = [action_reply()]</v> - <v>failure() = {error, reason()}</v> + <v>failure() = {error, reason()} | {error, ReplyNo, reason()}</v> <v>reason() = transaction_reason() | segment_reason() | user_cancel_reason() | send_reason() | other_reason()</v> <v>transaction_reason() = error_desc()</v> <v>segment_reason() = {segment_no(), last_segment(), error_desc()}</v> @@ -486,6 +486,7 @@ protocol_version() = integer() ]]></code> <v>send_failed_reason() = {send_message_failed, reason_for_send_failure()}</v> <v>reason_for_send_failure() = term()</v> <v>ReplyData = reply_data()</v> + <v>ReplyNo = integer() > 0</v> <v>reply_data() = term()</v> <v>Extra = term()</v> </type> diff --git a/lib/megaco/doc/src/notes.xml b/lib/megaco/doc/src/notes.xml index 65bf0345f5..ab17dd50ca 100644 --- a/lib/megaco/doc/src/notes.xml +++ b/lib/megaco/doc/src/notes.xml @@ -36,6 +36,51 @@ section is the version number of Megaco.</p> <section> + <title>Megaco 3.14.1</title> + + <p>Version 3.14.1 supports code replacement in runtime from/to + version 3.14, 3.13, 3.12 and 3.11.3.</p> + + <section> + <title>Improvements and new features</title> + +<!-- + <p>-</p> +--> + + <list type="bulleted"> + <item> + <p>A minor compiler related performance improvement. </p> + <p>Own Id: OTP-8561</p> + </item> + + </list> + + </section> + + <section> + <title>Fixed bugs and malfunctions</title> +<!-- + <p>-</p> +--> + + <list type="bulleted"> + <item> + <p>Fix shared libraries installation. </p> + <p>The flex shared lib(s) were incorrectly installed as data + files. </p> + <p>Peter Lemenkov</p> + <p>Own Id: OTP-8627</p> + </item> + + </list> + + </section> + + </section> <!-- 3.14.1 --> + + + <section> <title>Megaco 3.14</title> <p>Version 3.14 supports code replacement in runtime from/to diff --git a/lib/megaco/src/app/megaco.appup.src b/lib/megaco/src/app/megaco.appup.src index 4f781478ef..5df31f2923 100644 --- a/lib/megaco/src/app/megaco.appup.src +++ b/lib/megaco/src/app/megaco.appup.src @@ -124,10 +124,18 @@ %% | %% v %% 3.14 +%% | +%% v +%% 3.14.1 %% %% {"%VSN%", [ + {"3.14", + [ + {update, megaco_config, soft, soft_purge, soft_purge, []} + ] + }, {"3.13", [ {load_module, megaco_messenger, soft_purge, soft_purge, []}, @@ -163,6 +171,11 @@ } ], [ + {"3.14", + [ + {update, megaco_config, soft, soft_purge, soft_purge, []} + ] + }, {"3.13", [ {load_module, megaco_messenger, soft_purge, soft_purge, []}, diff --git a/lib/megaco/src/engine/megaco_config.erl b/lib/megaco/src/engine/megaco_config.erl index 1c7a141be7..0445f10838 100644 --- a/lib/megaco/src/engine/megaco_config.erl +++ b/lib/megaco/src/engine/megaco_config.erl @@ -224,149 +224,278 @@ update_user_info(UserMid, orig_pending_limit, Val) -> update_user_info(UserMid, Item, Val) -> call({update_user_info, UserMid, Item, Val}). -conn_info(CH, Item) - when is_record(CH, megaco_conn_handle) andalso (Item /= cancel) -> - case Item of - conn_handle -> - CH; - mid -> - CH#megaco_conn_handle.local_mid; - local_mid -> - CH#megaco_conn_handle.local_mid; - remote_mid -> - CH#megaco_conn_handle.remote_mid; - conn_data -> - case lookup_local_conn(CH) of - [] -> - exit({no_such_connection, CH}); - [ConnData] -> - ConnData - end; - _ -> - case lookup_local_conn(CH) of - [] -> - exit({no_such_connection, CH}); - [ConnData] -> - conn_info(ConnData, Item) - end + +conn_info(Data, Item) -> + %% The purpose of this is a compiler optimization... + %% Args are processed from left to right. + do_conn_info(Item, Data). + +do_conn_info(mid = _Item, #megaco_conn_handle{local_mid = Mid}) -> + Mid; +do_conn_info(local_mid = _Item, #megaco_conn_handle{local_mid = LMid}) -> + LMid; +do_conn_info(remote_mid = _Item, #megaco_conn_handle{remote_mid = RMid}) -> + RMid; +do_conn_info(conn_handle = _Item, CH) when is_record(CH, megaco_conn_handle) -> + CH; +do_conn_info(conn_data = _Item, CH) when is_record(CH, megaco_conn_handle) -> + case lookup_local_conn(CH) of + [] -> + exit({no_such_connection, CH}); + [ConnData] -> + ConnData + end; +do_conn_info(Item, CH) when is_record(CH, megaco_conn_handle) -> + case lookup_local_conn(CH) of + [] -> + exit({no_such_connection, CH}); + [ConnData] -> + do_conn_info(Item, ConnData) end; -conn_info(#conn_data{conn_handle = CH}, cancel) -> + +do_conn_info(cancel = _Item, #conn_data{conn_handle = CH}) -> + %% To minimise raise-condition propabillity, + %% we always look in the table instead of + %% in the record for this one + ets:lookup_element(megaco_local_conn, CH, #conn_data.cancel); +do_conn_info(cancel = _Item, CH) when is_record(CH, megaco_conn_handle) -> %% To minimise raise-condition propabillity, %% we always look in the table instead of %% in the record for this one ets:lookup_element(megaco_local_conn, CH, #conn_data.cancel); -conn_info(CD, Item) when is_record(CD, conn_data) -> - case Item of - all -> - Tags0 = record_info(fields, conn_data), - Tags1 = replace(serial, trans_id, Tags0), - Tags = [mid, local_mid, remote_mid] ++ - replace(max_serial, max_trans_id, Tags1), - [{Tag, conn_info(CD,Tag)} || Tag <- Tags, - Tag /= conn_data, - Tag /= trans_sender, - Tag /= cancel]; - conn_data -> CD; - conn_handle -> CD#conn_data.conn_handle; - mid -> (CD#conn_data.conn_handle)#megaco_conn_handle.local_mid; - local_mid -> (CD#conn_data.conn_handle)#megaco_conn_handle.local_mid; - remote_mid -> (CD#conn_data.conn_handle)#megaco_conn_handle.remote_mid; - trans_id -> CH = CD#conn_data.conn_handle, - LocalMid = CH#megaco_conn_handle.local_mid, - Item2 = {LocalMid, trans_id_counter}, - case (catch ets:lookup(megaco_config, Item2)) of - {'EXIT', _} -> - undefined_serial; - [] -> - user_info(LocalMid, min_trans_id); - [{_, Serial}] -> - Max = CD#conn_data.max_serial, - if - ((Max =:= infinity) andalso - is_integer(Serial) andalso - (Serial < 4294967295)) -> - Serial + 1; - (Max =:= infinity) andalso - is_integer(Serial) andalso - (Serial =:= 4294967295) -> - user_info(LocalMid, - min_trans_id); - Serial < Max -> - Serial + 1; - Serial =:= Max -> - user_info(LocalMid, - min_trans_id); - Serial =:= 4294967295 -> - user_info(LocalMid, - min_trans_id); - true -> - undefined_serial - end - end; - max_trans_id -> CD#conn_data.max_serial; - request_timer -> CD#conn_data.request_timer; - long_request_timer -> CD#conn_data.long_request_timer; - - auto_ack -> CD#conn_data.auto_ack; - - trans_ack -> CD#conn_data.trans_ack; - trans_ack_maxcount -> CD#conn_data.trans_ack_maxcount; - - trans_req -> CD#conn_data.trans_req; - trans_req_maxcount -> CD#conn_data.trans_req_maxcount; - trans_req_maxsize -> CD#conn_data.trans_req_maxsize; - - trans_timer -> CD#conn_data.trans_timer; - - pending_timer -> CD#conn_data.pending_timer; - orig_pending_limit -> CD#conn_data.sent_pending_limit; - sent_pending_limit -> CD#conn_data.sent_pending_limit; - recv_pending_limit -> CD#conn_data.recv_pending_limit; - reply_timer -> CD#conn_data.reply_timer; - control_pid -> CD#conn_data.control_pid; - monitor_ref -> CD#conn_data.monitor_ref; - send_mod -> CD#conn_data.send_mod; - send_handle -> CD#conn_data.send_handle; - encoding_mod -> CD#conn_data.encoding_mod; - encoding_config -> CD#conn_data.encoding_config; - protocol_version -> CD#conn_data.protocol_version; - auth_data -> CD#conn_data.auth_data; - user_mod -> CD#conn_data.user_mod; - user_args -> CD#conn_data.user_args; - reply_action -> CD#conn_data.reply_action; - reply_data -> CD#conn_data.reply_data; - threaded -> CD#conn_data.threaded; - strict_version -> CD#conn_data.strict_version; - long_request_resend -> CD#conn_data.long_request_resend; - call_proxy_gc_timeout -> CD#conn_data.call_proxy_gc_timeout; - cancel -> CD#conn_data.cancel; - resend_indication -> CD#conn_data.resend_indication; - segment_reply_ind -> CD#conn_data.segment_reply_ind; - segment_recv_acc -> CD#conn_data.segment_recv_acc; - segment_recv_timer -> CD#conn_data.segment_recv_timer; - segment_send -> CD#conn_data.segment_send; - segment_send_timer -> CD#conn_data.segment_send_timer; - max_pdu_size -> CD#conn_data.max_pdu_size; - request_keep_alive_timeout -> CD#conn_data.request_keep_alive_timeout; - receive_handle -> - LocalMid = (CD#conn_data.conn_handle)#megaco_conn_handle.local_mid, - #megaco_receive_handle{local_mid = LocalMid, - encoding_mod = CD#conn_data.encoding_mod, - encoding_config = CD#conn_data.encoding_config, - send_mod = CD#conn_data.send_mod}; - _ -> - exit({no_such_item, Item}) +do_conn_info(all = _Item, + #conn_data{conn_handle = CH, + serial = TransId, + max_serial = MaxTransId, + request_timer = ReqTmr, + long_request_timer = LongReqTmr, + auto_ack = AutoAck, + trans_ack = TransAck, + trans_ack_maxcount = TransAckMaxCount, + trans_req = TransReq, + trans_req_maxcount = TransReqMaxCount, + trans_req_maxsize = TransReqMaxSz, + trans_timer = TransTmr, + %% trans_sender, + pending_timer = PendingTmr, + sent_pending_limit = SentPendingLimit, + recv_pending_limit = RecvPendingLimit, + reply_timer = ReplyTmr, + control_pid = CtrlPid, + monitor_ref = MonRef, + send_mod = SendMod, + send_handle = SendHandle, + encoding_mod = EncodingMod, + encoding_config = EncodingConf, + protocol_version = ProtoVersion, + auth_data = AuthData, + user_mod = UserMod, + user_args = UserArgs, + reply_action = ReplyAction, + reply_data = ReplyData, + threaded = Threaded, + strict_version = StrictVersion, + long_request_resend = LongReqResend, + call_proxy_gc_timeout = CallProxyGCTimeout, + %% cancel, + resend_indication = ResendInd, + segment_reply_ind = SegReplyInd, + segment_recv_acc = SegRecvAcc, + segment_recv_timer = SegRecvTmr, + segment_send = SegSend, + segment_send_timer = SegSendTmr, + max_pdu_size = MaxPduSz, + request_keep_alive_timeout = RequestKeepAliveTmr}) -> + [{conn_handle, CH}, + {trans_id, TransId}, + {max_trans_id, MaxTransId}, + {request_timer, ReqTmr}, + {long_request_timer, LongReqTmr}, + {mid, CH#megaco_conn_handle.local_mid}, + {local_mid, CH#megaco_conn_handle.local_mid}, + {remote_mid, CH#megaco_conn_handle.remote_mid}, + {auto_ack, AutoAck}, + {trans_ack, TransAck}, + {trans_ack_maxcount, TransAckMaxCount}, + {trans_req, TransReq}, + {trans_req_maxcount, TransReqMaxCount}, + {trans_req_maxsize, TransReqMaxSz}, + {trans_timer, TransTmr}, + {pending_timer, PendingTmr}, + {sent_pending_limit, SentPendingLimit}, + {recv_pending_limit, RecvPendingLimit}, + {reply_timer, ReplyTmr}, + {control_pid, CtrlPid}, + {monitor_ref, MonRef}, + {send_mod, SendMod}, + {send_handle, SendHandle}, + {encoding_mod, EncodingMod}, + {encoding_config, EncodingConf}, + {protocol_version, ProtoVersion}, + {auth_data, AuthData}, + {user_mod, UserMod}, + {user_args, UserArgs}, + {reply_action, ReplyAction}, + {reply_data, ReplyData}, + {threaded, Threaded}, + {strict_version, StrictVersion}, + {long_request_resend, LongReqResend}, + {call_proxy_gc_timeout, CallProxyGCTimeout}, + {resend_indication, ResendInd}, + {segment_reply_ind, SegReplyInd}, + {segment_recv_acc, SegRecvAcc}, + {segment_recv_timer, SegRecvTmr}, + {segment_send, SegSend}, + {segment_send_timer, SegSendTmr}, + {max_pdu_size, MaxPduSz}, + {request_keep_alive_timeout, RequestKeepAliveTmr}]; + +do_conn_info(conn_data = _Item, CD) -> + CD; +do_conn_info(conn_handle = _Item, #conn_data{conn_handle = Val}) -> + Val; +do_conn_info(mid = _Item, + #conn_data{conn_handle = #megaco_conn_handle{local_mid = Val}}) -> + Val; +do_conn_info(local_mid = _Item, + #conn_data{conn_handle = #megaco_conn_handle{local_mid = Val}}) -> + Val; +do_conn_info(remote_mid = _Item, + #conn_data{conn_handle = #megaco_conn_handle{remote_mid = Val}}) -> + Val; +do_conn_info(trans_id = _Item, + #conn_data{conn_handle = #megaco_conn_handle{local_mid = LMid}, + max_serial = Max}) -> + Item2 = {LMid, trans_id_counter}, + case (catch ets:lookup(megaco_config, Item2)) of + {'EXIT', _} -> + undefined_serial; + [] -> + user_info(LMid, min_trans_id); + [{_, Serial}] -> + if + ((Max =:= infinity) andalso + is_integer(Serial) andalso + (Serial < 4294967295)) -> + Serial + 1; + ((Max =:= infinity) andalso + is_integer(Serial) andalso + (Serial =:= 4294967295)) -> + user_info(LMid, min_trans_id); + Serial < Max -> + Serial + 1; + Serial =:= Max -> + user_info(LMid, min_trans_id); + Serial =:= 4294967295 -> + user_info(LMid, min_trans_id); + true -> + undefined_serial + end end; -conn_info(BadHandle, _Item) -> - {error, {no_such_connection, BadHandle}}. - -replace(_, _, []) -> - []; -replace(Item, WithItem, [Item|List]) -> - [WithItem|List]; -replace(Item, WithItem, [OtherItem|List]) -> - [OtherItem | replace(Item, WithItem, List)]. +do_conn_info(max_trans_id = _Item, #conn_data{max_serial = Val}) -> + Val; +do_conn_info(request_timer = _Item, #conn_data{request_timer = Val}) -> + Val; +do_conn_info(long_request_timer = _Item, #conn_data{long_request_timer = Val}) -> + Val; +do_conn_info(auto_ack = _Item, #conn_data{auto_ack = Val}) -> + Val; +do_conn_info(trans_ack = _Item, #conn_data{trans_ack = Val}) -> + Val; +do_conn_info(trans_ack_maxcount = _Item, #conn_data{trans_ack_maxcount = Val}) -> + Val; +do_conn_info(trans_req = _Item, #conn_data{trans_req = Val}) -> + Val; +do_conn_info(trans_req_maxcount = _Item, #conn_data{trans_req_maxcount = Val}) -> + Val; +do_conn_info(trans_req_maxsize = _Item, #conn_data{trans_req_maxsize = Val}) -> + Val; +do_conn_info(trans_timer = _Item, #conn_data{trans_timer = Val}) -> + Val; +do_conn_info(pending_timer = _Item, #conn_data{pending_timer = Val}) -> + Val; +do_conn_info(orig_pending_limit = _Item, #conn_data{sent_pending_limit = Val}) -> + Val; +do_conn_info(sent_pending_limit = _Item, #conn_data{sent_pending_limit = Val}) -> + Val; +do_conn_info(recv_pending_limit = _Item, #conn_data{recv_pending_limit = Val}) -> + Val; +do_conn_info(reply_timer = _Item, #conn_data{reply_timer = Val}) -> + Val; +do_conn_info(control_pid = _Item, #conn_data{control_pid = Val}) -> + Val; +do_conn_info(send_mod = _Item, #conn_data{send_mod = Val}) -> + Val; +do_conn_info(send_handle = _Item, #conn_data{send_handle = Val}) -> + Val; +do_conn_info(encoding_mod = _Item, #conn_data{encoding_mod = Val}) -> + Val; +do_conn_info(encoding_config = _Item, #conn_data{encoding_config = Val}) -> + Val; +do_conn_info(protocol_version = _Item, #conn_data{protocol_version = Val}) -> + Val; +do_conn_info(auth_data = _Item, #conn_data{auth_data = Val}) -> + Val; +do_conn_info(user_mod = _Item, #conn_data{user_mod = Val}) -> + Val; +do_conn_info(user_args = _Item, #conn_data{user_args = Val}) -> + Val; +do_conn_info(reply_action = _Item, #conn_data{reply_action = Val}) -> + Val; +do_conn_info(reply_data = _Item, #conn_data{reply_data = Val}) -> + Val; +do_conn_info(threaded = _Item, #conn_data{threaded = Val}) -> + Val; +do_conn_info(strict_version = _Item, #conn_data{strict_version = Val}) -> + Val; +do_conn_info(long_request_resend = _Item, + #conn_data{long_request_resend = Val}) -> + Val; +do_conn_info(call_proxy_gc_timeout = _Item, + #conn_data{call_proxy_gc_timeout = Val}) -> + Val; +do_conn_info(resend_indication = _Item, #conn_data{resend_indication = Val}) -> + Val; +do_conn_info(segment_reply_ind = _Item, #conn_data{segment_reply_ind = Val}) -> + Val; +do_conn_info(segment_recv_acc = _Item, #conn_data{segment_recv_acc = Val}) -> + Val; +do_conn_info(segment_recv_timer = _Item, + #conn_data{segment_recv_timer = Val}) -> + Val; +do_conn_info(segment_send = _Item, #conn_data{segment_send = Val}) -> + Val; +do_conn_info(segment_send_timer = _Item, + #conn_data{segment_send_timer = Val}) -> + Val; +do_conn_info(max_pdu_size = _Item, #conn_data{max_pdu_size = Val}) -> + Val; +do_conn_info(request_keep_alive_timeout = _Item, + #conn_data{request_keep_alive_timeout = Val}) -> + Val; +do_conn_info(receive_handle = _Item, + #conn_data{conn_handle = #megaco_conn_handle{local_mid = LMid}, + encoding_mod = EM, + encoding_config = EC, + send_mod = SM}) -> + #megaco_receive_handle{local_mid = LMid, + encoding_mod = EM, + encoding_config = EC, + send_mod = SM}; +do_conn_info(Item, Data) + when is_record(Data, conn_data) orelse is_record(Data, megaco_conn_handle) -> + exit({no_such_item, Item}); +do_conn_info(_Item, BadData) -> + {error, {no_such_connection, BadData}}. + + +%% replace(_, _, []) -> +%% []; +%% replace(Item, WithItem, [Item|List]) -> +%% [WithItem|List]; +%% replace(Item, WithItem, [OtherItem|List]) -> +%% [OtherItem | replace(Item, WithItem, List)]. update_conn_info(#conn_data{conn_handle = CH}, Item, Val) -> diff --git a/lib/megaco/src/flex/Makefile.in b/lib/megaco/src/flex/Makefile.in index 6ce9b34617..5af651d89b 100644 --- a/lib/megaco/src/flex/Makefile.in +++ b/lib/megaco/src/flex/Makefile.in @@ -280,7 +280,7 @@ release_spec: opt $(INSTALL_DATA) $(TARGET_FILES) $(RELSYSDIR)/ebin ifeq ($(ENABLE_MEGACO_FLEX_SCANNER),true) $(INSTALL_DATA) $(FLEX_FILES) $(C_TARGETS) $(RELSYSDIR)/src/flex - $(INSTALL_DATA) $(SOLIBS) $(RELSYSDIR)/priv/lib + $(INSTALL_PROGRAM) $(SOLIBS) $(RELSYSDIR)/priv/lib endif diff --git a/lib/megaco/test/megaco_config_test.erl b/lib/megaco/test/megaco_config_test.erl index 453c1b8964..9ab1a7d90d 100644 --- a/lib/megaco/test/megaco_config_test.erl +++ b/lib/megaco/test/megaco_config_test.erl @@ -1,19 +1,19 @@ %% %% %CopyrightBegin% -%% -%% Copyright Ericsson AB 2000-2009. All Rights Reserved. -%% +%% +%% Copyright Ericsson AB 2000-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% %% @@ -106,166 +106,197 @@ config(Config) when is_list(Config) -> Evil = 400, End = 500, + InitialCmd = + fun(No, Desc, Cmd, VerifyVal) -> + initial_command(Initial + No, Desc, Cmd, VerifyVal) + end, + + VerifyCmd = + fun(M, No, Key, V) -> + verify_user_default_command(M, Verify + No, Key, V) + end, + + NiceCmd = + fun(M, No, Key, Val) -> + nice_user_update_command(M, Nice + No, Key, Val) + end, + + EvilCmd = + fun(M, No, Key, Val) -> + evil_user_update_command(M, Evil + No, Key, Val) + end, + + %% End commands + ExitCmd = + fun(No, Desc, Cmd) -> + exit_command(End + No, Desc, Cmd) + end, + ErrorCmd = + fun(No, Desc, Cmd, MainReason, TS) -> + error_command(End + No, Desc, Cmd, MainReason, TS) + end, + PlainCmd = + fun(No, Desc, Cmd, V) -> + command(End + No, Desc, Cmd, V) + end, + Commands = [ %% Initial commands - initial_command( Initial + 0, - "enable trace", - fun() -> megaco:enable_trace(100, io) end, ok), - initial_command( Initial + 1, - "start", - fun() -> megaco:start() end, ok), - initial_command( Initial + 2, - "Verify no active requests", - fun() -> megaco:system_info(n_active_requests) end, - 0), - initial_command( Initial + 3, - "Verify no active replies", - fun() -> megaco:system_info(n_active_replies) end, - 0), - initial_command( Initial + 4, - "Verify no active connections", - fun() -> - megaco:system_info(n_active_connections) - end, - 0), - initial_command( Initial + 5, - "Verify no connections", - fun() -> megaco:system_info(connections) end, []), - initial_command( Initial + 6, - "Verify no users", - fun() -> megaco:system_info(users) end, []), - initial_command( Initial + 7, - "Start user", - fun() -> megaco:start_user(Mid, []) end, ok), - + InitialCmd(0, + "enable trace", + fun() -> megaco:enable_trace(100, io) end, + ok), + InitialCmd(1, + "start", + fun() -> megaco:start() end, + ok), + InitialCmd(2, + "Verify no active requests", + fun() -> megaco:system_info(n_active_requests) end, + 0), + InitialCmd(3, + "Verify no active replies", + fun() -> megaco:system_info(n_active_replies) end, + 0), + InitialCmd(4, + "Verify no active connections", + fun() -> megaco:system_info(n_active_connections) end, + 0), + InitialCmd(5, + "Verify no connections", + fun() -> megaco:system_info(connections) end, + []), + InitialCmd(6, + "Verify no users", + fun() -> megaco:system_info(users) end, + []), + InitialCmd(7, + "Start user", + fun() -> megaco:start_user(Mid, []) end, + ok), + %% Verify user defaults - verify_user_default_command(Mid, Verify + 1, connections, []), - verify_user_default_command(Mid, Verify + 2, min_trans_id, 1), - verify_user_default_command(Mid, Verify + 3, max_trans_id, infinity), - verify_user_default_command(Mid, Verify + 4, request_timer, - #megaco_incr_timer{}), - verify_user_default_command(Mid, Verify + 5, long_request_timer, timer:seconds(60)), - verify_user_default_command(Mid, Verify + 6, auto_ack, false), - verify_user_default_command(Mid, Verify + 7, pending_timer, 30000), - verify_user_default_command(Mid, Verify + 8, reply_timer, 30000), - verify_user_default_command(Mid, Verify + 9, send_mod, megaco_tcp), - verify_user_default_command(Mid, Verify + 10, encoding_mod, - megaco_pretty_text_encoder), - verify_user_default_command(Mid, Verify + 11, encoding_config, []), - verify_user_default_command(Mid, Verify + 12, protocol_version, 1), - verify_user_default_command(Mid, Verify + 13, reply_data, undefined), - verify_user_default_command(Mid, Verify + 14, receive_handle, - fun(H) when is_record(H, megaco_receive_handle) -> {ok, H}; - (R) -> {error, R} - end), + VerifyCmd(Mid, 1, connections, []), + VerifyCmd(Mid, 2, min_trans_id, 1), + VerifyCmd(Mid, 3, max_trans_id, infinity), + VerifyCmd(Mid, 4, request_timer, #megaco_incr_timer{}), + VerifyCmd(Mid, 5, long_request_timer, timer:seconds(60)), + VerifyCmd(Mid, 6, auto_ack, false), + VerifyCmd(Mid, 7, pending_timer, 30000), + VerifyCmd(Mid, 8, reply_timer, 30000), + VerifyCmd(Mid, 9, send_mod, megaco_tcp), + VerifyCmd(Mid, 10, encoding_mod, megaco_pretty_text_encoder), + VerifyCmd(Mid, 11, encoding_config, []), + VerifyCmd(Mid, 12, protocol_version, 1), + VerifyCmd(Mid, 13, reply_data, undefined), + VerifyCmd(Mid, 14, receive_handle, + fun(H) when is_record(H, megaco_receive_handle) -> + {ok, H}; + (R) -> + {error, R} + end), %% Nice update - nice_user_update_command(Mid, Nice + 1, min_trans_id, Int), - nice_user_update_command(Mid, Nice + 2, max_trans_id, Int), - nice_user_update_command(Mid, Nice + 3, max_trans_id, infinity), - nice_user_update_command(Mid, Nice + 4, request_timer, Int), - nice_user_update_command(Mid, Nice + 5, request_timer, infinity), - nice_user_update_command(Mid, Nice + 6, request_timer, IT), - nice_user_update_command(Mid, Nice + 7, long_request_timer, Int), - nice_user_update_command(Mid, Nice + 8, long_request_timer, infinity), - nice_user_update_command(Mid, Nice + 9, long_request_timer, IT), - nice_user_update_command(Mid, Nice + 10, auto_ack, true), - nice_user_update_command(Mid, Nice + 11, auto_ack, false), - nice_user_update_command(Mid, Nice + 12, pending_timer, Int), - nice_user_update_command(Mid, Nice + 13, pending_timer, infinity), - nice_user_update_command(Mid, Nice + 14, pending_timer, IT), - nice_user_update_command(Mid, Nice + 15, reply_timer, Int), - nice_user_update_command(Mid, Nice + 16, reply_timer, infinity), - nice_user_update_command(Mid, Nice + 17, reply_timer, IT), - nice_user_update_command(Mid, Nice + 18, send_mod, an_atom), - nice_user_update_command(Mid, Nice + 19, encoding_mod, an_atom), - nice_user_update_command(Mid, Nice + 20, encoding_config, []), - nice_user_update_command(Mid, Nice + 21, protocol_version, Int), - nice_user_update_command(Mid, Nice + 23, reply_data, IT), - nice_user_update_command(Mid, Nice + 23, resend_indication, true), - nice_user_update_command(Mid, Nice + 24, resend_indication, false), - nice_user_update_command(Mid, Nice + 25, resend_indication, flag), + NiceCmd(Mid, 1, min_trans_id, Int), + NiceCmd(Mid, 2, max_trans_id, Int), + NiceCmd(Mid, 3, max_trans_id, infinity), + NiceCmd(Mid, 4, request_timer, Int), + NiceCmd(Mid, 5, request_timer, infinity), + NiceCmd(Mid, 6, request_timer, IT), + NiceCmd(Mid, 7, long_request_timer, Int), + NiceCmd(Mid, 8, long_request_timer, infinity), + NiceCmd(Mid, 9, long_request_timer, IT), + NiceCmd(Mid, 10, auto_ack, true), + NiceCmd(Mid, 11, auto_ack, false), + NiceCmd(Mid, 12, pending_timer, Int), + NiceCmd(Mid, 13, pending_timer, infinity), + NiceCmd(Mid, 14, pending_timer, IT), + NiceCmd(Mid, 15, reply_timer, Int), + NiceCmd(Mid, 16, reply_timer, infinity), + NiceCmd(Mid, 17, reply_timer, IT), + NiceCmd(Mid, 18, send_mod, an_atom), + NiceCmd(Mid, 19, encoding_mod, an_atom), + NiceCmd(Mid, 20, encoding_config, []), + NiceCmd(Mid, 21, protocol_version, Int), + NiceCmd(Mid, 23, reply_data, IT), + NiceCmd(Mid, 23, resend_indication, true), + NiceCmd(Mid, 24, resend_indication, false), + NiceCmd(Mid, 25, resend_indication, flag), %% Evil update - evil_user_update_command(Mid, Evil + 1, min_trans_id, NonInt), - evil_user_update_command(Mid, Evil + 2, max_trans_id, NonInt), - evil_user_update_command(Mid, Evil + 3, max_trans_id, non_infinity), - evil_user_update_command(Mid, Evil + 4, request_timer, NonInt), - evil_user_update_command(Mid, Evil + 5, request_timer, non_infinity), - evil_user_update_command(Mid, Evil + 6, request_timer, IT2), - evil_user_update_command(Mid, Evil + 7, request_timer, IT3), - evil_user_update_command(Mid, Evil + 8, request_timer, IT4), - evil_user_update_command(Mid, Evil + 9, request_timer, IT5), - evil_user_update_command(Mid, Evil + 10, long_request_timer, NonInt), - evil_user_update_command(Mid, Evil + 11, long_request_timer, non_infinity), - evil_user_update_command(Mid, Evil + 12, long_request_timer, IT2), - evil_user_update_command(Mid, Evil + 13, long_request_timer, IT3), - evil_user_update_command(Mid, Evil + 14, long_request_timer, IT4), - evil_user_update_command(Mid, Evil + 15, long_request_timer, IT5), - evil_user_update_command(Mid, Evil + 16, auto_ack, non_bool), - evil_user_update_command(Mid, Evil + 17, pending_timer, NonInt), - evil_user_update_command(Mid, Evil + 18, pending_timer, non_infinity), - evil_user_update_command(Mid, Evil + 19, pending_timer, IT2), - evil_user_update_command(Mid, Evil + 20, pending_timer, IT3), - evil_user_update_command(Mid, Evil + 21, pending_timer, IT4), - evil_user_update_command(Mid, Evil + 22, pending_timer, IT5), - evil_user_update_command(Mid, Evil + 23, reply_timer, NonInt), - evil_user_update_command(Mid, Evil + 24, reply_timer, non_infinity), - evil_user_update_command(Mid, Evil + 25, reply_timer, IT2), - evil_user_update_command(Mid, Evil + 26, reply_timer, IT3), - evil_user_update_command(Mid, Evil + 27, reply_timer, IT4), - evil_user_update_command(Mid, Evil + 28, reply_timer, IT5), - evil_user_update_command(Mid, Evil + 29, send_mod, {non_atom}), - evil_user_update_command(Mid, Evil + 30, encoding_mod, {non_atom}), - evil_user_update_command(Mid, Evil + 31, encoding_config, non_list), - evil_user_update_command(Mid, Evil + 32, protocol_version, NonInt), - evil_user_update_command(Mid, Evil + 33, resend_indication, flagg), - - - exit_command(End + 1, - "Verify non-existing system info", - fun() -> megaco:system_info(non_exist) end), - exit_command(End + 2, - "Verify non-existing user user info", - fun() -> megaco:user_info(non_exist, trans_id) end), - exit_command(End + 3, "Verify non-existing user info", - fun() -> megaco:user_info(Mid, non_exist) end), - - error_command(End + 4, - "Try updating user info for non-existing user", - fun() -> - megaco:update_user_info(non_exist, trans_id, 1) - end, - no_such_user, 2), - error_command(End + 11, - "Try updating non-existing user info", - fun() -> - megaco:update_user_info(Mid, trans_id, 4711) - end, - bad_user_val, 4), - error_command(End + 12, - "Try start already started user", - fun() -> - megaco:start_user(Mid, []) - end, - user_already_exists, 2), - - command(End + 13, "Verify started users", - fun() -> megaco:system_info(users) end, [Mid]), - command(End + 14, "Stop user", fun() -> megaco:stop_user(Mid) end, ok), - command(End + 15, "Verify started users", - fun() -> megaco:system_info(users) end, []), - error_command(End + 16, "Try stop not started user", - fun() -> megaco:stop_user(Mid) end, no_such_user, 2), - error_command(End + 17, "Try start megaco (it's already started)", - fun() -> megaco:start() end, already_started, 2), - command(End + 18, "Stop megaco", fun() -> megaco:stop() end, ok), - error_command(End + 19, "Try stop megaco (it's not running)", - fun() -> megaco:stop() end, not_started, 2) + EvilCmd(Mid, 1, min_trans_id, NonInt), + EvilCmd(Mid, 2, max_trans_id, NonInt), + EvilCmd(Mid, 3, max_trans_id, non_infinity), + EvilCmd(Mid, 4, request_timer, NonInt), + EvilCmd(Mid, 5, request_timer, non_infinity), + EvilCmd(Mid, 6, request_timer, IT2), + EvilCmd(Mid, 7, request_timer, IT3), + EvilCmd(Mid, 8, request_timer, IT4), + EvilCmd(Mid, 9, request_timer, IT5), + EvilCmd(Mid, 10, long_request_timer, NonInt), + EvilCmd(Mid, 11, long_request_timer, non_infinity), + EvilCmd(Mid, 12, long_request_timer, IT2), + EvilCmd(Mid, 13, long_request_timer, IT3), + EvilCmd(Mid, 14, long_request_timer, IT4), + EvilCmd(Mid, 15, long_request_timer, IT5), + EvilCmd(Mid, 16, auto_ack, non_bool), + EvilCmd(Mid, 17, pending_timer, NonInt), + EvilCmd(Mid, 18, pending_timer, non_infinity), + EvilCmd(Mid, 19, pending_timer, IT2), + EvilCmd(Mid, 20, pending_timer, IT3), + EvilCmd(Mid, 21, pending_timer, IT4), + EvilCmd(Mid, 22, pending_timer, IT5), + EvilCmd(Mid, 23, reply_timer, NonInt), + EvilCmd(Mid, 24, reply_timer, non_infinity), + EvilCmd(Mid, 25, reply_timer, IT2), + EvilCmd(Mid, 26, reply_timer, IT3), + EvilCmd(Mid, 27, reply_timer, IT4), + EvilCmd(Mid, 28, reply_timer, IT5), + EvilCmd(Mid, 29, send_mod, {non_atom}), + EvilCmd(Mid, 30, encoding_mod, {non_atom}), + EvilCmd(Mid, 31, encoding_config, non_list), + EvilCmd(Mid, 32, protocol_version, NonInt), + EvilCmd(Mid, 33, resend_indication, flagg), + + + %% End + ExitCmd(1, "Verify non-existing system info", + fun() -> megaco:system_info(non_exist) end), + ExitCmd(2, "Verify non-existing user user info", + fun() -> megaco:user_info(non_exist, trans_id) end), + ExitCmd(3, "Verify non-existing user info", + fun() -> megaco:user_info(Mid, non_exist) end), + + ErrorCmd(4, "Try updating user info for non-existing user", + fun() -> + megaco:update_user_info(non_exist, trans_id, 1) + end, + no_such_user, 2), + ErrorCmd(11, "Try updating non-existing user info", + fun() -> + megaco:update_user_info(Mid, trans_id, 4711) + end, + bad_user_val, 4), + ErrorCmd(12, "Try start already started user", + fun() -> megaco:start_user(Mid, []) end, + user_already_exists, 2), + + PlainCmd(13, "Verify started users", + fun() -> megaco:system_info(users) end, [Mid]), + PlainCmd(14, "Stop user", fun() -> megaco:stop_user(Mid) end, ok), + PlainCmd(15, "Verify started users", + fun() -> megaco:system_info(users) end, []), + ErrorCmd(16, "Try stop not started user", + fun() -> megaco:stop_user(Mid) end, no_such_user, 2), + ErrorCmd(17, "Try start megaco (it's already started)", + fun() -> megaco:start() end, already_started, 2), + PlainCmd(18, "Stop megaco", fun() -> megaco:stop() end, ok), + ErrorCmd(19, "Try stop megaco (it's not running)", + fun() -> megaco:stop() end, not_started, 2) ], @@ -279,7 +310,7 @@ exec([#command{id = No, desc = Desc, cmd = Cmd, verify = Verify}|Commands]) -> - io:format("Executing command ~2w: ~s: ", [No, Desc]), + io:format("Executing command ~3w: ~s: ", [No, Desc]), case (catch Verify((catch Cmd()))) of {ok, OK} -> io:format("ok => ~p~n", [OK]), @@ -320,7 +351,7 @@ nice_user_update_command(Mid, No, Key, Val) -> evil_user_update_command(Mid, No, Key, Val) -> - Desc = lists:flatten(io_lib:format("Evil: Update ~w", [Key])), + Desc = lists:flatten(io_lib:format("Evil - Update ~w", [Key])), Cmd = fun() -> case (catch megaco:user_info(Mid, Key)) of {'EXIT', R} -> @@ -371,14 +402,19 @@ error_command(No, Desc, Cmd, MainReason, TS) when is_function(Cmd) -> end, command(No, Desc, Cmd, Verify). -command(No, Desc, Cmd, Verify) when is_integer(No) and is_list(Desc) and - is_function(Cmd) and is_function(Verify) -> +command(No, Desc, Cmd, Verify) + when (is_integer(No) andalso + is_list(Desc) andalso + is_function(Cmd) andalso + is_function(Verify)) -> #command{id = No, desc = Desc, cmd = Cmd, verify = Verify}; -command(No, Desc, Cmd, VerifyVal) when is_integer(No) and is_list(Desc) and - is_function(Cmd) -> +command(No, Desc, Cmd, VerifyVal) + when (is_integer(No) andalso + is_list(Desc) andalso + is_function(Cmd)) -> Verify = fun(Val) -> case Val of VerifyVal -> @@ -881,6 +917,12 @@ otp_8167(Config) when is_list(Config) -> p("connect ok: CD = ~n~p", [CD]), CH = CD#conn_data.conn_handle, + p("get value for item cancel from connection: ~p", [CH]), + false = megaco_config:conn_info(CH, cancel), + + p("get value for item cancel from connection data", []), + false = megaco_config:conn_info(CD, cancel), + p("get value for item call_proxy_gc_timeout for connection: ~p", [CH]), 10101 = megaco_config:conn_info(CH, call_proxy_gc_timeout), diff --git a/lib/megaco/vsn.mk b/lib/megaco/vsn.mk index 19eca6d309..cf5957460d 100644 --- a/lib/megaco/vsn.mk +++ b/lib/megaco/vsn.mk @@ -18,11 +18,13 @@ # %CopyrightEnd% APPLICATION = megaco -MEGACO_VSN = 3.14 +MEGACO_VSN = 3.14.1 PRE_VSN = APP_VSN = "$(APPLICATION)-$(MEGACO_VSN)$(PRE_VSN)" -TICKETS = OTP-8317 OTP-8323 OTP-8328 OTP-8362 OTP-8403 +TICKETS = OTP-8561 OTP-8627 + +TICKETS_3_14 = OTP-8317 OTP-8323 OTP-8328 OTP-8362 OTP-8403 TICKETS_3_13 = OTP-8205 OTP-8239 OTP-8249 diff --git a/lib/public_key/src/pubkey_cert.erl b/lib/public_key/src/pubkey_cert.erl index 8f7dfa8352..799e3820d1 100644 --- a/lib/public_key/src/pubkey_cert.erl +++ b/lib/public_key/src/pubkey_cert.erl @@ -134,9 +134,10 @@ validate_names(OtpCert, Permit, Exclude, Last, AccErr, Verify) -> false -> TBSCert = OtpCert#'OTPCertificate'.tbsCertificate, Subject = TBSCert#'OTPTBSCertificate'.subject, + Extensions = + extensions_list(TBSCert#'OTPTBSCertificate'.extensions), AltSubject = - select_extension(?'id-ce-subjectAltName', - TBSCert#'OTPTBSCertificate'.extensions), + select_extension(?'id-ce-subjectAltName', Extensions), EmailAddress = extract_email(Subject), Name = [{directoryName, Subject}|EmailAddress], @@ -212,7 +213,7 @@ is_issuer({rdnSequence, Issuer}, {rdnSequence, Candidate}) -> issuer_id(Otpcert, other) -> TBSCert = Otpcert#'OTPCertificate'.tbsCertificate, - Extensions = TBSCert#'OTPTBSCertificate'.extensions, + Extensions = extensions_list(TBSCert#'OTPTBSCertificate'.extensions), case select_extension(?'id-ce-authorityKeyIdentifier', Extensions) of undefined -> {error, issuer_not_found}; @@ -232,12 +233,17 @@ is_fixed_dh_cert(#'OTPCertificate'{tbsCertificate = SubjectPublicKeyInfo, extensions = Extensions}}) -> - is_fixed_dh_cert(SubjectPublicKeyInfo, Extensions). + is_fixed_dh_cert(SubjectPublicKeyInfo, extensions_list(Extensions)). %%-------------------------------------------------------------------- %%% Internal functions %%-------------------------------------------------------------------- +extensions_list(asn1_NOVALUE) -> + []; +extensions_list(Extensions) -> + Extensions. + not_valid(Error, true, _) -> throw(Error); not_valid(Error, false, AccErrors) -> diff --git a/lib/public_key/vsn.mk b/lib/public_key/vsn.mk index da1465d538..8c4e4127b2 100644 --- a/lib/public_key/vsn.mk +++ b/lib/public_key/vsn.mk @@ -1,7 +1,10 @@ -PUBLIC_KEY_VSN = 0.6 -TICKETS = OTP-7046 \ - OTP-8553 -#TICKETS_o.5 = OTP-8372 +PUBLIC_KEY_VSN = 0.7 + +TICKETS = OTP-8626 + +#TICKETS_0.6 = OTP-7046 \ +# OTP-8553 +#TICKETS_0.5 = OTP-8372 #TICKETS_0.4 = OTP-8250 #TICKETS_0.3 = OTP-8100 OTP-8142 #TICKETS_0.2 = OTP-7860 diff --git a/lib/reltool/bin/reltool.escript b/lib/reltool/bin/reltool.escript new file mode 100644 index 0000000000..0dcd5ad1e9 --- /dev/null +++ b/lib/reltool/bin/reltool.escript @@ -0,0 +1,249 @@ +#!/usr/bin/env escript +%% -*- erlang -*- +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 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% + +-include_lib("reltool/src/reltool.hrl"). + +main(Args) -> + process_flag(trap_exit, true), + try + Tokens = scan_args(Args, [], []), + {Options, Actions} = parse_args(Tokens, []), + case invoke(Options, Actions) of + ok -> + safe_stop(0); + {error, ReasonString} -> + fatal_error(ReasonString, 2) + end + catch + throw:usage -> + usage(), + safe_stop(1); + exit:Reason -> + String = lists:flatten(io_lib:format("EXIT: ~p", [Reason])), + fatal_error(String, 3) + end. + +usage() -> + Usage = + [ + "[Config] [--window]", + "[Config] --create_config [-defaults] [-derived] [ConfigFile]", + "[Config] --create_rel RelName [RelFile]", + "[Config] --create_script RelName [ScriptFile]", + "[Config] --create_target TargetDir", + "[Config] --create_target_spec [SpecFile]", + "[Config] --eval_target_spec Spec TargetDir RootDir" + ], + Script = script_name(), + String = lists:flatten([[Script, " ", U, "\n"] || U <- Usage]), + io:format("Erlang/OTP release management tool\n\n" + "~s\nConfig = ConfigFile | '{sys, [sys()]}'\n" + "Spec = SpecFile | '{spec, [target_spec()}']\n\n" + "See User's guide and Reference manual for more info.\n", + [String]). + +safe_stop(Code) -> + init:stop(Code), + timer:sleep(infinity). + +invoke(Options, Actions) -> + case Actions of + [] -> + invoke(Options, [["--window"]]); + [["--window"]] -> + start_window(Options); + [["--create_config" | OptArgs]] -> + DefArg = "-defaults", + DerivArg = "-derived", + InclDef = lists:member(DefArg, OptArgs), + InclDeriv = lists:member(DerivArg, OptArgs), + case reltool:get_config(Options, InclDef, InclDeriv) of + {ok, Config} -> + String = pretty("config", Config), + case OptArgs -- [DefArg, DerivArg] of + [] -> + format("~s", [String]); + [ConfigFile] -> + write_file(ConfigFile, String); + _ -> + throw(usage) + end; + {error, Reason} -> + {error, Reason} + end; + [["--create_rel", RelName | OptArgs]] -> + case reltool:get_rel(Options, RelName) of + {ok, Rel} -> + String = pretty("rel", Rel), + case OptArgs of + [] -> + format("~s", [String]); + [RelFile] -> + write_file(RelFile, String); + _ -> + throw(usage) + end; + {error, Reason} -> + {error, Reason} + end; + [["--create_script", RelName | OptArgs]] -> + case reltool:get_script(Options, RelName) of + {ok, Script} -> + String = pretty("script", Script), + case OptArgs of + [] -> + format("~s", [String]); + [ScriptFile] -> + write_file(ScriptFile, String); + _ -> + throw(usage) + end; + {error, Reason} -> + {error, Reason} + end; + [["--create_target", TargetDir]] -> + reltool:create_target(Options, TargetDir); + [["--create_target_spec" | OptArgs]] -> + case reltool:get_target_spec(Options) of + {ok, Script} -> + String = pretty("target_spec", Script), + case OptArgs of + [] -> + format("~s", [String]); + [SpecFile] -> + write_file(SpecFile, String); + _ -> + throw(usage) + end; + {error, Reason} -> + {error, Reason} + end; + [["--eval_target_spec", TargetSpec, TargetDir, RootDir]] -> + try + {ok, Tokens, _} = erl_scan:string(TargetSpec ++ ". "), + {ok, {spec, Spec}} = erl_parse:parse_term(Tokens), + reltool:eval_target_spec(Spec, TargetDir, RootDir) + catch + error:{badmatch, _} -> + case file:consult(TargetSpec) of + {ok, Spec2} -> + reltool:eval_target_spec(Spec2, TargetDir, RootDir); + {error, Reason} -> + Text = file:format_error(Reason), + {error, TargetSpec ++ ": " ++ Text} + end + end; + _ -> + throw(usage) + end. + +start_window(Options) -> + case reltool:start_link(Options) of + {ok, WinPid} -> + receive + {'EXIT', WinPid, shutdown} -> + ok; + {'EXIT', WinPid, normal} -> + ok; + {'EXIT', WinPid, Reason} -> + exit(Reason) + end; + {error, Reason} -> + {error, Reason} + end. + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +%% Helpers +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% + +script_name() -> + filename:basename(escript:script_name(), ".escript"). + +fatal_error(String, Code) -> + io:format(standard_error, "~s: ~s\n", [script_name(), String]), + safe_stop(Code). + +write_file(File, IoList) -> + case file:write_file(File, IoList) of + ok -> + ok; + {error, Reason} -> + {error, file:format_error(Reason)} + end. + +format(Format, Args) -> + io:format(Format, Args), + %% Wait a while for the I/O to be processed + timer:sleep(timer:seconds(1)). + +pretty(Tag, Term) -> + lists:flatten(io_lib:format("%% ~s generated at ~w ~w\n~p.\n\n", + [Tag, date(), time(), Term])). + +scan_args([H | T], Single, Multi) -> + case H of + "--" ++ _ when Single =:= [] -> + scan_args(T, [H], Multi); + "--" ++ _ -> + scan_args(T, [H], [lists:reverse(Single) | Multi]); + _ -> + scan_args(T, [H | Single], Multi) + end; +scan_args([], [], Multi) -> + lists:reverse(Multi); +scan_args([], Single, Multi) -> + lists:reverse([lists:reverse(Single) | Multi]). + +parse_args([H | T] = Args, Options) -> + case H of + ["--wx_debug" | Levels] -> + Dbg = + fun(L) -> + case catch list_to_integer(L) of + {'EXIT', _} -> + case catch list_to_atom(L) of + {'EXIT', _} -> + exit("Illegal wx debug level: " ++ L); + Atom -> + Atom + end; + Int -> + Int + end + end, + Levels2 = lists:map(Dbg, Levels), + parse_args(T, [{wx_debug, Levels2} | Options]); + ["--" ++ _ | _] -> + %% No more options + {lists:reverse(Options), Args}; + [Config] -> + try + {ok, Tokens, _} = erl_scan:string(Config ++ ". "), + {ok, {sys, _} = Sys} = erl_parse:parse_term(Tokens), + parse_args(T, [{config, Sys} | Options]) + catch + error:{badmatch, _} -> + parse_args(T, [{config, Config} | Options]); + X:Y -> + io:format("\n\n~p\n\n", [{X, Y}]) + end + end; +parse_args([], Options) -> + {lists:reverse(Options), []}. diff --git a/lib/reltool/doc/src/reltool.xml b/lib/reltool/doc/src/reltool.xml index 9786928ae8..0c2b7d2a2b 100644 --- a/lib/reltool/doc/src/reltool.xml +++ b/lib/reltool/doc/src/reltool.xml @@ -67,14 +67,14 @@ <taglist> - <tag><c><![CDATA[config]]></c></tag> + <tag><c>config</c></tag> <item> <p>This is the main option and it controls the configuration of <c>reltool</c>. It can either be a <c>sys</c> tuple or a name of a <c>file</c> containing a sys tuple.</p> </item> - <tag><c><![CDATA[trap_exit]]></c></tag> + <tag><c>trap_exit></c></tag> <item> <p>This option controls the error handling behavior of <c>reltool</c>. By default the window processes traps @@ -82,7 +82,7 @@ <c>trap_exit</c> to <c>false</c>.</p> </item> - <tag><c><![CDATA[wx_debug]]></c></tag> + <tag><c>wx_debug</c></tag> <item> <p>This option controls the debug level of <c>wx</c>. As its name indicates it is only useful for debugging. See @@ -97,27 +97,27 @@ <taglist> - <tag><c><![CDATA[erts]]></c></tag> + <tag><c>erts</c></tag> <item> <p>Erts specific configuration. See application level options below.</p> </item> - <tag><c><![CDATA[escript]]></c></tag> + <tag><c>escript</c></tag> <item> <p>Escript specific configuration. An escript has a mandatory file name and escript level options that are described below.</p> </item> - <tag><c><![CDATA[app]]></c></tag> + <tag><c>app</c></tag> <item> <p>Application specific configuration. An application has a mandatory name and application level options that are described below.</p> </item> - <tag><c><![CDATA[mod_cond]]></c></tag> + <tag><c>mod_cond</c></tag> <item> <p>This parameter controls the module inclusion policy. It defaults to <c>all</c> which means that if an application is @@ -134,28 +134,28 @@ system level is used as default for all applications.</p> </item> - <tag><c><![CDATA[incl_cond]]></c></tag> + <tag><c>incl_cond</c></tag> <item> - <p>This parameter controls the application and escript - inclusion policy. It defaults to <c>derived</c> which means - that the applications that not have any explicit - <c>incl_cond</c> setting, will only be included if any other - (explicitly or implicitly included) application uses it. The - value <c>include</c> implies that all applications and - escripts that that not have any explicit <c>incl_cond</c> - setting will be included. <c>exclude</c> implies that all - applications and escripts) that that not have any explicit - <c>incl_cond</c> setting will be excluded.</p> + <p>This parameter controls the application and escript + inclusion policy. It defaults to <c>derived</c> which means + that the applications that not have any explicit + <c>incl_cond</c> setting, will only be included if any other + (explicitly or implicitly included) application uses it. The + value <c>include</c> implies that all applications and + escripts that that not have any explicit <c>incl_cond</c> + setting will be included. <c>exclude</c> implies that all + applications and escripts) that that not have any explicit + <c>incl_cond</c> setting will be excluded.</p> </item> - <tag><c><![CDATA[boot_rel]]></c></tag> + <tag><c>boot_rel</c></tag> <item> <p>A target system may have several releases but the one given as <c>boot_rel</c> will be used as default when the system is booting up.</p> </item> - <tag><c><![CDATA[rel]]></c></tag> + <tag><c>rel</c></tag> <item> <p>Release specific configuration. Each release maps to a <c>rel</c>, <c>script</c> and <c>boot </c> file. See the @@ -165,38 +165,38 @@ applications.</p> </item> - <tag><c><![CDATA[relocatable]]></c></tag> + <tag><c>relocatable</c></tag> <item> - <p>This parameter controls whether the <c>erl</c> executable - in the target system automatically should determine where it - is installed or if it should use a hardcoded path to the - installation. In the latter case the target system must be - installed with <c>reltool:install/2</c> before it can be - used. If the system is relocatable, the file tree containing - the target system can be moved to another location without - re-installation. The default is <c>true</c>.</p> + <p>This parameter controls whether the <c>erl</c> executable + in the target system automatically should determine where it + is installed or if it should use a hardcoded path to the + installation. In the latter case the target system must be + installed with <c>reltool:install/2</c> before it can be + used. If the system is relocatable, the file tree containing + the target system can be moved to another location without + re-installation. The default is <c>true</c>.</p> </item> - <tag><c><![CDATA[profile]]></c></tag> + <tag><c>profile</c></tag> <item> - <p>The creation of the specification for a target system is - performed in two steps. In the first step a complete - specification is generated. It will likely contain much more - files than you are interested in your customized target - system. In the second step the specification will be filtered - according to your filters. There you have the ability to - specify filters per application as well as system wide - filters. You can also select a <c>profile</c> for your - system. Depending on the <c>profile</c>, different default - filters will be used. There are three different profiles to - choose from: <c>development</c>, <c>embedded</c> and - <c>standalone</c>. <c>development</c> is default. The - parameters that are affected by the <c>profile</c> are: - <c>incl_sys_filters</c>, <c>excl_sys_filters</c>, - <c>incl_app_filters</c> and <c>excl_app_filters</c>.</p> + <p>The creation of the specification for a target system is + performed in two steps. In the first step a complete + specification is generated. It will likely contain much more + files than you are interested in your customized target + system. In the second step the specification will be filtered + according to your filters. There you have the ability to + specify filters per application as well as system wide + filters. You can also select a <c>profile</c> for your + system. Depending on the <c>profile</c>, different default + filters will be used. There are three different profiles to + choose from: <c>development</c>, <c>embedded</c> and + <c>standalone</c>. <c>development</c> is default. The + parameters that are affected by the <c>profile</c> are: + <c>incl_sys_filters</c>, <c>excl_sys_filters</c>, + <c>incl_app_filters</c> and <c>excl_app_filters</c>.</p> </item> - <tag><c><![CDATA[app_file]]></c></tag> + <tag><c>app_file</c></tag> <item> <p>This parameter controls the default handling of the <c>app</c> files when a target system is generated. It @@ -213,7 +213,7 @@ and <c>strip</c>.</p> </item> - <tag><c><![CDATA[debug_info]]></c></tag> + <tag><c>debug_info</c></tag> <item> <p>The <c>debug_info</c> parameter controls whether the debug information in the beam file should be kept (<c>keep</c>) or @@ -221,7 +221,7 @@ system.</p> </item> - <tag><c><![CDATA[incl_sys_filters]]></c></tag> + <tag><c>incl_sys_filters</c></tag> <item> <p>This parameter normally contains a list of regular expressions that controls which files in the system that @@ -235,7 +235,7 @@ <c>[".*"]</c>.</p> </item> - <tag><c><![CDATA[excl_sys_filters]]></c></tag> + <tag><c>excl_sys_filters</c></tag> <item> <p>This parameter normally contains a list of regular expressions that controls which files in the system that not @@ -245,7 +245,7 @@ <c>excl_sys_filters</c>. This parameter defaults to <c>[]</c>.</p> </item> - <tag><c><![CDATA[incl_app_filters]]></c></tag> + <tag><c>incl_app_filters</c></tag> <item> <p>This parameter normally contains a list of regular expressions that controls which application specific files @@ -256,7 +256,7 @@ parameter defaults to <c>[".*"]</c>.</p> </item> - <tag><c><![CDATA[excl_app_filters]]></c></tag> + <tag><c>excl_app_filters</c></tag> <item> <p>This parameter normally contains a list of regular expressions that controls which application specific files @@ -267,7 +267,7 @@ <c>[]</c>.</p> </item> - <tag><c><![CDATA[incl_archive_filters]]></c></tag> + <tag><c>incl_archive_filters</c></tag> <item> <p>This parameter normally contains a list of regular expressions that controls which top level directories in an @@ -280,7 +280,7 @@ parameter defaults to <c>[".*"]</c>.</p> </item> - <tag><c><![CDATA[excl_archive_filters]]></c></tag> + <tag><c>excl_archive_filters</c></tag> <item> <p>This parameter normally contains a list of regular expressions that controls which top level directories in an @@ -291,7 +291,7 @@ parameter defaults to <c>["^include$","^priv$"]</c>.</p> </item> - <tag><c><![CDATA[archive_opts]]></c></tag> + <tag><c>archive_opts</c></tag> <item> <p>This parameter contains a list of options that are given to <c>zip:create/3</c> when application specific files are @@ -307,7 +307,7 @@ supported:</p> <taglist> - <tag><c><![CDATA[incl_cond]]></c></tag> + <tag><c>incl_cond</c></tag> <item> <p>The value of this parameter overrides the parameter with the same name on system level.</p> @@ -318,62 +318,62 @@ supported:</p> <taglist> - <tag><c><![CDATA[vsn]]></c></tag> + <tag><c>vsn</c></tag> <item> <p>The version of the application. In an installed system there may exist several versions of an application. The <c>vsn</c> parameter controls which version of the application that will be choosen. If it is omitted, the latest version will be choosen.</p> </item> - <tag><c><![CDATA[mod]]></c></tag> + <tag><c>mod</c></tag> <item> <p>Module specific configuration. A module has a mandatory name and module level options that are described below.</p> </item> - <tag><c><![CDATA[mod_cond]]></c></tag> + <tag><c>mod_cond</c></tag> <item> <p>The value of this parameter overrides the parameter with the same name on system level.</p> </item> - <tag><c><![CDATA[incl_cond]]></c></tag> + <tag><c>incl_cond</c></tag> <item> <p>The value of this parameter overrides the parameter with the same name on system level.</p> </item> - <tag><c><![CDATA[app_file]]></c></tag> + <tag><c>app_file</c></tag> <item> <p>The value of this parameter overrides the parameter with the same name on system level.</p> </item> - <tag><c><![CDATA[debug_info]]></c></tag> + <tag><c>debug_info</c></tag> <item> <p>The value of this parameter overrides the parameter with the same name on system level.</p> </item> - <tag><c><![CDATA[incl_app_filters]]></c></tag> + <tag><c>incl_app_filters</c></tag> <item> <p>The value of this parameter overrides the parameter with the same name on system level.</p> </item> - <tag><c><![CDATA[excl_app_filters]]></c></tag> + <tag><c>excl_app_filters</c></tag> <item> <p>The value of this parameter overrides the parameter with the same name on system level.</p> </item> - <tag><c><![CDATA[incl_archive_filters]]></c></tag> + <tag><c>incl_archive_filters</c></tag> <item> <p>The value of this parameter overrides the parameter with the same name on system level.</p> </item> - <tag><c><![CDATA[excl_archive_filters]]></c></tag> + <tag><c>excl_archive_filters</c></tag> <item> <p>The value of this parameter overrides the parameter with the same name on system level.</p> </item> - <tag><c><![CDATA[archive_opts]]></c></tag> + <tag><c>archive_opts</c></tag> <item> <p>The value of this parameter overrides the parameter with the same name on system level.</p> @@ -384,18 +384,18 @@ supported:</p> <taglist> - <tag><c><![CDATA[incl_cond]]></c></tag> + <tag><c>incl_cond</c></tag> <item> - <p>This parameter controls whether the module is included or not. By - default the <c>mod_incl</c> parameter on application and system level - will be used to control whether the module is included or not. The - value of <c>incl_cond</c> overrides the module inclusion policy. - <c>include</c> implies that the module is included, while - <c>exclude</c> implies that the module not is included. - <c>derived</c> implies that the is included if any included uses the - module.</p> + <p>This parameter controls whether the module is included or not. By + default the <c>mod_incl</c> parameter on application and system level + will be used to control whether the module is included or not. The + value of <c>incl_cond</c> overrides the module inclusion policy. + <c>include</c> implies that the module is included, while + <c>exclude</c> implies that the module not is included. + <c>derived</c> implies that the is included if any included uses the + module.</p> </item> - <tag><c><![CDATA[debug_info]]></c></tag> + <tag><c>debug_info</c></tag> <item> <p>The value of this parameter overrides the parameter with the same name on application level.</p> @@ -477,7 +477,9 @@ mod_name() = atom() profile() = development | embedded | standalone re_regexp() = string() reason() = string() -regexps() = [re_regexp()] | {add, [re_regexp()]} | {del, [re_regexp()]} +regexps() = [re_regexp()] + | {add, [re_regexp()]} + | {del, [re_regexp()]} rel_file() = term() rel_name() = string() rel_vsn() = string() @@ -487,7 +489,19 @@ script_file() = term() server() = server_pid() | options() server_pid() = pid() target_dir() = file() -window_pid() = pid()]]></code> +window_pid() = pid() +base_dir() = dir() +base_file() = file() +top_dir() = file() +top_file() = file() +target_spec() = [target_spec()] + | {create_dir, base_dir(), [target_spec()]} + | {create_dir, base_dir(), top_dir(), [target_spec()]} + | {archive, base_file(), [archive_opt()], [target_spec()]} + | {copy_file, base_file()} + | {copy_file, base_file(), top_file()} + | {write_file, base_file(), iolist()} + | {strip_beam_file, base_file()}]]></code> <marker id="start"></marker> </section> @@ -497,9 +511,9 @@ window_pid() = pid()]]></code> <name>create_target(Server, TargetDir) -> ok | {error, Reason}</name> <fsummary>Create a target system</fsummary> <type> - <v>Server = server()</v> + <v>Server = server()</v> <v>TargetDir = target_dir()</v> - <v>Reason = reason()</v> + <v>Reason = reason()</v> </type> <desc><p>Create a target system. Gives the same result as <c>{ok,TargetSpec}=reltool:get_target_spec(Server)</c> and @@ -604,6 +618,17 @@ window_pid() = pid()]]></code> </func> <func> + <name>get_status(Server) -> {ok, [Warning]} | {error, Reason}</name> + <fsummary>Get contents of a release file</fsummary> + <type> + <v>Server = server()</v> + <v>Warning = string()</v> + <v>Reason = reason()</v> + </type> + <desc><p>Get status about the configuration</p></desc> + </func> + + <func> <name>get_server(WindowPid) -> {ok, ServerPid} | {error, Reason}</name> <fsummary>Start server process with options</fsummary> <type> diff --git a/lib/reltool/doc/src/reltool_examples.xml b/lib/reltool/doc/src/reltool_examples.xml index d6db246f6c..bce9413b52 100644 --- a/lib/reltool/doc/src/reltool_examples.xml +++ b/lib/reltool/doc/src/reltool_examples.xml @@ -249,11 +249,11 @@ Eshell V5.7.3 (abort with ^G) <pre> 5> {ok, Server} = reltool:start_server([{config, {sys, [{boot_rel, "NAME"}, {rel, "NAME", "VSN", - [kernel, stdlib, sasl]}]}}]). + [sasl]}]}}]). {ok,<0.1288.0>} 6> reltool:get_config(Server). {ok,{sys,[{boot_rel,"NAME"}, - {rel,"NAME","VSN",[kernel,stdlib,sasl]}]}} + {rel,"NAME","VSN",[sasl]}]}} 7> reltool:get_rel(Server, "NAME"). {ok,{release,{"NAME","VSN"}, {erts,"5.7"}, diff --git a/lib/reltool/src/Makefile b/lib/reltool/src/Makefile index 7fac7cbf88..4e6a112b7e 100644 --- a/lib/reltool/src/Makefile +++ b/lib/reltool/src/Makefile @@ -28,7 +28,6 @@ include ../vsn.mk VSN = $(RELTOOL_VSN) APP_VSN = "reltool-$(VSN)" - # ---------------------------------------------------- # Release directory specification # ---------------------------------------------------- @@ -39,25 +38,20 @@ RELSYSDIR = $(RELEASE_PATH)/lib/reltool-$(VSN) # Target Specs # ---------------------------------------------------- -MODULES = \ - reltool \ - reltool_app_win \ - reltool_fgraph \ - reltool_fgraph_win \ - reltool_mod_win \ - reltool_sys_win \ - reltool_server \ - reltool_target \ - reltool_utils - -HRL_FILES = - -INTERNAL_HRL_FILES = reltool.hrl reltool_fgraph.hrl +include files.mk ERL_FILES = $(MODULES:%=%.erl) TARGET_FILES= $(MODULES:%=$(EBIN)/%.$(EMULATOR)) +APP_FILE = reltool.app +APP_SRC = $(APP_FILE).src +APP_TARGET = $(EBIN)/$(APP_FILE) + +APPUP_FILE = reltool.appup +APPUP_SRC = $(APPUP_FILE).src +APPUP_TARGET = $(EBIN)/$(APPUP_FILE) + # ---------------------------------------------------- # FLAGS # ---------------------------------------------------- @@ -69,15 +63,28 @@ ERL_COMPILE_FLAGS += +'{parse_transform,sys_pre_attributes}' \ # Targets # ---------------------------------------------------- -debug opt: $(TARGET_FILES) $(HRL_FILES) +debug: + @${MAKE} TYPE=debug opt + +opt: $(TARGET_FILES) $(APP_TARGET) $(APPUP_TARGET) clean: - rm -f $(TARGET_FILES) + rm -f $(TARGET_FILES) $(APP_TARGET) $(APPUP_TARGET) rm -f core docs: # ---------------------------------------------------- +# Special Build Targets +# ---------------------------------------------------- + +$(APP_TARGET): $(APP_SRC) ../vsn.mk + sed -e 's;%VSN%;$(VSN);' $< > $@ + +$(APPUP_TARGET): $(APPUP_SRC) ../vsn.mk + sed -e 's;%VSN%;$(VSN);' $< > $@ + +# ---------------------------------------------------- # Dependencies # ---------------------------------------------------- @@ -94,6 +101,7 @@ release_spec: opt $(INSTALL_DATA) $(INTERNAL_HRL_FILES) $(ERL_FILES) $(RELSYSDIR)/src $(INSTALL_DIR) $(RELSYSDIR)/ebin $(INSTALL_DATA) $(TARGET_FILES) $(RELSYSDIR)/ebin + $(INSTALL_DATA) $(APP_TARGET) $(APPUP_TARGET) $(RELSYSDIR)/ebin release_docs_spec: diff --git a/lib/reltool/src/files.mk b/lib/reltool/src/files.mk new file mode 100644 index 0000000000..99a1f1c14a --- /dev/null +++ b/lib/reltool/src/files.mk @@ -0,0 +1,32 @@ +#-*-makefile-*- ; force emacs to enter makefile-mode +# %CopyrightBegin% +# +# Copyright Ericsson AB 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% + +MODULES = \ + reltool \ + reltool_app_win \ + reltool_fgraph \ + reltool_fgraph_win \ + reltool_mod_win \ + reltool_sys_win \ + reltool_server \ + reltool_target \ + reltool_utils + +HRL_FILES = + +INTERNAL_HRL_FILES = reltool.hrl reltool_fgraph.hrl diff --git a/lib/reltool/src/reltool.app.src b/lib/reltool/src/reltool.app.src index f83042c157..b80753e8fc 100644 --- a/lib/reltool/src/reltool.app.src +++ b/lib/reltool/src/reltool.app.src @@ -1,37 +1,38 @@ %% This is an -*- erlang -*- file. %% %% %CopyrightBegin% -%% -%% Copyright Ericsson AB 2009. All Rights Reserved. -%% +%% +%% Copyright Ericsson AB 2009-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% %% +%% %CopyrightEnd% {application, reltool, - [{description, "Release management tool"}, - {vsn, "%VSN%"}, - {modules, [ - reltool, - reltool_app, - reltool_fgraph, - reltool_fgraph_win, - reltool_gen, - reltool_mod, - reltool_sys, - reltool_server, - reltool_utils - ]}, - {applications, [kernel, stdlib]} - ] -}. + [{description, "Reltool the release management tool"}, + {vsn, "%VSN%"}, + {modules, + [ + reltool_app_win, + reltool, + reltool_fgraph, + reltool_fgraph_win, + reltool_mod_win, + reltool_server, + reltool_sys_win, + reltool_target, + reltool_utils + ]}, + {registered, []}, + {applications, [stdlib, kernel]}, + {env, []} + ]}. diff --git a/lib/reltool/src/reltool.appup.src b/lib/reltool/src/reltool.appup.src new file mode 100644 index 0000000000..c02edd2afb --- /dev/null +++ b/lib/reltool/src/reltool.appup.src @@ -0,0 +1,22 @@ +%% This is an -*- erlang -*- file. +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 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% + +{"%VSN%", + [ ] +}. diff --git a/lib/reltool/src/reltool.erl b/lib/reltool/src/reltool.erl index e6a8bca069..9dd0a24f46 100644 --- a/lib/reltool/src/reltool.erl +++ b/lib/reltool/src/reltool.erl @@ -20,9 +20,8 @@ %% Public -export([ - main/1, % Escript start/0, start/1, start_link/1, debug/0, % GUI - start_server/1, get_server/1, stop/1, + start_server/1, get_server/1, get_status/1, stop/1, get_config/1, get_config/3, get_rel/2, get_script/2, create_target/2, get_target_spec/1, eval_target_spec/3, install/2 @@ -32,39 +31,26 @@ %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -%% Main function for escript --spec main([escript_arg()]) -> ok. -main(_) -> - process_flag(trap_exit, true), - {ok, WinPid} = start_link([]), - receive - {'EXIT', WinPid, shutdown} -> - ok; - {'EXIT', WinPid, normal} -> - ok; - {'EXIT', WinPid, Reason} -> - io:format("EXIT: ~p\n", [Reason]), - erlang:halt(1) - end. - %% Start main window process --spec start() -> {ok, window_pid()}. +-spec start() -> {ok, window_pid()} | {error, reason()}. start() -> start([]). %% Start main window process --spec start(options()) -> {ok, window_pid() | {error, reason()}}. +-spec start(options()) -> {ok, window_pid()} | {error, reason()}. start(Options)when is_list(Options) -> - {ok, WinPid} = start_link(Options), - unlink(WinPid), - {ok, WinPid}. + case start_link(Options) of + {ok, WinPid} -> + unlink(WinPid), + {ok, WinPid}; + Other-> + Other + end. %% Start main window process with wx debugging enabled --spec debug() -> {ok, window_pid()}. +-spec debug() -> {ok, window_pid()} | {error, reason()}. debug() -> - {ok, WinPid} = start_link([{wx_debug, 2}]), - unlink(WinPid), - {ok, WinPid}. + start([{wx_debug, 2}]). %% Start main window process with options -spec start_link(options()) -> {ok, window_pid() | {error, reason()}}. @@ -110,20 +96,48 @@ stop(Pid) when is_pid(Pid) -> end. %% Internal library function --spec eval_server(server(), fun((server_pid()) -> term())) -> +-spec eval_server(server(), boolean(), fun((server_pid()) -> term())) -> {ok, server_pid()} | {error, reason()}. -eval_server(Pid, Fun) when is_pid(Pid) -> +eval_server(Pid, DisplayWarnings, Fun) + when is_pid(Pid) -> Fun(Pid); -eval_server(Options, Fun) when is_list(Options), is_function(Fun, 1) -> - case start_server(Options) of - {ok, Pid} -> - Res = Fun(Pid), - stop(Pid), - Res; - {error, Reason} -> - {error, Reason} +eval_server(Options, DisplayWarnings, Fun) + when is_list(Options) -> + TrapExit = process_flag(trap_exit, true), + Res = case start_server(Options) of + {ok, Pid} -> + apply_fun(Pid, DisplayWarnings, Fun); + {error, Reason} -> + {error, Reason} + end, + process_flag(trap_exit, TrapExit), + Res. + +apply_fun(Pid, false, Fun) -> + Res = Fun(Pid), + stop(Pid), + Res; +apply_fun(Pid, true, Fun) -> + case get_status(Pid) of + {ok, Warnings} -> + [io:format("~p: ~s\n", [?APPLICATION, W]) || W <- Warnings], + apply_fun(Pid, false, Fun); + {error, Reason} -> + stop(Pid), + {error, Reason} end. +%% Get status about the configuration +-type warning() :: string(). +-spec get_status(server()) -> + {ok, [warning()]} | {error, reason()}. +get_status(PidOrOptions) + when is_pid(PidOrOptions); is_list(PidOrOptions) -> + eval_server(PidOrOptions, false, + fun(Pid) -> + reltool_server:get_status(Pid) + end). + %% Get reltool configuration -spec get_config(server()) -> {ok, config()} | {error, reason()}. get_config(PidOrOption) -> @@ -133,7 +147,7 @@ get_config(PidOrOption) -> {ok, config()} | {error, reason()}. get_config(PidOrOptions, InclDef, InclDeriv) when is_pid(PidOrOptions); is_list(PidOrOptions) -> - eval_server(PidOrOptions, + eval_server(PidOrOptions, true, fun(Pid) -> reltool_server:get_config(Pid, InclDef, InclDeriv) end). @@ -142,7 +156,7 @@ get_config(PidOrOptions, InclDef, InclDeriv) -spec get_rel(server(), rel_name()) -> {ok, rel_file()} | {error, reason()}. get_rel(PidOrOptions, RelName) when is_pid(PidOrOptions); is_list(PidOrOptions) -> - eval_server(PidOrOptions, + eval_server(PidOrOptions, true, fun(Pid) -> reltool_server:get_rel(Pid, RelName) end). %% Get contents of boot script file @@ -150,21 +164,22 @@ get_rel(PidOrOptions, RelName) {ok, script_file()} | {error, reason()}. get_script(PidOrOptions, RelName) when is_pid(PidOrOptions); is_list(PidOrOptions) -> - eval_server(PidOrOptions, + eval_server(PidOrOptions, true, fun(Pid) -> reltool_server:get_script(Pid, RelName) end). %% Generate a target system -spec create_target(server(), target_dir()) -> ok | {error, reason()}. create_target(PidOrOptions, TargetDir) when is_pid(PidOrOptions); is_list(PidOrOptions) -> - eval_server(PidOrOptions, + eval_server(PidOrOptions, true, fun(Pid) -> reltool_server:gen_target(Pid, TargetDir) end). %% Generate a target system -spec get_target_spec(server()) -> {ok, target_spec()} | {error, reason()}. get_target_spec(PidOrOptions) when is_pid(PidOrOptions); is_list(PidOrOptions) -> - eval_server(PidOrOptions, fun(Pid) -> reltool_server:gen_spec(Pid) end). + eval_server(PidOrOptions, true, + fun(Pid) -> reltool_server:gen_spec(Pid) end). %% Generate a target system -spec eval_target_spec(target_spec(), root_dir(), target_dir()) -> diff --git a/lib/reltool/src/reltool.hrl b/lib/reltool/src/reltool.hrl index 8a6a2142fd..1a34ced89d 100644 --- a/lib/reltool/src/reltool.hrl +++ b/lib/reltool/src/reltool.hrl @@ -17,7 +17,7 @@ %% %CopyrightEnd% -define(APPLICATION, reltool). --define(MISSING_APP, '*MISSING*'). +-define(MISSING_APP_NAME, '*MISSING*'). -define(MISSING_APP_TEXT, "*MISSING*"). -type file() :: string(). @@ -104,7 +104,7 @@ -type rel_file() :: term(). -type script_file() :: term(). -type reason() :: string(). --type escript_arg() :: string(). + -type base_dir() :: dir(). -type base_file() :: file(). -type top_dir() :: file(). @@ -112,10 +112,7 @@ -type target_spec() :: [target_spec()] | {create_dir, base_dir(), [target_spec()]} | {create_dir, base_dir(), top_dir(), [target_spec()]} - | {archive, - base_file(), - [archive_opt()], - [target_spec()]} + | {archive, base_file(), [archive_opt()], [target_spec()]} | {copy_file, base_file()} | {copy_file, base_file(), top_file()} | {write_file, base_file(), iolist()} @@ -139,57 +136,58 @@ -record(mod, {%% Static - name :: mod_name(), - app_name :: app_name(), - incl_cond :: incl_cond() | undefined, - debug_info :: debug_info() | undefined, - is_app_mod :: boolean(), + name :: mod_name(), + app_name :: app_name(), + incl_cond :: incl_cond() | undefined, + debug_info :: debug_info() | undefined, + is_app_mod :: boolean(), is_ebin_mod :: boolean(), - uses_mods :: [mod_name()], - exists :: boolean(), + uses_mods :: [mod_name()], + exists :: boolean(), + %% Dynamic - status :: status(), - used_by_mods :: [mod_name()], + status :: status(), + used_by_mods :: [mod_name()], is_pre_included :: boolean() | undefined, - is_included :: boolean() | undefined + is_included :: boolean() | undefined }). -record(app_info, { - description = "", - id = "", - vsn = "", - modules = [], - maxP = infinity, - maxT = infinity, - registered = [], - incl_apps = [], - applications = [], - env = [], - mod = undefined, - start_phases = undefined + description = "" :: string(), + id = "" :: string(), + vsn = "" :: app_vsn(), + modules = [] :: [mod_name()], + maxP = infinity :: integer() | infinity, + maxT = infinity :: integer() | infinity, + registered = [] :: [atom()], + incl_apps = [] :: [app_name()], + applications = [] :: [app_name()], + env = [] :: [{atom(), term()}], + mod = undefined :: {mod_name(), [term()]} | undefined, + start_phases = undefined :: [{atom(), term()}] | undefined }). -record(app, {%% Static info - name :: app_name(), - is_escript :: boolean(), + name :: app_name(), + is_escript :: boolean(), use_selected_vsn :: boolean() | undefined, - active_dir :: dir(), - sorted_dirs :: [dir()], - vsn :: app_vsn(), - label :: app_label(), - info :: #app_info{} | undefined, - mods :: [#mod{}], + active_dir :: dir(), + sorted_dirs :: [dir()], + vsn :: app_vsn(), + label :: app_label(), + info :: #app_info{} | undefined, + mods :: [#mod{}], %% Static source cond - mod_cond :: mod_cond() | undefined, + mod_cond :: mod_cond() | undefined, incl_cond :: incl_cond() | undefined, %% Static target cond - debug_info :: debug_info() | undefined, - app_file :: app_file() | undefined, - app_type :: app_type(), + debug_info :: debug_info() | undefined, + app_file :: app_file() | undefined, + app_type :: app_type() | undefined, incl_app_filters :: incl_app_filters(), excl_app_filters :: excl_app_filters(), incl_archive_filters :: incl_archive_filters(), @@ -197,19 +195,20 @@ archive_opts :: [archive_opt()], %% Dynamic - status :: status(), - uses_mods :: [mod_name()], - used_by_mods :: [mod_name()], - uses_apps :: [app_name()], - used_by_apps :: [app_name()], + status :: status(), + uses_mods :: [mod_name()], + used_by_mods :: [mod_name()], + uses_apps :: [app_name()], + used_by_apps :: [app_name()], is_pre_included :: boolean(), - is_included :: boolean() + is_included :: boolean(), + rels :: [rel_name()] }). -record(rel_app, { - name :: app_name(), - app_type :: app_type(), + name :: app_name(), + app_type :: app_type(), incl_apps :: [incl_app()] }). @@ -231,21 +230,22 @@ apps :: [#app{}], %% Target cond - boot_rel :: boot_rel(), - rels :: [#rel{}], - emu_name :: emu_name(), - profile :: profile(), - incl_sys_filters :: incl_sys_filters(), - excl_sys_filters :: excl_sys_filters(), - incl_app_filters :: incl_app_filters(), - excl_app_filters :: excl_app_filters(), + boot_rel :: boot_rel(), + rels :: [#rel{}], + emu_name :: emu_name(), + profile :: profile(), + incl_sys_filters :: incl_sys_filters(), + excl_sys_filters :: excl_sys_filters(), + incl_app_filters :: incl_app_filters(), + excl_app_filters :: excl_app_filters(), incl_archive_filters :: incl_archive_filters(), excl_archive_filters :: excl_archive_filters(), - archive_opts :: [archive_opt()], - relocatable :: boolean(), - app_type :: app_type(), - app_file :: app_file(), - debug_info :: debug_info() + archive_opts :: [archive_opt()], + relocatable :: boolean(), + rel_app_type :: app_type(), + embedded_app_type :: app_type() | undefined, + app_file :: app_file(), + debug_info :: debug_info() }). -record(regexp, {source, compiled}). @@ -268,7 +268,8 @@ -define(DEFAULT_EMU_NAME, "beam"). -define(DEFAULT_PROFILE, development). -define(DEFAULT_RELOCATABLE, true). --define(DEFAULT_APP_TYPE, permanent). +-define(DEFAULT_REL_APP_TYPE, permanent). +-define(DEFAULT_EMBEDDED_APP_TYPE, undefined). -define(DEFAULT_APP_FILE, keep). -define(DEFAULT_DEBUG_INFO, keep). @@ -282,22 +283,23 @@ -define(DEFAULT_EXCL_APP_FILTERS, []). -define(EMBEDDED_INCL_SYS_FILTERS, ["^bin", - "^erts", - "^lib", - "^releases"]). + "^erts", + "^lib", + "^releases"]). -define(EMBEDDED_EXCL_SYS_FILTERS, ["^bin/(erlc|dialyzer|typer)(|\\.exe)\$", "^erts.*/bin/(erlc|dialyzer|typer)(|\\.exe)\$", "^erts.*/bin/.*(debug|pdb)"]). -define(EMBEDDED_INCL_APP_FILTERS, ["^ebin", - "^priv", - "^include"]). + "^include", + "^priv"]). -define(EMBEDDED_EXCL_APP_FILTERS, []). +-define(EMBEDDED_APP_TYPE, load). -define(STANDALONE_INCL_SYS_FILTERS, ["^bin/(erl|epmd)(|\\.exe|\\.ini)\$", - "^bin/start(|_clean).boot\$", - "^erts.*/bin", - "^lib\$"]). + "^bin/start(|_clean).boot\$", + "^erts.*/bin", + "^lib\$"]). -define(STANDALONE_EXCL_SYS_FILTERS, ["^erts.*/bin/(erlc|dialyzer|typer)(|\\.exe)\$", "^erts.*/bin/(start|escript|to_erl|run_erl)(|\\.exe)\$", diff --git a/lib/reltool/src/reltool_mod_win.erl b/lib/reltool/src/reltool_mod_win.erl index c2544cc2d8..f68c61fd6f 100644 --- a/lib/reltool/src/reltool_mod_win.erl +++ b/lib/reltool/src/reltool_mod_win.erl @@ -514,7 +514,7 @@ select_image(Xref, ModName) -> {ok, M} = reltool_server:get_mod(Xref, ModName), Image = case M#mod.is_included of - _ when M#mod.app_name =:= ?MISSING_APP -> ?ERR_IMAGE; + _ when M#mod.app_name =:= ?MISSING_APP_NAME -> ?ERR_IMAGE; true -> ?TICK_IMAGE; false -> ?WARN_IMAGE; undefined -> ?ERR_IMAGE @@ -674,7 +674,7 @@ do_goto_function(#state{active_page = P} = S, [FunName]) -> find_regexp_forward(S, "^" ++ FunName ++ "("); do_goto_function(S, [ModStr, FunStr]) -> case reltool_server:get_mod(S#state.xref_pid, list_to_atom(ModStr)) of - {ok, Mod} when Mod#mod.app_name =/= ?MISSING_APP -> + {ok, Mod} when Mod#mod.app_name =/= ?MISSING_APP_NAME -> S2 = create_code_page(S#state{mod = Mod}, ModStr), find_regexp_forward(S2, "^" ++ FunStr ++ "("); {ok, _} -> diff --git a/lib/reltool/src/reltool_server.erl b/lib/reltool/src/reltool_server.erl index a7064f7651..039ad56aa8 100644 --- a/lib/reltool/src/reltool_server.erl +++ b/lib/reltool/src/reltool_server.erl @@ -132,19 +132,20 @@ init(Options) -> end. do_init(Options) -> - case parse_options(Options) of - {#state{parent_pid = ParentPid, common = C, sys = Sys} = S, Status} -> - %% process_flag(trap_exit, (S#state.common)#common.trap_exit), - proc_lib:init_ack(ParentPid, - {ok, self(), C, Sys#sys{apps = undefined}}), - {S2, Status2} = refresh(S, true, Status), - {S3, Status3} = analyse(S2#state{old_sys = S2#state.sys}, Status2), - case Status3 of - {ok, _Warnings} -> - loop(S3#state{status = Status3, old_status = {ok, []}}); - {error, Reason} -> - exit(Reason) - end + {S, Status} = parse_options(Options), + #state{parent_pid = ParentPid, common = C, sys = Sys} = S, + + %% process_flag(trap_exit, (S#state.common)#common.trap_exit), + proc_lib:init_ack(ParentPid, + {ok, self(), C, Sys#sys{apps = undefined}}), + {S2, Status2} = refresh(S, true, Status), + {S3, Status3} = + analyse(S2#state{old_sys = S2#state.sys}, Status2), + case Status3 of + {ok, _Warnings} -> % BUGBUG: handle warnings + loop(S3#state{status = Status3, old_status = {ok, []}}); + {error, Reason} -> + exit(Reason) end. parse_options(Opts) -> @@ -161,33 +162,28 @@ parse_options(Opts) -> rels = reltool_utils:default_rels(), emu_name = ?DEFAULT_EMU_NAME, profile = ?DEFAULT_PROFILE, - incl_sys_filters = - reltool_utils:decode_regexps(incl_sys_filters, - ?DEFAULT_INCL_SYS_FILTERS, - []), - excl_sys_filters = - reltool_utils:decode_regexps(excl_sys_filters, - ?DEFAULT_EXCL_SYS_FILTERS, - []), - incl_app_filters = - reltool_utils:decode_regexps(incl_app_filters, - ?DEFAULT_INCL_APP_FILTERS, - []), - excl_app_filters = - reltool_utils:decode_regexps(excl_app_filters, - ?DEFAULT_EXCL_APP_FILTERS, - []), + incl_sys_filters = dec_re(incl_sys_filters, + ?DEFAULT_INCL_SYS_FILTERS, + []), + excl_sys_filters = dec_re(excl_sys_filters, + ?DEFAULT_EXCL_SYS_FILTERS, + []), + incl_app_filters = dec_re(incl_app_filters, + ?DEFAULT_INCL_APP_FILTERS, + []), + excl_app_filters = dec_re(excl_app_filters, + ?DEFAULT_EXCL_APP_FILTERS, + []), relocatable = ?DEFAULT_RELOCATABLE, - app_type = ?DEFAULT_APP_TYPE, + rel_app_type = ?DEFAULT_REL_APP_TYPE, + embedded_app_type = ?DEFAULT_EMBEDDED_APP_TYPE, app_file = ?DEFAULT_APP_FILE, - incl_archive_filters = - reltool_utils:decode_regexps(incl_archive_filters, - ?DEFAULT_INCL_ARCHIVE_FILTERS, - []), - excl_archive_filters = - reltool_utils:decode_regexps(excl_archive_filters, - ?DEFAULT_EXCL_ARCHIVE_FILTERS, - []), + incl_archive_filters = dec_re(incl_archive_filters, + ?DEFAULT_INCL_ARCHIVE_FILTERS, + []), + excl_archive_filters = dec_re(excl_archive_filters, + ?DEFAULT_EXCL_ARCHIVE_FILTERS, + []), archive_opts = ?DEFAULT_ARCHIVE_OPTS, debug_info = ?DEFAULT_DEBUG_INFO}, C2 = #common{sys_debug = [], @@ -199,6 +195,9 @@ parse_options(Opts) -> S = #state{options = Opts}, parse_options(Opts, S, C2, Sys, {ok, []}). +dec_re(Key, Regexps, Old) -> + reltool_utils:decode_regexps(Key, Regexps, Old). + parse_options([{Key, Val} | KeyVals], S, C, Sys, Status) -> case Key of parent -> @@ -261,6 +260,7 @@ loop(#state{common = C, sys = Sys} = S) -> {ok, _Warnings} -> S5#state{status = Status3, old_status = S#state.status}; {error, _} -> + %% Keep old state S end, reltool_utils:reply(ReplyTo, Ref, Status3), @@ -277,9 +277,9 @@ loop(#state{common = C, sys = Sys} = S) -> Reply = case lists:keysearch(RelName, #rel.name, Sys#sys.rels) of {value, Rel} -> - {ok, reltool_target:gen_rel(Rel, Sys)}; + reltool_target:gen_rel(Rel, Sys); false -> - {error, "No such release"} + {error, "No such release: " ++ RelName} end, reltool_utils:reply(ReplyTo, Ref, Reply), ?MODULE:loop(S); @@ -292,7 +292,7 @@ loop(#state{common = C, sys = Sys} = S) -> Vars = [], reltool_target:gen_script(Rel, Sys, PathFlag, Vars); false -> - {error, "No such release"} + {error, "No such release: " ++ RelName} end, reltool_utils:reply(ReplyTo, Ref, Reply), ?MODULE:loop(S); @@ -302,7 +302,7 @@ loop(#state{common = C, sys = Sys} = S) -> [M] -> {ok, M}; [] -> - {ok, missing_mod(ModName, ?MISSING_APP)} + {ok, missing_mod(ModName, ?MISSING_APP_NAME)} end, reltool_utils:reply(ReplyTo, Ref, Reply), ?MODULE:loop(S); @@ -312,7 +312,8 @@ loop(#state{common = C, sys = Sys} = S) -> {value, App} -> {ok, App}; false -> - {error, enoent} + {error, "No such application: " ++ + atom_to_list(AppName)} end, reltool_utils:reply(ReplyTo, Ref, Reply), ?MODULE:loop(S); @@ -327,6 +328,7 @@ loop(#state{common = C, sys = Sys} = S) -> reltool_utils:reply(ReplyTo, Ref, {ok, App2, Warnings}), ?MODULE:loop(S3); {error, Reason} -> + %% Keep old state reltool_utils:reply(ReplyTo, Ref, {error, Reason}), ?MODULE:loop(S) end; @@ -372,16 +374,20 @@ loop(#state{common = C, sys = Sys} = S) -> (Sys2#sys.lib_dirs =/= Sys#sys.lib_dirs) orelse (Sys2#sys.escripts =/= Sys#sys.escripts), {S3, Status} = refresh(S2, Force, {ok, []}), - {S4, Status2} = analyse(S3#state{old_sys = S#state.sys}, Status), - S6 = - case Status2 of - {ok, _Warnings} -> - S4#state{status = Status2, old_status = S#state.status}; - {error, _} -> - S - end, - reltool_utils:reply(ReplyTo, Ref, Status2), - ?MODULE:loop(S6); + {S4, Status2} = + analyse(S3#state{old_sys = S#state.sys}, Status), + {S5, Status3} = + case Status2 of + {ok, _Warnings} -> % BUGBUG: handle warnings + {S4#state{status = Status2, + old_status = S#state.status}, + Status2}; + {error, _} -> + %% Keep old state + {S, Status2} + end, + reltool_utils:reply(ReplyTo, Ref, Status3), + ?MODULE:loop(S5); {call, ReplyTo, Ref, get_status} -> reltool_utils:reply(ReplyTo, Ref, S#state.status), ?MODULE:loop(S); @@ -427,15 +433,24 @@ do_set_app(#state{sys = Sys} = S, App, Status) -> Sys2 = Sys#sys{apps = Apps2, escripts = Escripts}, {S#state{sys = Sys2}, Status2}. -analyse(#state{common = C, sys = #sys{apps = Apps0} = Sys} = S, Status) -> - Apps = lists:keydelete(?MISSING_APP, #app.name, Apps0), +analyse(#state{common = C, + sys = #sys{apps = Apps0, rels = Rels} = Sys} = S, + Status) -> + Apps = lists:keydelete(?MISSING_APP_NAME, #app.name, Apps0), ets:delete_all_objects(C#common.app_tab), ets:delete_all_objects(C#common.mod_tab), ets:delete_all_objects(C#common.mod_used_by_tab), - MissingApp = default_app(?MISSING_APP, "missing"), + MissingApp = default_app(?MISSING_APP_NAME, "missing"), ets:insert(C#common.app_tab, MissingApp), - Apps2 = lists:map(fun(App) -> app_init_is_included(C, Sys, App) end, Apps), + {RevRelApps, Status2} = apps_in_rels(Rels, Apps, Status), + RelApps2 = lists:reverse(RevRelApps), + {Apps2, Status3} = + lists:mapfoldl(fun(App, Acc) -> + app_init_is_included(C, Sys, App, RelApps2, Acc) + end, + Status2, + Apps), Apps3 = case app_propagate_is_included(C, Sys, Apps2, []) of [] -> @@ -452,17 +467,59 @@ analyse(#state{common = C, sys = #sys{apps = Apps0} = Sys} = S, Status) -> app_propagate_is_used_by(C, Apps3), Apps4 = read_apps(C, Sys, Apps3, []), %% io:format("Missing app: ~p\n", - %% [lists:keysearch(?MISSING_APP, #app.name, Apps4)]), + %% [lists:keysearch(?MISSING_APP_NAME, #app.name, Apps4)]), Sys2 = Sys#sys{apps = Apps4}, - try - Status2 = verify_config(Sys2, Status), - {S#state{sys = Sys2}, Status2} - catch - throw:{error, Status3} -> - {S, Status3} + + case verify_config(RelApps2, Sys2, Status3) of + {ok, _Warnings} = Status4 -> + {S#state{sys = Sys2}, Status4}; + {error, _} = Status4 -> + {S, Status4} end. -app_init_is_included(C, Sys, #app{mods = Mods} = A) -> +apps_in_rels(Rels, Apps, Status) -> + lists:foldl(fun(Rel, {RelApps, S}) -> + {MoreRelApps, S2} = apps_in_rel(Rel, Apps, S), + {MoreRelApps ++ RelApps, S2} + end, + {[], Status}, + Rels). + +apps_in_rel(#rel{name = RelName, rel_apps = RelApps}, Apps, Status) -> + Mandatory = [{RelName, kernel}, {RelName, stdlib}], + Other = [{RelName, AppName} || + RA <- RelApps, + AppName <- [RA#rel_app.name | RA#rel_app.incl_apps], + not lists:keymember(AppName, 2, Mandatory)], + more_apps_in_rels(Mandatory ++ Other, Apps, [], Status). + +more_apps_in_rels([{RelName, AppName} = RA | RelApps], Apps, Acc, Status) -> + case lists:member(RA, Acc) of + true -> + more_apps_in_rels(RelApps, Apps, Acc, Status); + false -> + case lists:keysearch(AppName, #app.name, Apps) of + {value, #app{info = #app_info{applications = InfoApps}}} -> + Extra = [{RelName, N} || N <- InfoApps], + {Acc2, Status2} = + more_apps_in_rels(Extra, Apps, [RA | Acc], Status), + more_apps_in_rels(RelApps, Apps, Acc2, Status2); + false -> + Text = lists:concat(["Release ", RelName, + " uses non existing application ", + AppName]), + Status2 = reltool_utils:return_first_error(Status, Text), + more_apps_in_rels(RelApps, Apps, Acc, Status2) + end + end; +more_apps_in_rels([], _Apps, Acc, Status) -> + {Acc, Status}. + +app_init_is_included(C, + Sys, + #app{name = AppName, mods = Mods} = A, + RelApps, + Status) -> AppCond = case A#app.incl_cond of undefined -> Sys#sys.incl_cond; @@ -473,24 +530,37 @@ app_init_is_included(C, Sys, #app{mods = Mods} = A) -> undefined -> Sys#sys.mod_cond; _ -> A#app.mod_cond end, - IsIncl = - case AppCond of - include -> true; - exclude -> false; - derived -> undefined + Rels = [RelName || {RelName, AN} <- RelApps, AN =:= AppName], + {Default, IsPreIncl, IsIncl, Status2} = + case {AppCond, Rels} of + {include, _} -> + {undefined, true, true, Status}; + {exclude, []} -> + {undefined, false, false, Status}; + {exclude, [RelName | _]} -> % App is included in at least one rel + Text = lists:concat(["Application ", AppName, " is used " + "in release ", RelName, " and cannot " + "be excluded"]), + TmpStatus = reltool_utils:return_first_error(Status, Text), + {undefined, false, false, TmpStatus}; + {derived, []} -> + {undefined, undefined, undefined, Status}; + {derived, [_ | _]} -> % App is included in at least one rel + {true, undefined, true, Status} end, - A2 = A#app{is_pre_included = IsIncl, is_included = IsIncl}, + A2 = A#app{is_pre_included = IsPreIncl, + is_included = IsIncl, + rels = Rels}, ets:insert(C#common.app_tab, A2), lists:foreach(fun(Mod) -> mod_init_is_included(C, Mod, ModCond, AppCond, - undefined) + Default) end, Mods), - %%app_mod_init_is_included(C, AppName, Info, ModCond, AppCond), - A2. + {A2, Status2}. mod_init_is_included(C, M, ModCond, AppCond, Default) -> %% print(M#mod.name, hipe, "incl_cond -> ~p\n", [AppCond]), @@ -635,7 +705,7 @@ mod_mark_is_included(C, Sys, UsedByName, [ModName | ModNames], Acc) -> Acc2) end; [] -> - M = missing_mod(ModName, ?MISSING_APP), + M = missing_mod(ModName, ?MISSING_APP_NAME), M2 = M#mod{is_included = true}, ets:insert(C#common.mod_tab, M2), ets:insert(C#common.mod_used_by_tab, {UsedByName, ModName}), @@ -646,7 +716,7 @@ mod_mark_is_included(_C, _Sys, _UsedByName, [], Acc) -> Acc. app_propagate_is_used_by(C, [#app{mods = Mods, name = Name} | Apps]) -> - case Name =:= ?MISSING_APP of + case Name =:= ?MISSING_APP_NAME of true -> ok; false -> ok end, @@ -672,8 +742,6 @@ mod_propagate_is_used_by(_C, []) -> read_apps(C, Sys, [#app{mods = Mods, is_included = IsIncl} = A | Apps], Acc) -> {Mods2, IsIncl2} = read_apps(C, Sys, A, Mods, [], IsIncl), - %% reltool_utils:print(A#app.name, stdlib, "Mods2: ~p\n", - %% [[M#mod.status || M <- Mods2]]), Status = case lists:keysearch(missing, #mod.status, Mods2) of {value, _} -> missing; @@ -736,9 +804,7 @@ filter_app(A) -> Mods = [M#mod{is_app_mod = undefined, is_ebin_mod = undefined, uses_mods = undefined, - exists = false, - is_pre_included = undefined, - is_included = undefined} || + exists = false} || M <- A#app.mods, M#mod.incl_cond =/= undefined], if @@ -747,8 +813,7 @@ filter_app(A) -> label = undefined, info = undefined, mods = [], - uses_mods = undefined, - is_included = undefined}}; + uses_mods = undefined}}; Mods =:= [], A#app.mod_cond =:= undefined, A#app.incl_cond =:= undefined, @@ -778,8 +843,7 @@ filter_app(A) -> label = undefined, info = undefined, mods = Mods, - uses_mods = undefined, - is_included = undefined}} + uses_mods = undefined}} end. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% @@ -816,16 +880,16 @@ refresh_app(#app{name = AppName, end, %% Add non-existing modules + AppInfoMods = AppInfo#app_info.modules, AppModNames = case AppInfo#app_info.mod of {StartModName, _} -> - case lists:member(StartModName, - AppInfo#app_info.modules) of - true -> AppInfo#app_info.modules; - false -> [StartModName | AppInfo#app_info.modules] + case lists:member(StartModName, AppInfoMods) of + true -> AppInfoMods; + false -> [StartModName | AppInfoMods] end; undefined -> - AppInfo#app_info.modules + AppInfoMods end, MissingMods = add_missing_mods(AppName, EbinMods, AppModNames), @@ -862,11 +926,15 @@ read_app_info(AppFileOrBin, AppFile, AppName, DefaultVsn, Status) -> parse_app_info(AppFile, Info, AI, Status); {ok, _BadApp} -> Text = lists:concat([AppName, - ": Illegal contents in app file ", AppFile]), + ": Illegal contents in app file ", AppFile, + ", application tuple with arity 3 expected."]), {missing_app_info(DefaultVsn), reltool_utils:add_warning(Status, Text)}; - {error, Text} when Text =:= EnoentText-> - {missing_app_info(DefaultVsn), Status}; + {error, Text} when Text =:= EnoentText -> + Text2 = lists:concat([AppName, + ": Missing app file ", AppFile, "."]), + {missing_app_info(DefaultVsn), + reltool_utils:add_warning(Status, Text2)}; {error, Text} -> Text2 = lists:concat([AppName, ": Cannot parse app file ", @@ -1045,7 +1113,7 @@ do_get_config(S, InclDef, InclDeriv) -> false -> shrink_sys(S); true -> S end, - {ok, reltool_target:gen_config(S2#state.sys, InclDef)}. + reltool_target:gen_config(S2#state.sys, InclDef). do_save_config(S, Filename, InclDef, InclDeriv) -> {ok, Config} = do_get_config(S, InclDef, InclDeriv), @@ -1072,6 +1140,7 @@ do_load_config(S, SysConfig) -> {ok, _Warnings2} -> S3#state{status = Status3, old_status = S#state.status}; {error, _} -> + %% Keep old state S end, {S4, Status3}; @@ -1093,29 +1162,36 @@ read_config(OldSys, Filename, Status) when is_list(Filename) -> {error, Reason} -> Text = file:format_error(Reason), {OldSys, - reltool_utils:return_first_error(Status, "File access: " ++ - Text)} + reltool_utils:return_first_error(Status, + "Illegal config file " ++ + Filename ++ ": " ++ Text)} end; read_config(OldSys, {sys, KeyVals}, Status) -> {NewSys, Status2} = - try - decode(OldSys#sys{apps = [], rels = []}, KeyVals, Status) - catch - throw:{error, Text} -> - {OldSys, reltool_utils:return_first_error(Status, Text)} - end, - Apps = [A#app{mods = lists:sort(A#app.mods)} || A <- NewSys#sys.apps], - case NewSys#sys.rels of - [] -> Rels = reltool_utils:default_rels(); - Rels -> ok - end, - NewSys2 = NewSys#sys{apps = lists:sort(Apps), rels = lists:sort(Rels)}, - case lists:keysearch(NewSys2#sys.boot_rel, #rel.name, NewSys2#sys.rels) of - {value, _} -> - {NewSys2, Status2}; - false -> - Text2 = "Missing rel: " ++ NewSys2#sys.boot_rel, - {OldSys, reltool_utils:return_first_error(Status2, Text2)} + decode(OldSys#sys{apps = [], rels = []}, KeyVals, Status), + case Status2 of + {ok, _Warnings} -> % BUGBUG: handle warnings + Apps = [A#app{mods = lists:sort(A#app.mods)} || + A <- NewSys#sys.apps], + case NewSys#sys.rels of + [] -> Rels = reltool_utils:default_rels(); + Rels -> ok + end, + NewSys2 = NewSys#sys{apps = lists:sort(Apps), + rels = lists:sort(Rels)}, + case lists:keysearch(NewSys2#sys.boot_rel, + #rel.name, + NewSys2#sys.rels) of + {value, _} -> + {NewSys2, Status2}; + false -> + Text2 = lists:concat(["Release " ++ NewSys2#sys.boot_rel, + " is mandatory (used as boot_rel)"]), + {OldSys, reltool_utils:return_first_error(Status2, Text2)} + end; + {error, _} -> + %% Keep old state + {OldSys, Status2} end; read_config(OldSys, BadConfig, Status) -> Text = lists:flatten(io_lib:format("~p", [BadConfig])), @@ -1160,120 +1236,96 @@ decode(#sys{} = Sys, [{Key, Val} | KeyVals], Status) -> {Sys#sys{root_dir = Val}, Status}; lib_dirs when is_list(Val) -> {Sys#sys{lib_dirs = Val}, Status}; - mod_cond when Val =:= all; Val =:= app; - Val =:= ebin; Val =:= derived; + mod_cond when Val =:= all; + Val =:= app; + Val =:= ebin; + Val =:= derived; Val =:= none -> {Sys#sys{mod_cond = Val}, Status}; - incl_cond when Val =:= include; Val =:= exclude; + incl_cond when Val =:= include; + Val =:= exclude; Val =:= derived -> {Sys#sys{incl_cond = Val}, Status}; boot_rel when is_list(Val) -> {Sys#sys{boot_rel = Val}, Status}; emu_name when is_list(Val) -> {Sys#sys{emu_name = Val}, Status}; - profile when Val =:= development -> - Val = ?DEFAULT_PROFILE, % assert, - {Sys#sys{profile = Val, - incl_sys_filters = - reltool_utils:decode_regexps(incl_sys_filters, - ?DEFAULT_INCL_SYS_FILTERS, - Sys#sys.incl_sys_filters), - excl_sys_filters = - reltool_utils:decode_regexps(excl_sys_filters, - ?DEFAULT_EXCL_SYS_FILTERS, - Sys#sys.excl_sys_filters), - incl_app_filters = - reltool_utils:decode_regexps(incl_app_filters, - ?DEFAULT_INCL_APP_FILTERS, - Sys#sys.incl_app_filters), - excl_app_filters = - reltool_utils:decode_regexps(excl_app_filters, - ?DEFAULT_EXCL_APP_FILTERS, - Sys#sys.excl_app_filters)}, - Status}; - profile when Val =:= embedded -> - {Sys#sys{profile = Val, - incl_sys_filters = - reltool_utils:decode_regexps(incl_sys_filters, - ?EMBEDDED_INCL_SYS_FILTERS, - Sys#sys.incl_sys_filters), - excl_sys_filters = - reltool_utils:decode_regexps(excl_sys_filters, - ?EMBEDDED_EXCL_SYS_FILTERS, - Sys#sys.excl_sys_filters), - incl_app_filters = - reltool_utils:decode_regexps(incl_app_filters, - ?EMBEDDED_INCL_APP_FILTERS, - Sys#sys.incl_app_filters), - excl_app_filters = - reltool_utils:decode_regexps(excl_app_filters, - ?EMBEDDED_EXCL_APP_FILTERS, - Sys#sys.excl_app_filters)}, - Status}; - profile when Val =:= standalone -> - {Sys#sys{profile = Val, - incl_sys_filters = - reltool_utils:decode_regexps(incl_sys_filters, - ?STANDALONE_INCL_SYS_FILTERS, - Sys#sys.incl_sys_filters), - excl_sys_filters = - reltool_utils:decode_regexps(excl_sys_filters, - ?STANDALONE_EXCL_SYS_FILTERS, - Sys#sys.excl_sys_filters), - incl_app_filters = - reltool_utils:decode_regexps(incl_app_filters, - ?STANDALONE_INCL_APP_FILTERS, - Sys#sys.incl_app_filters), - excl_app_filters = - reltool_utils:decode_regexps(excl_app_filters, - ?STANDALONE_EXCL_APP_FILTERS, - Sys#sys.excl_app_filters)}, + profile when Val =:= development; + Val =:= embedded; + Val =:= standalone -> + InclSys = reltool_utils:choose_default(incl_sys_filters, Val, false), + ExclSys = reltool_utils:choose_default(excl_sys_filters, Val, false), + InclApp = reltool_utils:choose_default(incl_app_filters, Val, false), + ExclApp = reltool_utils:choose_default(excl_app_filters, Val, false), + AppType = reltool_utils:choose_default(embedded_app_type, Val, false), + {Sys#sys{profile = Val, + incl_sys_filters = dec_re(incl_sys_filters, + InclSys, + Sys#sys.incl_sys_filters), + excl_sys_filters = dec_re(excl_sys_filters, + ExclSys, + Sys#sys.excl_sys_filters), + incl_app_filters = dec_re(incl_app_filters, + InclApp, + Sys#sys.incl_app_filters), + excl_app_filters = dec_re(excl_app_filters, + ExclApp, + Sys#sys.excl_app_filters), + embedded_app_type = AppType}, Status}; incl_sys_filters -> {Sys#sys{incl_sys_filters = - reltool_utils:decode_regexps(Key, - Val, - Sys#sys.incl_sys_filters)}, + dec_re(Key, + Val, + Sys#sys.incl_sys_filters)}, Status}; excl_sys_filters -> {Sys#sys{excl_sys_filters = - reltool_utils:decode_regexps(Key, - Val, - Sys#sys.excl_sys_filters)}, + dec_re(Key, + Val, + Sys#sys.excl_sys_filters)}, Status}; incl_app_filters -> {Sys#sys{incl_app_filters = - reltool_utils:decode_regexps(Key, - Val, - Sys#sys.incl_app_filters)}, + dec_re(Key, + Val, + Sys#sys.incl_app_filters)}, Status}; excl_app_filters -> {Sys#sys{excl_app_filters = - reltool_utils:decode_regexps(Key, - Val, - Sys#sys.excl_app_filters)}, + dec_re(Key, + Val, + Sys#sys.excl_app_filters)}, Status}; incl_archive_filters -> {Sys#sys{incl_archive_filters = - reltool_utils:decode_regexps(Key, - Val, - Sys#sys.incl_archive_filters)}, + dec_re(Key, + Val, + Sys#sys.incl_archive_filters)}, Status}; excl_archive_filters -> {Sys#sys{excl_archive_filters = - reltool_utils:decode_regexps(Key, - Val, - Sys#sys.excl_archive_filters)}, + dec_re(Key, + Val, + Sys#sys.excl_archive_filters)}, Status}; archive_opts when is_list(Val) -> {Sys#sys{archive_opts = Val}, Status}; relocatable when Val =:= true; Val =:= false -> {Sys#sys{relocatable = Val}, Status}; - app_type when Val =:= permanent; - Val =:= transient; - Val =:= temporary; - Val =:= load; Val =:= none -> - {Sys#sys{app_type = Val}, Status}; + rel_app_type when Val =:= permanent; + Val =:= transient; + Val =:= temporary; + Val =:= load; + Val =:= none -> + {Sys#sys{rel_app_type = Val}, Status}; + embedded_app_type when Val =:= permanent; + Val =:= transient; + Val =:= temporary; + Val =:= load; + Val =:= none; + Val =:= undefined -> + {Sys#sys{embedded_app_type = Val}, Status}; app_file when Val =:= keep; Val =:= strip, Val =:= all -> {Sys#sys{app_file = Val}, Status}; debug_info when Val =:= keep; Val =:= strip -> @@ -1303,38 +1355,39 @@ decode(#app{} = App, [{Key, Val} | KeyVals], Status) -> Val =:= strip -> {App#app{debug_info = Val}, Status}; app_file when Val =:= keep; - Val =:= strip, + Val =:= strip; Val =:= all -> {App#app{app_file = Val}, Status}; app_type when Val =:= permanent; Val =:= transient; Val =:= temporary; Val =:= load; - Val =:= none -> + Val =:= none; + Val =:= undefined -> {App#app{app_type = Val}, Status}; incl_app_filters -> {App#app{incl_app_filters = - reltool_utils:decode_regexps(Key, - Val, - App#app.incl_app_filters)}, + dec_re(Key, + Val, + App#app.incl_app_filters)}, Status}; excl_app_filters -> {App#app{excl_app_filters = - reltool_utils:decode_regexps(Key, - Val, - App#app.excl_app_filters)}, + dec_re(Key, + Val, + App#app.excl_app_filters)}, Status}; incl_archive_filters -> {App#app{incl_archive_filters = - reltool_utils:decode_regexps(Key, - Val, - App#app.incl_archive_filters)}, + dec_re(Key, + Val, + App#app.incl_archive_filters)}, Status}; excl_archive_filters -> {App#app{excl_archive_filters = - reltool_utils:decode_regexps(Key, - Val, - App#app.excl_archive_filters)}, + dec_re(Key, + Val, + App#app.excl_archive_filters)}, Status}; archive_opts when is_list(Val) -> {App#app{archive_opts = Val}, Status}; @@ -1439,54 +1492,53 @@ merge_config(OldSys, NewSys, Force, Status) -> apps = PatchedApps}, {NewSys2, Status5}. -verify_config(Sys, Status) -> - case lists:keymember(Sys#sys.boot_rel, #rel.name, Sys#sys.rels) of +verify_config(RelApps, #sys{boot_rel = BootRel, rels = Rels, apps = Apps}, Status) -> + case lists:keymember(BootRel, #rel.name, Rels) of true -> - lists:foreach(fun(Rel)-> check_rel(Rel, Sys, Status) end, - Sys#sys.rels), - Status; + Status2 = lists:foldl(fun(RA, Acc) -> + check_app(RA, Apps, Acc) end, + Status, + RelApps), + lists:foldl(fun(#rel{name = RelName}, Acc)-> + check_rel(RelName, RelApps, Acc) + end, + Status2, + Rels); false -> - Text = lists:concat([Sys#sys.boot_rel, ": release is mandatory"]), - Status2 = reltool_utils:return_first_error(Status, Text), - throw({error, Status2}) + Text = lists:concat(["Release ", BootRel, + " is mandatory (used as boot_rel)"]), + reltool_utils:return_first_error(Status, Text) + end. + +check_app({RelName, AppName}, Apps, Status) -> + case lists:keysearch(AppName, #app.name, Apps) of + {value, App} when App#app.is_pre_included -> + Status; + {value, App} when App#app.is_included -> + Status; + _ -> + Text = lists:concat(["Release ", RelName, + " uses non included application ", + AppName]), + reltool_utils:return_first_error(Status, Text) end. -check_rel(#rel{name = RelName, rel_apps = RelApps}, - #sys{apps = Apps}, - Status) -> +check_rel(RelName, RelApps, Status) -> EnsureApp = - fun(AppName) -> - case lists:keymember(AppName, #rel_app.name, RelApps) of + fun(AppName, Acc) -> + case lists:member({RelName, AppName}, RelApps) of true -> - ok; + Acc; false -> - Text = lists:concat([RelName, ": ", AppName, - " is not included."]), - Status2 = - reltool_utils:return_first_error(Status, Text), - throw({error, Status2}) - end - end, - EnsureApp(kernel), - EnsureApp(stdlib), - CheckRelApp = - fun(#rel_app{name = AppName}) -> - case lists:keysearch(AppName, #app.name, Apps) of - {value, App} when App#app.is_pre_included -> - ok; - {value, App} when App#app.is_included -> - ok; - _ -> - Text = - lists:concat([RelName, ": uses application ", - AppName, " that not is included."]), - Status2 = - reltool_utils:return_first_error(Status, Text), - %% throw BUGBUG: add throw - ({error, Status2}) + Text = lists:concat(["Mandatory application ", + AppName, + " is not included in release ", + RelName]), + reltool_utils:return_first_error(Acc, Text) end end, - lists:foreach(CheckRelApp, RelApps). + Mandatory = [kernel, stdlib], + lists:foldl(EnsureApp, Status, Mandatory). patch_erts_version(RootDir, Apps, Status) -> AppName = erts, @@ -1507,7 +1559,7 @@ patch_erts_version(RootDir, Apps, Status) -> {Apps, Status} end; false -> - Text = "erts cannnot be found in the root directory " ++ RootDir, + Text = "erts cannot be found in the root directory " ++ RootDir, Status2 = reltool_utils:return_first_error(Status, Text), {Apps, Status2} end. @@ -1813,7 +1865,8 @@ default_app(Name) -> status = missing, uses_mods = undefined, is_pre_included = undefined, - is_included = undefined}. + is_included = undefined, + rels = undefined}. %% Assume that the application are sorted refresh_apps([Old | OldApps], [New | NewApps], Acc, Force, Status) @@ -1842,7 +1895,7 @@ refresh_apps([Old | OldApps], [New | NewApps], Acc, Force, Status) when New#app.name > Old#app.name -> %% No new version. Remove the old. Status2 = - case Old#app.name =:= ?MISSING_APP of + case Old#app.name =:= ?MISSING_APP_NAME of true -> Status; false -> @@ -1860,7 +1913,7 @@ refresh_apps([], [New | NewApps], Acc, Force, Status) -> refresh_apps([Old | OldApps], [], Acc, Force, Status) -> %% No new version. Remove the old. Status2 = - case Old#app.name =:= ?MISSING_APP of + case Old#app.name =:= ?MISSING_APP_NAME of true -> Status; false -> diff --git a/lib/reltool/src/reltool_sys_win.erl b/lib/reltool/src/reltool_sys_win.erl index 2e226d9147..dbb8e32aa2 100644 --- a/lib/reltool/src/reltool_sys_win.erl +++ b/lib/reltool/src/reltool_sys_win.erl @@ -1227,7 +1227,7 @@ create_fgraph_window(S, Title, Nodes, Links) -> Panel = wxPanel:new(Frame, []), Options = [{size, {lists:max([100, ?WIN_WIDTH - 100]), ?WIN_HEIGHT}}], {Server, Fgraph} = reltool_fgraph_win:new(Panel, Options), - Choose = fun(?MISSING_APP) -> alternate; + Choose = fun(?MISSING_APP_NAME) -> alternate; (_) -> default end, [reltool_fgraph_win:add_node(Server, N, Choose(N)) || N <- Nodes], diff --git a/lib/reltool/src/reltool_target.erl b/lib/reltool/src/reltool_target.erl index e079a02f3c..dd6f75b9fc 100644 --- a/lib/reltool/src/reltool_target.erl +++ b/lib/reltool/src/reltool_target.erl @@ -31,7 +31,7 @@ gen_target/2, install/2 ]). --compile(export_all). + -include("reltool.hrl"). -include_lib("kernel/include/file.hrl"). @@ -64,54 +64,60 @@ kernel_processes(KernelApp) -> %% Generate the contents of a config file %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -gen_config(#sys{root_dir = RootDir, - lib_dirs = LibDirs, - mod_cond = ModCond, - incl_cond = AppCond, - apps = Apps, - boot_rel = BootRel, - rels = Rels, - emu_name = EmuName, - profile = Profile, - incl_sys_filters = InclSysFiles, - excl_sys_filters = ExclSysFiles, - incl_app_filters = InclAppFiles, - excl_app_filters = ExclAppFiles, - incl_archive_filters = InclArchiveDirs, - excl_archive_filters = ExclArchiveDirs, - archive_opts = ArchiveOpts, - relocatable = Relocatable, - app_type = AppType, - app_file = AppFile, - debug_info = DebugInfo}, - InclDefs) -> +gen_config(Sys, InclDefs) -> + {ok, do_gen_config(Sys, InclDefs)}. + +do_gen_config(#sys{root_dir = RootDir, + lib_dirs = LibDirs, + mod_cond = ModCond, + incl_cond = AppCond, + apps = Apps, + boot_rel = BootRel, + rels = Rels, + emu_name = EmuName, + profile = Profile, + incl_sys_filters = InclSysFiles, + excl_sys_filters = ExclSysFiles, + incl_app_filters = InclAppFiles, + excl_app_filters = ExclAppFiles, + incl_archive_filters = InclArchiveDirs, + excl_archive_filters = ExclArchiveDirs, + archive_opts = ArchiveOpts, + relocatable = Relocatable, + rel_app_type = RelAppType, + embedded_app_type = InclAppType, + app_file = AppFile, + debug_info = DebugInfo}, + InclDefs) -> ErtsItems = case lists:keysearch(erts, #app.name, Apps) of {value, Erts} -> - [{erts, gen_config(Erts, InclDefs)}]; + [{erts, do_gen_config(Erts, InclDefs)}]; false -> [] end, AppsItems = - [{app, A#app.name, gen_config(A, InclDefs)} + [do_gen_config(A, InclDefs) || A <- Apps, - A#app.name =/= ?MISSING_APP, + A#app.name =/= ?MISSING_APP_NAME, A#app.name =/= erts, - A#app.is_included =:= true, - A#app.is_escript =/= true], + not A#app.is_escript], EscriptItems = [{escript, A#app.active_dir, emit(incl_cond, A#app.incl_cond, undefined, InclDefs)} - || A <- Apps, A#app.is_escript], + || A <- Apps, A#app.is_escript], DefaultRels = reltool_utils:default_rels(), RelsItems = - case {[{rel, R#rel.name, R#rel.vsn, gen_config(R, InclDefs)} || - R <- Rels], - [{rel, R#rel.name, R#rel.vsn, gen_config(R, InclDefs)} || - R <- DefaultRels]} of - {RI, RI} -> []; - {RI, _} -> RI - end, + [{rel, R#rel.name, R#rel.vsn, do_gen_config(R, InclDefs)} || + R <- Rels], + DefaultRelsItems = + [{rel, R#rel.name, R#rel.vsn, do_gen_config(R, InclDefs)} || + R <- DefaultRels], + RelsItems2 = + case InclDefs of + true -> RelsItems; + false -> RelsItems -- DefaultRelsItems + end, X = fun(List) -> [Re || #regexp{source = Re} <- List] end, {sys, emit(root_dir, RootDir, code:root_dir(), InclDefs) ++ @@ -120,78 +126,103 @@ gen_config(#sys{root_dir = RootDir, emit(mod_cond, ModCond, ?DEFAULT_MOD_COND, InclDefs) ++ emit(incl_cond, AppCond, ?DEFAULT_INCL_COND, InclDefs) ++ ErtsItems ++ - AppsItems ++ + lists:flatten(AppsItems) ++ emit(boot_rel, BootRel, ?DEFAULT_REL_NAME, InclDefs) ++ - RelsItems ++ + RelsItems2 ++ emit(emu_name, EmuName, ?DEFAULT_EMU_NAME, InclDefs) ++ emit(relocatable, Relocatable, ?DEFAULT_RELOCATABLE, InclDefs) ++ emit(profile, Profile, ?DEFAULT_PROFILE, InclDefs) ++ - emit(incl_sys_filters, X(InclSysFiles), ?DEFAULT_INCL_SYS_FILTERS, InclDefs) ++ - emit(excl_sys_filters, X(ExclSysFiles), ?DEFAULT_EXCL_SYS_FILTERS, InclDefs) ++ - emit(incl_app_filters, X(InclAppFiles), ?DEFAULT_INCL_APP_FILTERS, InclDefs) ++ - emit(excl_app_filters, X(ExclAppFiles), ?DEFAULT_EXCL_APP_FILTERS, InclDefs) ++ + emit(incl_sys_filters, X(InclSysFiles), reltool_utils:choose_default(incl_sys_filters, Profile, InclDefs), InclDefs) ++ + emit(excl_sys_filters, X(ExclSysFiles), reltool_utils:choose_default(excl_sys_filters, Profile, InclDefs), InclDefs) ++ + emit(incl_app_filters, X(InclAppFiles), reltool_utils:choose_default(incl_app_filters, Profile, InclDefs), InclDefs) ++ + emit(excl_app_filters, X(ExclAppFiles), reltool_utils:choose_default(excl_app_filters, Profile, InclDefs), InclDefs) ++ emit(incl_archive_filters, X(InclArchiveDirs), ?DEFAULT_INCL_ARCHIVE_FILTERS, InclDefs) ++ emit(excl_archive_filters, X(ExclArchiveDirs), ?DEFAULT_EXCL_ARCHIVE_FILTERS, InclDefs) ++ emit(archive_opts, ArchiveOpts, ?DEFAULT_ARCHIVE_OPTS, InclDefs) ++ - emit(app_type, AppType, ?DEFAULT_APP_TYPE, InclDefs) ++ + emit(rel_app_type, RelAppType, ?DEFAULT_REL_APP_TYPE, InclDefs) ++ + emit(embedded_app_type, InclAppType, reltool_utils:choose_default(embedded_app_type, Profile, InclDefs), InclDefs) ++ emit(app_file, AppFile, ?DEFAULT_APP_FILE, InclDefs) ++ emit(debug_info, DebugInfo, ?DEFAULT_DEBUG_INFO, InclDefs)}; -gen_config(#app{name = _Name, - mod_cond = ModCond, - incl_cond = AppCond, - debug_info = DebugInfo, - app_file = AppFile, - incl_app_filters = InclAppFiles, - excl_app_filters = ExclAppFiles, - incl_archive_filters = InclArchiveDirs, - excl_archive_filters = ExclArchiveDirs, - archive_opts = ArchiveOpts, - use_selected_vsn = UseSelected, - vsn = Vsn, - mods = Mods}, - InclDefs) -> - emit(mod_cond, ModCond, undefined, InclDefs) ++ - emit(incl_cond, AppCond, undefined, InclDefs) ++ - emit(debug_info, DebugInfo, undefined, InclDefs) ++ - emit(app_file, AppFile, undefined, InclDefs) ++ - emit(incl_app_filters, InclAppFiles, undefined, InclDefs) ++ - emit(excl_app_filters, ExclAppFiles, undefined, InclDefs) ++ - emit(incl_archive_filters, InclArchiveDirs, undefined, InclDefs) ++ - emit(excl_archive_filters, ExclArchiveDirs, undefined, InclDefs) ++ - emit(archive_opts, ArchiveOpts, undefined, InclDefs) ++ - emit(vsn, Vsn, undefined, InclDefs orelse UseSelected =/= true) ++ - [{mod, M#mod.name, gen_config(M, InclDefs)} || - M <- Mods, - M#mod.is_included =:= true]; -gen_config(#mod{name = _Name, - incl_cond = AppCond, - debug_info = DebugInfo}, - InclDefs) -> - emit(incl_cond, AppCond, undefined, InclDefs) ++ - emit(debug_info, DebugInfo, undefined, InclDefs); -gen_config(#rel{name = _Name, - vsn = _Vsn, - rel_apps = RelApps}, - InclDefs) -> - [gen_config(RA, InclDefs) || RA <- RelApps]; -gen_config(#rel_app{name = Name, - app_type = Type, - incl_apps = InclApps}, - _InclDefs) -> +do_gen_config(#app{name = Name, + mod_cond = ModCond, + incl_cond = AppCond, + debug_info = DebugInfo, + app_file = AppFile, + incl_app_filters = InclAppFiles, + excl_app_filters = ExclAppFiles, + incl_archive_filters = InclArchiveDirs, + excl_archive_filters = ExclArchiveDirs, + archive_opts = ArchiveOpts, + use_selected_vsn = UseSelected, + vsn = Vsn, + mods = Mods, + is_included = IsIncl}, + InclDefs) -> + AppConfig = + [ + emit(mod_cond, ModCond, undefined, InclDefs), + emit(incl_cond, AppCond, undefined, InclDefs), + emit(debug_info, DebugInfo, undefined, InclDefs), + emit(app_file, AppFile, undefined, InclDefs), + emit(incl_app_filters, InclAppFiles, undefined, InclDefs), + emit(excl_app_filters, ExclAppFiles, undefined, InclDefs), + emit(incl_archive_filters, InclArchiveDirs, undefined, InclDefs), + emit(excl_archive_filters, ExclArchiveDirs, undefined, InclDefs), + emit(archive_opts, ArchiveOpts, undefined, InclDefs), + if + IsIncl, InclDefs -> [{vsn, Vsn}]; + UseSelected -> [{vsn, Vsn}]; + true -> [] + end, + [do_gen_config(M, InclDefs) || M <- Mods] + ], + case lists:flatten(AppConfig) of + FlatAppConfig when FlatAppConfig =/= []; IsIncl -> + [{app, Name, FlatAppConfig}]; + [] -> + [] + end; +do_gen_config(#mod{name = Name, + incl_cond = AppCond, + debug_info = DebugInfo, + is_included = IsIncl}, + InclDefs) -> + ModConfig = + [ + emit(incl_cond, AppCond, undefined, InclDefs), + emit(debug_info, DebugInfo, undefined, InclDefs) + ], + case lists:flatten(ModConfig) of + FlatModConfig when FlatModConfig =/= []; IsIncl -> + [{mod, Name, FlatModConfig}]; + _ -> + [] + end; +do_gen_config(#rel{name = _Name, + vsn = _Vsn, + rel_apps = RelApps}, + InclDefs) -> + [do_gen_config(RA, InclDefs) || RA <- RelApps]; +do_gen_config(#rel_app{name = Name, + app_type = Type, + incl_apps = InclApps}, + _InclDefs) -> case {Type, InclApps} of {undefined, []} -> Name; {undefined, _} -> {Name, InclApps}; {_, []} -> {Name, Type}; {_, _} -> {Name, Type, InclApps} end; -gen_config({Tag, Val}, InclDefs) -> +do_gen_config({Tag, Val}, InclDefs) -> emit(Tag, Val, undefined, InclDefs); -gen_config([], _InclDefs) -> +do_gen_config([], _InclDefs) -> []; -gen_config([H | T], InclDefs) -> - lists:flatten([gen_config(H, InclDefs), gen_config(T, InclDefs)]). +do_gen_config([H | T], InclDefs) -> + lists:flatten([do_gen_config(H, InclDefs), do_gen_config(T, InclDefs)]). emit(Tag, Val, Default, InclDefs) -> + %% io:format("~p(~p):\n\t~p\n\t~p\n", + %% [Tag, Val =/= Default, Val, Default]), if Val == undefined -> []; InclDefs -> [{Tag, Val}]; @@ -239,24 +270,127 @@ gen_app(#app{name = Name, %% Generate the contents of a rel file %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -gen_rel(#rel{name = RelName, vsn = RelVsn, rel_apps = RelApps}, - #sys{apps = Apps}) -> - {value, Erts} = lists:keysearch(erts, #app.name, Apps), - {release, - {RelName, RelVsn}, - {erts, Erts#app.vsn}, - [app_to_rel(RA, Apps ) || RA <- RelApps]}. - -app_to_rel(#rel_app{name = Name, app_type = Type, incl_apps = InclApps}, - Apps) -> - {value, #app{vsn = Vsn}} = lists:keysearch(Name, #app.name, Apps), +gen_rel(Rel, Sys) -> + try + MergedApps = merge_apps(Rel, Sys), + {ok, do_gen_rel(Rel, Sys, MergedApps)} + catch + throw:{error, Text} -> + {error, Text} + end. + +do_gen_rel(#rel{name = RelName, vsn = RelVsn}, + #sys{apps = Apps}, + MergedApps) -> + ErtsName = erts, + case lists:keysearch(ErtsName, #app.name, Apps) of + {value, Erts} -> + {release, + {RelName, RelVsn}, + {ErtsName, Erts#app.vsn}, + [strip_rel_info(App) || App <- MergedApps]}; + false -> + reltool_utils:throw_error("Mandatory application ~p is " + "not included", + [ErtsName]) + end. + +strip_rel_info(#app{name = Name, + vsn = Vsn, + app_type = Type, + info = #app_info{incl_apps = InclApps}}) + when Type =/= undefined -> case {Type, InclApps} of - {undefined, []} -> {Name, Vsn}; - {undefined, _} -> {Name, Vsn, InclApps}; + {permanent, []} -> {Name, Vsn}; + {permanent, _} -> {Name, Vsn, InclApps}; {_, []} -> {Name, Vsn, Type}; {_, _} -> {Name, Vsn, Type, InclApps} end. +merge_apps(#rel{name = RelName, + rel_apps = RelApps}, + #sys{apps = Apps, + rel_app_type = RelAppType, + embedded_app_type = EmbAppType}) -> + Mandatory = [kernel, stdlib], + MergedApps = do_merge_apps(RelName, Mandatory, Apps, permanent, []), + MergedApps2 = do_merge_apps(RelName, RelApps, Apps, RelAppType, MergedApps), + Embedded = + [A#app.name || A <- Apps, + EmbAppType =/= undefined, + A#app.is_included, + A#app.name =/= erts, + A#app.name =/= ?MISSING_APP_NAME, + not lists:keymember(A#app.name, #app.name, MergedApps2)], + MergedApps3 = do_merge_apps(RelName, Embedded, Apps, EmbAppType, MergedApps2), + sort_apps(MergedApps3). + +do_merge_apps(RelName, [#rel_app{name = Name} = RA | RelApps], Apps, RelAppType, Acc) -> + case is_already_merged(Name, RelApps, Acc) of + true -> + do_merge_apps(RelName, RelApps, Apps, RelAppType, Acc); + false -> + {value, App} = lists:keysearch(Name, #app.name, Apps), + MergedApp = merge_app(RelName, RA, RelAppType, App), + MoreNames = (MergedApp#app.info)#app_info.applications, + Acc2 = [MergedApp | Acc], + do_merge_apps(RelName, MoreNames ++ RelApps, Apps, RelAppType, Acc2) + end; +do_merge_apps(RelName, [Name | RelApps], Apps, RelAppType, Acc) -> + case is_already_merged(Name, RelApps, Acc) of + true -> + do_merge_apps(RelName, RelApps, Apps, RelAppType, Acc); + false -> + RelApp = init_rel_app(Name, Apps), + do_merge_apps(RelName, [RelApp | RelApps], Apps, RelAppType, Acc) + end; +do_merge_apps(_RelName, [], _Apps, _RelAppType, Acc) -> + lists:reverse(Acc). + +init_rel_app(Name, Apps) -> + {value, App} = lists:keysearch(Name, #app.name, Apps), + Info = App#app.info, + #rel_app{name = Name, + app_type = undefined, + incl_apps = Info#app_info.incl_apps}. + +merge_app(RelName, + #rel_app{name = Name, + app_type = Type, + incl_apps = InclApps}, + RelAppType, + App) -> + Type2 = + case {Type, App#app.app_type} of + {undefined, undefined} -> RelAppType; + {undefined, AppAppType} -> AppAppType; + {_, _} -> Type + end, + Info = App#app.info, + case InclApps -- Info#app_info.incl_apps of + [] -> + App#app{app_type = Type2, info = Info#app_info{incl_apps = InclApps}}; + BadIncl -> + reltool_utils:throw_error("~p: These applications are " + "used by release ~s but are " + "missing as included_applications " + "in the app file: ~p", + [Name, RelName, BadIncl]) + end. + +is_already_merged(Name, [Name | _], _MergedApps) -> + true; +is_already_merged(Name, [#rel_app{name = Name} | _], _MergedApps) -> + true; +is_already_merged(Name, [_ | RelApps], MergedApps) -> + is_already_merged(Name, RelApps, MergedApps); +is_already_merged(Name, [], [#app{name = Name} | _MergedApps]) -> + true; +is_already_merged(Name, [] = RelApps, [_ | MergedApps]) -> + is_already_merged(Name, RelApps, MergedApps); +is_already_merged(_Name, [], []) -> + false. + %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% %% Generate the contents of a boot file %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% @@ -270,27 +404,24 @@ gen_boot({script, {_, _}, _} = Script) -> gen_script(Rel, Sys, PathFlag, Variables) -> try - do_gen_script(Rel, Sys, PathFlag, Variables) + MergedApps = merge_apps(Rel, Sys), + do_gen_script(Rel, Sys, MergedApps, PathFlag, Variables) catch throw:{error, Text} -> {error, Text} end. -do_gen_script(#rel{name = RelName, vsn = RelVsn, rel_apps = RelApps}, - #sys{apps = Apps, app_type = DefaultType}, +do_gen_script(#rel{name = RelName, vsn = RelVsn}, + #sys{apps = Apps}, + MergedApps, PathFlag, Variables) -> {value, Erts} = lists:keysearch(erts, #app.name, Apps), Preloaded = [Mod#mod.name || Mod <- Erts#app.mods], Mandatory = mandatory_modules(), Early = Mandatory ++ Preloaded, - MergedApps = [merge_app(RA, Apps, DefaultType) || RA <- RelApps], - SortedApps = sort_apps(MergedApps), - {value, KernelApp} = lists:keysearch(kernel, #app.name, SortedApps), - - InclApps = - lists:append([I || - #app{info = #app_info{incl_apps = I}} <- SortedApps]), + {value, KernelApp} = lists:keysearch(kernel, #app.name, MergedApps), + InclApps = [I || #app{info = #app_info{incl_apps = I}} <- MergedApps], %% Create the script DeepList = @@ -300,30 +431,30 @@ do_gen_script(#rel{name = RelName, vsn = RelVsn, rel_apps = RelApps}, {progress, preloaded}, %% Load mandatory modules - {path, create_mandatory_path(SortedApps, PathFlag, Variables)}, + {path, create_mandatory_path(MergedApps, PathFlag, Variables)}, {primLoad, lists:sort(Mandatory)}, {kernel_load_completed}, {progress, kernel_load_completed}, %% Load remaining modules - [load_app_mods(A, Early, PathFlag, Variables) || A <- SortedApps], + [load_app_mods(A, Early, PathFlag, Variables) || A <- MergedApps], {progress, modules_loaded}, %% Start kernel processes - {path, create_path(SortedApps, PathFlag, Variables)}, + {path, create_path(MergedApps, PathFlag, Variables)}, kernel_processes(gen_app(KernelApp)), {progress, init_kernel_started}, %% Load applications [{apply, {application, load, [gen_app(A)]}} || - A = #app{name = Name, app_type = Type} <- SortedApps, + A = #app{name = Name, app_type = Type} <- MergedApps, Name =/= kernel, Type =/= none], {progress, applications_loaded}, %% Start applications [{apply, {application, start_boot, [Name, Type]}} || - #app{name = Name, app_type = Type} <- SortedApps, + #app{name = Name, app_type = Type} <- MergedApps, Type =/= none, Type =/= load, not lists:member(Name, InclApps)], @@ -334,28 +465,6 @@ do_gen_script(#rel{name = RelName, vsn = RelVsn, rel_apps = RelApps}, ], {ok, {script, {RelName, RelVsn}, lists:flatten(DeepList)}}. -merge_app(#rel_app{name = Name, app_type = Type, incl_apps = RelIncl}, - Apps, - DefaultType) -> - {value, App} = lists:keysearch(Name, #app.name, Apps), - Type2 = - case {Type, App#app.app_type} of - {undefined, undefined} -> DefaultType; - {undefined, AppType} -> AppType; - {_, _} -> Type - end, - Info = App#app.info, - case RelIncl -- Info#app_info.incl_apps of - [] -> - App#app{app_type = Type2, - info = Info#app_info{incl_apps = RelIncl}}; - BadIncl -> - reltool_utils:throw_error("~p: These applications are " - "missing as included_applications " - "in the app file: ~p\n", - [Name, BadIncl]) - end. - %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% load_app_mods(#app{mods = Mods} = App, Mand, PathFlag, Variables) -> @@ -438,13 +547,13 @@ sort_apps([], [], [], _) -> []; sort_apps([], Missing, [], _) -> %% this has already been checked before, but as we have the info... - reltool_utils:throw_error("Undefined applications: ~p\n", + reltool_utils:throw_error("Undefined applications: ~p", [make_set(Missing)]); sort_apps([], [], Circular, _) -> - reltool_utils:throw_error("Circular dependencies: ~p\n", + reltool_utils:throw_error("Circular dependencies: ~p", [make_set(Circular)]); sort_apps([], Missing, Circular, _) -> - reltool_utils:throw_error("Circular dependencies: ~p\n" + reltool_utils:throw_error("Circular dependencies: ~p" "Undefined applications: ~p\n", [make_set(Circular), make_set(Missing)]). @@ -603,14 +712,15 @@ gen_rel_files(Sys, TargetDir) -> spec_rel_files(#sys{rels = Rels} = Sys) -> lists:append([do_spec_rel_files(R, Sys) || R <- Rels]). -do_spec_rel_files(#rel{name = Name} = Rel, Sys) -> - RelFile = Name ++ ".rel", - ScriptFile = Name ++ ".script", - BootFile = Name ++ ".boot", - GenRel = gen_rel(Rel, Sys), +do_spec_rel_files(#rel{name = RelName} = Rel, Sys) -> + RelFile = RelName ++ ".rel", + ScriptFile = RelName ++ ".script", + BootFile = RelName ++ ".boot", + MergedApps = merge_apps(Rel, Sys), + GenRel = do_gen_rel(Rel, Sys, MergedApps), PathFlag = true, Variables = [], - {ok, Script} = do_gen_script(Rel, Sys, PathFlag, Variables), + {ok, Script} = do_gen_script(Rel, Sys, MergedApps, PathFlag, Variables), {ok, BootBin} = gen_boot(Script), Date = date(), Time = time(), @@ -665,8 +775,6 @@ do_gen_spec(#sys{root_dir = RootDir, {create_dir,BootVsn, RelFiles}]}, {create_dir, "bin", BinFiles} ] ++ SysFiles2, - %% io:format("InclRegexps2: ~p\n", [InclRegexps2]), - %% io:format("ExclRegexps2: ~p\n", [ExclRegexps2]), SysFiles4 = filter_spec(SysFiles3, InclRegexps2, ExclRegexps2), SysFiles5 = SysFiles4 ++ [{create_dir, "lib", LibFiles}], check_sys(["bin", "erts", "lib"], SysFiles5), @@ -678,23 +786,25 @@ strip_sys_files(Relocatable, SysFiles, Apps, ExclRegexps) -> true -> ExtraExcl = ["^erts.*/bin/.*src\$"], reltool_utils:decode_regexps(excl_sys_filters, - {add, ExtraExcl}, ExclRegexps); + {add, ExtraExcl}, + ExclRegexps); false -> ExclRegexps end, {value, Erts} = lists:keysearch(erts, #app.name, Apps), FilterErts = fun(Spec) -> - File = element(2, Spec), - case lists:prefix("erts", File) of - true -> - if - File =:= Erts#app.label -> - replace_dyn_erl(Relocatable, Spec); - true -> - false - end; - false -> + File = element(2, Spec), + case File of + "erts" -> + reltool_utils:throw_error("This system is not installed. " + "The directory ~s is missing.", + [Erts#app.label]); + _ when File =:= Erts#app.label -> + replace_dyn_erl(Relocatable, Spec); + "erts-" ++ _ -> + false; + _ -> true end end, @@ -707,7 +817,8 @@ strip_sys_files(Relocatable, SysFiles, Apps, ExclRegexps) -> replace_dyn_erl(false, _ErtsSpec) -> true; replace_dyn_erl(true, {create_dir, ErtsDir, ErtsFiles}) -> - [{create_dir, _, BinFiles}] = safe_lookup_spec("bin", ErtsFiles), + [{create_dir, _, BinFiles}] = + safe_lookup_spec("bin", ErtsFiles), case lookup_spec("dyn_erl", BinFiles) of [] -> case lookup_spec("erl.ini", BinFiles) of @@ -759,20 +870,31 @@ spec_bin_files(Sys, AllSysFiles, StrippedSysFiles, RelFiles, InclRegexps) -> GoodNames = [F || {copy_file, F} <- OldBinFiles, not lists:suffix(".boot", F), not lists:suffix(".script", F)], - BinFiles2 = [Map(S) || S <- BinFiles, lists:member(element(2, S), GoodNames)], + BinFiles2 = [Map(S) || S <- BinFiles, + lists:member(element(2, S), GoodNames)], BootFiles = [F || F <- RelFiles, lists:suffix(".boot", element(2, F))], - [{write_file, _, BootRel}] = safe_lookup_spec(Sys#sys.boot_rel ++ ".boot", BootFiles), - BootFiles2 = lists:keystore("start.boot", 2, BootFiles, {write_file, "start.boot", BootRel}), - MakeRegexp = fun(File) -> "^bin/" ++ element(2, File) ++ "(|.escript)\$" end, + [{write_file, _, BootRel}] = + safe_lookup_spec(Sys#sys.boot_rel ++ ".boot", BootFiles), + BootFiles2 = lists:keystore("start.boot", + 2, + BootFiles, + {write_file, "start.boot", BootRel}), + MakeRegexp = + fun(File) -> "^bin/" ++ element(2, File) ++ "(|.escript)\$" end, ExtraIncl = lists:map(MakeRegexp, Escripts), - InclRegexps2 = reltool_utils:decode_regexps(incl_sys_filters, {add, ExtraIncl}, InclRegexps), + InclRegexps2 = reltool_utils:decode_regexps(incl_sys_filters, + {add, ExtraIncl}, + InclRegexps), {InclRegexps2, Escripts ++ BinFiles2 ++ BootFiles2}. spec_escripts(#sys{apps = Apps}, ErtsBin, BinFiles) -> - Filter = fun(#app{is_escript = IsEscript, is_included = IsIncl, - is_pre_included = IsPre, name = Name, active_dir = File}) -> + Filter = fun(#app{is_escript = IsEscript, + is_included = IsIncl, + is_pre_included = IsPre, + name = Name, + active_dir = File}) -> if - Name =:= ?MISSING_APP -> + Name =:= ?MISSING_APP_NAME -> false; not IsEscript -> false; @@ -796,7 +918,6 @@ check_sys(Mandatory, SysFiles) -> lists:foreach(fun(M) -> do_check_sys(M, SysFiles) end, Mandatory). do_check_sys(Prefix, Specs) -> - %%io:format("Prefix: ~p\n", [Prefix]), case lookup_spec(Prefix, Specs) of [] -> reltool_utils:throw_error("Mandatory system directory ~s " @@ -820,6 +941,7 @@ lookup_spec(Prefix, Specs) -> safe_lookup_spec(Prefix, Specs) -> case lookup_spec(Prefix, Specs) of [] -> + %% io:format("lookup fail ~s:\n\t~p\n", [Prefix, Specs]), reltool_utils:throw_error("Mandatory system file ~s is " "not included", [Prefix]); Match -> @@ -834,7 +956,7 @@ spec_lib_files(#sys{apps = Apps} = Sys) -> Filter = fun(#app{is_escript = IsEscript, is_included = IsIncl, is_pre_included = IsPre, name = Name}) -> if - Name =:= ?MISSING_APP -> + Name =:= ?MISSING_APP_NAME -> false; IsEscript -> false; @@ -863,10 +985,10 @@ check_apps([], _) -> spec_app(#app{name = Name, mods = Mods, active_dir = SourceDir, - incl_app_filters = AppInclRegexps, - excl_app_filters = AppExclRegexps} = App, - #sys{incl_app_filters = SysInclRegexps, - excl_app_filters = SysExclRegexps, + incl_app_filters = AppInclRegexps, + excl_app_filters = AppExclRegexps} = App, + #sys{incl_app_filters = SysInclRegexps, + excl_app_filters = SysExclRegexps, debug_info = SysDebugInfo} = Sys) -> %% List files recursively {create_dir, _, AppFiles} = spec_dir(SourceDir), @@ -942,13 +1064,13 @@ spec_dir(Dir) -> Base, [spec_dir(filename:join([Dir, F])) || F <- Files]}; error -> - reltool_utils:throw_error("list dir ~s failed\n", [Dir]) + reltool_utils:throw_error("list dir ~s failed", [Dir]) end; {ok, #file_info{type = regular}} -> %% Plain file {copy_file, Base}; _ -> - reltool_utils:throw_error("read file info ~s failed\n", [Dir]) + reltool_utils:throw_error("read file info ~s failed", [Dir]) end. spec_mod(Mod, DebugInfo) -> @@ -1082,7 +1204,7 @@ do_eval_spec({archive, Archive, Options, Files}, {ok, _} -> ok; {error, Reason} -> - reltool_utils:throw_error("create archive ~s: ~p\n", + reltool_utils:throw_error("create archive ~s failed: ~p", [ArchiveFile, Reason]) end; do_eval_spec({copy_file, File}, _OrigSourceDir, SourceDir, TargetDir) -> @@ -1216,18 +1338,7 @@ opt_join(Path, File) -> filename:join([Path, File]). match(String, InclRegexps, ExclRegexps) -> - %%case - match(String, InclRegexps) andalso not match(String, ExclRegexps). -%% of -%% true -> -%% true; -%% false -> -%% io:format("no match: ~p\n" -%% " incl: ~p\n" -%% " excl: ~p\n", -%% [String, InclRegexps, ExclRegexps]), -%% false -%% end. + match(String, InclRegexps) andalso not match(String, ExclRegexps). %% Match at least one regexp match(_String, []) -> @@ -1284,7 +1395,7 @@ do_install(RelName, TargetDir) -> ok = release_handler:create_RELEASES(TargetDir2, RelFile), ok; _ -> - reltool_utils:throw_error("~s: Illegal syntax.\n", [DataFile]) + reltool_utils:throw_error("~s: Illegal data file syntax", [DataFile]) end. subst_src_scripts(Scripts, SrcDir, DestDir, Vars, Opts) -> diff --git a/lib/reltool/src/reltool_utils.erl b/lib/reltool/src/reltool_utils.erl index 403fa574c5..39d057d994 100644 --- a/lib/reltool/src/reltool_utils.erl +++ b/lib/reltool/src/reltool_utils.erl @@ -19,7 +19,30 @@ -module(reltool_utils). %% Public --compile([export_all]). +-export([root_dir/0, erl_libs/0, lib_dirs/1, + split_app_name/1, prim_consult/1, + default_rels/0, choose_default/3, + + assign_image_list/1, get_latest_resize/1, + mod_conds/0, list_to_mod_cond/1, mod_cond_to_index/1, + incl_conds/0, list_to_incl_cond/1, incl_cond_to_index/1, elem_to_index/2, + app_dir_test/2, split_app_dir/1, + get_item/1, get_items/1, get_selected_items/3, + select_items/3, select_item/2, + + safe_keysearch/5, print/4, return_first_error/2, add_warning/2, + + create_dir/1, list_dir/1, read_file_info/1, + write_file_info/2, read_file/1, write_file/2, + recursive_delete/1, delete/2, recursive_copy_file/2, copy_file/2, + + throw_error/2, + + decode_regexps/3, + default_val/2, + escript_foldl/3, + + call/2, cast/2, reply/3]). -include_lib("kernel/include/file.hrl"). -include_lib("wx/include/wx.hrl"). @@ -103,18 +126,46 @@ prim_parse(Tokens, Acc) -> %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% default_rels() -> - Kernel = #rel_app{name = kernel, incl_apps = []}, - Stdlib = #rel_app{name = stdlib, incl_apps = []}, - Sasl = #rel_app{name = sasl, incl_apps = []}, + %%Kernel = #rel_app{name = kernel, incl_apps = []}, + %%Stdlib = #rel_app{name = stdlib, incl_apps = []}, + Sasl = #rel_app{name = sasl, incl_apps = []}, [ #rel{name = ?DEFAULT_REL_NAME, vsn = "1.0", - rel_apps = [Kernel, Stdlib]}, + rel_apps = []}, + %%rel_apps = [Kernel, Stdlib]}, #rel{name = "start_sasl", vsn = "1.0", - rel_apps = [Kernel, Sasl, Stdlib]} + rel_apps = [Sasl]} + %%rel_apps = [Kernel, Sasl, Stdlib]} ]. +choose_default(Tag, Profile, InclDefs) + when Profile =:= ?DEFAULT_PROFILE; InclDefs -> + case Tag of + incl_sys_filters -> ?DEFAULT_INCL_SYS_FILTERS; + excl_sys_filters -> ?DEFAULT_EXCL_SYS_FILTERS; + incl_app_filters -> ?DEFAULT_INCL_APP_FILTERS; + excl_app_filters -> ?DEFAULT_EXCL_APP_FILTERS; + embedded_app_type -> ?DEFAULT_EMBEDDED_APP_TYPE + end; +choose_default(Tag, standalone, _InclDefs) -> + case Tag of + incl_sys_filters -> ?STANDALONE_INCL_SYS_FILTERS; + excl_sys_filters -> ?STANDALONE_EXCL_SYS_FILTERS; + incl_app_filters -> ?STANDALONE_INCL_APP_FILTERS; + excl_app_filters -> ?STANDALONE_EXCL_APP_FILTERS; + embedded_app_type -> ?DEFAULT_EMBEDDED_APP_TYPE + end; +choose_default(Tag, embedded, _InclDefs) -> + case Tag of + incl_sys_filters -> ?EMBEDDED_INCL_SYS_FILTERS; + excl_sys_filters -> ?EMBEDDED_EXCL_SYS_FILTERS; + incl_app_filters -> ?EMBEDDED_INCL_APP_FILTERS; + excl_app_filters -> ?EMBEDDED_EXCL_APP_FILTERS; + embedded_app_type -> ?EMBEDDED_APP_TYPE + end. + %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% assign_image_list(ListCtrl) -> @@ -379,7 +430,7 @@ create_dir(Dir) -> ok; {error, Reason} -> Text = file:format_error(Reason), - throw_error("create dir ~s: ~s\n", [Dir, Text]) + throw_error("create dir ~s: ~s", [Dir, Text]) end. list_dir(Dir) -> @@ -388,7 +439,7 @@ list_dir(Dir) -> Files; error -> Text = file:format_error(enoent), - throw_error("list dir ~s: ~s\n", [Dir, Text]) + throw_error("list dir ~s: ~s", [Dir, Text]) end. read_file_info(File) -> @@ -397,7 +448,7 @@ read_file_info(File) -> Info; {error, Reason} -> Text = file:format_error(Reason), - throw_error("read file info ~s: ~s\n", [File, Text]) + throw_error("read file info ~s: ~s", [File, Text]) end. write_file_info(File, Info) -> @@ -406,7 +457,7 @@ write_file_info(File, Info) -> ok; {error, Reason} -> Text = file:format_error(Reason), - throw_error("write file info ~s: ~s\n", [File, Text]) + throw_error("write file info ~s: ~s", [File, Text]) end. read_file(File) -> @@ -415,7 +466,7 @@ read_file(File) -> Bin; {error, Reason} -> Text = file:format_error(Reason), - throw_error("read file ~s: ~s\n", [File, Text]) + throw_error("read file ~s: ~s", [File, Text]) end. write_file(File, IoList) -> @@ -424,7 +475,7 @@ write_file(File, IoList) -> ok; {error, Reason} -> Text = file:format_error(Reason), - throw_error("write file ~s: ~s\n", [File, Text]) + throw_error("write file ~s: ~s", [File, Text]) end. recursive_delete(Dir) -> @@ -560,7 +611,12 @@ escript_foldl(Fun, Acc, File) -> %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% call(Name, Msg) when is_atom(Name) -> - call(whereis(Name), Msg); + case whereis(Name) of + undefined -> + {error, {noproc, Name}}; + Pid -> + call(Pid, Msg) + end; call(Pid, Msg) when is_pid(Pid) -> Ref = erlang:monitor(process, Pid), Pid ! {call, self(), Ref, Msg}, diff --git a/lib/reltool/test/Makefile b/lib/reltool/test/Makefile index 00d2add3e5..34781ae720 100644 --- a/lib/reltool/test/Makefile +++ b/lib/reltool/test/Makefile @@ -1,19 +1,19 @@ # # %CopyrightBegin% -# -# Copyright Ericsson AB 2009. All Rights Reserved. -# +# +# Copyright Ericsson AB 2009-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% include $(ERL_TOP)/make/target.mk @@ -25,6 +25,7 @@ include $(ERL_TOP)/make/$(TARGET)/otp.mk MODULES= \ rtt \ + reltool_app_SUITE \ reltool_wx_SUITE \ reltool_server_SUITE \ reltool_test_lib diff --git a/lib/reltool/test/reltool_app_SUITE.erl b/lib/reltool/test/reltool_app_SUITE.erl new file mode 100644 index 0000000000..f8433f73d0 --- /dev/null +++ b/lib/reltool/test/reltool_app_SUITE.erl @@ -0,0 +1,291 @@ +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 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% +%% + +%% +%%---------------------------------------------------------------------- +%% Purpose: Verify the application specifics of the Reltool application +%%---------------------------------------------------------------------- +-module(reltool_app_SUITE). + +-compile(export_all). + +-include("reltool_test_lib.hrl"). + + +t() -> reltool_test_lib:t(?MODULE). +t(Case) -> reltool_test_lib:t({?MODULE, Case}). + +%% Test server callbacks +init_per_suite(Config) -> + Config2 = reltool_test_lib:init_per_suite(Config), + case is_app(reltool) of + {ok, AppFile} -> + %% io:format("AppFile: ~n~p~n", [AppFile]), + [{app_file, AppFile} | Config2]; + {error, Reason} -> + fail(Reason) + end. + +end_per_suite(Config) -> + reltool_test_lib:end_per_suite(Config). + +init_per_testcase(Case, Config) -> + Config2 = + case Case of + undef_funcs -> + [{tc_timeout, timer:minutes(10)} | Config]; + _ -> + Config + end, + reltool_test_lib:init_per_testcase(Case, Config2). + +end_per_testcase(Func,Config) -> + reltool_test_lib:end_per_testcase(Func,Config). + +fin_per_testcase(Case, Config) -> + reltool_test_lib:end_per_testcase(Case, Config). + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% + +all() -> + all(suite). + +all(suite) -> + [ + fields, + modules, + export_all, + app_depend, + undef_funcs + ]. + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% + +is_app(App) -> + LibDir = code:lib_dir(App), + File = filename:join([LibDir, "ebin", atom_to_list(App) ++ ".app"]), + case file:consult(File) of + {ok, [{application, App, AppFile}]} -> + {ok, AppFile}; + {error, {LineNo, Mod, Code}} -> + IoList = lists:concat([File, ":", LineNo, ": ", + Mod:format_error(Code)]), + {error, list_to_atom(lists:flatten(IoList))} + end. + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% + +fields(suite) -> + []; +fields(doc) -> + []; +fields(Config) when is_list(Config) -> + AppFile = key1search(app_file, Config), + Fields = [vsn, description, modules, registered, applications], + case check_fields(Fields, AppFile, []) of + [] -> + ok; + Missing -> + fail({missing_fields, Missing}) + end. + +check_fields([], _AppFile, Missing) -> + Missing; +check_fields([Field|Fields], AppFile, Missing) -> + check_fields(Fields, AppFile, check_field(Field, AppFile, Missing)). + +check_field(Name, AppFile, Missing) -> + io:format("checking field: ~p~n", [Name]), + case lists:keymember(Name, 1, AppFile) of + true -> + Missing; + false -> + [Name|Missing] + end. + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% + +modules(suite) -> + []; +modules(doc) -> + []; +modules(Config) when is_list(Config) -> + AppFile = key1search(app_file, Config), + Mods = key1search(modules, AppFile), + EbinList = get_ebin_mods(reltool), + case missing_modules(Mods, EbinList, []) of + [] -> + ok; + Missing -> + throw({error, {missing_modules, Missing}}) + end, + case extra_modules(Mods, EbinList, []) of + [] -> + ok; + Extra -> + throw({error, {extra_modules, Extra}}) + end, + {ok, Mods}. + +get_ebin_mods(App) -> + LibDir = code:lib_dir(App), + EbinDir = filename:join([LibDir,"ebin"]), + {ok, Files0} = file:list_dir(EbinDir), + Files1 = [lists:reverse(File) || File <- Files0], + [list_to_atom(lists:reverse(Name)) || [$m,$a,$e,$b,$.|Name] <- Files1]. + +missing_modules([], _Ebins, Missing) -> + Missing; +missing_modules([Mod|Mods], Ebins, Missing) -> + case lists:member(Mod, Ebins) of + true -> + missing_modules(Mods, Ebins, Missing); + false -> + io:format("missing module: ~p~n", [Mod]), + missing_modules(Mods, Ebins, [Mod|Missing]) + end. + + +extra_modules(_Mods, [], Extra) -> + Extra; +extra_modules(Mods, [Mod|Ebins], Extra) -> + case lists:member(Mod, Mods) of + true -> + extra_modules(Mods, Ebins, Extra); + false -> + io:format("supefluous module: ~p~n", [Mod]), + extra_modules(Mods, Ebins, [Mod|Extra]) + end. + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% + +export_all(suite) -> + []; +export_all(doc) -> + []; +export_all(Config) when is_list(Config) -> + AppFile = key1search(app_file, Config), + Mods = key1search(modules, AppFile), + check_export_all(Mods). + + +check_export_all([]) -> + ok; +check_export_all([Mod|Mods]) -> + case (catch apply(Mod, module_info, [compile])) of + {'EXIT', {undef, _}} -> + check_export_all(Mods); + O -> + case lists:keysearch(options, 1, O) of + false -> + check_export_all(Mods); + {value, {options, List}} -> + case lists:member(export_all, List) of + true -> + throw({error, {export_all, Mod}}); + false -> + check_export_all(Mods) + end + end + end. + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% + +app_depend(suite) -> + []; +app_depend(doc) -> + []; +app_depend(Config) when is_list(Config) -> + AppFile = key1search(app_file, Config), + Apps = key1search(applications, AppFile), + check_apps(Apps). + +check_apps([]) -> + ok; +check_apps([App|Apps]) -> + case is_app(App) of + {ok, _} -> + check_apps(Apps); + Error -> + throw({error, {missing_app, {App, Error}}}) + end. + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% + +undef_funcs(suite) -> + []; +undef_funcs(doc) -> + []; +undef_funcs(Config) when is_list(Config) -> + App = reltool, + AppFile = key1search(app_file, Config), + Mods = key1search(modules, AppFile), + Root = code:root_dir(), + LibDir = code:lib_dir(App), + EbinDir = filename:join([LibDir,"ebin"]), + XRefTestName = undef_funcs_make_name(App, xref_test_name), + {ok, XRef} = xref:start(XRefTestName), + ok = xref:set_default(XRef, + [{verbose,false},{warnings,false}]), + XRefName = undef_funcs_make_name(App, xref_name), + {ok, XRefName} = xref:add_release(XRef, Root, {name,XRefName}), + {ok, App} = xref:replace_application(XRef, App, EbinDir), + {ok, Undefs} = xref:analyze(XRef, undefined_function_calls), + xref:stop(XRef), + analyze_undefined_function_calls(Undefs, Mods, []). + +analyze_undefined_function_calls([], _, []) -> + ok; +analyze_undefined_function_calls([], _, AppUndefs) -> + exit({suite_failed, {undefined_function_calls, AppUndefs}}); +analyze_undefined_function_calls([{{Mod, _F, _A}, _C} = AppUndef|Undefs], + AppModules, AppUndefs) -> + %% Check that this module is our's + case lists:member(Mod,AppModules) of + true -> + {Calling,Called} = AppUndef, + {Mod1,Func1,Ar1} = Calling, + {Mod2,Func2,Ar2} = Called, + io:format("undefined function call: " + "~n ~w:~w/~w calls ~w:~w/~w~n", + [Mod1,Func1,Ar1,Mod2,Func2,Ar2]), + analyze_undefined_function_calls(Undefs, AppModules, + [AppUndef|AppUndefs]); + false -> + io:format("dropping ~p~n", [Mod]), + analyze_undefined_function_calls(Undefs, AppModules, AppUndefs) + end. + +%% This function is used simply to avoid cut-and-paste errors later... +undef_funcs_make_name(App, PostFix) -> + list_to_atom(atom_to_list(App) ++ "_" ++ atom_to_list(PostFix)). + + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% + +fail(Reason) -> + exit({suite_failed, Reason}). + +key1search(Key, L) -> + case lists:keysearch(Key, 1, L) of + false -> + fail({not_found, Key, L}); + {value, {Key, Value}} -> + Value + end. diff --git a/lib/reltool/test/reltool_server_SUITE.erl b/lib/reltool/test/reltool_server_SUITE.erl index cf951191a0..faf1bdbba2 100644 --- a/lib/reltool/test/reltool_server_SUITE.erl +++ b/lib/reltool/test/reltool_server_SUITE.erl @@ -1,19 +1,19 @@ %% %% %CopyrightBegin% -%% -%% Copyright Ericsson AB 2009. All Rights Reserved. -%% +%% +%% Copyright Ericsson AB 2009-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% -module(reltool_server_SUITE). @@ -26,11 +26,13 @@ -include("reltool_test_lib.hrl"). -define(NODE_NAME, '__RELTOOL__TEMPORARY_TEST__NODE__'). +-define(WORK_DIR, "reltool_work_dir"). %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% %% Initialization functions. init_per_suite(Config) -> + ?ignore(file:make_dir(?WORK_DIR)), reltool_test_lib:init_per_suite(Config). end_per_suite(Config) -> @@ -128,8 +130,7 @@ create_release(_Config) -> {value, {_, _, StdlibVsn}} = lists:keysearch(stdlib, 1, Apps), Rel = {release, {RelName, RelVsn}, {erts, ErtsVsn}, - [{kernel, KernelVsn}, - {stdlib, StdlibVsn}]}, + [{kernel, KernelVsn}, {stdlib, StdlibVsn}]}, ?m({ok, Rel}, reltool:get_rel([{config, Config}], RelName)), ok. @@ -159,15 +160,17 @@ create_script(_Config) -> Rel = {release, {RelName, RelVsn}, {erts, ErtsVsn}, - [{stdlib, StdlibVsn}, {kernel, KernelVsn}]}, + [{kernel, KernelVsn}, {stdlib, StdlibVsn}]}, ?m({ok, Rel}, reltool:get_rel(Pid, RelName)), - RelFile = RelName ++ ".rel", - ?m(ok, file:write_file(RelFile, io_lib:format("~p.\n", [Rel]))), + ?m(ok, file:write_file(filename:join([?WORK_DIR, RelName ++ ".rel"]), + io_lib:format("~p.\n", [Rel]))), %% Generate script file + {ok, Cwd} = file:get_cwd(), + ?m(ok, file:set_cwd(?WORK_DIR)), ?m(ok, systools:make_script(RelName, [])), - ScriptFile = RelName ++ ".script", - {ok, [OrigScript]} = ?msym({ok, [_]}, file:consult(ScriptFile)), + {ok, [OrigScript]} = ?msym({ok, [_]}, file:consult(RelName ++ ".script")), + ?m(ok, file:set_cwd(Cwd)), {ok, Script} = ?msym({ok, _}, reltool:get_script(Pid, RelName)), %% OrigScript2 = sort_script(OrigScript), %% Script2 = sort_script(Script), @@ -201,9 +204,10 @@ create_target(_Config) -> ]}, %% Generate target file - TargetDir = "reltool_target_dir_development", + TargetDir = filename:join([?WORK_DIR, "target_development"]), ?m(ok, reltool_utils:recursive_delete(TargetDir)), ?m(ok, file:make_dir(TargetDir)), + ?log("SPEC: ~p\n", [reltool:get_target_spec([{config, Config}])]), ?m(ok, reltool:create_target([{config, Config}], TargetDir)), Erl = filename:join([TargetDir, "bin", "erl"]), @@ -234,7 +238,7 @@ create_embedded(_Config) -> ]}, %% Generate target file - TargetDir = "reltool_target_dir_embedded", + TargetDir = filename:join([?WORK_DIR, "target_embedded"]), ?m(ok, reltool_utils:recursive_delete(TargetDir)), ?m(ok, file:make_dir(TargetDir)), ?m(ok, reltool:create_target([{config, Config}], TargetDir)), @@ -264,7 +268,7 @@ create_standalone(_Config) -> ]}, %% Generate target file - TargetDir = "reltool_target_dir_standalone", + TargetDir = filename:join([?WORK_DIR, "target_standalone"]), ?m(ok, reltool_utils:recursive_delete(TargetDir)), ?m(ok, file:make_dir(TargetDir)), ?m(ok, reltool:create_target([{config, Config}], TargetDir)), @@ -290,6 +294,8 @@ create_standalone(_Config) -> create_old_target(TestInfo) when is_atom(TestInfo) -> reltool_test_lib:tc_info(TestInfo); create_old_target(_Config) -> + ?skip("Old style of target", []), + %% Configure the server RelName1 = "Just testing", RelName2 = "Just testing with SASL", @@ -306,7 +312,7 @@ create_old_target(_Config) -> ]}, %% Generate target file - TargetDir = "reltool_target_dir_old", + TargetDir = filename:join([?WORK_DIR, "target_old_style"]), ?m(ok, reltool_utils:recursive_delete(TargetDir)), ?m(ok, file:make_dir(TargetDir)), ?m(ok, reltool:create_target([{config, Config}], TargetDir)), diff --git a/lib/reltool/test/reltool_test_lib.erl b/lib/reltool/test/reltool_test_lib.erl index 25978294ee..5390b0a75e 100644 --- a/lib/reltool/test/reltool_test_lib.erl +++ b/lib/reltool/test/reltool_test_lib.erl @@ -1,19 +1,19 @@ %% %% %CopyrightBegin% -%% -%% Copyright Ericsson AB 2009. All Rights Reserved. -%% +%% +%% Copyright Ericsson AB 2009-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% -module(reltool_test_lib). @@ -24,9 +24,11 @@ %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% init_per_suite(Config) when is_list(Config)-> + global:register_name(reltool_global_logger, group_leader()), incr_timetrap(Config, 5). end_per_suite(Config) when is_list(Config)-> + global:unregister_name(reltool_global_logger), ok. incr_timetrap(Config, Times) -> @@ -130,11 +132,9 @@ wx_end_per_suite(Config) -> init_per_testcase(_Func, Config) when is_list(Config) -> set_kill_timer(Config), - global:register_name(reltool_global_logger, group_leader()), Config. end_per_testcase(_Func, Config) when is_list(Config) -> - global:unregister_name(reltool_global_logger), reset_kill_timer(Config), Config. diff --git a/lib/reltool/test/reltool_test_lib.hrl b/lib/reltool/test/reltool_test_lib.hrl index 93134144ea..b592ebb2f0 100644 --- a/lib/reltool/test/reltool_test_lib.hrl +++ b/lib/reltool/test/reltool_test_lib.hrl @@ -1,23 +1,24 @@ %% %% %CopyrightBegin% -%% -%% Copyright Ericsson AB 2009. All Rights Reserved. -%% +%% +%% Copyright Ericsson AB 2009-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% -include_lib("wx/include/wx.hrl"). +-define(flat_format(Format,Args), lists:flatten(io_lib:format(Format,Args))). -define(log(Format,Args), reltool_test_lib:log(Format,Args,?FILE,?LINE)). -define(warning(Format,Args), ?log("<WARNING>\n " ++ Format,Args)). -define(error(Format,Args), reltool_test_lib:error(Format,Args,?FILE,?LINE)). diff --git a/lib/reltool/test/rtt b/lib/reltool/test/rtt index 2411195338..1f93396196 100755 --- a/lib/reltool/test/rtt +++ b/lib/reltool/test/rtt @@ -1,19 +1,19 @@ #! /bin/sh -f # %CopyrightBegin% -# -# Copyright Ericsson AB 2009. All Rights Reserved. -# +# +# Copyright Ericsson AB 2009-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% # Usage: rtt [-cerl] <args to erlang startup script> @@ -23,7 +23,7 @@ while [ $# -gt 0 ]; do case "$1" in "-cerl") shift - emu=cerl + emu="$ERL_TOP/bin/cerl" ;; *) break diff --git a/lib/sasl/doc/src/notes.xml b/lib/sasl/doc/src/notes.xml index 4c4b11d3c4..e528af2522 100644 --- a/lib/sasl/doc/src/notes.xml +++ b/lib/sasl/doc/src/notes.xml @@ -30,6 +30,33 @@ </header> <p>This document describes the changes made to the SASL application.</p> +<section><title>SASL 2.1.9.2</title> + + <section><title>Fixed Bugs and Malfunctions</title> + <list> + <item> + <p>In R13B04 sys:get_status was modified to invoke + format_status/2 in the callback module if the module + exports that function. This resulted in a change to the + term returned from calling sys:get_status on the + supervisor module, since supervisor is a gen_server and + gen_server exports format_status. The sasl + release_handler_1 module had a dependency on the + pre-R13B04 term returned by sys:get_status when invoked + on a supervisor, so the R13B04 change broke that + dependency.</p> + <p>This problem has been fixed by change + release_handler_1 to handle both the pre-R13B04 and + R13B04 terms that sys:get_status can return from a + supervisor.</p> + <p> + Own Id: OTP-8619 Aux Id: seq11570 </p> + </item> + </list> + </section> + +</section> + <section><title>SASL 2.1.9.1</title> <section><title>Improvements and New Features</title> diff --git a/lib/sasl/src/release_handler_1.erl b/lib/sasl/src/release_handler_1.erl index e3e3caba99..9c0edf4e99 100644 --- a/lib/sasl/src/release_handler_1.erl +++ b/lib/sasl/src/release_handler_1.erl @@ -1,19 +1,19 @@ %% %% %CopyrightBegin% -%% -%% Copyright Ericsson AB 1996-2009. All Rights Reserved. -%% +%% +%% Copyright Ericsson AB 1996-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% %% -module(release_handler_1). @@ -554,7 +554,13 @@ get_supervisor_module(SupPid) -> get_supervisor_module1(SupPid) -> {status, _Pid, {module, _Mod}, [_PDict, _SysState, _Parent, _Dbg, Misc]} = sys:get_status(SupPid), - [_Name, State, _Type, _Time] = Misc, + %% supervisor Misc field changed at R13B04, handle old and new variants here + State = case Misc of + [_Name, State1, _Type, _Time] -> + State1; + [_Header, _Data, {data, [{"State", State2}]}] -> + State2 + end, %% Cannot use #supervisor_state{module = Module} = State. {ok, element(#supervisor_state.module, State)}. diff --git a/lib/sasl/vsn.mk b/lib/sasl/vsn.mk index cad33a5d9c..d01a9bc4f1 100644 --- a/lib/sasl/vsn.mk +++ b/lib/sasl/vsn.mk @@ -1 +1 @@ -SASL_VSN = 2.1.9.1 +SASL_VSN = 2.1.9.2 diff --git a/lib/snmp/doc/src/notes.xml b/lib/snmp/doc/src/notes.xml index 33e304abfa..45e1549de7 100644 --- a/lib/snmp/doc/src/notes.xml +++ b/lib/snmp/doc/src/notes.xml @@ -33,6 +33,83 @@ </header> <section> + <title>SNMP Development Toolkit 4.16.2</title> + <p>Version 4.16.2 supports code replacement in runtime from/to + version 4.16.1, 4.16, 4.15, 4.14 and 4.13.5.</p> + + <section> + <title>Improvements and new features</title> + <!-- + <p>-</p> + --> + <list type="bulleted"> + <item> + <p>[compiler] The SMI specifies that a table row OID should be + named: { <tableIdentifier> "1" }. </p> + <p>A new option has been introduced, + <seealso marker="snmpc#compiler_opts">relaxed_row_name_assign_check</seealso>, + that allows for a more liberal numbering scheme</p> + <p>Own Id: OTP-8574</p> + </item> + + <item> + <p>[agent|manager] Changes to make snmp (forward) compatible with + the new version of the crypto application (released in R14). + As of R14, crypto is implemented using NIFs. Also, + the API is more strict. </p> + <p>Own Id: OTP-8594</p> + </item> + + <item> + <p>Auto [agent] Changed default value for the MIB server cache. + GC is now on by default. </p> + <p>Own Id: OTP-8648</p> + </item> + + </list> + + </section> + + <section> + <title>Reported Fixed Bugs and Malfunctions</title> + <!-- + <p>-</p> + --> + + <list type="bulleted"> + <item> + <p>Encode/decode of Counter64 values larger than + 16#7fffffffffffffff (9223372036854775807) failed. </p> + <p>Own Id: OTP-8563</p> + </item> + + <item> + <p>[compiler] Fails to compile non-contiguous BITS. </p> + <p>Per Hedeland</p> + <p>Own Id: OTP-8595</p> + </item> + + <item> + <p>[manager] Raise condition causing the manager server process to + crash. Unregistering an agent while traffic (set/get-operations) + is ongoing could cause a crash in the manager server process + (raise condition). </p> + <p>Own Id: OTP-8646</p> + <p>Aux Id: Seq 11585</p> + </item> + + </list> + + </section> + + <section> + <title>Incompatibilities</title> + <p>-</p> + </section> + </section> <!-- 4.16.2 --> + + + <section> <title>SNMP Development Toolkit 4.16.1</title> <p>Version 4.16.1 supports code replacement in runtime from/to version 4.16, 4.15, 4.14 and 4.13.5.</p> diff --git a/lib/snmp/doc/src/snmp_app.xml b/lib/snmp/doc/src/snmp_app.xml index 57eb87a759..694e619da1 100644 --- a/lib/snmp/doc/src/snmp_app.xml +++ b/lib/snmp/doc/src/snmp_app.xml @@ -346,7 +346,7 @@ <p>Defines if the mib server shall perform cache gc automatically or leave it to the user (see <seealso marker="snmpa#gc_mibs_cache">gc_mibs_cache/0,1,2,3</seealso>). </p> - <p>Default is <c>false</c>.</p> + <p>Default is <c>true</c>.</p> </item> <tag><c><![CDATA[mibs_cache_age() = integer() > 0 <optional>]]></c></tag> diff --git a/lib/snmp/doc/src/snmp_config.xml b/lib/snmp/doc/src/snmp_config.xml index 5bd36305fc..769b908adc 100644 --- a/lib/snmp/doc/src/snmp_config.xml +++ b/lib/snmp/doc/src/snmp_config.xml @@ -343,7 +343,7 @@ <p>Defines if the mib server shall perform cache gc automatically or leave it to the user (see <seealso marker="snmpa#gc_mibs_cache">gc_mibs_cache/0,1,2,3</seealso>). </p> - <p>Default is <c>false</c>.</p> + <p>Default is <c>true</c>.</p> </item> <tag><c><![CDATA[mibs_cache_age() = integer() > 0 <optional>]]></c></tag> diff --git a/lib/snmp/doc/src/snmpa.xml b/lib/snmp/doc/src/snmpa.xml index b3661ae9b0..69fe6d62f4 100644 --- a/lib/snmp/doc/src/snmpa.xml +++ b/lib/snmp/doc/src/snmpa.xml @@ -4,7 +4,7 @@ <erlref> <header> <copyright> - <year>2004</year><year>2009</year> + <year>2004</year><year>2010</year> <holder>Ericsson AB. All Rights Reserved.</holder> </copyright> <legalnotice> @@ -13,12 +13,12 @@ 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. - + </legalnotice> <title>snmpa</title> @@ -648,6 +648,20 @@ notification_delivery_info() = #snmpa_notification_delivery_info{} <desc> <p>Disable the mib server cache. </p> + <marker id="which_mibs_cache_size"></marker> + </desc> + </func> + + <func> + <name>which_mibs_cache_size() -> void()</name> + <name>which_mibs_cache_size(Agent) -> void()</name> + <fsummary>The size of the mib server cache</fsummary> + <type> + <v>Agent = pid() | atom()</v> + </type> + <desc> + <p>Retreive the size of the mib server cache. </p> + <marker id="gc_mibs_cache"></marker> </desc> </func> diff --git a/lib/snmp/doc/src/snmpc.xml b/lib/snmp/doc/src/snmpc.xml index 48d63d6c91..fbd0950c69 100644 --- a/lib/snmp/doc/src/snmpc.xml +++ b/lib/snmp/doc/src/snmpc.xml @@ -4,7 +4,7 @@ <erlref> <header> <copyright> - <year>2004</year><year>2009</year> + <year>2004</year><year>2010</year> <holder>Ericsson AB. All Rights Reserved.</holder> </copyright> <legalnotice> @@ -13,12 +13,12 @@ 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. - + </legalnotice> <title>snmpc</title> @@ -47,9 +47,10 @@ <type> <v>File = string()</v> <v>Options = [opt()]</v> - <v>opt() = db() | deprecated() | description() | reference() | group_check() | i() | il() | imports() | module() | module_identity() | outdir() | no_defs() | verbosity() | warnings()</v> + <v>opt() = db() | relaxed_row_name_assign_check() | deprecated() | description() | reference() | group_check() | i() | il() | imports() | module() | module_identity() | outdir() | no_defs() | verbosity() | warnings()</v> <v>db() = {db, volatile|persistent|mnesia}</v> <v>deprecated() = {deprecated, bool()}</v> + <v>relaxed_row_name_assign_check() = relaxed_row_name_assign_check</v> <v>description() = description</v> <v>reference() = reference</v> <v>group_check() = {group_check, bool()}</v> @@ -71,75 +72,104 @@ compiled file <c>BinFileName</c> is called <c><![CDATA[<File>.bin]]></c>. </p> <list type="bulleted"> - <item>The option <c>db</c> specifies which database should - be used for the default instrumentation. Default is - <c>volatile</c>. + <item> + <p>The option <c>db</c> specifies which database should + be used for the default instrumentation. </p> + <p>Default is <c>volatile</c>. </p> + </item> + <item> + <p>The option <c>deprecated</c> specifies if a deprecated + definition should be kept or not. If the option is + false the MIB compiler will ignore all deprecated + definitions. </p> + <p>Default is <c>true</c>. </p> </item> - <item>The option <c>deprecated</c> specifies if a deprecated - definition should be kept or not. If the option is - false the MIB compiler will ignore all deprecated - definitions. Default is <c>true</c>. + <item> + <p>The option <c>relaxed_row_name_assign_check</c>, if present, + specifies that the row name assign check shall not be done + strictly according to the SMI (which allows only the value 1). + With this option, all values greater than zero is allowed + (>= 1). This means that the error will be converted to a + warning. </p> + <p>By default it is not included, but if this option is present + it will be. </p> </item> - <item>The option <c>description</c> specifies if the text - of the DESCRIPTION field will be included or not. By default - it is not included, but if this option is present it will - be. + <item> + <p>The option <c>description</c> specifies if the text + of the DESCRIPTION field will be included or not. </p> + <p>By default it is not included, but if this option is + present it will be. </p> </item> - <item>The option <c>reference</c> specifies if the text - of the REFERENCE field, when found in a table definition, - will be included or not. By default - it is not included, but if this option is present it will - be. The reference text will be placed in the allocList field - of the mib-entry record (#me{}) for the table. + <item> + <p>The option <c>reference</c> specifies if the text + of the REFERENCE field, when found in a table definition, + will be included or not. </p> + <p>By default it is not included, but if this option is present + it will be. The reference text will be placed in the allocList + field of the mib-entry record (#me{}) for the table. </p> </item> - <item>The option <c>group_check</c> specifies whether the - mib compiler should check the OBJECT-GROUP macro and - the NOTIFICATION-GROUP macro for correctness or not. - Default is <c>true</c>. + <item> + <p>The option <c>group_check</c> specifies whether the + mib compiler should check the OBJECT-GROUP macro and + the NOTIFICATION-GROUP macro for correctness or not. </p> + <p>Default is <c>true</c>. </p> </item> - <item>The option <c>i</c> specifies the path to search for - imported (compiled) MIB files. The directories should be - strings with a trailing directory delimiter. Default is - <c>["./"]</c>. + <item> + <p>The option <c>i</c> specifies the path to search for + imported (compiled) MIB files. The directories should be + strings with a trailing directory delimiter. </p> + <p>Default is <c>["./"]</c>. </p> </item> - <item>The option <c>il</c> (include_lib) also specifies a - list of directories to search for imported MIBs. It - assumes that the first element in the directory name - corresponds to an OTP application. The compiler will find - the current installed version. For example, the value - ["snmp/mibs/"] will be replaced by ["snmp-3.1.1/mibs/"] - (or what the current version may be in the system). The - current directory and the <c><![CDATA[<snmp-home>/priv/mibs/]]></c> - are always listed last in the include path. + <item> + <p>The option <c>il</c> (include_lib) also specifies a + list of directories to search for imported MIBs. It + assumes that the first element in the directory name + corresponds to an OTP application. The compiler will find + the current installed version. For example, the value + ["snmp/mibs/"] will be replaced by ["snmp-3.1.1/mibs/"] + (or what the current version may be in the system). The + current directory and the + <c><![CDATA[<snmp-home>/priv/mibs/]]></c> + are always listed last in the include path. </p> </item> - <item>The option <c>imports</c>, if present, specifies that the - IMPORT statement of the MIB shall be included in the compiled mib. + <item> + <p>The option <c>imports</c>, if present, specifies that + the IMPORT statement of the MIB shall be included in the + compiled mib. </p> </item> - <item>The option <c>module</c>, if present, specifies the - name of a module which implements all instrumentation - functions for the MIB. The name of all instrumentation - functions must be the same as the corresponding managed - object it implements. + <item> + <p>The option <c>module</c>, if present, specifies the + name of a module which implements all instrumentation + functions for the MIB. </p> + <p>The name of all instrumentation + functions must be the same as the corresponding managed + object it implements. </p> </item> - <item>The option <c>module_identity</c>, if present, specifies - that the info part of the MODULE-IDENTITY statement of the MIB - shall be included in the compiled mib. + <item> + <p>The option <c>module_identity</c>, if present, specifies + that the info part of the MODULE-IDENTITY statement of the MIB + shall be included in the compiled mib. </p> </item> - <item>The option <c>no_defs</c>, if present, specifies - that if a managed object does not have an instrumentation - function, the default instrumentation function should NOT - be used, instead this is reported as an error, and the - compilation aborts. + <item> + <p>The option <c>no_defs</c>, if present, specifies + that if a managed object does not have an instrumentation + function, the default instrumentation function should NOT + be used, instead this is reported as an error, and the + compilation aborts. </p> </item> - <item>The option <c>verbosity</c> specifies the verbosity of - the SNMP mib compiler. I.e. if warning, info, log, debug - and trace messages shall be shown. Default is <c>silence</c>. - Note that if the option <c>warnings</c> is <c>true</c> and the - option <c>verbosity</c> is <c>silence</c>, warning messages will - still be shown. + <item> + <p>The option <c>verbosity</c> specifies the verbosity of + the SNMP mib compiler. I.e. if warning, info, log, debug + and trace messages shall be shown. </p> + <p>Default is <c>silence</c>. </p> + <p>Note that if the option <c>warnings</c> is <c>true</c> and the + option <c>verbosity</c> is <c>silence</c>, warning messages will + still be shown. </p> </item> - <item>The option <c>warnings</c> specifies whether warning - messages should be shown. Default is <c>true</c>. + <item> + <p>The option <c>warnings</c> specifies whether warning + messages should be shown. </p> + <p>Default is <c>true</c>. </p> </item> </list> <p>The MIB compiler understands both SMIv1 and SMIv2 MIBs. It diff --git a/lib/snmp/src/agent/snmpa.erl b/lib/snmp/src/agent/snmpa.erl index a113bba3a7..1c37d76074 100644 --- a/lib/snmp/src/agent/snmpa.erl +++ b/lib/snmp/src/agent/snmpa.erl @@ -47,6 +47,7 @@ mib_of/1, mib_of/2, me_of/1, me_of/2, invalidate_mibs_cache/0, invalidate_mibs_cache/1, + which_mibs_cache_size/0, which_mibs_cache_size/1, enable_mibs_cache/0, enable_mibs_cache/1, disable_mibs_cache/0, disable_mibs_cache/1, gc_mibs_cache/0, gc_mibs_cache/1, gc_mibs_cache/2, gc_mibs_cache/3, @@ -302,6 +303,13 @@ invalidate_mibs_cache(Agent) -> snmpa_agent:invalidate_mibs_cache(Agent). +which_mibs_cache_size() -> + which_mibs_cache_size(snmp_master_agent). + +which_mibs_cache_size(Agent) -> + snmpa_agent:which_mibs_cache_size(Agent). + + enable_mibs_cache() -> enable_mibs_cache(snmp_master_agent). diff --git a/lib/snmp/src/agent/snmpa_agent.erl b/lib/snmp/src/agent/snmpa_agent.erl index fb04fca632..648f5b53fa 100644 --- a/lib/snmp/src/agent/snmpa_agent.erl +++ b/lib/snmp/src/agent/snmpa_agent.erl @@ -48,6 +48,7 @@ get/2, get/3, get_next/2, get_next/3]). -export([mib_of/1, mib_of/2, me_of/1, me_of/2, invalidate_mibs_cache/1, + which_mibs_cache_size/1, enable_mibs_cache/1, disable_mibs_cache/1, gc_mibs_cache/1, gc_mibs_cache/2, gc_mibs_cache/3, enable_mibs_cache_autogc/1, disable_mibs_cache_autogc/1, @@ -245,6 +246,10 @@ disable_mibs_cache(Agent) -> call(Agent, {mibs_cache_request, disable_cache}). +which_mibs_cache_size(Agent) -> + call(Agent, {mibs_cache_request, cache_size}). + + enable_mibs_cache_autogc(Agent) -> call(Agent, {mibs_cache_request, enable_autogc}). @@ -1219,6 +1224,8 @@ handle_mibs_cache_request(MibServer, Req) -> snmpa_mib:gc_cache(MibServer, Age); {gc_cache, Age, GcLimit} -> snmpa_mib:gc_cache(MibServer, Age, GcLimit); + cache_size -> + snmpa_mib:which_cache_size(MibServer); enable_cache -> snmpa_mib:enable_cache(MibServer); disable_cache -> diff --git a/lib/snmp/src/agent/snmpa_mib.erl b/lib/snmp/src/agent/snmpa_mib.erl index 370989d0be..ce90db18b3 100644 --- a/lib/snmp/src/agent/snmpa_mib.erl +++ b/lib/snmp/src/agent/snmpa_mib.erl @@ -1,19 +1,19 @@ %% %% %CopyrightBegin% -%% -%% Copyright Ericsson AB 1996-2009. All Rights Reserved. -%% +%% +%% Copyright Ericsson AB 1996-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% %% -module(snmpa_mib). @@ -55,7 +55,7 @@ -define(NO_CACHE, no_mibs_cache). -define(DEFAULT_CACHE_USAGE, true). -define(CACHE_GC_TICKTIME, timer:minutes(1)). --define(DEFAULT_CACHE_AUTOGC, false). +-define(DEFAULT_CACHE_AUTOGC, true). -define(DEFAULT_CACHE_GCLIMIT, 100). -define(DEFAULT_CACHE_AGE, timer:minutes(10)). -define(CACHE_GC_TRIGGER, cache_gc_trigger). diff --git a/lib/snmp/src/agent/snmpa_usm.erl b/lib/snmp/src/agent/snmpa_usm.erl index 12a6b996ff..b94294844b 100644 --- a/lib/snmp/src/agent/snmpa_usm.erl +++ b/lib/snmp/src/agent/snmpa_usm.erl @@ -560,11 +560,15 @@ encrypt(Data, PrivProtocol, PrivKey, SecLevel) -> ?vtrace("encrypt -> 3.1.4a",[]), case (catch try_encrypt(PrivProtocol, PrivKey, Data)) of {ok, ScopedPduData, MsgPrivParams} -> - ?vtrace("encrypt -> encode tag",[]), + ?vtrace("encrypt -> encrypted - now encode tag",[]), {snmp_pdus:enc_oct_str_tag(ScopedPduData), MsgPrivParams}; {error, Reason} -> + ?vtrace("encrypt -> error: " + "~n Reason: ~p", [Reason]), error(Reason); - _Error -> + Error -> + ?vtrace("encrypt -> other: " + "~n Error: ~p", [Error]), error(encryptionError) end end. diff --git a/lib/snmp/src/app/snmp.appup.src b/lib/snmp/src/app/snmp.appup.src index 204de71c2e..2acff74b42 100644 --- a/lib/snmp/src/app/snmp.appup.src +++ b/lib/snmp/src/app/snmp.appup.src @@ -22,36 +22,63 @@ %% ----- U p g r a d e ------------------------------------------------------- [ + {"4.16.1", + [ + {load_module, snmpa, soft_purge, soft_purge, [snmpa_agent]}, + {load_module, snmpa_usm, soft_purge, soft_purge, [snmp_usm]}, + {load_module, snmp_usm, soft_purge, soft_purge, []}, + {load_module, snmp_pdus, soft_purge, soft_purge, []}, + {update, snmpm_server, soft, soft_purge, soft_purge, []}, + {update, snmpa_mib, soft, soft_purge, soft_purge, []}, + {update, snmpa_agent, soft, soft_purge, soft_purge, [snmpa_mib]} + ] + }, {"4.16", [ + {load_module, snmpa, soft_purge, soft_purge, [snmpa_agent]}, + {load_module, snmpa_usm, soft_purge, soft_purge, [snmp_usm]}, + {load_module, snmp_usm, soft_purge, soft_purge, []}, + {load_module, snmp_pdus, soft_purge, soft_purge, []}, {load_module, snmpa_general_db, soft_purge, soft_purge, []}, - {update, snmpm_net_if, soft, soft_purge, soft_purge, []} + {update, snmpm_net_if, soft, soft_purge, soft_purge, []}, + {update, snmpm_server, soft, soft_purge, soft_purge, []}, + {update, snmpm_mib, soft, soft_purge, soft_purge, []}, + {update, snmpa_agent, soft, soft_purge, soft_purge, [snmpa_mib]} ] }, {"4.15", [ - {load_module, snmpa, soft_purge, soft_purge, [snmp_log]}, + {load_module, snmp_pdus, soft_purge, soft_purge, []}, + {load_module, snmpa, soft_purge, soft_purge, [snmpa_agent, snmp_log]}, {load_module, snmp_config, soft_purge, soft_purge, []}, {load_module, snmp_log, soft_purge, soft_purge, []}, {load_module, snmpa_general_db, soft_purge, soft_purge, []}, - {update, snmpm_net_if, {advanced, upgrade_from_pre_4_16}, - soft_purge, soft_purge, [snmpm_config, snmp_log]}, - {update, snmpa_net_if, {advanced, upgrade_from_pre_4_16}, + {update, snmpa_net_if, {advanced, upgrade_from_pre_4_16}, soft_purge, soft_purge, [snmpa_agent, snmp_log]}, - {update, snmpa_agent, soft, soft_purge, soft_purge, []}, + {update, snmpa_mib, soft, soft_purge, soft_purge, []}, + {update, snmpa_agent, soft, soft_purge, soft_purge, [snmpa_mib]}, + {load_module, snmpa_usm, soft_purge, soft_purge, [snmp_usm]}, + {load_module, snmp_usm, soft_purge, soft_purge, []}, - {update, snmpm_config, soft, soft_purge, soft_purge, []} + {update, snmpm_net_if, {advanced, upgrade_from_pre_4_16}, + soft_purge, soft_purge, [snmpm_config, snmp_log]}, + {update, snmpm_config, soft, soft_purge, soft_purge, []}, + {update, snmpm_server, soft, soft_purge, soft_purge, []} ] }, {"4.14", [ - {load_module, snmpa, soft_purge, soft_purge, [snmp_log]}, + {load_module, snmp_pdus, soft_purge, soft_purge, []}, + {load_module, snmpa, soft_purge, soft_purge, [snmpa_agent, snmp_log]}, {load_module, snmp_config, soft_purge, soft_purge, []}, {load_module, snmp_log, soft_purge, soft_purge, []}, {load_module, snmpa_general_db, soft_purge, soft_purge, []}, {update, snmpa_net_if, {advanced, upgrade_from_pre_4_16}, soft_purge, soft_purge, [snmpa_agent, snmp_log]}, - {update, snmpa_agent, soft, soft_purge, soft_purge, []}, + {update, snmpa_mib, soft, soft_purge, soft_purge, []}, + {update, snmpa_agent, soft, soft_purge, soft_purge, [snmpa_mib]}, + {load_module, snmpa_usm, soft_purge, soft_purge, [snmp_usm]}, + {load_module, snmp_usm, soft_purge, soft_purge, []}, {load_module, snmpm_user, soft_purge, soft_purge, []}, {load_module, snmpm_user_default, soft_purge, soft_purge, [snmpm_user]}, @@ -64,14 +91,18 @@ }, {"4.13.5", [ + {load_module, snmp_pdus, soft_purge, soft_purge, []}, {load_module, snmpa_mib_data, soft_purge, soft_purge, []}, - {load_module, snmpa, soft_purge, soft_purge, [snmp_log]}, + {load_module, snmpa, soft_purge, soft_purge, [snmpa_agent, snmp_log]}, {load_module, snmp_config, soft_purge, soft_purge, []}, {load_module, snmp_log, soft_purge, soft_purge, []}, {load_module, snmpa_general_db, soft_purge, soft_purge, []}, {update, snmpa_net_if, {advanced, upgrade_from_pre_4_16}, soft_purge, soft_purge, [snmpa_agent, snmp_log]}, - {update, snmpa_agent, soft, soft_purge, soft_purge, []}, + {update, snmpa_mib, soft, soft_purge, soft_purge, [snmpa_mib_data]}, + {update, snmpa_agent, soft, soft_purge, soft_purge, [snmpa_mib]}, + {load_module, snmpa_usm, soft_purge, soft_purge, [snmp_usm]}, + {load_module, snmp_usm, soft_purge, soft_purge, []}, {load_module, snmpm_user, soft_purge, soft_purge, []}, {load_module, snmpm_user_default, soft_purge, soft_purge, [snmpm_user]}, @@ -88,37 +119,64 @@ %% ------D o w n g r a d e --------------------------------------------------- [ + {"4.16.1", + [ + {load_module, snmpa, soft_purge, soft_purge, [snmpa_agent]}, + {load_module, snmpa_usm, soft_purge, soft_purge, [snmp_usm]}, + {load_module, snmp_usm, soft_purge, soft_purge, []}, + {load_module, snmp_pdus, soft_purge, soft_purge, []}, + {update, snmpm_server, soft, soft_purge, soft_purge, []}, + {update, snmpa_mib, soft, soft_purge, soft_purge, []}, + {update, snmpa_agent, soft, soft_purge, soft_purge, [snmpa_mib]} + ] + }, {"4.16", [ + {load_module, snmpa, soft_purge, soft_purge, [snmpa_agent]}, + {load_module, snmpa_usm, soft_purge, soft_purge, [snmp_usm]}, + {load_module, snmp_usm, soft_purge, soft_purge, []}, + {load_module, snmp_pdus, soft_purge, soft_purge, []}, {load_module, snmpa_general_db, soft_purge, soft_purge, []}, - {update, snmpm_net_if, soft, soft_purge, soft_purge, []} + {update, snmpm_net_if, soft, soft_purge, soft_purge, []}, + {update, snmpm_server, soft, soft_purge, soft_purge, []}, + {update, snmpa_mib, soft, soft_purge, soft_purge, []}, + {update, snmpa_agent, soft, soft_purge, soft_purge, [snmpa_mib]} ] }, {"4.15", [ - {load_module, snmpa, soft_purge, soft_purge, [snmp_log]}, + {load_module, snmp_pdus, soft_purge, soft_purge, []}, + {load_module, snmpa, soft_purge, soft_purge, [snmpa_agent, snmp_log]}, {load_module, snmp_config, soft_purge, soft_purge, []}, {load_module, snmp_log, soft_purge, soft_purge, []}, {load_module, snmpa_general_db, soft_purge, soft_purge, []}, - {update, snmpa_net_if, {advanced, downgrade_to_pre_4_16}, + {update, snmpa_net_if, {advanced, downgrade_to_pre_4_16}, soft_purge, soft_purge, [snmpa_agent, snmp_log]}, - {update, snmpa_agent, soft, soft_purge, soft_purge, []}, + {update, snmpa_mib, soft, soft_purge, soft_purge, []}, + {update, snmpa_agent, soft, soft_purge, soft_purge, [snmpa_mib]}, + {load_module, snmpa_usm, soft_purge, soft_purge, [snmp_usm]}, + {load_module, snmp_usm, soft_purge, soft_purge, []}, {load_module, snmpa_general_db, soft_purge, soft_purge, []}, - {update, snmpm_net_if, {advanced, downgrade_to_pre_4_16}, + {update, snmpm_net_if, {advanced, downgrade_to_pre_4_16}, soft_purge, soft_purge, [snmpm_config, snmp_log]}, - {update, snmpm_config, soft, soft_purge, soft_purge, []} + {update, snmpm_config, soft, soft_purge, soft_purge, []}, + {update, snmpm_server, soft, soft_purge, soft_purge, []} ] }, {"4.14", [ - {load_module, snmpa, soft_purge, soft_purge, [snmp_log]}, + {load_module, snmp_pdus, soft_purge, soft_purge, []}, + {load_module, snmpa, soft_purge, soft_purge, [snmpa_agent, snmp_log]}, {load_module, snmp_config, soft_purge, soft_purge, []}, {load_module, snmp_log, soft_purge, soft_purge, []}, {load_module, snmpa_general_db, soft_purge, soft_purge, []}, - {update, snmpa_net_if, {advanced, downgrade_to_pre_4_16}, + {update, snmpa_net_if, {advanced, downgrade_to_pre_4_16}, soft_purge, soft_purge, [snmpa_agent, snmp_log]}, - {update, snmpa_agent, soft, soft_purge, soft_purge, []}, + {update, snmpa_mib, soft, soft_purge, soft_purge, []}, + {update, snmpa_agent, soft, soft_purge, soft_purge, [snmpa_mib]}, + {load_module, snmpa_usm, soft_purge, soft_purge, [snmp_usm]}, + {load_module, snmp_usm, soft_purge, soft_purge, []}, {load_module, snmpm_user, soft_purge, soft_purge, []}, {load_module, snmpm_user_default, soft_purge, soft_purge, [snmpm_user]}, @@ -131,14 +189,18 @@ }, {"4.13.5", [ + {load_module, snmp_pdus, soft_purge, soft_purge, []}, {load_module, snmpa_mib_data, soft_purge, soft_purge, []}, {load_module, snmp_config, soft_purge, soft_purge, []}, - {load_module, snmpa, soft_purge, soft_purge, [snmp_log]}, + {load_module, snmpa, soft_purge, soft_purge, [snmpa_agent, snmp_log]}, {load_module, snmp_log, soft_purge, soft_purge, []}, {load_module, snmpa_general_db, soft_purge, soft_purge, []}, {update, snmpa_net_if, {advanced, downgrade_to_pre_4_16}, soft_purge, soft_purge, [snmpa_agent, snmp_log]}, - {update, snmpa_agent, soft, soft_purge, soft_purge, []}, + {update, snmpa_mib, soft, soft_purge, soft_purge, [snmpa_mib_data]}, + {update, snmpa_agent, soft, soft_purge, soft_purge, [snmpa_mib]}, + {load_module, snmpa_usm, soft_purge, soft_purge, [snmp_usm]}, + {load_module, snmp_usm, soft_purge, soft_purge, []}, {load_module, snmpm_user, soft_purge, soft_purge, []}, {load_module, snmpm_user_default, soft_purge, soft_purge, [snmpm_user]}, diff --git a/lib/snmp/src/compile/snmpc.erl b/lib/snmp/src/compile/snmpc.erl index 8a1f15d4a4..a7f2cdc2bc 100644 --- a/lib/snmp/src/compile/snmpc.erl +++ b/lib/snmp/src/compile/snmpc.erl @@ -1,19 +1,19 @@ %% %% %CopyrightBegin% -%% -%% Copyright Ericsson AB 1997-2009. All Rights Reserved. -%% +%% +%% Copyright Ericsson AB 1997-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% %% -module(snmpc). @@ -34,6 +34,7 @@ -include("snmpc.hrl"). -include("snmpc_lib.hrl"). +-record(dldata, {deprecated, relaxed_row_name_assign_check}). look_at(Mib) -> io:format("~p ~n", [snmpc_lib:look_at(Mib)]). @@ -114,6 +115,7 @@ compile(FileName) -> %% module_identity %% {module, string()} %% no_defs +%% relaxed_row_name_assign_check %% (hidden) {verbosity, trace|debug|log|info|silence} silence %% (hidden) version %% (hidden) options @@ -201,6 +203,8 @@ get_options([imports|Opts], Formats, Args) -> get_options(Opts, ["~n imports"|Formats], Args); get_options([module_identity|Opts], Formats, Args) -> get_options(Opts, ["~n module_identity"|Formats], Args); +get_options([relaxed_row_name_assign_check|Opts], Formats, Args) -> + get_options(Opts, ["~n relaxed_row_name_assign_check"|Formats], Args); get_options([_|Opts], Formats, Args) -> get_options(Opts, Formats, Args). @@ -284,6 +288,8 @@ check_options([imports| T]) -> check_options(T); check_options([module_identity| T]) -> check_options(T); +check_options([relaxed_row_name_assign_check| T]) -> + check_options(T); check_options([{module, M} | T]) when is_atom(M) -> check_options(T); check_options([no_defs| T]) -> @@ -309,6 +315,9 @@ get_description(Options) -> get_reference(Options) -> get_bool_option(reference, Options). +get_relaxed_row_name_assign_check(Options) -> + lists:member(relaxed_row_name_assign_check, Options). + get_bool_option(Option, Options) -> case lists:member(Option, Options) of false -> @@ -406,8 +415,12 @@ compile_parsed_data(#pdata{mib_name = MibName, defs = Definitions}) -> snmpc_lib:import(Imports), update_imports(Imports), - Deprecated = get_deprecated(get(options)), - definitions_loop(Definitions, Deprecated), + Opts = get(options), + Deprecated = get_deprecated(Opts), + RelChk = get_relaxed_row_name_assign_check(Opts), + Data = #dldata{deprecated = Deprecated, + relaxed_row_name_assign_check = RelChk}, + definitions_loop(Definitions, Data), MibName. update_imports(Imports) -> @@ -436,21 +449,21 @@ update_status(Name, Status) -> %% A deprecated object definitions_loop([{#mc_object_type{name = ObjName, status = deprecated}, Line}|T], - false) -> + #dldata{deprecated = false} = Data) -> %% May be implemented but the compiler chooses not to. ?vinfo2("object_type ~w is deprecated => ignored", [ObjName], Line), update_status(ObjName, deprecated), - definitions_loop(T, false); + definitions_loop(T, Data); %% A obsolete object definitions_loop([{#mc_object_type{name = ObjName, status = obsolete}, Line}|T], - Deprecated) -> + Data) -> ?vlog2("object_type ~w is obsolete => ignored", [ObjName], Line), %% No need to implement a obsolete object update_status(ObjName, obsolete), ensure_macro_imported('OBJECT-TYPE', Line), - definitions_loop(T, Deprecated); + definitions_loop(T, Data); %% Defining a table definitions_loop([{#mc_object_type{name = NameOfTable, @@ -475,7 +488,7 @@ definitions_loop([{#mc_object_type{name = NameOfTable, {#mc_sequence{name = SeqName, fields = FieldList}, Sline}|ColsEtc], - Deprecated) -> + Data) -> ?vlog("defloop -> " "[object_type(sequence_of),object_type(type,[1]),sequence]:" "~n NameOfTable: ~p" @@ -529,7 +542,89 @@ definitions_loop([{#mc_object_type{name = NameOfTable, TableME#me{assocList=[{table_info, TableInfo} | make_reference(Ref)]} | ColMEs]), - definitions_loop(RestObjs, Deprecated); + definitions_loop(RestObjs, Data); + +definitions_loop([{#mc_object_type{name = NameOfTable, + syntax = {{sequence_of, SeqName}, _}, + max_access = Taccess, + kind = Kind, + status = Tstatus, + description = Desc1, + units = Tunits, + reference = Ref, + name_assign = Tindex}, + Tline}, + {#mc_object_type{name = NameOfEntry, + syntax = {{type, SeqName}, TEline}, + max_access = 'not-accessible', + kind = {table_entry, IndexingInfo}, + status = Estatus, + description = Desc2, + units = Eunits, + name_assign = {NameOfTable,[Idx]} = BadOID}, + Eline}, + {#mc_sequence{name = SeqName, + fields = FieldList}, + Sline}|ColsEtc], + #dldata{relaxed_row_name_assign_check = true} = Data) + when is_integer(Idx) andalso (Idx > 1) -> + ?vlog("defloop -> " + "[object_type(sequence_of),object_type(type,[~w]),sequence]:" + "~n NameOfTable: ~p" + "~n SeqName: ~p" + "~n Taccess: ~p" + "~n Kind: ~p" + "~n Tstatus: ~p" + "~n Tindex: ~p" + "~n Tunits: ~p" + "~n Tline: ~p" + "~n NameOfEntry: ~p" + "~n TEline: ~p" + "~n IndexingInfo: ~p" + "~n Estatus: ~p" + "~n Eunits: ~p" + "~n Ref: ~p" + "~n Eline: ~p" + "~n FieldList: ~p" + "~n Sline: ~p", + [Idx, + NameOfTable,SeqName,Taccess,Kind,Tstatus, + Tindex,Tunits,Tline, + NameOfEntry,TEline,IndexingInfo,Estatus,Eunits,Ref,Eline, + FieldList,Sline]), + update_status(NameOfTable, Tstatus), + update_status(NameOfEntry, Estatus), + update_status(SeqName, undefined), + ensure_macro_imported('OBJECT-TYPE', Tline), + ?vwarning2("Bad TableEntry OID definition (~w)", + [BadOID], Eline), + test_table(NameOfTable,Taccess,Kind,Tindex,Tline), + {Tfather,Tsubindex} = Tindex, + snmpc_lib:register_oid(Tline,NameOfTable,Tfather,Tsubindex), + Description1 = make_description(Desc1), + TableME = #me{aliasname = NameOfTable, + entrytype = table, + access = 'not-accessible', + description = Description1, + units = Tunits}, + snmpc_lib:register_oid(TEline,NameOfEntry,NameOfTable,[Idx]), + Description2 = make_description(Desc2), + TableEntryME = #me{aliasname = NameOfEntry, + entrytype = table_entry, + assocList = [{table_entry_with_sequence, SeqName}], + access = 'not-accessible', + description = Description2, + units = Eunits}, + {ColMEs, RestObjs} = + define_cols(ColsEtc, 1, FieldList, NameOfEntry, NameOfTable, []), + TableInfo = snmpc_lib:make_table_info(Eline, NameOfTable, + IndexingInfo, ColMEs), + snmpc_lib:add_cdata(#cdata.mes, + [TableEntryME, + TableME#me{assocList=[{table_info, + TableInfo} | make_reference(Ref)]} | + ColMEs]), + definitions_loop(RestObjs, Data); definitions_loop([{#mc_object_type{name = NameOfTable, syntax = {{sequence_of, SeqName},_}, @@ -550,7 +645,7 @@ definitions_loop([{#mc_object_type{name = NameOfTable, name_assign = BadOID}, Eline}, {#mc_sequence{name = SeqName, fields = FieldList}, Sline}|ColsEtc], - Deprecated) -> + Data) -> ?vlog("defloop -> " "[object_type(sequence_of),object_type(type),sequence(fieldList)]:" "~n NameOfTable: ~p" @@ -605,13 +700,13 @@ definitions_loop([{#mc_object_type{name = NameOfTable, TableME#me{assocList=[{table_info, TableInfo} | make_reference(Ref)]} | ColMEs]), - definitions_loop(RestObjs, Deprecated); + definitions_loop(RestObjs, Data); definitions_loop([{#mc_new_type{name = NewTypeName, macro = Macro, syntax = OldType, display_hint = DisplayHint},Line}|T], - Deprecated) -> + Data) -> ?vlog2("defloop -> new_type:" "~n Macro: ~p" "~n NewTypeName: ~p" @@ -632,7 +727,7 @@ definitions_loop([{#mc_new_type{name = NewTypeName, imported = false, display_hint = DisplayHint}]) end, - definitions_loop(T, Deprecated); + definitions_loop(T, Data); %% Plain variable definitions_loop([{#mc_object_type{name = NewVarName, @@ -643,7 +738,7 @@ definitions_loop([{#mc_object_type{name = NewVarName, description = Desc1, units = Units, name_assign = {Parent,SubIndex}},Line} |T], - Deprecated) -> + Data) -> ?vlog2("defloop -> object_type (variable):" "~n NewVarName: ~p" "~n Type: ~p" @@ -672,7 +767,7 @@ definitions_loop([{#mc_object_type{name = NewVarName, VI = snmpc_lib:make_variable_info(NewME2), snmpc_lib:add_cdata(#cdata.mes, [NewME2#me{assocList = [{variable_info, VI}]}]), - definitions_loop(T, Deprecated); + definitions_loop(T, Data); definitions_loop([{#mc_module_identity{name = NewVarName, last_updated = LU, @@ -682,7 +777,7 @@ definitions_loop([{#mc_module_identity{name = NewVarName, revisions = Revs0, name_assign = {Parent, SubIndex}}, Line}|T], - Deprecated) -> + Data) -> ?vlog2("defloop -> module-identity: " "~n NewVarName: ~p" "~n LU: ~p" @@ -706,13 +801,13 @@ definitions_loop([{#mc_module_identity{name = NewVarName, snmpc_lib:add_cdata( #cdata.mes, [snmpc_lib:makeInternalNode2(false, NewVarName)]), - definitions_loop(T, Deprecated); + definitions_loop(T, Data); definitions_loop([{#mc_internal{name = NewVarName, macro = Macro, parent = Parent, sub_index = SubIndex},Line}|T], - Deprecated) -> + Data) -> ?vlog2("defloop -> internal:" "~n NewVarName: ~p" "~n Macro: ~p" @@ -724,7 +819,7 @@ definitions_loop([{#mc_internal{name = NewVarName, snmpc_lib:add_cdata( #cdata.mes, [snmpc_lib:makeInternalNode2(false, NewVarName)]), - definitions_loop(T, Deprecated); + definitions_loop(T, Data); %% A trap message definitions_loop([{#mc_trap{name = TrapName, @@ -732,7 +827,7 @@ definitions_loop([{#mc_trap{name = TrapName, vars = Variables, description = Desc1, num = SpecificCode}, Line}|T], - Deprecated) -> + Data) -> ?vlog2("defloop -> trap:" "~n TrapName: ~p" "~n EnterPrise: ~p" @@ -755,7 +850,7 @@ definitions_loop([{#mc_trap{name = TrapName, lists:foreach(fun(Trap2) -> snmpc_lib:check_trap(Trap2, Trap, Line) end, CDATA#cdata.traps), snmpc_lib:add_cdata(#cdata.traps, [Trap]), - definitions_loop(T, Deprecated); + definitions_loop(T, Data); definitions_loop([{#mc_object_type{name = NameOfEntry, syntax = Type, @@ -763,7 +858,7 @@ definitions_loop([{#mc_object_type{name = NameOfEntry, kind = {table_entry, Index}, status = Estatus, name_assign = SubIndex},Eline}|T], - Deprecated) -> + Data) -> ?vlog("defloop -> object_type (table_entry):" "~n NameOfEntry: ~p" "~n Type: ~p" @@ -777,7 +872,7 @@ definitions_loop([{#mc_object_type{name = NameOfEntry, update_status(NameOfEntry, Estatus), snmpc_lib:print_error("Misplaced TableEntry definition (~w)", [NameOfEntry], Eline), - definitions_loop(T, Deprecated); + definitions_loop(T, Data); definitions_loop([{#mc_notification{name = TrapName, status = deprecated}, Line}|T], @@ -790,19 +885,19 @@ definitions_loop([{#mc_notification{name = TrapName, definitions_loop([{#mc_notification{name = TrapName, status = obsolete}, Line}|T], - Deprecated) -> + Data) -> ?vlog2("defloop -> notification ~w is obsolete => ignored", [TrapName], Line), update_status(TrapName, obsolete), ensure_macro_imported('NOTIFICATION-TYPE', Line), - definitions_loop(T, Deprecated); + definitions_loop(T, Data); definitions_loop([{#mc_notification{name = TrapName, vars = Variables, status = Status, description = Desc, name_assign = {Parent, SubIndex}},Line}|T], - Deprecated) -> + Data) -> ?vlog2("defloop -> notification:" "~n TrapName: ~p" "~n Variables: ~p" @@ -824,13 +919,13 @@ definitions_loop([{#mc_notification{name = TrapName, oidobjects = Variables}, snmpc_lib:check_notification(Notif, Line, CDATA#cdata.traps), snmpc_lib:add_cdata(#cdata.traps, [Notif]), - definitions_loop(T, Deprecated); + definitions_loop(T, Data); -definitions_loop([{#mc_module_compliance{name = Name},Line}|T], Deprecated) -> +definitions_loop([{#mc_module_compliance{name = Name},Line}|T], Data) -> ?vlog2("defloop -> module_compliance:" "~n Name: ~p", [Name], Line), ensure_macro_imported('MODULE-COMPLIANCE', Line), - definitions_loop(T, Deprecated); + definitions_loop(T, Data); definitions_loop([{#mc_object_group{name = Name, objects = GroupObjects, @@ -838,7 +933,7 @@ definitions_loop([{#mc_object_group{name = Name, description = Desc, reference = Ref, name_assign = {Parent,SubIndex}}, Line}|T], - Deprecated) -> + Data) -> ?vlog2("defloop -> object_group ~p:" "~n GroupObjects: ~p" "~n Status: ~p" @@ -873,7 +968,7 @@ definitions_loop([{#mc_object_group{name = Name, {objects, GroupObjects}]}, snmpc_lib:add_cdata(#cdata.mes, [NewME]), - definitions_loop(T, Deprecated); + definitions_loop(T, Data); definitions_loop([{#mc_notification_group{name = Name, objects = GroupObjects, @@ -882,7 +977,7 @@ definitions_loop([{#mc_notification_group{name = Name, reference = Ref, name_assign = {Parent,SubIndex}}, Line} - |T], Deprecated) -> + |T], Data) -> ?vlog2("defloop -> notification_group ~p:" "~n GroupObjects: ~p" "~n Status: ~p" @@ -918,13 +1013,13 @@ definitions_loop([{#mc_notification_group{name = Name, {objects, GroupObjects}]}, snmpc_lib:add_cdata(#cdata.mes, [NewME]), - definitions_loop(T, Deprecated); + definitions_loop(T, Data); definitions_loop([{#mc_object_type{name = NameOfTable, syntax = {{sequence_of, SeqName},_}, status = Tstatus},Tline}, Entry, Seq|T], - Deprecated) -> + Data) -> ?vlog("defloop -> object_type (sequence_of): " "~n NameOfTable: ~p" "~n SeqName: ~p" @@ -956,12 +1051,12 @@ definitions_loop([{#mc_object_type{name = NameOfTable, "Invalid TableEntry '~p' (check STATUS, Sequence name, Oid)", [safe_elem(1,safe_elem(2,Entry))],Tline) end, - definitions_loop(T, Deprecated); + definitions_loop(T, Data); definitions_loop([{#mc_object_type{name = NameOfTable, syntax = {{sequence_of, SeqName},_}, status = Tstatus},Tline}|T], - Deprecated) -> + Data) -> ?vlog("defloop -> object_type (sequence_of):" "~n object_type: ~p" "~n sequence_of: ~p" @@ -969,24 +1064,24 @@ definitions_loop([{#mc_object_type{name = NameOfTable, update_status(NameOfTable, Tstatus), snmpc_lib:print_error("Invalid statements following table ~p.", [NameOfTable],Tline), - definitions_loop(T, Deprecated); + definitions_loop(T, Data); definitions_loop([{#mc_sequence{name = SeqName, fields = _FieldList},Line}|T], - Deprecated) -> + Data) -> ?vwarning2("Unexpected SEQUENCE ~w => ignoring", [SeqName], Line), - definitions_loop(T, Deprecated); + definitions_loop(T, Data); -definitions_loop([{Obj,Line}|T], Deprecated) -> +definitions_loop([{Obj,Line}|T], Data) -> ?vinfo2("defloop -> unknown error" "~n Obj: ~p", [Obj], Line), snmpc_lib:print_error("Unknown Error in MIB. " "Can't describe the error better than this: ~999p ignored." " Please send a trouble report to [email protected].", [Obj], Line), - definitions_loop(T, Deprecated); + definitions_loop(T, Data); -definitions_loop([], _Deprecated) -> +definitions_loop([], _Data) -> ?vlog("defloop -> done", []), ok. diff --git a/lib/snmp/src/compile/snmpc_lib.erl b/lib/snmp/src/compile/snmpc_lib.erl index b7e84e7d6b..4e5bc69f81 100644 --- a/lib/snmp/src/compile/snmpc_lib.erl +++ b/lib/snmp/src/compile/snmpc_lib.erl @@ -1,19 +1,19 @@ %% %% %CopyrightBegin% -%% -%% Copyright Ericsson AB 1997-2009. All Rights Reserved. -%% +%% +%% Copyright Ericsson AB 1997-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% %% @@ -125,7 +125,8 @@ test_kibbles(Kibbles,Line) -> test_kibbles2([],_,_) -> ok; -test_kibbles2([{_KibbleName,BitNo}|Ks],BitNo,Line) -> +test_kibbles2([{_KibbleName,BitNo}|Ks],ExpectBitNo,Line) + when BitNo >= ExpectBitNo -> test_kibbles2(Ks,BitNo+1,Line); test_kibbles2([{_KibbleName,BitNo}|_Ks],ExpectBitNo,Line) -> print_error("Expected kibble no ~p but got ~p.",[ExpectBitNo,BitNo],Line). diff --git a/lib/snmp/src/manager/snmpm_server.erl b/lib/snmp/src/manager/snmpm_server.erl index 30aacc0ec3..d64b5b1d53 100644 --- a/lib/snmp/src/manager/snmpm_server.erl +++ b/lib/snmp/src/manager/snmpm_server.erl @@ -1,19 +1,19 @@ %% %% %CopyrightBegin% -%% -%% Copyright Ericsson AB 2004-2009. All Rights Reserved. -%% +%% +%% Copyright Ericsson AB 2004-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% %% @@ -2804,16 +2804,16 @@ agent_data(TargetName, CtxName) -> agent_data(TargetName, CtxName, Config) -> case snmpm_config:agent_info(TargetName, all) of {ok, Info} -> - {value, {_, Version}} = lists:keysearch(version, 1, Info), + Version = agent_data_item(version, Info), MsgData = case Version of v3 -> DefSecModel = agent_data_item(sec_model, Info), DefSecName = agent_data_item(sec_name, Info), DefSecLevel = agent_data_item(sec_level, Info), - + EngineId = agent_data_item(engine_id, Info), - + SecModel = agent_data_item(sec_model, Config, DefSecModel), @@ -2829,7 +2829,7 @@ agent_data(TargetName, CtxName, Config) -> _ -> DefComm = agent_data_item(community, Info), DefSecModel = agent_data_item(sec_model, Info), - + Comm = agent_data_item(community, Config, DefComm), @@ -2848,8 +2848,12 @@ agent_data(TargetName, CtxName, Config) -> end. agent_data_item(Item, Info) -> - {value, {_, Val}} = lists:keysearch(Item, 1, Info), - Val. + case lists:keysearch(Item, 1, Info) of + {value, {_, Val}} -> + Val; + false -> + throw({error, {not_found, Item, Info}}) + end. agent_data_item(Item, Info, Default) -> case lists:keysearch(Item, 1, Info) of diff --git a/lib/snmp/src/misc/snmp_pdus.erl b/lib/snmp/src/misc/snmp_pdus.erl index 6c80fc3876..dc8900c8cd 100644 --- a/lib/snmp/src/misc/snmp_pdus.erl +++ b/lib/snmp/src/misc/snmp_pdus.erl @@ -1,19 +1,19 @@ %% %% %CopyrightBegin% -%% -%% Copyright Ericsson AB 1996-2009. All Rights Reserved. -%% +%% +%% Copyright Ericsson AB 1996-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% %% @@ -38,7 +38,10 @@ dec_usm_security_parameters/1, strip_encrypted_scoped_pdu_data/1, octet_str_to_bits/1, bits_to_str/1, - get_encoded_length/1]). + get_encoded_length/1, + enc_value/2, dec_value/1]). + +%% -compile(export_all). %% Returns the number of octets required to encode Length. get_encoded_length(Length) -> @@ -290,12 +293,18 @@ dec_value([68 | Bytes]) -> {Value, Rest} = dec_oct_str_notag(Bytes), {{'Opaque', Value}, Rest}; dec_value([70 | Bytes]) -> + %% Counter64 is an unsigned 64 but is actually encoded as + %% a signed integer 64. {Value, Rest} = dec_integer_notag(Bytes), - if Value >= 0, Value =< 18446744073709551615 -> - {{'Counter64', Value}, Rest}; - true -> - exit({error, {bad_counter64, Value}}) - end; + Value2 = + if + (Value >= 0) andalso (Value < 16#8000000000000000) -> + Value; + (Value < 0) -> + 18446744073709551615 + Value + 1; + true -> + exit({error, {bad_counter64, Value}}) end, + {{'Counter64', Value2}, Rest}; dec_value([128,0|T]) -> {{'NULL', noSuchObject}, T}; dec_value([129,0|T]) -> @@ -633,6 +642,21 @@ enc_value(_Type, endOfMibView) -> [130,0]; enc_value('NULL', _Val) -> [5,0]; +enc_value('Counter64', Val) -> + Val2 = + if + Val > 16#ffffffffffffffff -> + exit({error, {bad_counter64, Val}}); + Val >= 16#8000000000000000 -> + (Val band 16#7fffffffffffffff) - 16#8000000000000000; + Val >= 0 -> + Val; + true -> + exit({error, {bad_counter64, Val}}) + end, + Bytes2 = enc_integer_notag(Val2), + Len2 = elength(length(Bytes2)), + lists:append([70 | Len2],Bytes2); enc_value(Type, Val) -> Bytes2 = enc_integer_notag(Val), Len2 = elength(length(Bytes2)), @@ -643,10 +667,7 @@ enc_val_tag('Counter32',Val) when (Val >= 0) andalso (Val =< 4294967295) -> enc_val_tag('Unsigned32', Val) when (Val >= 0) andalso (Val =< 4294967295) -> 66; enc_val_tag('TimeTicks', Val) when (Val >= 0) andalso (Val =< 4294967295) -> - 67; -enc_val_tag('Counter64', Val) when ((Val >= 0) andalso - (Val =< 18446744073709551615)) -> - 70. + 67. %%---------------------------------------------------------------------- diff --git a/lib/snmp/src/misc/snmp_usm.erl b/lib/snmp/src/misc/snmp_usm.erl index 19be564a8e..3508f9e1c2 100644 --- a/lib/snmp/src/misc/snmp_usm.erl +++ b/lib/snmp/src/misc/snmp_usm.erl @@ -198,7 +198,7 @@ des_encrypt(PrivKey, Data, SaltFun) -> [A,B,C,D,E,F,G,H | PreIV] = PrivKey, DesKey = [A,B,C,D,E,F,G,H], Salt = SaltFun(), - IV = snmp_misc:str_xor(PreIV, Salt), + IV = list_to_binary(snmp_misc:str_xor(PreIV, Salt)), TailLen = (8 - (length(Data) rem 8)) rem 8, Tail = mk_tail(TailLen), EncData = crypto:des_cbc_encrypt(DesKey, IV, [Data,Tail]), @@ -213,13 +213,13 @@ des_decrypt(PrivKey, MsgPrivParams, EncData) [A,B,C,D,E,F,G,H | PreIV] = PrivKey, DesKey = [A,B,C,D,E,F,G,H], Salt = MsgPrivParams, - IV = snmp_misc:str_xor(PreIV, Salt), + IV = list_to_binary(snmp_misc:str_xor(PreIV, Salt)), %% Whatabout errors here??? E.g. not a mulitple of 8! Data = binary_to_list(crypto:des_cbc_decrypt(DesKey, IV, EncData)), Data2 = snmp_pdus:strip_encrypted_scoped_pdu_data(Data), {ok, Data2}; des_decrypt(PrivKey, BadMsgPrivParams, EncData) -> - ?vtrace("des_decrypt -> entry with when bad MsgPrivParams" + ?vtrace("des_decrypt -> entry when bad MsgPrivParams" "~n PrivKey: ~p" "~n BadMsgPrivParams: ~p" "~n EncData: ~p", @@ -232,7 +232,7 @@ aes_encrypt(PrivKey, Data, SaltFun) -> Salt = SaltFun(), EngineBoots = snmp_framework_mib:get_engine_boots(), EngineTime = snmp_framework_mib:get_engine_time(), - IV = [?i32(EngineBoots), ?i32(EngineTime) | Salt], + IV = list_to_binary([?i32(EngineBoots), ?i32(EngineTime) | Salt]), EncData = crypto:aes_cfb_128_encrypt(AesKey, IV, Data), {ok, binary_to_list(EncData), Salt}. @@ -240,7 +240,7 @@ aes_decrypt(PrivKey, MsgPrivParams, EncData, EngineBoots, EngineTime) when length(MsgPrivParams) =:= 8 -> AesKey = PrivKey, Salt = MsgPrivParams, - IV = [?i32(EngineBoots), ?i32(EngineTime) | Salt], + IV = list_to_binary([?i32(EngineBoots), ?i32(EngineTime) | Salt]), %% Whatabout errors here??? E.g. not a mulitple of 8! Data = binary_to_list(crypto:aes_cfb_128_decrypt(AesKey, IV, EncData)), Data2 = snmp_pdus:strip_encrypted_scoped_pdu_data(Data), diff --git a/lib/snmp/test/modules.mk b/lib/snmp/test/modules.mk index ff848cad1b..6a0c3e9481 100644 --- a/lib/snmp/test/modules.mk +++ b/lib/snmp/test/modules.mk @@ -1,20 +1,20 @@ #-*-makefile-*- ; force emacs to enter makefile-mode # %CopyrightBegin% -# -# Copyright Ericsson AB 2004-2009. All Rights Reserved. -# +# +# Copyright Ericsson AB 2004-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% SUITE_MODULES = \ @@ -57,6 +57,10 @@ MODULES = \ HRL_FILES = snmp_test_lib.hrl +# These are MIBs that aure used by the compiler test-suite. +COMPILER_MIB_FILES = \ + OTP8574-MIB + MIB_FILES = \ OLD-SNMPEA-MIB.mib \ OLD-SNMPEA-MIB-v2.mib \ diff --git a/lib/snmp/test/snmp_compiler_test.erl b/lib/snmp/test/snmp_compiler_test.erl index 9a9127a130..ad77b01362 100644 --- a/lib/snmp/test/snmp_compiler_test.erl +++ b/lib/snmp/test/snmp_compiler_test.erl @@ -1,19 +1,19 @@ %% %% %CopyrightBegin% -%% -%% Copyright Ericsson AB 2003-2009. All Rights Reserved. -%% +%% +%% Copyright Ericsson AB 2003-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% %% @@ -46,7 +46,9 @@ module_identity/1, tickets/1, - otp_6150/1 + otp_6150/1, + otp_8574/1, + otp_8595/1 ]). @@ -56,6 +58,7 @@ -export([ ]). + %%---------------------------------------------------------------------- %% Macros %%---------------------------------------------------------------------- @@ -98,7 +101,9 @@ all(suite) -> tickets(suite) -> [ - otp_6150 + otp_6150, + otp_8574, + otp_8595 ]. @@ -178,6 +183,54 @@ otp_6150(Config) when is_list(Config) -> ok. +otp_8574(suite) -> + []; +otp_8574(Config) when is_list(Config) -> + put(tname,otp_8574), + p("starting with Config: ~p~n", [Config]), + + Dir = ?config(comp_dir, Config), + MibDir = ?config(mib_dir, Config), + MibFile = join(MibDir, "OTP8574-MIB.mib"), + + p("ensure compile fail without relaxed assign check"), + case snmpc:compile(MibFile, [{group_check, false}, {outdir, Dir}]) of + {error, compilation_failed} -> + p("with relaxed assign check MIB compiles with warning"), + case snmpc:compile(MibFile, [{group_check, false}, + {outdir, Dir}, + relaxed_row_name_assign_check]) of + {ok, _Mib} -> + ok; + {error, Reason} -> + p("unexpected compile failure: " + "~n Reason: ~p", [Reason]), + exit({unexpected_compile_failure, Reason}) + end; + + {ok, _} -> + p("unexpected compile success"), + exit(unexpected_compile_success) + end. + + +otp_8595(suite) -> + []; +otp_8595(Config) when is_list(Config) -> + put(tname,otp_8595), + p("starting with Config: ~p~n", [Config]), + + Dir = ?config(comp_dir, Config), + MibDir = ?config(mib_dir, Config), + MibFile = join(MibDir, "OTP8595-MIB.mib"), + ?line {ok, Mib} = + snmpc:compile(MibFile, [{outdir, Dir}, + {verbosity, trace}, + {group_check, false}]), + io:format("otp_8595 -> Mib: ~n~p~n", [Mib]), + ok. + + %%====================================================================== %% Internal functions %%====================================================================== @@ -373,6 +426,9 @@ join(A,B) -> %% p(F) -> %% p(F, []). +p(F) -> + p(F, []). + p(F, A) -> p(get(tname), F, A). diff --git a/lib/snmp/test/snmp_manager_config_test.erl b/lib/snmp/test/snmp_manager_config_test.erl index fcb3d7e30c..d5dc1387f7 100644 --- a/lib/snmp/test/snmp_manager_config_test.erl +++ b/lib/snmp/test/snmp_manager_config_test.erl @@ -1444,10 +1444,9 @@ start_with_invalid_usm_conf_file1(Conf) when is_list(Conf) -> p("[test 54] write usm config file with invalid auth-key (4)"), Usm54 = setelement(4, Usm51, "[1,2,3,4,5,6,7,8,9,0,1,2,3,4,5,kalle]"), write_usm_conf(ConfDir, [Usm54]), - %% ?line ok = crypto:start(), %% Varf�r k�r den redan? - ?line crypto:start(), %% Make sure it's started... + ?line maybe_start_crypto(), %% Make sure it's started... ?line {error, Reason54} = config_start(Opts), - ?line ok = crypto:stop(), + ?line ok = maybe_stop_crypto(), p("start failed (as expected): ~p", [Reason54]), ?line {failed_check, _, _, _, {invalid_auth_key, _}} = Reason54, await_config_not_running(), @@ -1492,21 +1491,35 @@ start_with_invalid_usm_conf_file1(Conf) when is_list(Conf) -> p("[test 59] write usm config file with invalid auth-key (9)"), Usm59 = setelement(4, Usm57, "[1,2,3,4,5,6,7,8,9,0,1,2,3,4,5,6,7,8,9,ka]"), write_usm_conf(ConfDir, [Usm59]), - ?line ok = crypto:start(), + ?line ok = maybe_start_crypto(), ?line {error, Reason59} = config_start(Opts), - ?line ok = crypto:stop(), + ?line ok = maybe_stop_crypto(), p("start failed (as expected): ~p", [Reason59]), ?line {failed_check, _, _, _, {invalid_auth_key, _}} = Reason59, await_config_not_running(), %% -- - p("[test 5A] write usm config file with valid auth-key when crypto not started (10)"), - Usm5A = setelement(4, Usm57, "[1,2,3,4,5,6,7,8,9,0,1,2,3,4,5,6,7,8,9,0]"), - write_usm_conf(ConfDir, [Usm5A]), - ?line {error, Reason5A} = config_start(Opts), - p("start failed (as expected): ~p", [Reason5A]), - ?line {failed_check, _, _, _, {unsupported_crypto, _}} = Reason5A, - await_config_not_running(), + %% <CRYPTO-MODIFICATIONS> + %% The crypto application do no longer need to be started + %% explicitly (all of it is as of R14 implemented with NIFs). + case (catch crypto:version()) of + {'EXIT', {undef, _}} -> + p("[test 5A] write usm config file with valid auth-key " + "when crypto not started (10)"), + Usm5A = setelement(4, + Usm57, + "[1,2,3,4,5,6,7,8,9,0,1,2,3,4,5,6,7,8,9,0]"), + write_usm_conf(ConfDir, [Usm5A]), + ?line {error, Reason5A} = config_start(Opts), + p("start failed (as expected): ~p", [Reason5A]), + ?line {failed_check, _, _, _, {unsupported_crypto, _}} = Reason5A, + await_config_not_running(); + _ -> + %% This function is only present in version 2.0 or greater. + %% The crypto app no longer needs to be explicitly started + ok + end, + %% </CRYPTO-MODIFICATIONS> %% -- p("[test 61] write usm config file with invalid priv-protocol (1)"), @@ -1566,9 +1579,9 @@ start_with_invalid_usm_conf_file1(Conf) when is_list(Conf) -> p("[test 74] write usm config file with invalid priv-key (4)"), Usm74 = setelement(6, Usm71, "[1,2,3,4,5,6,7,8,9,0,1,2,3,4,5,kalle]"), write_usm_conf(ConfDir, [Usm74]), - ?line ok = crypto:start(), + ?line ok = maybe_start_crypto(), ?line {error, Reason74} = config_start(Opts), - ?line ok = crypto:stop(), + ?line ok = maybe_stop_crypto(), p("start failed (as expected): ~p", [Reason74]), ?line {failed_check, _, _, _, {invalid_priv_key, _}} = Reason74, await_config_not_running(), @@ -1592,15 +1605,27 @@ start_with_invalid_usm_conf_file1(Conf) when is_list(Conf) -> await_config_not_running(), %% -- - p("[test 77] write usm config file with valid priv-key when crypto not started (7)"), - Usm77 = setelement(6, Usm71, "[1,2,3,4,5,6,7,8,9,0,1,2,3,4,5,6]"), - write_usm_conf(ConfDir, [Usm77]), - ?line {error, Reason77} = config_start(Opts), - p("start failed (as expected): ~p", [Reason77]), - ?line {failed_check, _, _, _, {unsupported_crypto, _}} = Reason77, - await_config_not_running(), + %% <CRYPTO-MODIFICATIONS> + %% The crypto application do no longer need to be started + %% explicitly (all of it is as of R14 implemented with NIFs). + case (catch crypto:version()) of + {'EXIT', {undef, _}} -> + p("[test 77] write usm config file with valid priv-key " + "when crypto not started (7)"), + Usm77 = setelement(6, Usm71, "[1,2,3,4,5,6,7,8,9,0,1,2,3,4,5,6]"), + write_usm_conf(ConfDir, [Usm77]), + ?line {error, Reason77} = config_start(Opts), + p("start failed (as expected): ~p", [Reason77]), + ?line {failed_check, _, _, _, {unsupported_crypto, _}} = Reason77, + await_config_not_running(); + _ -> + %% This function is only present in version 2.0 or greater. + %% The crypto app no longer needs to be explicitly started + ok + end, + %% </CRYPTO-MODIFICATIONS> - %% -- + %% -- p("[test 78] write usm config file with invalid usm (1)"), write_usm_conf2(ConfDir, "{\"bmkEngine\", \"swiusmcf\"}."), ?line {error, Reason81} = config_start(Opts), @@ -2676,6 +2701,27 @@ write_conf_file(Dir, File, Str) -> file:close(Fd). +maybe_start_crypto() -> + case (catch crypto:version()) of + {'EXIT', {undef, _}} -> + %% This is the version of crypto before the NIFs... + ?CRYPTO_START(); + _ -> + %% No need to start this version of crypto.. + ok + end. + +maybe_stop_crypto() -> + case (catch crypto:version()) of + {'EXIT', {undef, _}} -> + %% This is the version of crypto before the NIFs... + crypto:stop(); + _ -> + %% There is nothing to stop in this version of crypto.. + ok + end. + + %% ------ str(X) -> diff --git a/lib/snmp/test/snmp_pdus_test.erl b/lib/snmp/test/snmp_pdus_test.erl index d5add50f52..6dc5b779aa 100644 --- a/lib/snmp/test/snmp_pdus_test.erl +++ b/lib/snmp/test/snmp_pdus_test.erl @@ -1,19 +1,19 @@ %% %% %CopyrightBegin% -%% -%% Copyright Ericsson AB 2003-2009. All Rights Reserved. -%% +%% +%% Copyright Ericsson AB 2003-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% %% @@ -37,6 +37,7 @@ all/1, tickets/1, otp7575/1, + otp8563/1, init_per_testcase/2, fin_per_testcase/2 ]). @@ -66,6 +67,7 @@ init_per_testcase(_Case, Config) when is_list(Config) -> fin_per_testcase(_Case, Config) when is_list(Config) -> Config. + %%====================================================================== %% Test case definitions %%====================================================================== @@ -76,7 +78,8 @@ all(suite) -> tickets(suite) -> [ - otp7575 + otp7575, + otp8563 ]. @@ -118,6 +121,55 @@ otp7575(Config) when is_list(Config) -> ok. +otp8563(suite) -> []; +otp8563(doc) -> ["OTP-8563"]; +otp8563(Config) when is_list(Config) -> + Val1 = 16#7fffffffffffffff, + io:format("try encode and decode ~w~n", [Val1]), + Enc1 = snmp_pdus:enc_value('Counter64', Val1), + {{'Counter64', Val1}, []} = snmp_pdus:dec_value(Enc1), + + Val2 = Val1 + 1, + io:format("try encode and decode ~w~n", [Val2]), + Enc2 = snmp_pdus:enc_value('Counter64', Val2), + {{'Counter64', Val2}, []} = snmp_pdus:dec_value(Enc2), + + Val3 = Val2 + 1, + io:format("try encode and decode ~w~n", [Val3]), + Enc3 = snmp_pdus:enc_value('Counter64', Val3), + {{'Counter64', Val3}, []} = snmp_pdus:dec_value(Enc3), + + Val4 = 16#fffffffffffffffe, + io:format("try encode and decode ~w~n", [Val4]), + Enc4 = snmp_pdus:enc_value('Counter64', Val4), + {{'Counter64', Val4}, []} = snmp_pdus:dec_value(Enc4), + + Val5 = Val4 + 1, + io:format("try encode and decode ~w~n", [Val5]), + Enc5 = snmp_pdus:enc_value('Counter64', Val5), + {{'Counter64', Val5}, []} = snmp_pdus:dec_value(Enc5), + + Val6 = 16#ffffffffffffffff + 1, + io:format("try and fail to encode ~w~n", [Val6]), + case (catch snmp_pdus:enc_value('Counter64', Val6)) of + {'EXIT', {error, {bad_counter64, Val6}}} -> + ok; + Unexpected6 -> + exit({unexpected_encode_result, Unexpected6, Val6}) + end, + + Val7 = -1, + io:format("try and fail to encode ~w~n", [Val7]), + case (catch snmp_pdus:enc_value('Counter64', Val7)) of + {'EXIT', {error, {bad_counter64, Val7}}} -> + ok; + Unexpected7 -> + exit({unexpected_encode_result, Unexpected7, Val7}) + end, + + ok. + + %%====================================================================== %% Internal functions %%====================================================================== diff --git a/lib/snmp/test/snmp_test_data/OLD-SNMPEA-MIB.mib b/lib/snmp/test/snmp_test_data/OLD-SNMPEA-MIB.mib index dd90d0ab50..2ba1a6fd67 100644 --- a/lib/snmp/test/snmp_test_data/OLD-SNMPEA-MIB.mib +++ b/lib/snmp/test/snmp_test_data/OLD-SNMPEA-MIB.mib @@ -12,18 +12,12 @@ OLD-SNMPEA-MIB DEFINITIONS ::= BEGIN ; -- MODULE-IDENTITY --- LAST-UPDATED "9709220900Z" --- ORGANIZATION "ETX/DN/S" --- CONTACT-INFO --- " Martin Bj�rklund --- --- Postal: ERICSSON SOFTWARE TECHNOLOGY AB --- ERLANG SYSTEMS --- Box 1214 --- S-164 28 KISTA, SWEDEN --- --- Tel: +46 8 719 20 89 --- E-mail: [email protected]" +-- LAST-UPDATED "1004200000Z" +-- ORGANIZATION "Erlang/OTP" +-- CONTACT-INFO "" +-- DESCRIPTION +-- "Header cleanup." +-- REVISION "1004200000Z" -- DESCRIPTION -- "This MIB module defines MIB objects for the SNMPEA -- component in OTP." diff --git a/lib/snmp/test/snmp_test_data/OTP8574-MIB.mib b/lib/snmp/test/snmp_test_data/OTP8574-MIB.mib new file mode 100644 index 0000000000..b5e5ed1848 --- /dev/null +++ b/lib/snmp/test/snmp_test_data/OTP8574-MIB.mib @@ -0,0 +1,77 @@ +OTP8574-MIB DEFINITIONS ::= BEGIN + +IMPORTS + MODULE-IDENTITY, OBJECT-TYPE, enterprises, IpAddress FROM SNMPv2-SMI + RowStatus FROM SNMPv2-TC + ; + +otp8574MIB MODULE-IDENTITY + LAST-UPDATED "1004200000Z" + ORGANIZATION "Erlang/OTP" + CONTACT-INFO "www.erlang.org" + DESCRIPTION "The MIB module is used for testing a compiler feature" + ::= { otpSnmp 1 } + +ericsson OBJECT IDENTIFIER ::= { enterprises 193 } +otp OBJECT IDENTIFIER ::= { ericsson 19 } +otpApplications OBJECT IDENTIFIER ::= { otp 3 } +otpSnmp OBJECT IDENTIFIER ::= { otpApplications 3 } + +testMIBObjects OBJECT IDENTIFIER ::= { otp8574MIB 1 } + +testMIBObjectGroup OBJECT IDENTIFIER ::= { testMIBObjects 1 } + +example-Table OBJECT-TYPE + SYNTAX SEQUENCE OF ExampleEntry + MAX-ACCESS not-accessible + STATUS current + DESCRIPTION "An example table" + ::= { testMIBObjectGroup 1 } + +example-Entry OBJECT-TYPE + SYNTAX ExampleEntry + MAX-ACCESS not-accessible + STATUS current + DESCRIPTION "Example table entry" + INDEX { exampleIndex } + ::= { example-Table 5 } + +ExampleEntry ::= SEQUENCE { + exampleIndex INTEGER, + exampleColumn OCTET STRING, + exampleNotAccessible OCTET STRING, + exampleRowStatus RowStatus +} + +exampleIndex OBJECT-TYPE + SYNTAX INTEGER (1..100) + MAX-ACCESS read-write + STATUS current + DESCRIPTION "The index for this entry." + ::= { example-Entry 1 } + +exampleColumn OBJECT-TYPE + SYNTAX OCTET STRING + MAX-ACCESS read-write + STATUS current + DESCRIPTION + "Example table column" + ::= { example-Entry 2 } + +exampleNotAccessible OBJECT-TYPE + SYNTAX OCTET STRING + MAX-ACCESS not-accessible + STATUS current + DESCRIPTION + "Example table column" + ::= { example-Entry 3 } + +exampleRowStatus OBJECT-TYPE + SYNTAX RowStatus + MAX-ACCESS read-write + STATUS current + DESCRIPTION + "Example table RowStatus" + ::= { example-Entry 4 } + +END diff --git a/lib/snmp/test/snmp_test_data/OTP8595-MIB.mib b/lib/snmp/test/snmp_test_data/OTP8595-MIB.mib new file mode 100644 index 0000000000..23245bce37 --- /dev/null +++ b/lib/snmp/test/snmp_test_data/OTP8595-MIB.mib @@ -0,0 +1,45 @@ +OTP8595-MIB DEFINITIONS ::= BEGIN + +IMPORTS + MODULE-IDENTITY, OBJECT-TYPE, snmpModules, mib-2 + FROM SNMPv2-SMI + DisplayString, TestAndIncr, TimeStamp, RowStatus, TruthValue, + TEXTUAL-CONVENTION + FROM SNMPv2-TC + MODULE-COMPLIANCE, OBJECT-GROUP, NOTIFICATION-GROUP + FROM SNMPv2-CONF + sysLocation, sysContact + FROM SNMPv2-MIB + ; + +otp8595MIB MODULE-IDENTITY + LAST-UPDATED "1004210000Z" + ORGANIZATION "" + CONTACT-INFO + "" + DESCRIPTION + "Test mib for OTP-8595" + ::= { snmpModules 1 } + + +test OBJECT IDENTIFIER ::= { mib-2 15 } + +bits1 OBJECT-TYPE + SYNTAX BITS { + b0(0), + b1(1), + b2(2), + -- The following are extensions to the original set of + -- labels. The extensions start at an octet boundary. + -- So for bits 3 - 7, one MUST set them to zero on send + -- and one MUST ignore them on receipt. + b8(8), + b9(9) + } + MAX-ACCESS read-write + STATUS current + DESCRIPTION + "" + ::= { test 1 } + +END diff --git a/lib/snmp/test/snmp_test_mgr_misc.erl b/lib/snmp/test/snmp_test_mgr_misc.erl index e6220f9241..ef1ba0b948 100644 --- a/lib/snmp/test/snmp_test_mgr_misc.erl +++ b/lib/snmp/test/snmp_test_mgr_misc.erl @@ -1,19 +1,19 @@ %% %% %CopyrightBegin% -%% -%% Copyright Ericsson AB 1996-2009. All Rights Reserved. -%% +%% +%% Copyright Ericsson AB 1996-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% %% @@ -101,8 +101,8 @@ init_packet(Parent, SnmpMgr, init_debug(Dbg) when is_atom(Dbg) -> put(debug,Dbg), - put(verbosity,silence); - %% put(verbosity,trace); + %% put(verbosity, silence); + put(verbosity, trace); init_debug(DbgOptions) when is_list(DbgOptions) -> case lists:keysearch(debug, 1, DbgOptions) of {value, {_, Dbg}} when is_atom(Dbg) -> diff --git a/lib/snmp/vsn.mk b/lib/snmp/vsn.mk index 50c72b33b5..c3704bf6c9 100644 --- a/lib/snmp/vsn.mk +++ b/lib/snmp/vsn.mk @@ -17,11 +17,15 @@ # # %CopyrightEnd% -SNMP_VSN = 4.16.1 +SNMP_VSN = 4.16.2 PRE_VSN = APP_VSN = "snmp-$(SNMP_VSN)$(PRE_VSN)" -TICKETS = OTP-8480 OTP-8481 +TICKETS = OTP-8563 OTP-8574 OTP-8594 OTP-8595 OTP-8646 OTP-8648 + +TICKETS_4_16_1 = \ + OTP-8480 \ + OTP-8481 TICKETS_4_16 = \ OTP-8395 \ diff --git a/lib/ssl/doc/src/new_ssl.xml b/lib/ssl/doc/src/new_ssl.xml index 08868a1b3c..4ffaa9d96a 100644 --- a/lib/ssl/doc/src/new_ssl.xml +++ b/lib/ssl/doc/src/new_ssl.xml @@ -88,6 +88,10 @@ extensions are not supported yet. </item> <item>Supported SSL/TLS-versions are SSL-3.0 and TLS-1.0 </item> <item>For security reasons sslv2 is not supported.</item> + <item>Ephemeral Diffie-Hellman cipher suites are supported + but not Diffie Hellman Certificates cipher suites.</item> + <item>Export cipher suites are not supported as the + U.S. lifted its export restrictions in early 2000.</item> </list> </section> @@ -148,25 +152,20 @@ <p><c>protocol() = sslv3 | tlsv1 </c></p> - <p><c>ciphers() = [ciphersuite()] | sting() (according to old API)</c></p> + <p><c>ciphers() = [ciphersuite()] | string() (according to old API)</c></p> <p><c>ciphersuite() = - {key_exchange(), cipher(), hash(), exportable()}</c></p> + {key_exchange(), cipher(), hash()}</c></p> - <p><c>key_exchange() = rsa | dh_dss | dh_rsa | dh_anon | dhe_dss - | dhe_rsa | krb5 | KeyExchange_export + <p><c>key_exchange() = rsa | dhe_dss | dhe_rsa </c></p> - <p><c>cipher() = rc4_128 | idea_cbc | des_cbc | '3des_ede_cbc' - des40_cbc | dh_dss | aes_128_cbc | aes_256_cbc | - rc2_cbc_40 | rc4_40 </c></p> + <p><c>cipher() = rc4_128 | des_cbc | '3des_ede_cbc' + | aes_128_cbc | aes_256_cbc </c></p> <p> <c>hash() = md5 | sha </c></p> - <p> <c>exportable() = export | no_export | ignore - </c></p> - <p><c>ssl_imp() = new | old - default is old.</c></p> </section> @@ -581,6 +580,10 @@ end <p> Upgrades a gen_tcp, or equivalent, socket to a ssl socket e.i performs the ssl server-side handshake.</p> + <p><note>Note that the listen socket should be in {active, false} mode + before telling the client that the server is ready to upgrade + and calling this function, otherwise the upgrade may + or may not succeed depending on timing.</note></p> </desc> </func> diff --git a/lib/ssl/src/ssl.erl b/lib/ssl/src/ssl.erl index 3cd4c7fdbd..185a1f755a 100644 --- a/lib/ssl/src/ssl.erl +++ b/lib/ssl/src/ssl.erl @@ -147,14 +147,14 @@ transport_accept(ListenSocket) -> transport_accept(ListenSocket, infinity). transport_accept(#sslsocket{pid = {ListenSocket, #config{cb=CbInfo, ssl=SslOpts}}, - fd = new_ssl} = SslSocket, Timeout) -> + fd = new_ssl}, Timeout) -> %% The setopt could have been invoked on the listen socket %% and options should be inherited. EmOptions = emulated_options(), {ok, InetValues} = inet:getopts(ListenSocket, EmOptions), ok = inet:setopts(ListenSocket, internal_inet_values()), - {CbModule,_,_} = CbInfo, + {CbModule,_,_, _} = CbInfo, case CbModule:accept(ListenSocket, Timeout) of {ok, Socket} -> ok = inet:setopts(ListenSocket, InetValues), @@ -163,8 +163,7 @@ transport_accept(#sslsocket{pid = {ListenSocket, #config{cb=CbInfo, ssl=SslOpts} {SslOpts, socket_options(InetValues)}, self(), CbInfo], case ssl_connection_sup:start_child(ConnArgs) of {ok, Pid} -> - CbModule:controlling_process(Socket, Pid), - {ok, SslSocket#sslsocket{pid = Pid}}; + ssl_connection:socket_control(Socket, Pid, CbModule); {error, Reason} -> {error, Reason} end; @@ -187,22 +186,9 @@ transport_accept(#sslsocket{} = ListenSocket, Timeout) -> ssl_accept(ListenSocket) -> ssl_accept(ListenSocket, infinity). -ssl_accept(#sslsocket{pid = Pid, fd = new_ssl}, Timeout) -> - gen_fsm:send_event(Pid, socket_control), - try gen_fsm:sync_send_all_state_event(Pid, started, Timeout) of - connected -> - ok; - {error, _} = Error -> - Error - catch - exit:{noproc, _} -> - {error, closed}; - exit:{timeout, _} -> - {error, timeout}; - exit:{normal, _} -> - {error, closed} - end; - +ssl_accept(#sslsocket{fd = new_ssl} = Socket, Timeout) -> + ssl_connection:handshake(Socket, Timeout); + ssl_accept(ListenSocket, SslOptions) when is_port(ListenSocket) -> ssl_accept(ListenSocket, SslOptions, infinity); @@ -218,7 +204,7 @@ ssl_accept(Socket, SslOptions, Timeout) when is_port(Socket) -> try handle_options(SslOptions ++ InetValues, server) of {ok, #config{cb=CbInfo,ssl=SslOpts, emulated=EmOpts}} -> {ok, Port} = inet:port(Socket), - ssl_connection:accept(Port, Socket, + ssl_connection:ssl_accept(Port, Socket, {SslOpts, EmOpts}, self(), CbInfo, Timeout) catch @@ -230,7 +216,7 @@ ssl_accept(Socket, SslOptions, Timeout) when is_port(Socket) -> %% %% Description: Close a ssl connection %%-------------------------------------------------------------------- -close(#sslsocket{pid = {ListenSocket, #config{cb={CbMod,_, _}}}, fd = new_ssl}) -> +close(#sslsocket{pid = {ListenSocket, #config{cb={CbMod,_, _, _}}}, fd = new_ssl}) -> CbMod:close(ListenSocket); close(#sslsocket{pid = Pid, fd = new_ssl}) -> ssl_connection:close(Pid); @@ -239,7 +225,7 @@ close(Socket = #sslsocket{}) -> ssl_broker:close(Socket). %%-------------------------------------------------------------------- -%% Function: send(Socket, Data) -> ok +%% Function: send(Socket, Data) -> ok | {error, Reason} %% %% Description: Sends data over the ssl connection %%-------------------------------------------------------------------- @@ -389,7 +375,7 @@ setopts(#sslsocket{} = Socket, Options) -> %% %% Description: Same as gen_tcp:shutdown/2 %%-------------------------------------------------------------------- -shutdown(#sslsocket{pid = {ListenSocket, #config{cb={CbMod,_, _}}}, fd = new_ssl}, How) -> +shutdown(#sslsocket{pid = {ListenSocket, #config{cb={CbMod,_, _, _}}}, fd = new_ssl}, How) -> CbMod:shutdown(ListenSocket, How); shutdown(#sslsocket{pid = Pid, fd = new_ssl}, How) -> ssl_connection:shutdown(Pid, How). @@ -463,7 +449,7 @@ do_new_connect(Address, Port, #config{cb=CbInfo, inet_user=UserOpts, ssl=SslOpts, emulated=EmOpts,inet_ssl=SocketOpts}, Timeout) -> - {CbModule, _, _} = CbInfo, + {CbModule, _, _, _} = CbInfo, try CbModule:connect(Address, Port, SocketOpts, Timeout) of {ok, Socket} -> ssl_connection:connect(Address, Port, Socket, {SslOpts,EmOpts}, @@ -485,7 +471,7 @@ old_connect(Address, Port, Options, Timeout) -> new_listen(Port, Options0) -> try {ok, Config} = handle_options(Options0, server), - #config{cb={CbModule, _, _},inet_user=Options} = Config, + #config{cb={CbModule, _, _, _},inet_user=Options} = Config, case CbModule:listen(Port, Options) of {ok, ListenSocket} -> {ok, #sslsocket{pid = {ListenSocket, Config}, fd = new_ssl}}; @@ -560,17 +546,18 @@ handle_options(Opts0, Role) -> %% Server side option reuse_session = handle_option(reuse_session, Opts, ReuseSessionFun), reuse_sessions = handle_option(reuse_sessions, Opts, true), + secure_renegotiate = handle_option(secure_renegotiate, Opts, false), renegotiate_at = handle_option(renegotiate_at, Opts, ?DEFAULT_RENEGOTIATE_AT), debug = handle_option(debug, Opts, []) }, - CbInfo = proplists:get_value(cb_info, Opts, {gen_tcp, tcp, tcp_closed}), + CbInfo = proplists:get_value(cb_info, Opts, {gen_tcp, tcp, tcp_closed, tcp_error}), SslOptions = [versions, verify, verify_fun, validate_extensions_fun, fail_if_no_peer_cert, verify_client_once, depth, certfile, keyfile, key, password, cacertfile, dhfile, ciphers, debug, reuse_session, reuse_sessions, ssl_imp, - cb_info, renegotiate_at], + cb_info, renegotiate_at, secure_renegotiate], SockOpts = lists:foldl(fun(Key, PropList) -> proplists:delete(Key, PropList) @@ -641,6 +628,10 @@ validate_option(reuse_session, Value) when is_function(Value) -> validate_option(reuse_sessions, Value) when Value == true; Value == false -> Value; + +validate_option(secure_renegotiate, Value) when Value == true; + Value == false -> + Value; validate_option(renegotiate_at, Value) when is_integer(Value) -> min(Value, ?DEFAULT_RENEGOTIATE_AT); @@ -727,7 +718,10 @@ emulated_options([], Inet,Emulated) -> cipher_suites(Version, []) -> ssl_cipher:suites(Version); -cipher_suites(Version, [{_,_,_,_}| _] = Ciphers0) -> +cipher_suites(Version, [{_,_,_,_}| _] = Ciphers0) -> %% Backwards compatibility + Ciphers = [{KeyExchange, Cipher, Hash} || {KeyExchange, Cipher, Hash, _} <- Ciphers0], + cipher_suites(Version, Ciphers); +cipher_suites(Version, [{_,_,_}| _] = Ciphers0) -> Ciphers = [ssl_cipher:suite(C) || C <- Ciphers0], cipher_suites(Version, Ciphers); cipher_suites(Version, [Cipher0 | _] = Ciphers0) when is_binary(Cipher0) -> @@ -749,24 +743,34 @@ cipher_suites(Version, Ciphers0) -> format_error({error, Reason}) -> format_error(Reason); +format_error(Reason) when is_list(Reason) -> + Reason; format_error(closed) -> - "Connection closed for the operation in question."; + "The connection is closed"; +format_error(ecacertfile) -> + "Own CA certificate file is invalid."; +format_error(ecertfile) -> + "Own certificate file is invalid."; +format_error(ekeyfile) -> + "Own private key file is invalid."; +format_error(esslaccept) -> + "Server SSL handshake procedure between client and server failed."; +format_error(esslconnect) -> + "Client SSL handshake procedure between client and server failed."; +format_error({eoptions, Options}) -> + lists:flatten(io_lib:format("Error in options list: ~p~n", [Options])); + +%%%%%%%%%%%% START OLD SSL format_error %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% format_error(ebadsocket) -> "Connection not found (internal error)."; format_error(ebadstate) -> "Connection not in connect state (internal error)."; format_error(ebrokertype) -> "Wrong broker type (internal error)."; -format_error(ecacertfile) -> - "Own CA certificate file is invalid."; -format_error(ecertfile) -> - "Own certificate file is invalid."; format_error(echaintoolong) -> "The chain of certificates provided by peer is too long."; format_error(ecipher) -> "Own list of specified ciphers is invalid."; -format_error(ekeyfile) -> - "Own private key file is invalid."; format_error(ekeymismatch) -> "Own private key does not match own certificate."; format_error(enoissuercert) -> @@ -792,10 +796,6 @@ format_error(epeercertinvalid) -> "Certificate provided by peer is invalid."; format_error(eselfsignedcert) -> "Certificate provided by peer is self signed."; -format_error(esslaccept) -> - "Server SSL handshake procedure between client and server failed."; -format_error(esslconnect) -> - "Client SSL handshake procedure between client and server failed."; format_error(esslerrssl) -> "SSL protocol failure. Typically because of a fatal alert from peer."; format_error(ewantconnect) -> @@ -814,6 +814,9 @@ format_error({badcast, _Cast}) -> format_error({badinfo, _Info}) -> "Call not recognized for current mode (active or passive) and state " "of socket."; + +%%%%%%%%%%%%%%%%%% END OLD SSL format_error %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% + format_error(Error) -> case (catch inet:format_error(Error)) of "unkknown POSIX" ++ _ -> @@ -825,7 +828,7 @@ format_error(Error) -> end. no_format(Error) -> - io_lib:format("No format string for error: \"~p\" available.", [Error]). + lists:flatten(io_lib:format("No format string for error: \"~p\" available.", [Error])). %% Start old ssl port program if needed. ensure_old_ssl_started() -> diff --git a/lib/ssl/src/ssl_alert.erl b/lib/ssl/src/ssl_alert.erl index d3f9c833f1..db9a883654 100644 --- a/lib/ssl/src/ssl_alert.erl +++ b/lib/ssl/src/ssl_alert.erl @@ -1,19 +1,19 @@ %% %% %CopyrightBegin% -%% -%% Copyright Ericsson AB 2007-2009. All Rights Reserved. -%% +%% +%% Copyright Ericsson AB 2007-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% %% @@ -38,10 +38,6 @@ reason_code(#alert{description = ?HANDSHAKE_FAILURE}, client) -> esslconnect; reason_code(#alert{description = ?HANDSHAKE_FAILURE}, server) -> esslaccept; -reason_code(#alert{description = ?CERTIFICATE_EXPIRED}, _) -> - epeercertexpired; -reason_code(#alert{level = ?FATAL}, _) -> - esslerrssl; reason_code(#alert{description = Description}, _) -> description_txt(Description). @@ -55,51 +51,51 @@ level_txt(?FATAL) -> "Fatal error:". description_txt(?CLOSE_NOTIFY) -> - "close_notify"; + "close notify"; description_txt(?UNEXPECTED_MESSAGE) -> - "unexpected_message"; + "unexpected message"; description_txt(?BAD_RECORD_MAC) -> - "bad_record_mac"; + "bad record mac"; description_txt(?DECRYPTION_FAILED) -> - "decryption_failed"; + "decryption failed"; description_txt(?RECORD_OVERFLOW) -> - "record_overflow"; + "record overflow"; description_txt(?DECOMPRESSION_FAILURE) -> - "decompression_failure"; + "decompression failure"; description_txt(?HANDSHAKE_FAILURE) -> - "handshake_failure"; + "handshake failure"; description_txt(?BAD_CERTIFICATE) -> - "bad_certificate"; + "bad certificate"; description_txt(?UNSUPPORTED_CERTIFICATE) -> - "unsupported_certificate"; + "unsupported certificate"; description_txt(?CERTIFICATE_REVOKED) -> - "certificate_revoked"; + "certificate revoked"; description_txt(?CERTIFICATE_EXPIRED) -> - "certificate_expired"; + "certificate expired"; description_txt(?CERTIFICATE_UNKNOWN) -> - "certificate_unknown"; + "certificate unknown"; description_txt(?ILLEGAL_PARAMETER) -> - "illegal_parameter"; + "illegal parameter"; description_txt(?UNKNOWN_CA) -> - "unknown_ca"; + "unknown ca"; description_txt(?ACCESS_DENIED) -> - "access_denied"; + "access denied"; description_txt(?DECODE_ERROR) -> - "decode_error"; + "decode error"; description_txt(?DECRYPT_ERROR) -> - "decrypt_error"; + "decrypt error"; description_txt(?EXPORT_RESTRICTION) -> - "export_restriction"; + "export restriction"; description_txt(?PROTOCOL_VERSION) -> - "protocol_version"; + "protocol version"; description_txt(?INSUFFICIENT_SECURITY) -> - "insufficient_security"; + "insufficient security"; description_txt(?INTERNAL_ERROR) -> - "internal_error"; + "internal error"; description_txt(?USER_CANCELED) -> - "user_canceled"; + "user canceled"; description_txt(?NO_RENEGOTIATION) -> - "no_renegotiation". + "no renegotiation". diff --git a/lib/ssl/src/ssl_certificate.erl b/lib/ssl/src/ssl_certificate.erl index 686e90a70c..37d5646673 100644 --- a/lib/ssl/src/ssl_certificate.erl +++ b/lib/ssl/src/ssl_certificate.erl @@ -67,7 +67,7 @@ trusted_cert_and_path(CertChain, CertDbRef, Verify) -> %% The root CA was not sent and can not be found, we fail if verify = true not_valid(?ALERT_REC(?FATAL, ?UNKNOWN_CA), Verify, {Cert, RestPath}); {{SerialNr, Issuer}, Path} -> - case ssl_certificate_db:lookup_trusted_cert(CertDbRef, + case ssl_manager:lookup_trusted_cert(CertDbRef, SerialNr, Issuer) of {ok, {BinCert,_}} -> {BinCert, Path, []}; @@ -85,7 +85,7 @@ certificate_chain(OwnCert, CertsDbRef) -> {ok, ErlCert} = public_key:pkix_decode_cert(OwnCert, otp), certificate_chain(ErlCert, OwnCert, CertsDbRef, [OwnCert]). -file_to_certificats(File) -> +file_to_certificats(File) -> {ok, List} = ssl_manager:cache_pem_file(File), [Bin || {cert, Bin, not_encrypted} <- List]. @@ -148,7 +148,7 @@ certificate_chain(_CertsDbRef, Chain, _SerialNr, _Issuer, true) -> {ok, lists:reverse(Chain)}; certificate_chain(CertsDbRef, Chain, SerialNr, Issuer, _SelfSigned) -> - case ssl_certificate_db:lookup_trusted_cert(CertsDbRef, + case ssl_manager:lookup_trusted_cert(CertsDbRef, SerialNr, Issuer) of {ok, {IssuerCert, ErlCert}} -> {ok, ErlCert} = public_key:pkix_decode_cert(IssuerCert, otp), @@ -164,7 +164,7 @@ certificate_chain(CertsDbRef, Chain, SerialNr, Issuer, _SelfSigned) -> end. find_issuer(OtpCert, PrevCandidateKey) -> - case ssl_certificate_db:issuer_candidate(PrevCandidateKey) of + case ssl_manager:issuer_candidate(PrevCandidateKey) of no_more_candidates -> {error, issuer_not_found}; {Key, {_Cert, ErlCertCandidate}} -> diff --git a/lib/ssl/src/ssl_cipher.erl b/lib/ssl/src/ssl_cipher.erl index 3d3d11b7f3..daf4ef48b7 100644 --- a/lib/ssl/src/ssl_cipher.erl +++ b/lib/ssl/src/ssl_cipher.erl @@ -1,19 +1,19 @@ %% %% %CopyrightBegin% -%% -%% Copyright Ericsson AB 2007-2009. All Rights Reserved. -%% +%% +%% Copyright Ericsson AB 2007-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% %% @@ -48,7 +48,7 @@ %% cipher values has been updated according to <CipherSuite> %%------------------------------------------------------------------- security_parameters(CipherSuite, SecParams) -> - { _, Cipher, Hash, Exportable} = suite_definition(CipherSuite), + { _, Cipher, Hash} = suite_definition(CipherSuite), SecParams#security_parameters{ cipher_suite = CipherSuite, bulk_cipher_algorithm = bulk_cipher_algorithm(Cipher), @@ -58,8 +58,7 @@ security_parameters(CipherSuite, SecParams) -> key_material_length = key_material(Cipher), iv_size = iv_size(Cipher), mac_algorithm = mac_algorithm(Hash), - hash_size = hash_size(Hash), - exportable = Exportable}. + hash_size = hash_size(Hash)}. %%-------------------------------------------------------------------- %% Function: cipher(Method, CipherState, Mac, Data) -> @@ -91,10 +90,10 @@ cipher(?DES, CipherState, Mac, Fragment) -> block_cipher(fun(Key, IV, T) -> crypto:des_cbc_encrypt(Key, IV, T) end, block_size(des_cbc), CipherState, Mac, Fragment); -cipher(?DES40, CipherState, Mac, Fragment) -> - block_cipher(fun(Key, IV, T) -> - crypto:des_cbc_encrypt(Key, IV, T) - end, block_size(des_cbc), CipherState, Mac, Fragment); +%% cipher(?DES40, CipherState, Mac, Fragment) -> +%% block_cipher(fun(Key, IV, T) -> +%% crypto:des_cbc_encrypt(Key, IV, T) +%% end, block_size(des_cbc), CipherState, Mac, Fragment); cipher(?'3DES', CipherState, Mac, Fragment) -> block_cipher(fun(<<K1:8/binary, K2:8/binary, K3:8/binary>>, IV, T) -> crypto:des3_cbc_encrypt(K1, K2, K3, IV, T) @@ -104,15 +103,11 @@ cipher(?AES, CipherState, Mac, Fragment) -> crypto:aes_cbc_128_encrypt(Key, IV, T); (Key, IV, T) when byte_size(Key) =:= 32 -> crypto:aes_cbc_256_encrypt(Key, IV, T) - end, block_size(aes_128_cbc), CipherState, Mac, Fragment); + end, block_size(aes_128_cbc), CipherState, Mac, Fragment). %% cipher(?IDEA, CipherState, Mac, Fragment) -> %% block_cipher(fun(Key, IV, T) -> %% crypto:idea_cbc_encrypt(Key, IV, T) %% end, block_size(idea_cbc), CipherState, Mac, Fragment); -cipher(?RC2, CipherState, Mac, Fragment) -> - block_cipher(fun(Key, IV, T) -> - crypto:rc2_40_cbc_encrypt(Key, IV, T) - end, block_size(rc2_cbc_40), CipherState, Mac, Fragment). block_cipher(Fun, BlockSz, #cipher_state{key=Key, iv=IV} = CS0, Mac, Fragment) -> @@ -157,10 +152,10 @@ decipher(?DES, HashSz, CipherState, Fragment) -> block_decipher(fun(Key, IV, T) -> crypto:des_cbc_decrypt(Key, IV, T) end, CipherState, HashSz, Fragment); -decipher(?DES40, HashSz, CipherState, Fragment) -> - block_decipher(fun(Key, IV, T) -> - crypto:des_cbc_decrypt(Key, IV, T) - end, CipherState, HashSz, Fragment); +%% decipher(?DES40, HashSz, CipherState, Fragment) -> +%% block_decipher(fun(Key, IV, T) -> +%% crypto:des_cbc_decrypt(Key, IV, T) +%% end, CipherState, HashSz, Fragment); decipher(?'3DES', HashSz, CipherState, Fragment) -> block_decipher(fun(<<K1:8/binary, K2:8/binary, K3:8/binary>>, IV, T) -> crypto:des3_cbc_decrypt(K1, K2, K3, IV, T) @@ -170,15 +165,11 @@ decipher(?AES, HashSz, CipherState, Fragment) -> crypto:aes_cbc_128_decrypt(Key, IV, T); (Key, IV, T) when byte_size(Key) =:= 32 -> crypto:aes_cbc_256_decrypt(Key, IV, T) - end, CipherState, HashSz, Fragment); + end, CipherState, HashSz, Fragment). %% decipher(?IDEA, HashSz, CipherState, Fragment) -> %% block_decipher(fun(Key, IV, T) -> %% crypto:idea_cbc_decrypt(Key, IV, T) %% end, CipherState, HashSz, Fragment); -decipher(?RC2, HashSz, CipherState, Fragment) -> - block_decipher(fun(Key, IV, T) -> - crypto:rc2_40_cbc_decrypt(Key, IV, T) - end, CipherState, HashSz, Fragment). block_decipher(Fun, #cipher_state{key=Key, iv=IV} = CipherState0, HashSz, Fragment) -> @@ -209,289 +200,147 @@ suites({3, N}) when N == 1; N == 2 -> %%-------------------------------------------------------------------- %% Function: suite_definition(CipherSuite) -> -%% {KeyExchange, Cipher, Hash, Exportable} +%% {KeyExchange, Cipher, Hash} %% %% %% CipherSuite - as defined in ssl_cipher.hrl -%% KeyExchange - rsa | dh_dss | dh_rsa | dh_anon | dhe_dss | dhe_rsa -%% krb5 | *_export (old ssl) +%% KeyExchange - rsa | dh_anon | dhe_dss | dhe_rsa | kerb5 +%% %% Cipher - null | rc4_128 | idea_cbc | des_cbc | '3des_ede_cbc' -%% des40_cbc | dh_dss | aes_128_cbc | aes_256_cbc | -%% rc2_cbc_40 | rc4_40 +%% des40_cbc | aes_128_cbc | aes_256_cbc %% Hash - null | md5 | sha -%% Exportable - export | no_export | ignore(?) %% -%% Description: Returns a security parameters record where the +%% Description: Returns a security parameters tuple where the %% cipher values has been updated according to <CipherSuite> -%% Note: since idea is unsupported on the openssl version used by -%% crypto (as of OTP R12B), we've commented away the idea stuff +%% Note: Currently not supported suites are commented away. +%% They should be supported or removed in the future. %%------------------------------------------------------------------- %% TLS v1.1 suites suite_definition(?TLS_NULL_WITH_NULL_NULL) -> - {null, null, null, ignore}; -suite_definition(?TLS_RSA_WITH_NULL_MD5) -> - {rsa, null, md5, ignore}; -suite_definition(?TLS_RSA_WITH_NULL_SHA) -> - {rsa, null, sha, ignore}; -suite_definition(?TLS_RSA_WITH_RC4_128_MD5) -> % ok - {rsa, rc4_128, md5, no_export}; -suite_definition(?TLS_RSA_WITH_RC4_128_SHA) -> % ok - {rsa, rc4_128, sha, no_export}; -%% suite_definition(?TLS_RSA_WITH_IDEA_CBC_SHA) -> % unsupported -%% {rsa, idea_cbc, sha, no_export}; -suite_definition(?TLS_RSA_WITH_DES_CBC_SHA) -> % ok - {rsa, des_cbc, sha, no_export}; + {null, null, null}; +%% suite_definition(?TLS_RSA_WITH_NULL_MD5) -> +%% {rsa, null, md5}; +%% suite_definition(?TLS_RSA_WITH_NULL_SHA) -> +%% {rsa, null, sha}; +suite_definition(?TLS_RSA_WITH_RC4_128_MD5) -> + {rsa, rc4_128, md5}; +suite_definition(?TLS_RSA_WITH_RC4_128_SHA) -> + {rsa, rc4_128, sha}; +%% suite_definition(?TLS_RSA_WITH_IDEA_CBC_SHA) -> +%% {rsa, idea_cbc, sha}; +suite_definition(?TLS_RSA_WITH_DES_CBC_SHA) -> + {rsa, des_cbc, sha}; suite_definition(?TLS_RSA_WITH_3DES_EDE_CBC_SHA) -> - {rsa, '3des_ede_cbc', sha, no_export}; -suite_definition(?TLS_DH_DSS_WITH_DES_CBC_SHA) -> - {dh_dss, des_cbc, sha, no_export}; -suite_definition(?TLS_DH_DSS_WITH_3DES_EDE_CBC_SHA) -> - {dh_dss, '3des_ede_cbc', sha, no_export}; -suite_definition(?TLS_DH_RSA_WITH_DES_CBC_SHA) -> - {dh_rsa, des_cbc, sha, no_export}; -suite_definition(?TLS_DH_RSA_WITH_3DES_EDE_CBC_SHA) -> - {dh_rsa, '3des_ede_cbc', sha, no_export}; + {rsa, '3des_ede_cbc', sha}; suite_definition(?TLS_DHE_DSS_WITH_DES_CBC_SHA) -> - {dhe_dss, des_cbc, sha, no_export}; + {dhe_dss, des_cbc, sha}; suite_definition(?TLS_DHE_DSS_WITH_3DES_EDE_CBC_SHA) -> - {dhe_dss, '3des_ede_cbc', sha, no_export}; + {dhe_dss, '3des_ede_cbc'}; suite_definition(?TLS_DHE_RSA_WITH_DES_CBC_SHA) -> - {dhe_rsa, des_cbc, sha, no_export}; + {dhe_rsa, des_cbc, sha}; suite_definition(?TLS_DHE_RSA_WITH_3DES_EDE_CBC_SHA) -> - {dhe_rsa, '3des_ede_cbc', sha, no_export}; -suite_definition(?TLS_DH_anon_WITH_RC4_128_MD5) -> - {dh_anon, rc4_128, md5, no_export}; -suite_definition(?TLS_DH_anon_WITH_DES_CBC_SHA) -> - {dh_anon, des40_cbc, sha, no_export}; -suite_definition(?TLS_DH_anon_WITH_3DES_EDE_CBC_SHA) -> - {dh_anon, '3des_ede_cbc', sha, no_export}; + {dhe_rsa, '3des_ede_cbc', sha}; %%% TSL V1.1 AES suites -suite_definition(?TLS_RSA_WITH_AES_128_CBC_SHA) -> % ok - {rsa, aes_128_cbc, sha, ignore}; -suite_definition(?TLS_DH_DSS_WITH_AES_128_CBC_SHA) -> - {dh_dss, aes_128_cbc, sha, ignore}; -suite_definition(?TLS_DH_RSA_WITH_AES_128_CBC_SHA) -> - {dh_rsa, aes_128_cbc, sha, ignore}; +suite_definition(?TLS_RSA_WITH_AES_128_CBC_SHA) -> + {rsa, aes_128_cbc, sha}; suite_definition(?TLS_DHE_DSS_WITH_AES_128_CBC_SHA) -> - {dhe_dss, aes_128_cbc, sha, ignore}; + {dhe_dss, aes_128_cbc, sha}; suite_definition(?TLS_DHE_RSA_WITH_AES_128_CBC_SHA) -> - {dhe_rsa, aes_128_cbc, sha, ignore}; -suite_definition(?TLS_DH_anon_WITH_AES_128_CBC_SHA) -> - {dh_anon, aes_128_cbc, sha, ignore}; -suite_definition(?TLS_RSA_WITH_AES_256_CBC_SHA) -> % ok - {rsa, aes_256_cbc, sha, ignore}; -suite_definition(?TLS_DH_DSS_WITH_AES_256_CBC_SHA) -> - {dh_dss, aes_256_cbc, sha, ignore}; -suite_definition(?TLS_DH_RSA_WITH_AES_256_CBC_SHA) -> - {dh_rsa, aes_256_cbc, sha, ignore}; + {dhe_rsa, aes_128_cbc, sha}; +suite_definition(?TLS_RSA_WITH_AES_256_CBC_SHA) -> + {rsa, aes_256_cbc, sha}; suite_definition(?TLS_DHE_DSS_WITH_AES_256_CBC_SHA) -> - {dhe_dss, aes_256_cbc, sha, ignore}; + {dhe_dss, aes_256_cbc, sha}; suite_definition(?TLS_DHE_RSA_WITH_AES_256_CBC_SHA) -> - {dhe_rsa, aes_256_cbc, sha, ignore}; -suite_definition(?TLS_DH_anon_WITH_AES_256_CBC_SHA) -> - {dh_anon, aes_256_cbc, sha, ignore}; - -%% TSL V1.1 KRB SUITES -suite_definition(?TLS_KRB5_WITH_DES_CBC_SHA) -> - {krb5, des_cbc, sha, ignore}; -suite_definition(?TLS_KRB5_WITH_3DES_EDE_CBC_SHA) -> - {krb5, '3des_ede_cbc', sha, ignore}; -suite_definition(?TLS_KRB5_WITH_RC4_128_SHA) -> - {krb5, rc4_128, sha, ignore}; + {dhe_rsa, aes_256_cbc, sha}. + +%% TODO: support kerbos key exchange? +%% TSL V1.1 KRB SUITES +%% suite_definition(?TLS_KRB5_WITH_DES_CBC_SHA) -> +%% {krb5, des_cbc, sha}; +%% suite_definition(?TLS_KRB5_WITH_3DES_EDE_CBC_SHA) -> +%% {krb5, '3des_ede_cbc', sha}; +%% suite_definition(?TLS_KRB5_WITH_RC4_128_SHA) -> +%% {krb5, rc4_128, sha}; %% suite_definition(?TLS_KRB5_WITH_IDEA_CBC_SHA) -> -%% {krb5, idea_cbc, sha, ignore}; -suite_definition(?TLS_KRB5_WITH_DES_CBC_MD5) -> - {krb5, des_cbc, md5, ignore}; -suite_definition(?TLS_KRB5_WITH_3DES_EDE_CBC_MD5) -> - {krb5, '3des_ede_cbc', md5, ignore}; -suite_definition(?TLS_KRB5_WITH_RC4_128_MD5) -> - {krb5, rc4_128, md5, ignore}; +%% {krb5, idea_cbc, sha}; +%% suite_definition(?TLS_KRB5_WITH_DES_CBC_MD5) -> +%% {krb5, des_cbc, md5}; +%% suite_definition(?TLS_KRB5_WITH_3DES_EDE_CBC_MD5) -> +%% {krb5, '3des_ede_cbc', md5}; +%% suite_definition(?TLS_KRB5_WITH_RC4_128_MD5) -> +%% {krb5, rc4_128, md5}; %% suite_definition(?TLS_KRB5_WITH_IDEA_CBC_MD5) -> -%% {krb5, idea_cbc, md5, ignore}; - -suite_definition(?TLS_RSA_EXPORT1024_WITH_RC4_56_MD5) -> - {rsa, rc4_56, md5, export}; -suite_definition(?TLS_RSA_EXPORT1024_WITH_RC2_CBC_56_MD5) -> - {rsa, rc2_cbc_56, md5, export}; -suite_definition(?TLS_RSA_EXPORT1024_WITH_DES_CBC_SHA) -> - {rsa, des_cbc, sha, export}; -suite_definition(?TLS_DHE_DSS_EXPORT1024_WITH_DES_CBC_SHA) -> - {dhe_dss, des_cbc, sha, export}; -suite_definition(?TLS_RSA_EXPORT1024_WITH_RC4_56_SHA) -> - {rsa, rc4_56, sha, export}; -suite_definition(?TLS_DHE_DSS_EXPORT1024_WITH_RC4_56_SHA) -> - {dhe_dss, rc4_56, sha, export}; -suite_definition(?TLS_DHE_DSS_WITH_RC4_128_SHA) -> - {dhe_dss, rc4_128, sha, export}; - -%% Export suites TLS 1.0 OR SSLv3-only servers. -suite_definition(?TLS_KRB5_EXPORT_WITH_DES_CBC_40_SHA) -> - {krb5_export, des40_cbc, sha, export}; -suite_definition(?TLS_KRB5_EXPORT_WITH_RC2_CBC_40_SHA) -> - {krb5_export, rc2_cbc_40, sha, export}; -suite_definition(?TLS_KRB5_EXPORT_WITH_RC4_40_SHA) -> - {krb5_export, des40_cbc, sha, export}; -suite_definition(?TLS_KRB5_EXPORT_WITH_DES_CBC_40_MD5) -> - {krb5_export, des40_cbc, md5, export}; -suite_definition(?TLS_KRB5_EXPORT_WITH_RC2_CBC_40_MD5) -> - {krb5_export, rc2_cbc_40, md5, export}; -suite_definition(?TLS_KRB5_EXPORT_WITH_RC4_40_MD5) -> - {krb5_export, rc2_cbc_40, md5, export}; -suite_definition(?TLS_RSA_EXPORT_WITH_RC4_40_MD5) -> % ok - {rsa, rc4_40, md5, export}; -suite_definition(?TLS_RSA_EXPORT_WITH_RC2_CBC_40_MD5) -> % ok - {rsa, rc2_cbc_40, md5, export}; -suite_definition(?TLS_RSA_EXPORT_WITH_DES40_CBC_SHA) -> - {rsa, des40_cbc, sha, export}; -suite_definition(?TLS_DH_DSS_EXPORT_WITH_DES40_CBC_SHA) -> - {dh_dss, des40_cbc, sha, export}; -suite_definition(?TLS_DH_RSA_EXPORT_WITH_DES40_CBC_SHA) -> - {dh_rsa, des40_cbc, sha, export}; -suite_definition(?TLS_DHE_DSS_EXPORT_WITH_DES40_CBC_SHA) -> - {dhe_dss, des40_cbc, sha, export}; -suite_definition(?TLS_DHE_RSA_EXPORT_WITH_DES40_CBC_SHA) -> - {dhe_rsa, des40_cbc, sha, export}; -suite_definition(?TLS_DH_anon_EXPORT_WITH_RC4_40_MD5) -> - {dh_anon, rc4_40, md5, export}; -suite_definition(?TLS_DH_anon_EXPORT_WITH_DES40_CBC_SHA) -> - {dh_anon, des40_cbc, sha, export}. +%% {krb5, idea_cbc, md5}; %% TLS v1.1 suites -suite({rsa, null, md5, ignore}) -> - ?TLS_RSA_WITH_NULL_MD5; -suite({rsa, null, sha, ignore}) -> - ?TLS_RSA_WITH_NULL_SHA; -suite({rsa, rc4_128, md5, no_export}) -> +%%suite({rsa, null, md5}) -> +%% ?TLS_RSA_WITH_NULL_MD5; +%%suite({rsa, null, sha}) -> +%% ?TLS_RSA_WITH_NULL_SHA; +suite({rsa, rc4_128, md5}) -> ?TLS_RSA_WITH_RC4_128_MD5; -suite({rsa, rc4_128, sha, no_export}) -> +suite({rsa, rc4_128, sha}) -> ?TLS_RSA_WITH_RC4_128_SHA; -%% suite({rsa, idea_cbc, sha, no_export}) -> +%% suite({rsa, idea_cbc, sha}) -> %% ?TLS_RSA_WITH_IDEA_CBC_SHA; -suite({rsa, des_cbc, sha, no_export}) -> +suite({rsa, des_cbc, sha}) -> ?TLS_RSA_WITH_DES_CBC_SHA; -suite({rsa, '3des_ede_cbc', sha, no_export}) -> +suite({rsa, '3des_ede_cbc', sha}) -> ?TLS_RSA_WITH_3DES_EDE_CBC_SHA; -suite({dh_dss, des_cbc, sha, no_export}) -> - ?TLS_DH_DSS_WITH_DES_CBC_SHA; -suite({dh_dss, '3des_ede_cbc', sha, no_export}) -> - ?TLS_DH_DSS_WITH_3DES_EDE_CBC_SHA; -suite({dh_rsa, des_cbc, sha, no_export}) -> - ?TLS_DH_RSA_WITH_DES_CBC_SHA; -suite({dh_rsa, '3des_ede_cbc', sha, no_export}) -> - ?TLS_DH_RSA_WITH_3DES_EDE_CBC_SHA; -suite({dhe_dss, des_cbc, sha, no_export}) -> +suite({dhe_dss, des_cbc, sha}) -> ?TLS_DHE_DSS_WITH_DES_CBC_SHA; -suite({dhe_dss, '3des_ede_cbc', sha, no_export}) -> +suite({dhe_dss, '3des_ede_cbc', sha}) -> ?TLS_DHE_DSS_WITH_3DES_EDE_CBC_SHA; -suite({dhe_rsa, des_cbc, sha, no_export}) -> +suite({dhe_rsa, des_cbc, sha}) -> ?TLS_DHE_RSA_WITH_DES_CBC_SHA; -suite({dhe_rsa, '3des_ede_cbc', sha, no_export}) -> +suite({dhe_rsa, '3des_ede_cbc', sha}) -> ?TLS_DHE_RSA_WITH_3DES_EDE_CBC_SHA; -suite({dh_anon, rc4_128, md5, no_export}) -> - ?TLS_DH_anon_WITH_RC4_128_MD5; -suite({dh_anon, des40_cbc, sha, no_export}) -> - ?TLS_DH_anon_WITH_DES_CBC_SHA; -suite({dh_anon, '3des_ede_cbc', sha, no_export}) -> - ?TLS_DH_anon_WITH_3DES_EDE_CBC_SHA; +%% suite({dh_anon, rc4_128, md5}) -> +%% ?TLS_DH_anon_WITH_RC4_128_MD5; +%% suite({dh_anon, des40_cbc, sha}) -> +%% ?TLS_DH_anon_WITH_DES_CBC_SHA; +%% suite({dh_anon, '3des_ede_cbc', sha}) -> +%% ?TLS_DH_anon_WITH_3DES_EDE_CBC_SHA; %%% TSL V1.1 AES suites -suite({rsa, aes_128_cbc, sha, ignore}) -> +suite({rsa, aes_128_cbc, sha}) -> ?TLS_RSA_WITH_AES_128_CBC_SHA; -suite({dh_dss, aes_128_cbc, sha, ignore}) -> - ?TLS_DH_DSS_WITH_AES_128_CBC_SHA; -suite({dh_rsa, aes_128_cbc, sha, ignore}) -> - ?TLS_DH_RSA_WITH_AES_128_CBC_SHA; -suite({dhe_dss, aes_128_cbc, sha, ignore}) -> - ?TLS_DHE_DSS_WITH_AES_128_CBC_SHA; -suite({dhe_rsa, aes_128_cbc, sha, ignore}) -> +%% suite({dhe_dss, aes_128_cbc, sha}) -> +%% ?TLS_DHE_DSS_WITH_AES_128_CBC_SHA; +suite({dhe_rsa, aes_128_cbc, sha}) -> ?TLS_DHE_RSA_WITH_AES_128_CBC_SHA; -suite({dh_anon, aes_128_cbc, sha, ignore}) -> - ?TLS_DH_anon_WITH_AES_128_CBC_SHA; -suite({rsa, aes_256_cbc, sha, ignore}) -> +%% suite({dh_anon, aes_128_cbc, sha}) -> +%% ?TLS_DH_anon_WITH_AES_128_CBC_SHA; +suite({rsa, aes_256_cbc, sha}) -> ?TLS_RSA_WITH_AES_256_CBC_SHA; -suite({dh_dss, aes_256_cbc, sha, ignore}) -> - ?TLS_DH_DSS_WITH_AES_256_CBC_SHA; -suite({dh_rsa, aes_256_cbc, sha, ignore}) -> - ?TLS_DH_RSA_WITH_AES_256_CBC_SHA; -suite({dhe_dss, aes_256_cbc, sha, ignore}) -> +suite({dhe_dss, aes_256_cbc, sha}) -> ?TLS_DHE_DSS_WITH_AES_256_CBC_SHA; -suite({dhe_rsa, aes_256_cbc, sha, ignore}) -> - ?TLS_DHE_RSA_WITH_AES_256_CBC_SHA; -suite({dh_anon, aes_256_cbc, sha, ignore}) -> - ?TLS_DH_anon_WITH_AES_256_CBC_SHA; +suite({dhe_rsa, aes_256_cbc, sha}) -> + ?TLS_DHE_RSA_WITH_AES_256_CBC_SHA. +%% suite({dh_anon, aes_256_cbc, sha}) -> +%% ?TLS_DH_anon_WITH_AES_256_CBC_SHA. +%% TODO: support kerbos key exchange? %% TSL V1.1 KRB SUITES -suite({krb5, des_cbc, sha, ignore}) -> - ?TLS_KRB5_WITH_DES_CBC_SHA; -suite({krb5_cbc, '3des_ede_cbc', sha, ignore}) -> - ?TLS_KRB5_WITH_3DES_EDE_CBC_SHA; -suite({krb5, rc4_128, sha, ignore}) -> - ?TLS_KRB5_WITH_RC4_128_SHA; -%% suite({krb5_cbc, idea_cbc, sha, ignore}) -> +%% suite({krb5, des_cbc, sha}) -> +%% ?TLS_KRB5_WITH_DES_CBC_SHA; +%% suite({krb5_cbc, '3des_ede_cbc', sha}) -> +%% ?TLS_KRB5_WITH_3DES_EDE_CBC_SHA; +%% suite({krb5, rc4_128, sha}) -> +%% ?TLS_KRB5_WITH_RC4_128_SHA; +%% suite({krb5_cbc, idea_cbc, sha}) -> %% ?TLS_KRB5_WITH_IDEA_CBC_SHA; -suite({krb5_cbc, md5, ignore}) -> - ?TLS_KRB5_WITH_DES_CBC_MD5; -suite({krb5_ede_cbc, des_cbc, md5, ignore}) -> - ?TLS_KRB5_WITH_3DES_EDE_CBC_MD5; -suite({krb5_128, rc4_128, md5, ignore}) -> - ?TLS_KRB5_WITH_RC4_128_MD5; -%% suite({krb5, idea_cbc, md5, ignore}) -> +%% suite({krb5_cbc, md5}) -> +%% ?TLS_KRB5_WITH_DES_CBC_MD5; +%% suite({krb5_ede_cbc, des_cbc, md5}) -> +%% ?TLS_KRB5_WITH_3DES_EDE_CBC_MD5; +%% suite({krb5_128, rc4_128, md5}) -> +%% ?TLS_KRB5_WITH_RC4_128_MD5; +%% suite({krb5, idea_cbc, md5}) -> %% ?TLS_KRB5_WITH_IDEA_CBC_MD5; -%% Export suites TLS 1.0 OR SSLv3-only servers. -suite({rsa, rc4_40, md5, export}) -> - ?TLS_RSA_EXPORT_WITH_RC4_40_MD5; -suite({rsa, rc2_cbc_40, md5, export}) -> - ?TLS_RSA_EXPORT_WITH_RC2_CBC_40_MD5; -suite({rsa, des40_cbc, sha, export}) -> - ?TLS_RSA_EXPORT_WITH_DES40_CBC_SHA; -suite({rsa, rc4_56, md5, export}) -> - ?TLS_RSA_EXPORT1024_WITH_RC4_56_MD5; -suite({rsa, rc2_cbc_56, md5, export}) -> - ?TLS_RSA_EXPORT1024_WITH_RC2_CBC_56_MD5; -suite({rsa, des_cbc, sha, export}) -> - ?TLS_RSA_EXPORT1024_WITH_DES_CBC_SHA; -suite({dhe_dss, des_cbc, sha, export}) -> - ?TLS_DHE_DSS_EXPORT1024_WITH_DES_CBC_SHA; -suite({rsa, rc4_56, sha, export}) -> - ?TLS_RSA_EXPORT1024_WITH_RC4_56_SHA; -suite({dhe_dss, rc4_56, sha, export}) -> - ?TLS_DHE_DSS_EXPORT1024_WITH_RC4_56_SHA; -suite({dhe_dss, rc4_128, sha, export}) -> - ?TLS_DHE_DSS_WITH_RC4_128_SHA; -suite({krb5_export, des40_cbc, sha, export}) -> - ?TLS_KRB5_EXPORT_WITH_DES_CBC_40_SHA; -suite({krb5_export, rc2_cbc_40, sha, export}) -> - ?TLS_KRB5_EXPORT_WITH_RC2_CBC_40_SHA; -suite({krb5_export, rc4_cbc_40, sha, export}) -> - ?TLS_KRB5_EXPORT_WITH_RC4_40_SHA; -suite({krb5_export, des40_cbc, md5, export}) -> - ?TLS_KRB5_EXPORT_WITH_DES_CBC_40_MD5; -suite({krb5_export, rc2_cbc_40, md5, export}) -> - ?TLS_KRB5_EXPORT_WITH_RC2_CBC_40_MD5; -suite({krb5_export, rc4_cbc_40, md5, export}) -> - ?TLS_KRB5_EXPORT_WITH_RC4_40_MD5; -suite({rsa_export, rc4_cbc_40, md5, export}) -> - ?TLS_RSA_EXPORT_WITH_RC4_40_MD5; -suite({rsa_export, rc2_cbc_40, md5, export}) -> - ?TLS_RSA_EXPORT_WITH_RC2_CBC_40_MD5; -suite({rsa_export, des40_cbc, sha, export}) -> - ?TLS_RSA_EXPORT_WITH_DES40_CBC_SHA; -suite({dh_dss_export, des40_cbc, sha, export}) -> - ?TLS_DH_DSS_EXPORT_WITH_DES40_CBC_SHA; -suite({dh_rsa_export, des40_cbc, sha, export}) -> - ?TLS_DH_RSA_EXPORT_WITH_DES40_CBC_SHA; -suite({dhe_dss_export, des40_cbc, sha, export}) -> - ?TLS_DHE_DSS_EXPORT_WITH_DES40_CBC_SHA; -suite({dhe_rsa_export, des40_cbc, sha, export}) -> - ?TLS_DHE_RSA_EXPORT_WITH_DES40_CBC_SHA; -suite({dh_anon_export, rc4_40, md5, export}) -> - ?TLS_DH_anon_EXPORT_WITH_RC4_40_MD5; -suite({dh_anon_export, des40_cbc, sha, export}) -> - ?TLS_DH_anon_EXPORT_WITH_DES40_CBC_SHA. - - %% translate constants <-> openssl-strings %% TODO: Is there a pattern in the nameing %% that is useable to make a nicer function defention? @@ -523,36 +372,12 @@ openssl_suite("RC4-SHA") -> ?TLS_RSA_WITH_RC4_128_SHA; openssl_suite("RC4-MD5") -> ?TLS_RSA_WITH_RC4_128_MD5; -%% TODO: Do we want to support this? -openssl_suite("EXP1024-RC4-MD5") -> - ?TLS_RSA_EXPORT1024_WITH_RC4_56_MD5; -openssl_suite("EXP1024-RC2-CBC-MD5") -> - ?TLS_RSA_EXPORT1024_WITH_RC2_CBC_56_MD5; -openssl_suite("EXP1024-DES-CBC-SHA") -> - ?TLS_RSA_EXPORT1024_WITH_DES_CBC_SHA; -openssl_suite("EXP1024-DHE-DSS-DES-CBC-SHA") -> - ?TLS_DHE_DSS_EXPORT1024_WITH_DES_CBC_SHA; -openssl_suite("EXP1024-RC4-SHA") -> - ?TLS_RSA_EXPORT1024_WITH_RC4_56_SHA; -openssl_suite("EXP1024-DHE-DSS-RC4-SHA") -> - ?TLS_DHE_DSS_EXPORT1024_WITH_RC4_56_SHA; -openssl_suite("DHE-DSS-RC4-SHA") -> - ?TLS_DHE_DSS_WITH_RC4_128_SHA; - +%% openssl_suite("DHE-DSS-RC4-SHA") -> +%% ?TLS_DHE_DSS_WITH_RC4_128_SHA; openssl_suite("EDH-RSA-DES-CBC-SHA") -> ?TLS_DHE_RSA_WITH_DES_CBC_SHA; openssl_suite("DES-CBC-SHA") -> - ?TLS_RSA_WITH_DES_CBC_SHA; -openssl_suite("EXP-EDH-RSA-DES-CBC-SHA") -> - ?TLS_DHE_RSA_EXPORT_WITH_DES40_CBC_SHA; -openssl_suite("EXP-EDH-DSS-DES-CBC-SHA") -> - ?TLS_DHE_DSS_EXPORT_WITH_DES40_CBC_SHA; -openssl_suite("EXP-DES-CBC-SHA") -> - ?TLS_RSA_EXPORT_WITH_DES40_CBC_SHA; -openssl_suite("EXP-RC2-CBC-MD5") -> - ?TLS_RSA_EXPORT_WITH_RC2_CBC_40_MD5; -openssl_suite("EXP-RC4-MD5") -> - ?TLS_RSA_EXPORT_WITH_RC4_40_MD5. + ?TLS_RSA_WITH_DES_CBC_SHA. openssl_suite_name(?TLS_DHE_RSA_WITH_AES_256_CBC_SHA) -> "DHE-RSA-AES256-SHA"; @@ -582,31 +407,9 @@ openssl_suite_name(?TLS_DHE_RSA_WITH_DES_CBC_SHA) -> "EDH-RSA-DES-CBC-SHA"; openssl_suite_name(?TLS_RSA_WITH_DES_CBC_SHA) -> "DES-CBC-SHA"; -openssl_suite_name(?TLS_DHE_RSA_EXPORT_WITH_DES40_CBC_SHA) -> - "EXP-EDH-RSA-DES-CBC-SHA"; -openssl_suite_name(?TLS_DHE_DSS_EXPORT_WITH_DES40_CBC_SHA) -> - "EXP-EDH-DSS-DES-CBC-SHA"; -openssl_suite_name(?TLS_RSA_EXPORT_WITH_DES40_CBC_SHA) -> - "EXP-DES-CBC-SHA"; -openssl_suite_name(?TLS_RSA_EXPORT_WITH_RC2_CBC_40_MD5) -> - "EXP-RC2-CBC-MD5"; -openssl_suite_name(?TLS_RSA_EXPORT_WITH_RC4_40_MD5) -> - "EXP-RC4-MD5"; - -openssl_suite_name(?TLS_RSA_EXPORT1024_WITH_RC4_56_MD5) -> - "EXP1024-RC4-MD5"; -openssl_suite_name(?TLS_RSA_EXPORT1024_WITH_RC2_CBC_56_MD5) -> - "EXP1024-RC2-CBC-MD5"; -openssl_suite_name(?TLS_RSA_EXPORT1024_WITH_DES_CBC_SHA) -> - "EXP1024-DES-CBC-SHA"; -openssl_suite_name(?TLS_DHE_DSS_EXPORT1024_WITH_DES_CBC_SHA) -> - "EXP1024-DHE-DSS-DES-CBC-SHA"; -openssl_suite_name(?TLS_RSA_EXPORT1024_WITH_RC4_56_SHA) -> - "EXP1024-RC4-SHA"; -openssl_suite_name(?TLS_DHE_DSS_EXPORT1024_WITH_RC4_56_SHA) -> - "EXP1024-DHE-DSS-RC4-SHA"; -openssl_suite_name(?TLS_DHE_DSS_WITH_RC4_128_SHA) -> - "DHE-DSS-RC4-SHA"; + +%% openssl_suite_name(?TLS_DHE_DSS_WITH_RC4_128_SHA) -> +%% "DHE-DSS-RC4-SHA"; %% No oppenssl name openssl_suite_name(Cipher) -> @@ -621,15 +424,10 @@ bulk_cipher_algorithm(null) -> %% Not supported yet %% bulk_cipher_algorithm(idea_cbc) -> %% ?IDEA; -bulk_cipher_algorithm(Cipher) when Cipher == rc2_cbc_40; - Cipher == rc2_cbc_56 -> - ?RC2; -bulk_cipher_algorithm(Cipher) when Cipher == rc4_40; - Cipher == rc4_56; - Cipher == rc4_128 -> +bulk_cipher_algorithm(rc4_128) -> ?RC4; -bulk_cipher_algorithm(des40_cbc) -> - ?DES40; +%% bulk_cipher_algorithm(des40_cbc) -> +%% ?DES40; bulk_cipher_algorithm(des_cbc) -> ?DES; bulk_cipher_algorithm('3des_ede_cbc') -> @@ -639,14 +437,10 @@ bulk_cipher_algorithm(Cipher) when Cipher == aes_128_cbc; ?AES. type(Cipher) when Cipher == null; - Cipher == rc4_40; - Cipher == rc4_56; Cipher == rc4_128 -> ?STREAM; type(Cipher) when Cipher == idea_cbc; - Cipher == rc2_cbc_40; - Cipher == rc2_cbc_56; Cipher == des40_cbc; Cipher == des_cbc; Cipher == '3des_ede_cbc'; @@ -659,13 +453,8 @@ key_material(null) -> key_material(Cipher) when Cipher == idea_cbc; Cipher == rc4_128 -> 16; -key_material(Cipher) when Cipher == rc2_cbc_56; - Cipher == rc4_56 -> - 7; -key_material(Cipher) when Cipher == rc2_cbc_40; - Cipher == rc4_40; - Cipher == des40_cbc -> - 5; +%%key_material(des40_cbc) -> +%% 5; key_material(des_cbc) -> 8; key_material('3des_ede_cbc') -> @@ -678,10 +467,6 @@ key_material(aes_256_cbc) -> expanded_key_material(null) -> 0; expanded_key_material(Cipher) when Cipher == idea_cbc; - Cipher == rc2_cbc_40; - Cipher == rc2_cbc_56; - Cipher == rc4_40; - Cipher == rc4_56; Cipher == rc4_128 -> 16; expanded_key_material(Cipher) when Cipher == des_cbc; @@ -696,13 +481,9 @@ expanded_key_material(Cipher) when Cipher == aes_128_cbc; effective_key_bits(null) -> 0; -effective_key_bits(Cipher) when Cipher == rc2_cbc_40; - Cipher == rc4_40; - Cipher == des40_cbc -> - 40; -effective_key_bits(Cipher) when Cipher == rc2_cbc_56; - Cipher == rc4_56; - Cipher == des_cbc -> +%%effective_key_bits(des40_cbc) -> +%% 40; +effective_key_bits(des_cbc) -> 56; effective_key_bits(Cipher) when Cipher == idea_cbc; Cipher == rc4_128; @@ -714,16 +495,12 @@ effective_key_bits(aes_256_cbc) -> 256. iv_size(Cipher) when Cipher == null; - Cipher == rc4_40; - Cipher == rc4_56; Cipher == rc4_128 -> 0; iv_size(Cipher) -> block_size(Cipher). block_size(Cipher) when Cipher == idea_cbc; - Cipher == rc2_cbc_40; - Cipher == rc2_cbc_56; Cipher == des40_cbc; Cipher == des_cbc; Cipher == '3des_ede_cbc' -> diff --git a/lib/ssl/src/ssl_cipher.hrl b/lib/ssl/src/ssl_cipher.hrl index 4304c501b7..80fe527f45 100644 --- a/lib/ssl/src/ssl_cipher.hrl +++ b/lib/ssl/src/ssl_cipher.hrl @@ -1,19 +1,19 @@ %% %% %CopyrightBegin% -%% -%% Copyright Ericsson AB 2007-2009. All Rights Reserved. -%% +%% +%% Copyright Ericsson AB 2007-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% %% @@ -57,7 +57,7 @@ %% TLS_NULL_WITH_NULL_NULL = { 0x00,0x00 }; -define(TLS_NULL_WITH_NULL_NULL, <<?BYTE(16#00), ?BYTE(16#00)>>). -%%% The following CipherSuite definitions require that the server +%%% The following cipher suite definitions require that the server %%% provide an RSA certificate that can be used for key exchange. The %%% server may request either an RSA or a DSS signature-capable %%% certificate in the certificate request message. @@ -68,24 +68,15 @@ %% TLS_RSA_WITH_NULL_SHA = { 0x00,0x02 }; -define(TLS_RSA_WITH_NULL_SHA, <<?BYTE(16#00), ?BYTE(16#02)>>). -%% TLS_RSA_EXPORT_WITH_RC4_40_MD5 = { 0x00,0x03 }; --define(TLS_RSA_EXPORT_WITH_RC4_40_MD5, <<?BYTE(16#00), ?BYTE(16#03)>>). - %% TLS_RSA_WITH_RC4_128_MD5 = { 0x00,0x04 }; -define(TLS_RSA_WITH_RC4_128_MD5, <<?BYTE(16#00), ?BYTE(16#04)>>). %% TLS_RSA_WITH_RC4_128_SHA = { 0x00,0x05 }; -define(TLS_RSA_WITH_RC4_128_SHA, <<?BYTE(16#00), ?BYTE(16#05)>>). -%% TLS_RSA_EXPORT_WITH_RC2_CBC_40_MD5 = { 0x00,0x06 }; --define(TLS_RSA_EXPORT_WITH_RC2_CBC_40_MD5, <<?BYTE(16#00), ?BYTE(16#06)>>). - %% TLS_RSA_WITH_IDEA_CBC_SHA = { 0x00,0x07 }; -define(TLS_RSA_WITH_IDEA_CBC_SHA, <<?BYTE(16#00), ?BYTE(16#07)>>). -%% TLS_RSA_EXPORT_WITH_DES40_CBC_SHA = { 0x00,0x08 }; --define(TLS_RSA_EXPORT_WITH_DES40_CBC_SHA, <<?BYTE(16#00), ?BYTE(16#08)>>). - %% TLS_RSA_WITH_DES_CBC_SHA = { 0x00,0x09 }; -define(TLS_RSA_WITH_DES_CBC_SHA, <<?BYTE(16#00), ?BYTE(16#09)>>). @@ -106,51 +97,33 @@ %%% provided by the client must use the parameters (group and %%% generator) described by the server. -%% TLS_DH_DSS_EXPORT_WITH_DES40_CBC_SHA = { 0x00,0x0B }; --define(TLS_DH_DSS_EXPORT_WITH_DES40_CBC_SHA, <<?BYTE(16#00), ?BYTE(16#0B)>>). - %% TLS_DH_DSS_WITH_DES_CBC_SHA = { 0x00,0x0C }; -define(TLS_DH_DSS_WITH_DES_CBC_SHA, <<?BYTE(16#00), ?BYTE(16#0C)>>). %% TLS_DH_DSS_WITH_3DES_EDE_CBC_SHA = { 0x00,0x0D }; -define(TLS_DH_DSS_WITH_3DES_EDE_CBC_SHA, <<?BYTE(16#00), ?BYTE(16#0D)>>). -%% TLS_DH_RSA_EXPORT_WITH_DES40_CBC_SHA = { 0x00,0x0E }; --define(TLS_DH_RSA_EXPORT_WITH_DES40_CBC_SHA, <<?BYTE(16#00), ?BYTE(16#0E)>>). - %% TLS_DH_RSA_WITH_DES_CBC_SHA = { 0x00,0x0F }; -define(TLS_DH_RSA_WITH_DES_CBC_SHA, <<?BYTE(16#00), ?BYTE(16#0F)>>). %% TLS_DH_RSA_WITH_3DES_EDE_CBC_SHA = { 0x00,0x10 }; -define(TLS_DH_RSA_WITH_3DES_EDE_CBC_SHA, <<?BYTE(16#00), ?BYTE(16#10)>>). -%% TLS_DHE_DSS_EXPORT_WITH_DES40_CBC_SHA = { 0x00,0x11 }; --define(TLS_DHE_DSS_EXPORT_WITH_DES40_CBC_SHA, <<?BYTE(16#00), ?BYTE(16#11)>>). - %% TLS_DHE_DSS_WITH_DES_CBC_SHA = { 0x00,0x12 }; -define(TLS_DHE_DSS_WITH_DES_CBC_SHA, <<?BYTE(16#00), ?BYTE(16#12)>>). %% TLS_DHE_DSS_WITH_3DES_EDE_CBC_SHA = { 0x00,0x13 }; -define(TLS_DHE_DSS_WITH_3DES_EDE_CBC_SHA, <<?BYTE(16#00), ?BYTE(16#13)>>). -%% TLS_DHE_RSA_EXPORT_WITH_DES40_CBC_SHA = { 0x00,0x14 }; --define(TLS_DHE_RSA_EXPORT_WITH_DES40_CBC_SHA, <<?BYTE(16#00), ?BYTE(16#14)>>). - %% TLS_DHE_RSA_WITH_DES_CBC_SHA = { 0x00,0x15 }; -define(TLS_DHE_RSA_WITH_DES_CBC_SHA, <<?BYTE(16#00), ?BYTE(16#15)>>). %% TLS_DHE_RSA_WITH_3DES_EDE_CBC_SHA = { 0x00,0x16 }; -define(TLS_DHE_RSA_WITH_3DES_EDE_CBC_SHA, <<?BYTE(16#00), ?BYTE(16#16)>>). -%% TLS_DH_anon_EXPORT_WITH_RC4_40_MD5 = { 0x00,0x17 }; --define(TLS_DH_anon_EXPORT_WITH_RC4_40_MD5, <<?BYTE(16#00), ?BYTE(16#17)>>). - %% TLS_DH_anon_WITH_RC4_128_MD5 = { 0x00,0x18 }; -define(TLS_DH_anon_WITH_RC4_128_MD5, <<?BYTE(16#00),?BYTE(16#18)>>). -%% TLS_DH_anon_EXPORT_WITH_DES40_CBC_SHA = { 0x00,0x19 }; --define(TLS_DH_anon_EXPORT_WITH_DES40_CBC_SHA, <<?BYTE(16#00), ?BYTE(16#19)>>). - %% TLS_DH_anon_WITH_DES_CBC_SHA = { 0x00,0x1A }; -define(TLS_DH_anon_WITH_DES_CBC_SHA, <<?BYTE(16#00), ?BYTE(16#1A)>>). @@ -222,32 +195,9 @@ %% TLS_KRB5_WITH_IDEA_CBC_MD5 = { 0x00,0x25 }; -define(TLS_KRB5_WITH_IDEA_CBC_MD5, <<?BYTE(16#00), ?BYTE(16#25)>>). -%% TLS_KRB5_EXPORT_WITH_DES_CBC_40_SHA = { 0x00,0x26 }; --define(TLS_KRB5_EXPORT_WITH_DES_CBC_40_SHA, <<?BYTE(16#00), ?BYTE(16#26)>>). - -%% TLS_KRB5_EXPORT_WITH_RC2_CBC_40_SHA = { 0x00,0x27 }; --define(TLS_KRB5_EXPORT_WITH_RC2_CBC_40_SHA, <<?BYTE(16#00), ?BYTE(16#27)>>). - -%% TLS_KRB5_EXPORT_WITH_RC4_40_SHA = { 0x00,0x28 }; --define(TLS_KRB5_EXPORT_WITH_RC4_40_SHA, <<?BYTE(16#00), ?BYTE(16#28)>>). - -%% TLS_KRB5_EXPORT_WITH_DES_CBC_40_MD5 = { 0x00,0x29 }; --define(TLS_KRB5_EXPORT_WITH_DES_CBC_40_MD5, <<?BYTE(16#00), ?BYTE(16#29)>>). - -%% TLS_KRB5_EXPORT_WITH_RC2_CBC_40_MD5 = { 0x00,0x2A }; --define(TLS_KRB5_EXPORT_WITH_RC2_CBC_40_MD5, <<?BYTE(16#00), ?BYTE(16#2A)>>). - -%% TLS_KRB5_EXPORT_WITH_RC4_40_MD5 = { 0x00,0x2B }; --define(TLS_KRB5_EXPORT_WITH_RC4_40_MD5, <<?BYTE(16#00), ?BYTE(16#2B)>>). - -%% Additional TLS ciphersuites from draft-ietf-tls-56-bit-ciphersuites-00.txt - --define(TLS_RSA_EXPORT1024_WITH_RC4_56_MD5, <<?BYTE(16#00), ?BYTE(16#60)>>). --define(TLS_RSA_EXPORT1024_WITH_RC2_CBC_56_MD5, <<?BYTE(16#00), ?BYTE(16#61)>>). --define(TLS_RSA_EXPORT1024_WITH_DES_CBC_SHA, <<?BYTE(16#00), ?BYTE(16#62)>>). --define(TLS_DHE_DSS_EXPORT1024_WITH_DES_CBC_SHA, <<?BYTE(16#00), ?BYTE(16#63)>>). --define(TLS_RSA_EXPORT1024_WITH_RC4_56_SHA, <<?BYTE(16#00), ?BYTE(16#64)>>). --define(TLS_DHE_DSS_EXPORT1024_WITH_RC4_56_SHA, <<?BYTE(16#00), ?BYTE(16#65)>>). --define(TLS_DHE_DSS_WITH_RC4_128_SHA, <<?BYTE(16#00), ?BYTE(16#66)>>). +%% RFC 5746 - Not a real cipher suite used to signal empty "renegotiation_info" extension +%% to avoid handshake failure from old servers that do not ignore +%% hello extension data as they should. +-define(TLS_EMPTY_RENEGOTIATION_INFO_SCSV, <<?BYTE(16#00), ?BYTE(16#FF)>>). -endif. % -ifdef(ssl_cipher). diff --git a/lib/ssl/src/ssl_connection.erl b/lib/ssl/src/ssl_connection.erl index 8ff001b172..6912ee8983 100644 --- a/lib/ssl/src/ssl_connection.erl +++ b/lib/ssl/src/ssl_connection.erl @@ -39,7 +39,8 @@ -include_lib("public_key/include/public_key.hrl"). %% Internal application API --export([send/2, send/3, recv/3, connect/7, accept/6, close/1, shutdown/2, +-export([send/2, recv/3, connect/7, ssl_accept/6, handshake/2, + socket_control/3, close/1, shutdown/2, new_user/2, get_opts/2, set_opts/2, info/1, session_info/1, peer_certificate/1, sockname/1, peername/1, renegotiation/1]). @@ -57,6 +58,7 @@ transport_cb, % atom() - callback module data_tag, % atom() - ex tcp. close_tag, % atom() - ex tcp_closed + error_tag, % atom() - ex tcp_error host, % string() | ipadress() port, % integer() socket, % socket() @@ -85,7 +87,6 @@ from, % term(), where to reply bytes_to_read, % integer(), # bytes to read in passive mode user_data_buffer, % binary() -%% tls_buffer, % Keeps a lookahead one packet if available log_alert, % boolean() renegotiation, % {boolean(), From | internal | peer} recv_during_renegotiation, %boolean() @@ -101,41 +102,70 @@ %%==================================================================== %%-------------------------------------------------------------------- -%% Function: +%% Function: send(Pid, Data) -> ok | {error, Reason} %% -%% Description: +%% Description: Sends data over the ssl connection %%-------------------------------------------------------------------- send(Pid, Data) -> - sync_send_all_state_event(Pid, {application_data, erlang:iolist_to_binary(Data)}, infinity). -send(Pid, Data, Timeout) -> - sync_send_all_state_event(Pid, {application_data, erlang:iolist_to_binary(Data)}, Timeout). + sync_send_all_state_event(Pid, {application_data, + erlang:iolist_to_binary(Data)}, infinity). + %%-------------------------------------------------------------------- -%% Function: +%% Function: recv(Socket, Length Timeout) -> {ok, Data} | {error, reason} %% -%% Description: +%% Description: Receives data when active = false %%-------------------------------------------------------------------- recv(Pid, Length, Timeout) -> sync_send_all_state_event(Pid, {recv, Length}, Timeout). %%-------------------------------------------------------------------- -%% Function: +%% Function: : connect(Host, Port, Socket, Options, +%% User, CbInfo, Timeout) -> {ok, Socket} %% -%% Description: +%% Description: Connect to a ssl server. %%-------------------------------------------------------------------- connect(Host, Port, Socket, Options, User, CbInfo, Timeout) -> start_fsm(client, Host, Port, Socket, Options, User, CbInfo, Timeout). %%-------------------------------------------------------------------- -%% Function: +%% Function: accept(Port, Socket, Opts, User, +%% CbInfo, Timeout) -> {ok, Socket} | {error, Reason} %% -%% Description: +%% Description: Performs accept on a ssl listen socket. e.i. performs +%% ssl handshake. %%-------------------------------------------------------------------- -accept(Port, Socket, Opts, User, CbInfo, Timeout) -> +ssl_accept(Port, Socket, Opts, User, CbInfo, Timeout) -> start_fsm(server, "localhost", Port, Socket, Opts, User, CbInfo, Timeout). + %%-------------------------------------------------------------------- -%% Function: +%% Function: handshake(SslSocket, Timeout) -> ok | {error, Reason} +%% +%% Description: Starts ssl handshake. +%%-------------------------------------------------------------------- +handshake(#sslsocket{pid = Pid}, Timeout) -> + case sync_send_all_state_event(Pid, start, Timeout) of + connected -> + ok; + Error -> + Error + end. +%-------------------------------------------------------------------- +%% Function: socket_control(Pid) -> {ok, SslSocket} | {error, Reason} +%% +%% Description: Set the ssl process to own the accept socket +%%-------------------------------------------------------------------- +socket_control(Socket, Pid, CbModule) -> + case CbModule:controlling_process(Socket, Pid) of + ok -> + {ok, sslsocket(Pid)}; + {error, Reason} -> + {error, Reason} + end. + +%%-------------------------------------------------------------------- +%% Function: close() -> ok %% -%% Description: +%% Description: Close a ssl connection %%-------------------------------------------------------------------- close(ConnectionPid) -> case sync_send_all_state_event(ConnectionPid, close) of @@ -146,80 +176,79 @@ close(ConnectionPid) -> end. %%-------------------------------------------------------------------- -%% Function: +%% Function: shutdown(Socket, How) -> ok | {error, Reason} %% -%% Description: +%% Description: Same as gen_tcp:shutdown/2 %%-------------------------------------------------------------------- shutdown(ConnectionPid, How) -> sync_send_all_state_event(ConnectionPid, {shutdown, How}). - %%-------------------------------------------------------------------- -%% Function: +%% Function: new_user(ConnectionPid, User) -> ok | {error, Reason} %% -%% Description: +%% Description: Changes process that receives the messages when active = true +%% or once. %%-------------------------------------------------------------------- new_user(ConnectionPid, User) -> sync_send_all_state_event(ConnectionPid, {new_user, User}). %%-------------------------------------------------------------------- -%% Function: +%% Function: sockname(ConnectionPid) -> {ok, {Address, Port}} | {error, Reason} %% -%% Description: +%% Description: Same as inet:sockname/1 %%-------------------------------------------------------------------- sockname(ConnectionPid) -> sync_send_all_state_event(ConnectionPid, sockname). %%-------------------------------------------------------------------- -%% Function: +%% Function: peername(ConnectionPid) -> {ok, {Address, Port}} | {error, Reason} %% -%% Description: +%% Description: Same as inet:peername/1 %%-------------------------------------------------------------------- peername(ConnectionPid) -> sync_send_all_state_event(ConnectionPid, peername). %%-------------------------------------------------------------------- -%% Function: +%% Function: get_opts(ConnectionPid, OptTags) -> {ok, Options} | {error, Reason} %% -%% Description: +%% Description: Same as inet:getopts/2 %%-------------------------------------------------------------------- -get_opts({ListenSocket, {_SslOpts, SockOpts}, _}, OptTags) -> - get_socket_opts(ListenSocket, OptTags, SockOpts, []); get_opts(ConnectionPid, OptTags) -> sync_send_all_state_event(ConnectionPid, {get_opts, OptTags}). %%-------------------------------------------------------------------- -%% Function: +%% Function: setopts(Socket, Options) -> ok | {error, Reason} %% -%% Description: +%% Description: Same as inet:setopts/2 %%-------------------------------------------------------------------- set_opts(ConnectionPid, Options) -> sync_send_all_state_event(ConnectionPid, {set_opts, Options}). %%-------------------------------------------------------------------- -%% Function: +%% Function: info(ConnectionPid) -> {ok, {Protocol, CipherSuite}} | +%% {error, Reason} %% -%% Description: +%% Description: Returns ssl protocol and cipher used for the connection %%-------------------------------------------------------------------- info(ConnectionPid) -> sync_send_all_state_event(ConnectionPid, info). %%-------------------------------------------------------------------- -%% Function: +%% Function: session_info(ConnectionPid) -> {ok, PropList} | {error, Reason} %% -%% Description: +%% Description: Returns info about the ssl session %%-------------------------------------------------------------------- session_info(ConnectionPid) -> sync_send_all_state_event(ConnectionPid, session_info). %%-------------------------------------------------------------------- -%% Function: +%% Function: peercert(ConnectionPid) -> {ok, Cert} | {error, Reason} %% -%% Description: +%% Description: Returns the peer cert %%-------------------------------------------------------------------- peer_certificate(ConnectionPid) -> sync_send_all_state_event(ConnectionPid, peer_certificate). %%-------------------------------------------------------------------- -%% Function: +%% Function: renegotiation(ConnectionPid) -> ok | {error, Reason} %% -%% Description: +%% Description: Starts a renegotiation of the ssl session. %%-------------------------------------------------------------------- renegotiation(ConnectionPid) -> sync_send_all_state_event(ConnectionPid, renegotiate). @@ -269,7 +298,7 @@ init([Role, Host, Port, Socket, {SSLOpts, _} = Options, throw:Error -> {stop, Error} end. - + %%-------------------------------------------------------------------- %% Function: %% state_name(Event, State) -> {next_state, NextStateName, NextState}| @@ -282,32 +311,38 @@ init([Role, Host, Port, Socket, {SSLOpts, _} = Options, %% using gen_fsm:send_event/2, the instance of this function with the %% same name as the current state name StateName is called to handle %% the event. It is also called if a timeout occurs. +%% %%-------------------------------------------------------------------- -hello(socket_control, #state{host = Host, port = Port, role = client, - ssl_options = SslOpts, - transport_cb = Transport, socket = Socket, - connection_states = ConnectionStates} +hello(start, #state{host = Host, port = Port, role = client, + ssl_options = SslOpts, + transport_cb = Transport, socket = Socket, + connection_states = ConnectionStates, + renegotiation = {Renegotiation, _}} = State0) -> Hello = ssl_handshake:client_hello(Host, Port, - ConnectionStates, SslOpts), + ConnectionStates, SslOpts, Renegotiation), + Version = Hello#client_hello.client_version, Hashes0 = ssl_handshake:init_hashes(), {BinMsg, CS2, Hashes1} = encode_handshake(Hello, Version, ConnectionStates, Hashes0), Transport:send(Socket, BinMsg), - State = State0#state{connection_states = CS2, + State1 = State0#state{connection_states = CS2, negotiated_version = Version, %% Requested version session = #session{session_id = Hello#client_hello.session_id, is_resumable = false}, tls_handshake_hashes = Hashes1}, - {next_state, hello, next_record(State)}; + {Record, State} = next_record(State1), + next_state(hello, Record, State); -hello(socket_control, #state{role = server} = State) -> - {next_state, hello, next_record(State)}; +hello(start, #state{role = server} = State0) -> + {Record, State} = next_record(State0), + next_state(hello, Record, State); -hello(#hello_request{}, #state{role = client} = State) -> - {next_state, hello, State}; +hello(#hello_request{}, #state{role = client} = State0) -> + {Record, State} = next_record(State0), + next_state(hello, Record, State); hello(#server_hello{cipher_suite = CipherSuite, compression_method = Compression} = Hello, @@ -316,54 +351,60 @@ hello(#server_hello{cipher_suite = CipherSuite, role = client, negotiated_version = ReqVersion, host = Host, port = Port, + renegotiation = {Renegotiation, _}, + ssl_options = SslOptions, session_cache = Cache, session_cache_cb = CacheCb} = State0) -> - {Version, NewId, ConnectionStates1} = - ssl_handshake:hello(Hello, ConnectionStates0), - - {KeyAlgorithm, _, _, _} = - ssl_cipher:suite_definition(CipherSuite), - - PremasterSecret = make_premaster_secret(ReqVersion, KeyAlgorithm), - - State = State0#state{key_algorithm = KeyAlgorithm, - negotiated_version = Version, - connection_states = ConnectionStates1, - premaster_secret = PremasterSecret}, - - case ssl_session:is_new(OldId, NewId) of - true -> - Session = Session0#session{session_id = NewId, - cipher_suite = CipherSuite, + case ssl_handshake:hello(Hello, SslOptions, ConnectionStates0, Renegotiation) of + {Version, NewId, ConnectionStates1} -> + {KeyAlgorithm, _, _} = + ssl_cipher:suite_definition(CipherSuite), + + PremasterSecret = make_premaster_secret(ReqVersion, KeyAlgorithm), + + State1 = State0#state{key_algorithm = KeyAlgorithm, + negotiated_version = Version, + connection_states = ConnectionStates1, + premaster_secret = PremasterSecret}, + + case ssl_session:is_new(OldId, NewId) of + true -> + Session = Session0#session{session_id = NewId, + cipher_suite = CipherSuite, compression_method = Compression}, - {next_state, certify, - next_record(State#state{session = Session})}; - false -> - Session = CacheCb:lookup(Cache, {{Host, Port}, NewId}), - case ssl_handshake:master_secret(Version, Session, - ConnectionStates1, client) of - {_, ConnectionStates2} -> - {next_state, abbreviated, - next_record(State#state{ - connection_states = ConnectionStates2, - session = Session})}; - #alert{} = Alert -> - handle_own_alert(Alert, Version, hello, State), - {stop, normal, State} - end + {Record, State} = next_record(State1#state{session = Session}), + next_state(certify, Record, State); + false -> + Session = CacheCb:lookup(Cache, {{Host, Port}, NewId}), + case ssl_handshake:master_secret(Version, Session, + ConnectionStates1, client) of + {_, ConnectionStates2} -> + {Record, State} = + next_record(State1#state{ + connection_states = ConnectionStates2, + session = Session}), + next_state(abbreviated, Record, State); + #alert{} = Alert -> + handle_own_alert(Alert, Version, hello, State1), + {stop, normal, State1} + end + end; + #alert{} = Alert -> + handle_own_alert(Alert, ReqVersion, hello, State0), + {stop, normal, State0} end; hello(Hello = #client_hello{client_version = ClientVersion}, State = #state{connection_states = ConnectionStates0, port = Port, session = Session0, - session_cache = Cache, + renegotiation = {Renegotiation, _}, + session_cache = Cache, session_cache_cb = CacheCb, ssl_options = SslOpts}) -> - case ssl_handshake:hello(Hello, {Port, SslOpts, - Session0, Cache, CacheCb, - ConnectionStates0}) of + case ssl_handshake:hello(Hello, SslOpts, {Port, Session0, Cache, CacheCb, + ConnectionStates0}, Renegotiation) of {Version, {Type, Session}, ConnectionStates} -> do_server_hello(Type, State#state{connection_states = ConnectionStates, @@ -372,50 +413,59 @@ hello(Hello = #client_hello{client_version = ClientVersion}, #alert{} = Alert -> handle_own_alert(Alert, ClientVersion, hello, State), {stop, normal, State} - end. + end; + +hello(Msg, State) -> + handle_unexpected_message(Msg, hello, State). -abbreviated(socket_control, #state{role = server} = State) -> - {next_state, abbreviated, State}; -abbreviated(#hello_request{}, State) -> - {next_state, certify, State}; +abbreviated(#hello_request{}, State0) -> + {Record, State} = next_record(State0), + next_state(hello, Record, State); -abbreviated(Finished = #finished{}, +abbreviated(#finished{verify_data = Data} = Finished, #state{role = server, negotiated_version = Version, tls_handshake_hashes = Hashes, - session = #session{master_secret = MasterSecret}} = - State0) -> + session = #session{master_secret = MasterSecret}, + connection_states = ConnectionStates0} = + State) -> case ssl_handshake:verify_connection(Version, Finished, client, MasterSecret, Hashes) of - verified -> - State = ack_connection(State0), - next_state_connection(State); + verified -> + ConnectionStates = ssl_record:set_client_verify_data(current_both, Data, ConnectionStates0), + next_state_connection(abbreviated, + ack_connection(State#state{connection_states = ConnectionStates})); #alert{} = Alert -> - handle_own_alert(Alert, Version, abbreviated, State0), - {stop, normal, State0} + handle_own_alert(Alert, Version, abbreviated, State), + {stop, normal, State} end; -abbreviated(Finished = #finished{}, +abbreviated(#finished{verify_data = Data} = Finished, #state{role = client, tls_handshake_hashes = Hashes0, session = #session{master_secret = MasterSecret}, - negotiated_version = Version} = State0) -> + negotiated_version = Version, + connection_states = ConnectionStates0} = State) -> case ssl_handshake:verify_connection(Version, Finished, server, MasterSecret, Hashes0) of verified -> - {ConnectionStates, Hashes} = finalize_client_handshake(State0), - State = ack_connection(State0), - next_state_connection(State#state{tls_handshake_hashes = Hashes, - connection_states = - ConnectionStates}); + ConnectionStates1 = ssl_record:set_server_verify_data(current_read, Data, ConnectionStates0), + {ConnectionStates, Hashes} = + finalize_handshake(State#state{connection_states = ConnectionStates1}, abbreviated), + next_state_connection(abbreviated, + ack_connection(State#state{tls_handshake_hashes = Hashes, + connection_states = + ConnectionStates})); #alert{} = Alert -> - handle_own_alert(Alert, Version, abbreviated, State0), - {stop, normal, State0} - end. + handle_own_alert(Alert, Version, abbreviated, State), + {stop, normal, State} + end; + +abbreviated(Msg, State) -> + handle_unexpected_message(Msg, abbreviated, State). -certify(socket_control, #state{role = server} = State) -> - {next_state, certify, State}; -certify(#hello_request{}, State) -> - {next_state, certify, State}; +certify(#hello_request{}, State0) -> + {Record, State} = next_record(State0), + next_state(hello, Record, State); certify(#certificate{asn1_certificates = []}, #state{role = server, negotiated_version = Version, @@ -430,9 +480,9 @@ certify(#certificate{asn1_certificates = []}, #state{role = server, ssl_options = #ssl_options{verify = verify_peer, fail_if_no_peer_cert = false}} = - State) -> - {next_state, certify, - next_record(State#state{client_certificate_requested = false})}; + State0) -> + {Record, State} = next_record(State0#state{client_certificate_requested = false}), + next_state(certify, Record, State); certify(#certificate{} = Cert, #state{negotiated_version = Version, @@ -454,28 +504,24 @@ certify(#certificate{} = Cert, certify(#server_key_exchange{} = KeyExchangeMsg, #state{role = client, negotiated_version = Version, key_algorithm = Alg} = State0) - when Alg == dhe_dss; Alg == dhe_rsa ->%%Not imp:Alg == dh_anon;Alg == krb5 -> + when Alg == dhe_dss; Alg == dhe_rsa -> case handle_server_key(KeyExchangeMsg, State0) of - #state{} = State -> - {next_state, certify, next_record(State)}; + #state{} = State1 -> + {Record, State} = next_record(State1), + next_state(certify, Record, State); #alert{} = Alert -> handle_own_alert(Alert, Version, certify_server_keyexchange, State0), {stop, normal, State0} end; -certify(#server_key_exchange{}, - State = #state{role = client, negotiated_version = Version, - key_algorithm = Alg}) - when Alg == rsa; Alg == dh_dss; Alg == dh_rsa -> - Alert = ?ALERT_REC(?FATAL, ?UNEXPECTED_MESSAGE), - handle_own_alert(Alert, Version, certify_server_key_exchange, State), - {stop, normal, State}; - -certify(#certificate_request{}, State) -> - NewState = State#state{client_certificate_requested = true}, - {next_state, certify, next_record(NewState)}; +certify(#server_key_exchange{} = Msg, + #state{role = client, key_algorithm = rsa} = State) -> + handle_unexpected_message(Msg, certify_server_keyexchange, State); +certify(#certificate_request{}, State0) -> + {Record, State} = next_record(State0#state{client_certificate_requested = true}), + next_state(certify, Record, State); %% Master secret was determined with help of server-key exchange msg certify(#server_hello_done{}, @@ -515,17 +561,12 @@ certify(#server_hello_done{}, {stop, normal, State0} end; -certify(#client_key_exchange{}, - State = #state{role = server, - client_certificate_requested = true, - ssl_options = #ssl_options{fail_if_no_peer_cert = true}, - negotiated_version = Version}) -> +certify(#client_key_exchange{} = Msg, + #state{role = server, + client_certificate_requested = true, + ssl_options = #ssl_options{fail_if_no_peer_cert = true}} = State) -> %% We expect a certificate here - Alert = ?ALERT_REC(?FATAL, ?UNEXPECTED_MESSAGE), - handle_own_alert(Alert, Version, - certify_server_waiting_certificate, State), - {stop, normal, State}; - + handle_unexpected_message(Msg, certify_client_key_exchange, State); certify(#client_key_exchange{exchange_keys = #encrypted_premaster_secret{premaster_secret @@ -540,9 +581,10 @@ certify(#client_key_exchange{exchange_keys ConnectionStates0, server) of {MasterSecret, ConnectionStates} -> Session = Session0#session{master_secret = MasterSecret}, - State = State0#state{connection_states = ConnectionStates, + State1 = State0#state{connection_states = ConnectionStates, session = Session}, - {next_state, cipher, next_record(State)}; + {Record, State} = next_record(State1), + next_state(cipher, Record, State); #alert{} = Alert -> handle_own_alert(Alert, Version, certify_client_key_exchange, State0), @@ -574,21 +616,25 @@ certify(#client_key_exchange{exchange_keys = #client_diffie_hellman_public{ case ssl_handshake:master_secret(Version, PremasterSecret, ConnectionStates0, Role) of {MasterSecret, ConnectionStates} -> - State = State0#state{session = + State1 = State0#state{session = Session#session{master_secret = MasterSecret}, connection_states = ConnectionStates}, - {next_state, cipher, next_record(State)}; + + {Record, State} = next_record(State1), + next_state(cipher, Record, State); #alert{} = Alert -> handle_own_alert(Alert, Version, certify_client_key_exchange, State0), {stop, normal, State0} - end. + end; + +certify(Msg, State) -> + handle_unexpected_message(Msg, certify, State). -cipher(socket_control, #state{role = server} = State) -> - {next_state, cipher, State}; -cipher(#hello_request{}, State) -> - {next_state, cipher, State}; +cipher(#hello_request{}, State0) -> + {Record, State} = next_record(State0), + next_state(hello, Record, State); cipher(#certificate_verify{signature = Signature}, #state{role = server, @@ -597,71 +643,83 @@ cipher(#certificate_verify{signature = Signature}, session = #session{master_secret = MasterSecret}, key_algorithm = Algorithm, tls_handshake_hashes = Hashes - } = State) -> + } = State0) -> case ssl_handshake:certificate_verify(Signature, PublicKeyInfo, Version, MasterSecret, Algorithm, Hashes) of valid -> - {next_state, cipher, next_record(State)}; + {Record, State} = next_record(State0), + next_state(cipher, Record, State); #alert{} = Alert -> - handle_own_alert(Alert, Version, cipher, State), - {stop, normal, State} + handle_own_alert(Alert, Version, cipher, State0), + {stop, normal, State0} end; -cipher(#finished{} = Finished, +cipher(#finished{verify_data = Data} = Finished, #state{negotiated_version = Version, host = Host, port = Port, role = Role, session = #session{master_secret = MasterSecret} = Session0, - tls_handshake_hashes = Hashes} = State0) -> + tls_handshake_hashes = Hashes0, + connection_states = ConnectionStates0} = State) -> case ssl_handshake:verify_connection(Version, Finished, opposite_role(Role), - MasterSecret, Hashes) of + MasterSecret, Hashes0) of verified -> - State = ack_connection(State0), Session = register_session(Role, Host, Port, Session0), case Role of client -> - next_state_connection(State#state{session = Session}); + ConnectionStates = ssl_record:set_server_verify_data(current_both, Data, ConnectionStates0), + next_state_connection(cipher, ack_connection(State#state{session = Session, + connection_states = ConnectionStates})); server -> - {NewConnectionStates, NewHashes} = - finalize_server_handshake(State#state{ - session = Session}), - next_state_connection(State#state{connection_states = - NewConnectionStates, - session = Session, - tls_handshake_hashes = - NewHashes}) + ConnectionStates1 = ssl_record:set_client_verify_data(current_read, Data, ConnectionStates0), + {ConnectionStates, Hashes} = + finalize_handshake(State#state{ + connection_states = ConnectionStates1, + session = Session}, cipher), + next_state_connection(cipher, ack_connection(State#state{connection_states = + ConnectionStates, + session = Session, + tls_handshake_hashes = + Hashes})) end; #alert{} = Alert -> - handle_own_alert(Alert, Version, cipher, State0), - {stop, normal, State0} - end. + handle_own_alert(Alert, Version, cipher, State), + {stop, normal, State} + end; + +cipher(Msg, State) -> + handle_unexpected_message(Msg, cipher, State). -connection(socket_control, #state{role = server} = State) -> - {next_state, connection, State}; -connection(#hello_request{}, State = #state{host = Host, port = Port, - socket = Socket, - ssl_options = SslOpts, - negotiated_version = Version, - transport_cb = Transport, - connection_states = ConnectionStates0, - tls_handshake_hashes = Hashes0}) -> +connection(#hello_request{}, #state{host = Host, port = Port, + socket = Socket, + ssl_options = SslOpts, + negotiated_version = Version, + transport_cb = Transport, + connection_states = ConnectionStates0, + renegotiation = {Renegotiation, _}, + tls_handshake_hashes = Hashes0} = State0) -> + Hello = ssl_handshake:client_hello(Host, Port, - ConnectionStates0, SslOpts), + ConnectionStates0, SslOpts, Renegotiation), + {BinMsg, ConnectionStates1, Hashes1} = encode_handshake(Hello, Version, ConnectionStates0, Hashes0), Transport:send(Socket, BinMsg), - {next_state, hello, next_record(State#state{connection_states = - ConnectionStates1, - tls_handshake_hashes = Hashes1})}; + {Record, State} = next_record(State0#state{connection_states = + ConnectionStates1, + tls_handshake_hashes = Hashes1}), + next_state(hello, Record, State); connection(#client_hello{} = Hello, #state{role = server} = State) -> - hello(Hello, State). + hello(Hello, State); +connection(Msg, State) -> + handle_unexpected_message(Msg, connection, State). %%-------------------------------------------------------------------- %% Function: %% handle_event(Event, StateName, State) -> {next_state, NextStateName, @@ -673,110 +731,8 @@ connection(#client_hello{} = Hello, #state{role = server} = State) -> %% gen_fsm:send_all_state_event/2, this function is called to handle %% the event. %%-------------------------------------------------------------------- -handle_event(#ssl_tls{type = ?HANDSHAKE, fragment = Data}, - StateName, - State0 = #state{key_algorithm = KeyAlg, - tls_handshake_buffer = Buf0, - negotiated_version = Version}) -> - Handle = - fun({#hello_request{} = Packet, _}, {next_state, connection = SName, State}) -> - %% This message should not be included in handshake - %% message hashes. Starts new handshake (renegotiation) - Hs0 = ssl_handshake:init_hashes(), - ?MODULE:SName(Packet, State#state{tls_handshake_hashes=Hs0, - renegotiation = {true, peer}}); - ({#hello_request{} = Packet, _}, {next_state, SName, State}) -> - %% This message should not be included in handshake - %% message hashes. Already in negotiation so it will be ignored! - ?MODULE:SName(Packet, State); - ({#client_hello{} = Packet, Raw}, {next_state, connection = SName, State}) -> - Hs0 = ssl_handshake:init_hashes(), - Hs1 = ssl_handshake:update_hashes(Hs0, Raw), - ?MODULE:SName(Packet, State#state{tls_handshake_hashes=Hs1, - renegotiation = {true, peer}}); - ({Packet, Raw}, {next_state, SName, State = #state{tls_handshake_hashes=Hs0}}) -> - Hs1 = ssl_handshake:update_hashes(Hs0, Raw), - ?MODULE:SName(Packet, State#state{tls_handshake_hashes=Hs1}); - (_, StopState) -> StopState - end, - try - {Packets, Buf} = ssl_handshake:get_tls_handshake(Data,Buf0, KeyAlg,Version), - Start = {next_state, StateName, State0#state{tls_handshake_buffer = Buf}}, - lists:foldl(Handle, Start, Packets) - catch throw:#alert{} = Alert -> - handle_own_alert(Alert, Version, StateName, State0), - {stop, normal, State0} - end; - -handle_event(#ssl_tls{type = ?APPLICATION_DATA, fragment = Data}, - StateName, State0) -> - case application_data(Data, State0) of - Stop = {stop,_,_} -> - Stop; - State -> - {next_state, StateName, State} - end; - -handle_event(#ssl_tls{type = ?CHANGE_CIPHER_SPEC, fragment = <<1>>} = - _ChangeCipher, - StateName, - State = #state{connection_states = ConnectionStates0}) -> - ?DBG_TERM(_ChangeCipher), - ConnectionStates1 = - ssl_record:activate_pending_connection_state(ConnectionStates0, read), - {next_state, StateName, - next_record(State#state{connection_states = ConnectionStates1})}; - -handle_event(#ssl_tls{type = ?ALERT, fragment = Data}, StateName, State) -> - Alerts = decode_alerts(Data), - ?DBG_TERM(Alerts), - [alert_event(A) || A <- Alerts], - {next_state, StateName, State}; - -handle_event(#alert{level = ?FATAL} = Alert, connection, - #state{from = From, user_application = {_Mon, Pid}, - log_alert = Log, - host = Host, port = Port, session = Session, - role = Role, socket_options = Opts} = State) -> - invalidate_session(Role, Host, Port, Session), - log_alert(Log, connection, Alert), - alert_user(Opts#socket_options.active, Pid, From, Alert, Role), - {stop, normal, State}; -handle_event(#alert{level = ?WARNING, description = ?CLOSE_NOTIFY} = Alert, - connection, #state{from = From, - role = Role, - user_application = {_Mon, Pid}, - socket_options = Opts} = State) -> - alert_user(Opts#socket_options.active, Pid, From, Alert, Role), - {stop, normal, State}; - -handle_event(#alert{level = ?FATAL} = Alert, StateName, - #state{from = From, host = Host, port = Port, session = Session, - log_alert = Log, role = Role} = State) -> - invalidate_session(Role, Host, Port, Session), - log_alert(Log, StateName, Alert), - alert_user(From, Alert, Role), - {stop, normal, State}; -handle_event(#alert{level = ?WARNING, description = ?CLOSE_NOTIFY} = Alert, - _, #state{from = From, role = Role} = State) -> - alert_user(From, Alert, Role), - {stop, normal, State}; - -handle_event(#alert{level = ?WARNING, description = ?NO_RENEGOTIATION} = Alert, StateName, - #state{log_alert = Log, renegotiation = {true, internal}} = State) -> - log_alert(Log, StateName, Alert), - {stop, normal, State}; - -handle_event(#alert{level = ?WARNING, description = ?NO_RENEGOTIATION} = Alert, StateName, - #state{log_alert = Log, renegotiation = {true, From}} = State) -> - log_alert(Log, StateName, Alert), - gen_fsm:reply(From, {error, renegotiation_rejected}), - {next_state, connection, next_record(State)}; - -handle_event(#alert{level = ?WARNING, description = ?USER_CANCELED} = Alert, StateName, - #state{log_alert = Log} = State) -> - log_alert(Log, StateName, Alert), - {next_state, StateName, next_record(State)}. +handle_event(_Event, StateName, State) -> + {next_state, StateName, State}. %%-------------------------------------------------------------------- %% Function: @@ -830,27 +786,53 @@ handle_sync_event({application_data, Data}, From, StateName, #state{send_queue = Queue} = State) -> %% In renegotiation priorities handshake, send data when handshake is finished {next_state, StateName, State#state{send_queue = queue:in({From, Data}, Queue)}}; -handle_sync_event(started, From, StateName, State) -> + +handle_sync_event(start, From, hello, State) -> + hello(start, State#state{from = From}); + +%% The two clauses below could happen if a server upgrades a socket in +%% active mode. Note that in this case we are lucky that +%% controlling_process has been evalueated before receiving handshake +%% messages from client. The server should put the socket in passive +%% mode before telling the client that it is willing to upgrade +%% and before calling ssl:ssl_accept/2. These clauses are +%% here to make sure it is the users problem and not owers if +%% they upgrade a active socket. +handle_sync_event(start, _, connection, State) -> + {reply, connected, connection, State}; +handle_sync_event(start, From, StateName, State) -> {next_state, StateName, State#state{from = From}}; -handle_sync_event(close, From, _StateName, State) -> - {stop, normal, ok, State#state{from = From}}; +handle_sync_event(close, _, _StateName, State) -> + {stop, normal, ok, State}; -handle_sync_event({shutdown, How}, From, StateName, - #state{transport_cb = CbModule, +handle_sync_event({shutdown, How0}, _, StateName, + #state{transport_cb = Transport, + negotiated_version = Version, + connection_states = ConnectionStates, socket = Socket} = State) -> - case CbModule:shutdown(Socket, How) of + case How0 of + How when How == write; How == both -> + Alert = ?ALERT_REC(?WARNING, ?CLOSE_NOTIFY), + {BinMsg, _} = + encode_alert(Alert, Version, ConnectionStates), + Transport:send(Socket, BinMsg); + _ -> + ok + end, + + case Transport:shutdown(Socket, How0) of ok -> {reply, ok, StateName, State}; Error -> - {stop, normal, Error, State#state{from = From}} + {stop, normal, Error, State} end; handle_sync_event({recv, N}, From, connection = StateName, State0) -> passive_receive(State0#state{bytes_to_read = N, from = From}, StateName); %% Doing renegotiate wait with handling request until renegotiate is -%% finished. Will be handled by next_state_connection/1. +%% finished. Will be handled by next_state_connection/2. handle_sync_event({recv, N}, From, StateName, State) -> {next_state, StateName, State#state{bytes_to_read = N, from = From, recv_during_renegotiation = true}}; @@ -888,7 +870,13 @@ handle_sync_event({set_opts, Opts0}, _From, StateName, {reply, ok, StateName, State1}; Buffer =:= <<>>, Opts1#socket_options.active =:= false -> %% Need data, set active once - {reply, ok, StateName, next_record_if_active(State1)}; + {Record, State2} = next_record_if_active(State1), + case next_state(StateName, Record, State2) of + {next_state, StateName, State} -> + {reply, ok, StateName, State}; + {stop, Reason, State} -> + {stop, Reason, State} + end; Buffer =:= <<>> -> %% Active once already set {reply, ok, StateName, State1}; @@ -896,10 +884,15 @@ handle_sync_event({set_opts, Opts0}, _From, StateName, case application_data(<<>>, State1) of Stop = {stop,_,_} -> Stop; - State -> - {reply, ok, StateName, State} + {Record, State2} -> + case next_state(StateName, Record, State2) of + {next_state, StateName, State} -> + {reply, ok, StateName, State}; + {stop, Reason, State} -> + {stop, Reason, State} + end end - end; + end; handle_sync_event(renegotiate, From, connection, State) -> renegotiate(State#state{renegotiation = {true, From}}); @@ -939,20 +932,15 @@ handle_sync_event(peer_certificate, _, StateName, %%-------------------------------------------------------------------- %% raw data from TCP, unpack records -handle_info({Protocol, _, Data}, StateName, State = +handle_info({Protocol, _, Data}, StateName, #state{data_tag = Protocol, - negotiated_version = Version, - tls_record_buffer = Buf0, - tls_cipher_texts = CT0}) -> - case ssl_record:get_tls_records(Data, Buf0) of - {Records, Buf1} -> - CT1 = CT0 ++ Records, - {next_state, StateName, - next_record(State#state{tls_record_buffer = Buf1, - tls_cipher_texts = CT1})}; + negotiated_version = Version} = State0) -> + case next_tls_record(Data, State0) of + {Record, State} -> + next_state(StateName, Record, State); #alert{} = Alert -> - handle_own_alert(Alert, Version, StateName, State), - {stop, normal, State} + handle_own_alert(Alert, Version, StateName, State0), + {stop, normal, State0} end; handle_info({CloseTag, Socket}, _StateName, @@ -973,13 +961,28 @@ handle_info({CloseTag, Socket}, _StateName, ?ALERT_REC(?WARNING, ?CLOSE_NOTIFY), Role), {stop, normal, State}; +handle_info({ErrorTag, Socket, econnaborted}, StateName, + #state{socket = Socket, from = User, role = Role, + error_tag = ErrorTag} = State) when StateName =/= connection -> + alert_user(User, ?ALERT_REC(?FATAL, ?HANDSHAKE_FAILURE), Role), + {stop, normal, State}; + +handle_info({ErrorTag, Socket, Reason}, _, + #state{socket = Socket, from = User, + role = Role, error_tag = ErrorTag} = State) -> + Report = io_lib:format("SSL: Socket error: ~p ~n", [Reason]), + error_logger:info_report(Report), + alert_user(User, ?ALERT_REC(?FATAL, ?CLOSE_NOTIFY), Role), + {stop, normal, State}; + handle_info({'DOWN', MonitorRef, _, _, _}, _, State = #state{user_application={MonitorRef,_Pid}}) -> {stop, normal, State}; -handle_info(A, StateName, State) -> - io:format("SSL: Bad info (state ~w): ~w\n", [StateName, A]), - {stop, bad_info, State}. +handle_info(Msg, StateName, State) -> + Report = io_lib:format("SSL: Got unexpected info: ~p ~n", [Msg]), + error_logger:info_report(Report), + {next_state, StateName, State}. %%-------------------------------------------------------------------- %% Function: terminate(Reason, StateName, State) -> void() @@ -998,12 +1001,14 @@ terminate(_Reason, connection, #state{negotiated_version = Version, {BinAlert, _} = encode_alert(?ALERT_REC(?WARNING,?CLOSE_NOTIFY), Version, ConnectionStates), Transport:send(Socket, BinAlert), + workaround_transport_delivery_problems(Socket, Transport), Transport:close(Socket); terminate(_Reason, _StateName, #state{transport_cb = Transport, socket = Socket, send_queue = SendQueue, renegotiation = Renegotiate}) -> notify_senders(SendQueue), notify_renegotiater(Renegotiate), + workaround_transport_delivery_problems(Socket, Transport), Transport:close(Socket). %%-------------------------------------------------------------------- @@ -1017,18 +1022,21 @@ code_change(_OldVsn, StateName, State, _Extra) -> %%-------------------------------------------------------------------- %%% Internal functions %%-------------------------------------------------------------------- -start_fsm(Role, Host, Port, Socket, Opts, User, {CbModule, _,_} = CbInfo, +start_fsm(Role, Host, Port, Socket, Opts, User, {CbModule, _,_, _} = CbInfo, Timeout) -> case ssl_connection_sup:start_child([Role, Host, Port, Socket, Opts, User, CbInfo]) of {ok, Pid} -> - CbModule:controlling_process(Socket, Pid), - send_event(Pid, socket_control), - case sync_send_all_state_event(Pid, started, Timeout) of - connected -> - {ok, sslsocket(Pid)}; - {error, Reason} -> - {error, Reason} + case socket_control(Socket, Pid, CbModule) of + {ok, SslSocket} -> + case handshake(SslSocket, Timeout) of + ok -> + {ok, SslSocket}; + {error, Reason} -> + {error, Reason} + end; + {error, Reason} -> + {error, Reason} end; {error, Reason} -> {error, Reason} @@ -1048,16 +1056,9 @@ init_certificates(#ssl_options{cacertfile = CACertFile, case ssl_manager:connection_init(CACertFile, Role) of {ok, CertDbRef, CacheRef} -> init_certificates(CertDbRef, CacheRef, CertFile, Role); - {error, {badmatch, _Error}} -> - Report = io_lib:format("SSL: Error ~p Initializing: ~p ~n", - [_Error, CACertFile]), - error_logger:error_report(Report), - throw(ecacertfile); - {error, _Error} -> - Report = io_lib:format("SSL: Error ~p Initializing: ~p ~n", - [_Error, CACertFile]), - error_logger:error_report(Report), - throw(ecacertfile) + {error, Reason} -> + handle_file_error(?LINE, error, Reason, CACertFile, ecacertfile, + erlang:get_stacktrace()) end. init_certificates(CertDbRef, CacheRef, CertFile, client) -> @@ -1073,70 +1074,60 @@ init_certificates(CertDbRef, CacheRef, CertFile, server) -> [OwnCert] = ssl_certificate:file_to_certificats(CertFile), {ok, CertDbRef, CacheRef, OwnCert} catch - _E:{badmatch, _R={error,_}} -> - Report = io_lib:format("SSL: ~p: ~p:~p ~s~n ~p~n", - [?LINE, _E,_R, CertFile, - erlang:get_stacktrace()]), - error_logger:error_report(Report), - throw(ecertfile); - _E:_R -> - Report = io_lib:format("SSL: ~p: ~p:~p ~s~n ~p~n", - [?LINE, _E,_R, CertFile, - erlang:get_stacktrace()]), - error_logger:error_report(Report), - throw(ecertfile) + Error:Reason -> + handle_file_error(?LINE, Error, Reason, CertFile, ecertfile, + erlang:get_stacktrace()) end. init_private_key(undefined, "", _Password, client) -> undefined; init_private_key(undefined, KeyFile, Password, _) -> - try - {ok, List} = ssl_manager:cache_pem_file(KeyFile), - [Der] = [Der || Der = {PKey, _ , _} <- List, - PKey =:= rsa_private_key orelse - PKey =:= dsa_private_key], - {ok, Decoded} = public_key:decode_private_key(Der,Password), - Decoded - catch - _E:{badmatch, _R={error,_}} -> - Report = io_lib:format("SSL: ~p: ~p:~p ~s~n ~p~n", - [?LINE, _E,_R, KeyFile, - erlang:get_stacktrace()]), - error_logger:error_report(Report), - throw(ekeyfile); - _E:_R -> - Report = io_lib:format("SSL: ~p: ~p:~p ~s~n ~p~n", - [?LINE, _E,_R, KeyFile, - erlang:get_stacktrace()]), - error_logger:error_report(Report), - throw(ekeyfile) + case ssl_manager:cache_pem_file(KeyFile) of + {ok, List} -> + [Der] = [Der || Der = {PKey, _ , _} <- List, + PKey =:= rsa_private_key orelse + PKey =:= dsa_private_key], + {ok, Decoded} = public_key:decode_private_key(Der,Password), + Decoded; + {error, Reason} -> + handle_file_error(?LINE, error, Reason, KeyFile, ekeyfile, + erlang:get_stacktrace()) end; + init_private_key(PrivateKey, _, _,_) -> PrivateKey. +handle_file_error(Line, Error, {badmatch, Reason}, File, Throw, Stack) -> + file_error(Line, Error, Reason, File, Throw, Stack); +handle_file_error(Line, Error, Reason, File, Throw, Stack) -> + file_error(Line, Error, Reason, File, Throw, Stack). + +file_error(Line, Error, Reason, File, Throw, Stack) -> + Report = io_lib:format("SSL: ~p: ~p:~p ~s~n ~p~n", + [Line, Error, Reason, File, Stack]), + error_logger:error_report(Report), + throw(Throw). + init_diffie_hellman(_, client) -> undefined; init_diffie_hellman(undefined, _) -> ?DEFAULT_DIFFIE_HELLMAN_PARAMS; init_diffie_hellman(DHParamFile, server) -> - {ok, List} = ssl_manager:cache_pem_file(DHParamFile), - case [Der || Der = {dh_params, _ , _} <- List] of - [Der] -> - {ok, Decoded} = public_key:decode_dhparams(Der), - Decoded; - [] -> - ?DEFAULT_DIFFIE_HELLMAN_PARAMS + case ssl_manager:cache_pem_file(DHParamFile) of + {ok, List} -> + case [Der || Der = {dh_params, _ , _} <- List] of + [Der] -> + {ok, Decoded} = public_key:decode_dhparams(Der), + Decoded; + [] -> + ?DEFAULT_DIFFIE_HELLMAN_PARAMS + end; + {error, Reason} -> + handle_file_error(?LINE, error, Reason, DHParamFile, edhfile, erlang:get_stacktrace()) end. -send_event(FsmPid, Event) -> - gen_fsm:send_event(FsmPid, Event). - - -send_all_state_event(FsmPid, Event) -> - gen_fsm:send_all_state_event(FsmPid, Event). - sync_send_all_state_event(FsmPid, Event) -> - sync_send_all_state_event(FsmPid, Event, ?DEFAULT_TIMEOUT). + sync_send_all_state_event(FsmPid, Event, infinity). sync_send_all_state_event(FsmPid, Event, Timeout) -> try gen_fsm:sync_send_all_state_event(FsmPid, Event, Timeout) @@ -1149,19 +1140,16 @@ sync_send_all_state_event(FsmPid, Event, Timeout) -> {error, closed} end. -%% Events: #alert{} -alert_event(Alert) -> - send_all_state_event(self(), Alert). - %% We do currently not support cipher suites that use fixed DH. %% If we want to implement that we should add a code %% here to extract DH parameters form cert. handle_peer_cert(PeerCert, PublicKeyInfo, #state{session = Session} = State0) -> - State = State0#state{session = + State1 = State0#state{session = Session#session{peer_certificate = PeerCert}, public_key_info = PublicKeyInfo}, - {next_state, certify, next_record(State)}. + {Record, State} = next_record(State1), + next_state(certify, Record, State). certify_client(#state{client_certificate_requested = true, role = client, connection_states = ConnectionStates0, @@ -1193,46 +1181,52 @@ verify_client_cert(#state{client_certificate_requested = true, role = client, case ssl_handshake:client_certificate_verify(OwnCert, MasterSecret, Version, KeyAlg, PrivateKey, Hashes0) of - ignore -> %% No key or cert or fixed_diffie_hellman - State; - Verified -> + #certificate_verify{} = Verified -> {BinVerified, ConnectionStates1, Hashes1} = encode_handshake(Verified, KeyAlg, Version, ConnectionStates0, Hashes0), Transport:send(Socket, BinVerified), State#state{connection_states = ConnectionStates1, - tls_handshake_hashes = Hashes1} + tls_handshake_hashes = Hashes1}; + ignore -> + State; + #alert{} = Alert -> + handle_own_alert(Alert, Version, certify, State) + end; verify_client_cert(#state{client_certificate_requested = false} = State) -> State. do_server_hello(Type, #state{negotiated_version = Version, session = Session, - connection_states = ConnectionStates0} + connection_states = ConnectionStates0, + renegotiation = {Renegotiation, _}} = State0) when is_atom(Type) -> ServerHello = ssl_handshake:server_hello(Session#session.session_id, Version, - ConnectionStates0), - State = server_hello(ServerHello, State0), + ConnectionStates0, Renegotiation), + State1 = server_hello(ServerHello, State0), case Type of new -> - do_server_hello(ServerHello, State); + do_server_hello(ServerHello, State1); resumed -> + ConnectionStates1 = State1#state.connection_states, case ssl_handshake:master_secret(Version, Session, - ConnectionStates0, server) of - {_, ConnectionStates1} -> - State1 = State#state{connection_states=ConnectionStates1, - session = Session}, + ConnectionStates1, server) of + {_, ConnectionStates2} -> + State2 = State1#state{connection_states=ConnectionStates2, + session = Session}, {ConnectionStates, Hashes} = - finalize_server_handshake(State1), - Resumed = State1#state{connection_states = - ConnectionStates, - tls_handshake_hashes = Hashes}, - {next_state, abbreviated, next_record(Resumed)}; + finalize_handshake(State2, abbreviated), + State3 = State2#state{connection_states = + ConnectionStates, + tls_handshake_hashes = Hashes}, + {Record, State} = next_record(State3), + next_state(abbreviated, Record, State); #alert{} = Alert -> - handle_own_alert(Alert, Version, hello, State), - {stop, normal, State} + handle_own_alert(Alert, Version, hello, State1), + {stop, normal, State1} end end; @@ -1243,12 +1237,13 @@ do_server_hello(#server_hello{cipher_suite = CipherSuite, negotiated_version = Version} = State0) -> try server_certify_and_key_exchange(State0) of #state{} = State1 -> - State = server_hello_done(State1), + State2 = server_hello_done(State1), Session = Session0#session{session_id = SessionId, cipher_suite = CipherSuite, compression_method = Compression}, - {next_state, certify, State#state{session = Session}} + {Record, State} = next_record(State2#state{session = Session}), + next_state(certify, Record, State) catch #alert{} = Alert -> handle_own_alert(Alert, Version, hello, State0), @@ -1259,16 +1254,16 @@ client_certify_and_key_exchange(#state{negotiated_version = Version} = State0) -> try do_client_certify_and_key_exchange(State0) of State1 = #state{} -> - {ConnectionStates, Hashes} = finalize_client_handshake(State1), - State = State1#state{connection_states = ConnectionStates, + {ConnectionStates, Hashes} = finalize_handshake(State1, certify), + State2 = State1#state{connection_states = ConnectionStates, %% Reinitialize client_certificate_requested = false, tls_handshake_hashes = Hashes}, - {next_state, cipher, next_record(State)} - + {Record, State} = next_record(State2), + next_state(cipher, Record, State) catch #alert{} = Alert -> - handle_own_alert(Alert, Version, certify_foo, State0), + handle_own_alert(Alert, Version, client_certify_and_key_exchange, State0), {stop, normal, State0} end. @@ -1288,7 +1283,7 @@ server_hello(ServerHello, #state{transport_cb = Transport, connection_states = ConnectionStates0, tls_handshake_hashes = Hashes0} = State) -> CipherSuite = ServerHello#server_hello.cipher_suite, - {KeyAlgorithm, _, _, _} = ssl_cipher:suite_definition(CipherSuite), + {KeyAlgorithm, _, _} = ssl_cipher:suite_definition(CipherSuite), %% Version = ServerHello#server_hello.server_version, TODO ska kontrolleras {BinMsg, ConnectionStates1, Hashes1} = encode_handshake(ServerHello, Version, ConnectionStates0, Hashes0), @@ -1301,17 +1296,16 @@ server_hello_done(#state{transport_cb = Transport, socket = Socket, negotiated_version = Version, connection_states = ConnectionStates, - tls_handshake_hashes = Hashes} = State0) -> + tls_handshake_hashes = Hashes} = State) -> HelloDone = ssl_handshake:server_hello_done(), - + {BinHelloDone, NewConnectionStates, NewHashes} = encode_handshake(HelloDone, Version, ConnectionStates, Hashes), Transport:send(Socket, BinHelloDone), - State = State0#state{connection_states = NewConnectionStates, - tls_handshake_hashes = NewHashes}, - next_record(State). - + State#state{connection_states = NewConnectionStates, + tls_handshake_hashes = NewHashes}. + certify_server(#state{transport_cb = Transport, socket = Socket, negotiated_version = Version, @@ -1332,18 +1326,8 @@ certify_server(#state{transport_cb = Transport, throw(Alert) end. -key_exchange(#state{role = server, key_algorithm = Algo} = State) - when Algo == rsa; - Algo == dh_dss; - Algo == dh_rsa -> +key_exchange(#state{role = server, key_algorithm = rsa} = State) -> State; - -%key_exchange(#state{role = server, key_algorithm = rsa_export} = State) -> - %% TODO when the public key in the server certificate is - %% less than or equal to 512 bits in length dont send key_exchange - %% but do it otherwise -% State; - key_exchange(#state{role = server, key_algorithm = Algo, diffie_hellman_params = Params, private_key = PrivateKey, @@ -1394,7 +1378,6 @@ key_exchange(#state{role = client, Transport:send(Socket, BinMsg), State#state{connection_states = ConnectionStates1, tls_handshake_hashes = Hashes1}; - key_exchange(#state{role = client, connection_states = ConnectionStates0, key_algorithm = Algorithm, @@ -1411,24 +1394,6 @@ key_exchange(#state{role = client, encode_handshake(Msg, Version, ConnectionStates0, Hashes0), Transport:send(Socket, BinMsg), State#state{connection_states = ConnectionStates1, - tls_handshake_hashes = Hashes1}; - -key_exchange(#state{role = client, - connection_states = ConnectionStates0, - key_algorithm = Algorithm, - negotiated_version = Version, - client_certificate_requested = ClientCertReq, - own_cert = OwnCert, - diffie_hellman_keys = DhKeys, - socket = Socket, transport_cb = Transport, - tls_handshake_hashes = Hashes0} = State) - when Algorithm == dh_dss; - Algorithm == dh_rsa -> - Msg = dh_key_exchange(OwnCert, DhKeys, ClientCertReq), - {BinMsg, ConnectionStates1, Hashes1} = - encode_handshake(Msg, Version, ConnectionStates0, Hashes0), - Transport:send(Socket, BinMsg), - State#state{connection_states = ConnectionStates1, tls_handshake_hashes = Hashes1}. rsa_key_exchange(PremasterSecret, PublicKeyInfo = {Algorithm, _, _}) @@ -1442,17 +1407,6 @@ rsa_key_exchange(PremasterSecret, PublicKeyInfo = {Algorithm, _, _}) rsa_key_exchange(_, _) -> throw (?ALERT_REC(?FATAL,?HANDSHAKE_FAILURE)). -dh_key_exchange(OwnCert, DhKeys, true) -> - case public_key:pkix_is_fixed_dh_cert(OwnCert) of - true -> - ssl_handshake:key_exchange(client, fixed_diffie_hellman); - false -> - {DhPubKey, _} = DhKeys, - ssl_handshake:key_exchange(client, {dh, DhPubKey}) - end; -dh_key_exchange(_, {DhPubKey, _}, false) -> - ssl_handshake:key_exchange(client, {dh, DhPubKey}). - request_client_cert(#state{ssl_options = #ssl_options{verify = verify_peer}, connection_states = ConnectionStates0, cert_db_ref = CertDbRef, @@ -1471,45 +1425,44 @@ request_client_cert(#state{ssl_options = #ssl_options{verify = verify_none}} = State) -> State. -finalize_client_handshake(#state{connection_states = ConnectionStates0} - = State) -> - ConnectionStates1 = - cipher_protocol(State#state{connection_states = - ConnectionStates0}), - ConnectionStates2 = - ssl_record:activate_pending_connection_state(ConnectionStates1, +finalize_handshake(State, StateName) -> + ConnectionStates0 = cipher_protocol(State), + ConnectionStates = + ssl_record:activate_pending_connection_state(ConnectionStates0, write), - finished(State#state{connection_states = ConnectionStates2}). + finished(State#state{connection_states = ConnectionStates}, StateName). - -finalize_server_handshake(State) -> - ConnectionStates0 = cipher_protocol(State), - ConnectionStates = - ssl_record:activate_pending_connection_state(ConnectionStates0, - write), - finished(State#state{connection_states = ConnectionStates}). - -cipher_protocol(#state{connection_states = ConnectionStates, +cipher_protocol(#state{connection_states = ConnectionStates0, socket = Socket, negotiated_version = Version, transport_cb = Transport}) -> - {BinChangeCipher, NewConnectionStates} = + {BinChangeCipher, ConnectionStates} = encode_change_cipher(#change_cipher_spec{}, - Version, ConnectionStates), + Version, ConnectionStates0), Transport:send(Socket, BinChangeCipher), - NewConnectionStates. + ConnectionStates. finished(#state{role = Role, socket = Socket, negotiated_version = Version, transport_cb = Transport, session = Session, - connection_states = ConnectionStates, - tls_handshake_hashes = Hashes}) -> + connection_states = ConnectionStates0, + tls_handshake_hashes = Hashes0}, StateName) -> MasterSecret = Session#session.master_secret, - Finished = ssl_handshake:finished(Version, Role, MasterSecret, Hashes), - {BinFinished, NewConnectionStates, NewHashes} = - encode_handshake(Finished, Version, ConnectionStates, Hashes), + Finished = ssl_handshake:finished(Version, Role, MasterSecret, Hashes0), + ConnectionStates1 = save_verify_data(Role, Finished, ConnectionStates0, StateName), + {BinFinished, ConnectionStates, Hashes} = + encode_handshake(Finished, Version, ConnectionStates1, Hashes0), Transport:send(Socket, BinFinished), - {NewConnectionStates, NewHashes}. + {ConnectionStates, Hashes}. + +save_verify_data(client, #finished{verify_data = Data}, ConnectionStates, certify) -> + ssl_record:set_client_verify_data(current_write, Data, ConnectionStates); +save_verify_data(server, #finished{verify_data = Data}, ConnectionStates, cipher) -> + ssl_record:set_server_verify_data(current_both, Data, ConnectionStates); +save_verify_data(client, #finished{verify_data = Data}, ConnectionStates, abbreviated) -> + ssl_record:set_client_verify_data(current_both, Data, ConnectionStates); +save_verify_data(server, #finished{verify_data = Data}, ConnectionStates, abbreviated) -> + ssl_record:set_server_verify_data(current_write, Data, ConnectionStates). handle_server_key( #server_key_exchange{params = @@ -1622,14 +1575,14 @@ decode_alerts(<<>>, Acc) -> passive_receive(State0 = #state{user_data_buffer = Buffer}, StateName) -> case Buffer of <<>> -> - State = next_record(State0), - {next_state, StateName, State}; + {Record, State} = next_record(State0), + next_state(StateName, Record, State); _ -> case application_data(<<>>, State0) of Stop = {stop, _, _} -> Stop; - State -> - {next_state, StateName, State} + {Record, State} -> + next_state(StateName, Record, State) end end. @@ -1654,12 +1607,12 @@ application_data(Data, #state{user_application = {_Mon, Pid}, socket_options = SocketOpt }, if - SocketOpt#socket_options.active =:= false -> - State; %% Passive mode, wait for active once or recv - Buffer =:= <<>> -> %% Active and empty, get more data - next_record(State); - true -> %% We have more data - application_data(<<>>, State) + SocketOpt#socket_options.active =:= false; Buffer =:= <<>> -> + %% Passive mode, wait for active once or recv + %% Active and empty, get more data + next_record_if_active(State); + true -> %% We have more data + application_data(<<>>, State) end; {error,_Reason} -> %% Invalid packet in packet mode deliver_packet_error(SOpts, Buffer1, Pid, From), @@ -1727,33 +1680,40 @@ deliver_app_data(SOpts = #socket_options{active=Active, packet=Type}, SO end. -format_reply(#socket_options{active=false, mode=Mode, header=Header}, Data) -> - {ok, format_reply(Mode, Header, Data)}; -format_reply(#socket_options{active=_, mode=Mode, header=Header}, Data) -> - {ssl, sslsocket(), format_reply(Mode, Header, Data)}. +format_reply(#socket_options{active = false, mode = Mode, packet = Packet, + header = Header}, Data) -> + {ok, format_reply(Mode, Packet, Header, Data)}; +format_reply(#socket_options{active = _, mode = Mode, packet = Packet, + header = Header}, Data) -> + {ssl, sslsocket(), format_reply(Mode, Packet, Header, Data)}. -deliver_packet_error(SO= #socket_options{active=Active}, Data, Pid, From) -> +deliver_packet_error(SO= #socket_options{active = Active}, Data, Pid, From) -> send_or_reply(Active, Pid, From, format_packet_error(SO, Data)). -format_packet_error(#socket_options{active=false, mode=Mode}, Data) -> - {error, {invalid_packet, format_reply(Mode, raw, Data)}}; -format_packet_error(#socket_options{active=_, mode=Mode}, Data) -> - {ssl_error, sslsocket(), {invalid_packet, format_reply(Mode, raw, Data)}}. - -format_reply(list, _, Data) -> binary_to_list(Data); -format_reply(binary, 0, Data) -> Data; -format_reply(binary, raw, Data) -> Data; -format_reply(binary, N, Data) -> % Header mode - <<Header:N/binary, Rest/binary>> = Data, - [binary_to_list(Header), Rest]. - -%% tcp_closed -send_or_reply(false, _Pid, undefined, _Data) -> - Report = io_lib:format("SSL(debug): Unexpected Data ~p ~n",[_Data]), - error_logger:error_report(Report), - erlang:error({badarg, _Pid, undefined, _Data}), - ok; -send_or_reply(false, _Pid, From, Data) -> +format_packet_error(#socket_options{active = false, mode = Mode}, Data) -> + {error, {invalid_packet, format_reply(Mode, raw, 0, Data)}}; +format_packet_error(#socket_options{active = _, mode = Mode}, Data) -> + {ssl_error, sslsocket(), {invalid_packet, format_reply(Mode, raw, 0, Data)}}. + +format_reply(binary, _, N, Data) when N > 0 -> % Header mode + header(N, Data); +format_reply(binary, _, _, Data) -> Data; +format_reply(list, Packet, _, Data) when is_integer(Packet); Packet == raw -> + binary_to_list(Data); +format_reply(list, _,_, Data) -> + Data. + +header(0, <<>>) -> + <<>>; +header(_, <<>>) -> + []; +header(0, Binary) -> + Binary; +header(N, Binary) -> + <<?BYTE(ByteN), NewBinary/binary>> = Binary, + [ByteN | header(N-1, NewBinary)]. + +send_or_reply(false, _Pid, From, Data) when From =/= undefined -> gen_fsm:reply(From, Data); send_or_reply(_, Pid, _From, Data) -> send_user(Pid, Data). @@ -1766,40 +1726,111 @@ opposite_role(server) -> send_user(Pid, Msg) -> Pid ! Msg. +next_state(Next, no_record, State) -> + {next_state, Next, State}; + +next_state(Next, #ssl_tls{type = ?ALERT, fragment = EncAlerts}, State) -> + Alerts = decode_alerts(EncAlerts), + handle_alerts(Alerts, {next_state, Next, State}); + +next_state(StateName, #ssl_tls{type = ?HANDSHAKE, fragment = Data}, + State0 = #state{key_algorithm = KeyAlg, + tls_handshake_buffer = Buf0, + negotiated_version = Version}) -> + Handle = + fun({#hello_request{} = Packet, _}, {next_state, connection = SName, State}) -> + %% This message should not be included in handshake + %% message hashes. Starts new handshake (renegotiation) + Hs0 = ssl_handshake:init_hashes(), + ?MODULE:SName(Packet, State#state{tls_handshake_hashes=Hs0, + renegotiation = {true, peer}}); + ({#hello_request{} = Packet, _}, {next_state, SName, State}) -> + %% This message should not be included in handshake + %% message hashes. Already in negotiation so it will be ignored! + ?MODULE:SName(Packet, State); + ({#client_hello{} = Packet, Raw}, {next_state, connection = SName, State}) -> + Hs0 = ssl_handshake:init_hashes(), + Hs1 = ssl_handshake:update_hashes(Hs0, Raw), + ?MODULE:SName(Packet, State#state{tls_handshake_hashes=Hs1, + renegotiation = {true, peer}}); + ({Packet, Raw}, {next_state, SName, State = #state{tls_handshake_hashes=Hs0}}) -> + Hs1 = ssl_handshake:update_hashes(Hs0, Raw), + ?MODULE:SName(Packet, State#state{tls_handshake_hashes=Hs1}); + (_, StopState) -> StopState + end, + try + {Packets, Buf} = ssl_handshake:get_tls_handshake(Data,Buf0, KeyAlg,Version), + Start = {next_state, StateName, State0#state{tls_handshake_buffer = Buf}}, + lists:foldl(Handle, Start, Packets) + catch throw:#alert{} = Alert -> + handle_own_alert(Alert, Version, StateName, State0), + {stop, normal, State0} + end; + +next_state(StateName, #ssl_tls{type = ?APPLICATION_DATA, fragment = Data}, State0) -> + case application_data(Data, State0) of + Stop = {stop,_,_} -> + Stop; + {Record, State} -> + next_state(StateName, Record, State) + end; +next_state(StateName, #ssl_tls{type = ?CHANGE_CIPHER_SPEC, fragment = <<1>>} = + _ChangeCipher, + #state{connection_states = ConnectionStates0} = State0) -> + ?DBG_TERM(_ChangeCipher), + ConnectionStates1 = + ssl_record:activate_pending_connection_state(ConnectionStates0, read), + {Record, State} = next_record(State0#state{connection_states = ConnectionStates1}), + next_state(StateName, Record, State); +next_state(StateName, #ssl_tls{type = _Unknown}, State0) -> + %% Ignore unknown type + {Record, State} = next_record(State0), + next_state(StateName, Record, State). + +next_tls_record(Data, #state{tls_record_buffer = Buf0, + tls_cipher_texts = CT0} = State0) -> + case ssl_record:get_tls_records(Data, Buf0) of + {Records, Buf1} -> + CT1 = CT0 ++ Records, + next_record(State0#state{tls_record_buffer = Buf1, + tls_cipher_texts = CT1}); + #alert{} = Alert -> + Alert + end. + next_record(#state{tls_cipher_texts = [], socket = Socket} = State) -> inet:setopts(Socket, [{active,once}]), - State; + {no_record, State}; next_record(#state{tls_cipher_texts = [CT | Rest], connection_states = ConnStates0} = State) -> {Plain, ConnStates} = ssl_record:decode_cipher_text(CT, ConnStates0), - gen_fsm:send_all_state_event(self(), Plain), - State#state{tls_cipher_texts = Rest, connection_states = ConnStates}. - + {Plain, State#state{tls_cipher_texts = Rest, connection_states = ConnStates}}. next_record_if_active(State = #state{socket_options = #socket_options{active = false}}) -> - State; + {no_record ,State}; next_record_if_active(State) -> next_record(State). -next_state_connection(#state{send_queue = Queue0, - negotiated_version = Version, - socket = Socket, - transport_cb = Transport, - connection_states = ConnectionStates0, - ssl_options = #ssl_options{renegotiate_at = RenegotiateAt} - } = State) -> +next_state_connection(StateName, #state{send_queue = Queue0, + negotiated_version = Version, + socket = Socket, + transport_cb = Transport, + connection_states = ConnectionStates0, + ssl_options = #ssl_options{renegotiate_at = RenegotiateAt} + } = State) -> %% Send queued up data case queue:out(Queue0) of {{value, {From, Data}}, Queue} -> case encode_data(Data, Version, ConnectionStates0, RenegotiateAt) of {Msgs, [], ConnectionStates} -> Result = Transport:send(Socket, Msgs), - gen_fsm:reply(From, Result), - next_state_connection(State#state{connection_states = ConnectionStates, - send_queue = Queue}); + gen_fsm:reply(From, Result), + next_state_connection(StateName, + State#state{connection_states = ConnectionStates, + send_queue = Queue}); %% This is unlikely to happen. User configuration of the %% undocumented test option renegotiation_at can make it more likely. {Msgs, RestData, ConnectionStates} -> @@ -1822,9 +1853,9 @@ next_state_is_connection(State = #socket_options{active = false}}) -> passive_receive(State#state{recv_during_renegotiation = false}, connection); -next_state_is_connection(State) -> - {next_state, connection, next_record_if_active(State)}. - +next_state_is_connection(State0) -> + {Record, State} = next_record_if_active(State0), + next_state(connection, Record, State). register_session(_, _, _, #session{is_resumable = true} = Session) -> Session; %% Already registered @@ -1843,7 +1874,7 @@ invalidate_session(server, _, Port, Session) -> ssl_manager:invalidate_session(Port, Session). initial_state(Role, Host, Port, Socket, {SSLOptions, SocketOptions}, User, - {CbModule, DataTag, CloseTag}) -> + {CbModule, DataTag, CloseTag, ErrorTag}) -> ConnectionStates = ssl_record:init_connection_states(Role), SessionCacheCb = case application:get_env(ssl, session_cb) of @@ -1863,6 +1894,7 @@ initial_state(Role, Host, Port, Socket, {SSLOptions, SocketOptions}, User, transport_cb = CbModule, data_tag = DataTag, close_tag = CloseTag, + error_tag = ErrorTag, role = Role, host = Host, port = Port, @@ -1934,10 +1966,61 @@ set_socket_opts(Socket, [{active, Active}| Opts], SockOpts, Other) -> set_socket_opts(Socket, [Opt | Opts], SockOpts, Other) -> set_socket_opts(Socket, Opts, SockOpts, [Opt | Other]). +handle_alerts([], Result) -> + Result; +handle_alerts(_, {stop, _, _} = Stop) -> + %% If it is a fatal alert immediately close + Stop; +handle_alerts([Alert | Alerts], {next_state, StateName, State}) -> + handle_alerts(Alerts, handle_alert(Alert, StateName, State)). + +handle_alert(#alert{level = ?FATAL} = Alert, StateName, + #state{from = From, host = Host, port = Port, session = Session, + user_application = {_Mon, Pid}, + log_alert = Log, role = Role, socket_options = Opts} = State) -> + invalidate_session(Role, Host, Port, Session), + log_alert(Log, StateName, Alert), + alert_user(StateName, Opts, Pid, From, Alert, Role), + {stop, normal, State}; + +handle_alert(#alert{level = ?WARNING, description = ?CLOSE_NOTIFY} = Alert, + StateName, #state{from = From, role = Role, + user_application = {_Mon, Pid}, socket_options = Opts} = State) -> + alert_user(StateName, Opts, Pid, From, Alert, Role), + {stop, normal, State}; + +handle_alert(#alert{level = ?WARNING, description = ?NO_RENEGOTIATION} = Alert, StateName, + #state{log_alert = Log, renegotiation = {true, internal}, from = From, + role = Role} = State) -> + log_alert(Log, StateName, Alert), + alert_user(From, Alert, Role), + {stop, normal, State}; + +handle_alert(#alert{level = ?WARNING, description = ?NO_RENEGOTIATION} = Alert, StateName, + #state{log_alert = Log, renegotiation = {true, From}} = State0) -> + log_alert(Log, StateName, Alert), + gen_fsm:reply(From, {error, renegotiation_rejected}), + {Record, State} = next_record(State0), + next_state(connection, Record, State); + +handle_alert(#alert{level = ?WARNING, description = ?USER_CANCELED} = Alert, StateName, + #state{log_alert = Log} = State0) -> + log_alert(Log, StateName, Alert), + {Record, State} = next_record(State0), + next_state(StateName, Record, State). + +alert_user(connection, Opts, Pid, From, Alert, Role) -> + alert_user(Opts#socket_options.active, Pid, From, Alert, Role); +alert_user(_, _, _, From, Alert, Role) -> + alert_user(From, Alert, Role). + alert_user(From, Alert, Role) -> alert_user(false, no_pid, From, Alert, Role). alert_user(false = Active, Pid, From, Alert, Role) -> + %% If there is an outstanding ssl_accept | recv + %% From will be defined and send_or_reply will + %% send the appropriate error message. ReasonCode = ssl_alert:reason_code(Alert, Role), send_or_reply(Active, Pid, From, {error, ReasonCode}); alert_user(Active, Pid, From, Alert, Role) -> @@ -1950,13 +2033,13 @@ alert_user(Active, Pid, From, Alert, Role) -> {ssl_error, sslsocket(), ReasonCode}) end. -log_alert(true, StateName, Alert) -> +log_alert(true, Info, Alert) -> Txt = ssl_alert:alert_txt(Alert), - error_logger:format("SSL: ~p: ~s\n", [StateName, Txt]); + error_logger:format("SSL: ~p: ~s\n", [Info, Txt]); log_alert(false, _, _) -> ok. -handle_own_alert(Alert, Version, StateName, +handle_own_alert(Alert, Version, Info, #state{transport_cb = Transport, socket = Socket, from = User, @@ -1965,20 +2048,24 @@ handle_own_alert(Alert, Version, StateName, log_alert = Log}) -> try %% Try to tell the other side {BinMsg, _} = - encode_alert(Alert, Version, ConnectionStates), + encode_alert(Alert, Version, ConnectionStates), Transport:send(Socket, BinMsg) catch _:_ -> %% Can crash if we are in a uninitialized state ignore end, try %% Try to tell the local user - log_alert(Log, StateName, Alert), + log_alert(Log, Info, Alert), alert_user(User, Alert, Role) catch _:_ -> ok end. -make_premaster_secret({MajVer, MinVer}, Alg) when Alg == rsa; - Alg == dh_dss; - Alg == dh_rsa -> + +handle_unexpected_message(Msg, Info, #state{negotiated_version = Version} = State) -> + Alert = ?ALERT_REC(?FATAL,?UNEXPECTED_MESSAGE), + handle_own_alert(Alert, Version, {Info, Msg}, State), + {stop, normal, State}. + +make_premaster_secret({MajVer, MinVer}, rsa) -> Rand = crypto:rand_bytes(?NUM_OF_PREMASTERSECRET_BYTES-2), <<?BYTE(MajVer), ?BYTE(MinVer), Rand/binary>>; make_premaster_secret(_, _) -> @@ -1996,9 +2083,12 @@ ack_connection(#state{renegotiation = {true, Initiater}} = State) ack_connection(#state{renegotiation = {true, From}} = State) -> gen_fsm:reply(From, ok), State#state{renegotiation = undefined}; -ack_connection(#state{renegotiation = {false, first}, from = From} = State) -> +ack_connection(#state{renegotiation = {false, first}, + from = From} = State) when From =/= undefined -> gen_fsm:reply(From, connected), - State#state{renegotiation = undefined}. + State#state{renegotiation = undefined}; +ack_connection(State) -> + State. renegotiate(#state{role = client} = State) -> %% Handle same way as if server requested @@ -2009,16 +2099,18 @@ renegotiate(#state{role = server, socket = Socket, transport_cb = Transport, negotiated_version = Version, - connection_states = ConnectionStates0} = State) -> + connection_states = ConnectionStates0} = State0) -> HelloRequest = ssl_handshake:hello_request(), Frag = ssl_handshake:encode_handshake(HelloRequest, Version, undefined), Hs0 = ssl_handshake:init_hashes(), {BinMsg, ConnectionStates} = ssl_record:encode_handshake(Frag, Version, ConnectionStates0), Transport:send(Socket, BinMsg), - {next_state, hello, next_record(State#state{connection_states = - ConnectionStates, - tls_handshake_hashes = Hs0})}. + {Record, State} = next_record(State0#state{connection_states = + ConnectionStates, + tls_handshake_hashes = Hs0}), + next_state(hello, Record, State). + notify_senders(SendQueue) -> lists:foreach(fun({From, _}) -> gen_fsm:reply(From, {error, closed}) @@ -2028,3 +2120,8 @@ notify_renegotiater({true, From}) when not is_atom(From) -> gen_fsm:reply(From, {error, closed}); notify_renegotiater(_) -> ok. + +workaround_transport_delivery_problems(Socket, Transport) -> + inet:setopts(Socket, [{active, false}]), + Transport:shutdown(Socket, write), + Transport:recv(Socket, 0). diff --git a/lib/ssl/src/ssl_handshake.erl b/lib/ssl/src/ssl_handshake.erl index 9f5ac7106a..5f3dff8894 100644 --- a/lib/ssl/src/ssl_handshake.erl +++ b/lib/ssl/src/ssl_handshake.erl @@ -31,7 +31,7 @@ -include("ssl_debug.hrl"). -include_lib("public_key/include/public_key.hrl"). --export([master_secret/4, client_hello/4, server_hello/3, hello/2, +-export([master_secret/4, client_hello/5, server_hello/4, hello/4, hello_request/0, certify/7, certificate/3, client_certificate_verify/6, certificate_verify/6, certificate_request/2, @@ -57,7 +57,7 @@ %%-------------------------------------------------------------------- client_hello(Host, Port, ConnectionStates, #ssl_options{versions = Versions, ciphers = Ciphers} - = SslOpts) -> + = SslOpts, Renegotiation) -> Fun = fun(Version) -> ssl_record:protocol_version(Version) @@ -70,22 +70,25 @@ client_hello(Host, Port, ConnectionStates, #ssl_options{versions = Versions, #client_hello{session_id = Id, client_version = Version, - cipher_suites = Ciphers, + cipher_suites = cipher_suites(Ciphers, Renegotiation), compression_methods = ssl_record:compressions(), - random = SecParams#security_parameters.client_random + random = SecParams#security_parameters.client_random, + renegotiation_info = + renegotiation_info(client, ConnectionStates, Renegotiation) }. %%-------------------------------------------------------------------- -%% Function: server_hello(Host, Port, SessionId, -%% Version, ConnectionStates) -> #server_hello{} +%% Function: server_hello(SessionId, Version, +%% ConnectionStates, Renegotiation) -> #server_hello{} %% SessionId %% Version -%% ConnectionStates +%% ConnectionStates +%% Renegotiation %% %% %% Description: Creates a server hello message. %%-------------------------------------------------------------------- -server_hello(SessionId, Version, ConnectionStates) -> +server_hello(SessionId, Version, ConnectionStates, Renegotiation) -> Pending = ssl_record:pending_connection_state(ConnectionStates, read), SecParams = Pending#connection_state.security_parameters, #server_hello{server_version = Version, @@ -93,7 +96,9 @@ server_hello(SessionId, Version, ConnectionStates) -> compression_method = SecParams#security_parameters.compression_algorithm, random = SecParams#security_parameters.server_random, - session_id = SessionId + session_id = SessionId, + renegotiation_info = + renegotiation_info(server, ConnectionStates, Renegotiation) }. %%-------------------------------------------------------------------- @@ -106,27 +111,41 @@ hello_request() -> #hello_request{}. %%-------------------------------------------------------------------- -%% Function: hello(Hello, Info) -> +%% Function: hello(Hello, Info, Renegotiation) -> %% {Version, Id, NewConnectionStates} | %% #alert{} %% %% Hello = #client_hello{} | #server_hello{} -%% Info = ConnectionStates | {Port, Session, ConnectionStates} +%% Info = ConnectionStates | {Port, #ssl_options{}, Session, +%% Cahce, CahceCb, ConnectionStates} %% ConnectionStates = #connection_states{} +%% Renegotiation = boolean() %% %% Description: Handles a recieved hello message %%-------------------------------------------------------------------- hello(#server_hello{cipher_suite = CipherSuite, server_version = Version, compression_method = Compression, random = Random, - session_id = SessionId}, ConnectionStates) -> - NewConnectionStates = - hello_pending_connection_states(client, CipherSuite, Random, - Compression, ConnectionStates), - {Version, SessionId, NewConnectionStates}; - -hello(#client_hello{client_version = ClientVersion, random = Random} = Hello, - {Port, #ssl_options{versions = Versions} = SslOpts, - Session0, Cache, CacheCb, ConnectionStates0}) -> + session_id = SessionId, renegotiation_info = Info}, + #ssl_options{secure_renegotiate = SecureRenegotation}, + ConnectionStates0, Renegotiation) -> + + case handle_renegotiation_info(client, Info, ConnectionStates0, + Renegotiation, SecureRenegotation, []) of + {ok, ConnectionStates1} -> + ConnectionStates = + hello_pending_connection_states(client, CipherSuite, Random, + Compression, ConnectionStates1), + {Version, SessionId, ConnectionStates}; + #alert{} = Alert -> + Alert + end; + +hello(#client_hello{client_version = ClientVersion, random = Random, + cipher_suites = CipherSuites, + renegotiation_info = Info} = Hello, + #ssl_options{versions = Versions, + secure_renegotiate = SecureRenegotation} = SslOpts, + {Port, Session0, Cache, CacheCb, ConnectionStates0}, Renegotiation) -> Version = select_version(ClientVersion, Versions), case ssl_record:is_acceptable_version(Version) of true -> @@ -138,13 +157,20 @@ hello(#client_hello{client_version = ClientVersion, random = Random} = Hello, no_suite -> ?ALERT_REC(?FATAL, ?INSUFFICIENT_SECURITY); _ -> - ConnectionStates = - hello_pending_connection_states(server, - CipherSuite, - Random, - Compression, - ConnectionStates0), - {Version, {Type, Session}, ConnectionStates} + case handle_renegotiation_info(server, Info, ConnectionStates0, + Renegotiation, SecureRenegotation, + CipherSuites) of + {ok, ConnectionStates1} -> + ConnectionStates = + hello_pending_connection_states(server, + CipherSuite, + Random, + Compression, + ConnectionStates1), + {Version, {Type, Session}, ConnectionStates}; + #alert{} = Alert -> + Alert + end end; false -> ?ALERT_REC(?FATAL, ?PROTOCOL_VERSION) @@ -256,7 +282,7 @@ client_certificate_verify(OwnCert, MasterSecret, Version, Algorithm, PrivateKey, {Hashes0, _}) -> case public_key:pkix_is_fixed_dh_cert(OwnCert) of true -> - ignore; + ?ALERT_REC(?FATAL, ?UNSUPPORTED_CERTIFICATE); false -> Hashes = calc_certificate_verify(Version, MasterSecret, @@ -276,7 +302,6 @@ client_certificate_verify(OwnCert, MasterSecret, Version, Algorithm, certificate_verify(Signature, {_, PublicKey, _}, Version, MasterSecret, Algorithm, {_, Hashes0}) when Algorithm == rsa; - Algorithm == dh_rsa; Algorithm == dhe_rsa -> Hashes = calc_certificate_verify(Version, MasterSecret, Algorithm, Hashes0), @@ -319,11 +344,7 @@ key_exchange(client, {premaster_secret, Secret, {_, PublicKey, _}}) -> EncPremasterSecret = encrypted_premaster_secret(Secret, PublicKey), #client_key_exchange{exchange_keys = EncPremasterSecret}; -key_exchange(client, fixed_diffie_hellman) -> - #client_key_exchange{exchange_keys = - #client_diffie_hellman_public{ - dh_public = <<>> - }}; + key_exchange(client, {dh, <<?UINT32(Len), PublicKey:Len/binary>>}) -> #client_key_exchange{ exchange_keys = #client_diffie_hellman_public{ @@ -349,10 +370,7 @@ key_exchange(server, {dh, {<<?UINT32(_), PublicKey/binary>>, _}, ?UINT16(YLen), PublicKey/binary>>), Signed = digitally_signed(Hash, PrivateKey), #server_key_exchange{params = ServerDHParams, - signed_params = Signed}; -key_exchange(_, _) -> - %%TODO : Real imp - #server_key_exchange{}. + signed_params = Signed}. %%-------------------------------------------------------------------- %% Function: master_secret(Version, Session/PremasterSecret, @@ -525,7 +543,109 @@ select_session(Hello, Port, Session, Version, false -> {resumed, CacheCb:lookup(Cache, {Port, SessionId})} end. - + + +cipher_suites(Suites, false) -> + [?TLS_EMPTY_RENEGOTIATION_INFO_SCSV | Suites]; +cipher_suites(Suites, true) -> + Suites. + +renegotiation_info(client, _, false) -> + #renegotiation_info{renegotiated_connection = undefined}; +renegotiation_info(server, ConnectionStates, false) -> + CS = ssl_record:current_connection_state(ConnectionStates, read), + case CS#connection_state.secure_renegotiation of + true -> + #renegotiation_info{renegotiated_connection = ?byte(0)}; + false -> + #renegotiation_info{renegotiated_connection = undefined} + end; +renegotiation_info(client, ConnectionStates, true) -> + CS = ssl_record:current_connection_state(ConnectionStates, read), + case CS#connection_state.secure_renegotiation of + true -> + Data = CS#connection_state.client_verify_data, + #renegotiation_info{renegotiated_connection = Data}; + false -> + #renegotiation_info{renegotiated_connection = undefined} + end; + +renegotiation_info(server, ConnectionStates, true) -> + CS = ssl_record:current_connection_state(ConnectionStates, read), + case CS#connection_state.secure_renegotiation of + true -> + CData = CS#connection_state.client_verify_data, + SData =CS#connection_state.server_verify_data, + #renegotiation_info{renegotiated_connection = <<CData/binary, SData/binary>>}; + false -> + #renegotiation_info{renegotiated_connection = undefined} + end. + +handle_renegotiation_info(_, #renegotiation_info{renegotiated_connection = ?byte(0)}, + ConnectionStates, false, _, _) -> + {ok, ssl_record:set_renegotiation_flag(true, ConnectionStates)}; + +handle_renegotiation_info(server, undefined, ConnectionStates, _, _, CipherSuites) -> + case is_member(?TLS_EMPTY_RENEGOTIATION_INFO_SCSV, CipherSuites) of + true -> + {ok, ssl_record:set_renegotiation_flag(true, ConnectionStates)}; + false -> + {ok, ssl_record:set_renegotiation_flag(false, ConnectionStates)} + end; + +handle_renegotiation_info(_, undefined, ConnectionStates, false, _, _) -> + {ok, ssl_record:set_renegotiation_flag(false, ConnectionStates)}; + +handle_renegotiation_info(client, #renegotiation_info{renegotiated_connection = ClientServerVerify}, + ConnectionStates, true, _, _) -> + CS = ssl_record:current_connection_state(ConnectionStates, read), + CData = CS#connection_state.client_verify_data, + SData = CS#connection_state.server_verify_data, + case <<CData/binary, SData/binary>> == ClientServerVerify of + true -> + {ok, ConnectionStates}; + false -> + ?ALERT_REC(?FATAL, ?HANDSHAKE_FAILURE) + end; +handle_renegotiation_info(server, #renegotiation_info{renegotiated_connection = ClientVerify}, + ConnectionStates, true, _, CipherSuites) -> + + case is_member(?TLS_EMPTY_RENEGOTIATION_INFO_SCSV, CipherSuites) of + true -> + ?ALERT_REC(?FATAL, ?HANDSHAKE_FAILURE); + false -> + CS = ssl_record:current_connection_state(ConnectionStates, read), + Data = CS#connection_state.client_verify_data, + case Data == ClientVerify of + true -> + {ok, ConnectionStates}; + false -> + ?ALERT_REC(?FATAL, ?HANDSHAKE_FAILURE) + end + end; + +handle_renegotiation_info(client, undefined, ConnectionStates, true, SecureRenegotation, _) -> + handle_renegotiation_info(ConnectionStates, SecureRenegotation); + +handle_renegotiation_info(server, undefined, ConnectionStates, true, SecureRenegotation, CipherSuites) -> + case is_member(?TLS_EMPTY_RENEGOTIATION_INFO_SCSV, CipherSuites) of + true -> + ?ALERT_REC(?FATAL, ?HANDSHAKE_FAILURE); + false -> + handle_renegotiation_info(ConnectionStates, SecureRenegotation) + end. + +handle_renegotiation_info(ConnectionStates, SecureRenegotation) -> + CS = ssl_record:current_connection_state(ConnectionStates, read), + case {SecureRenegotation, CS#connection_state.secure_renegotiation} of + {_, true} -> + ?ALERT_REC(?FATAL, ?HANDSHAKE_FAILURE); + {true, false} -> + ?ALERT_REC(?FATAL, ?NO_RENEGOTIATION); + {false, false} -> + {ok, ConnectionStates} + end. + %% Update pending connection states with parameters exchanged via %% hello messages %% NOTE : Role is the role of the receiver of the hello message @@ -597,12 +717,11 @@ master_secret(Version, MasterSecret, #security_parameters{ hash_size = HashSize, key_material_length = KML, expanded_key_material_length = EKML, - iv_size = IVS, - exportable = Exportable}, + iv_size = IVS}, ConnectionStates, Role) -> {ClientWriteMacSecret, ServerWriteMacSecret, ClientWriteKey, ServerWriteKey, ClientIV, ServerIV} = - setup_keys(Version, Exportable, MasterSecret, ServerRandom, + setup_keys(Version, MasterSecret, ServerRandom, ClientRandom, HashSize, KML, EKML, IVS), ?DBG_HEX(ClientWriteKey), ?DBG_HEX(ClientIV), @@ -636,40 +755,55 @@ dec_hs(?CLIENT_HELLO, <<?BYTE(Major), ?BYTE(Minor), random = ssl_ssl2:client_random(ChallengeData, CDLength), session_id = 0, cipher_suites = from_3bytes(CipherSuites), - compression_methods = [?NULL] + compression_methods = [?NULL], + renegotiation_info = undefined }; dec_hs(?CLIENT_HELLO, <<?BYTE(Major), ?BYTE(Minor), Random:32/binary, ?BYTE(SID_length), Session_ID:SID_length/binary, ?UINT16(Cs_length), CipherSuites:Cs_length/binary, ?BYTE(Cm_length), Comp_methods:Cm_length/binary, - _FutureCompatData/binary>>, + Extensions/binary>>, _, _) -> + + RenegotiationInfo = proplists:get_value(renegotiation_info, dec_hello_extensions(Extensions), + undefined), #client_hello{ client_version = {Major,Minor}, random = Random, session_id = Session_ID, cipher_suites = from_2bytes(CipherSuites), - compression_methods = Comp_methods + compression_methods = Comp_methods, + renegotiation_info = RenegotiationInfo }; + dec_hs(?SERVER_HELLO, <<?BYTE(Major), ?BYTE(Minor), Random:32/binary, ?BYTE(SID_length), Session_ID:SID_length/binary, - Cipher_suite:2/binary, ?BYTE(Comp_method)>>, _, _) -> + Cipher_suite:2/binary, ?BYTE(Comp_method)>>, _, _) -> #server_hello{ server_version = {Major,Minor}, random = Random, session_id = Session_ID, cipher_suite = Cipher_suite, - compression_method = Comp_method - }; + compression_method = Comp_method, + renegotiation_info = undefined}; + +dec_hs(?SERVER_HELLO, <<?BYTE(Major), ?BYTE(Minor), Random:32/binary, + ?BYTE(SID_length), Session_ID:SID_length/binary, + Cipher_suite:2/binary, ?BYTE(Comp_method), + ?UINT16(ExtLen), Extensions:ExtLen/binary>>, _, _) -> + + RenegotiationInfo = proplists:get_value(renegotiation_info, dec_hello_extensions(Extensions, []), + undefined), + #server_hello{ + server_version = {Major,Minor}, + random = Random, + session_id = Session_ID, + cipher_suite = Cipher_suite, + compression_method = Comp_method, + renegotiation_info = RenegotiationInfo}; dec_hs(?CERTIFICATE, <<?UINT24(ACLen), ASN1Certs:ACLen/binary>>, _, _) -> #certificate{asn1_certificates = certs_to_list(ASN1Certs)}; -dec_hs(?SERVER_KEY_EXCHANGE, <<?UINT16(ModLen), Mod:ModLen/binary, - ?UINT16(ExpLen), Exp:ExpLen/binary, - ?UINT16(_), Sig/binary>>, - ?KEY_EXCHANGE_RSA, _) -> - #server_key_exchange{params = #server_rsa_params{rsa_modulus = Mod, - rsa_exponent = Exp}, - signed_params = Sig}; + dec_hs(?SERVER_KEY_EXCHANGE, <<?UINT16(PLen), P:PLen/binary, ?UINT16(GLen), G:GLen/binary, ?UINT16(YLen), Y:YLen/binary, @@ -696,8 +830,7 @@ dec_hs(?CLIENT_KEY_EXCHANGE, <<?UINT16(_), PKEPMS/binary>>, PreSecret = #encrypted_premaster_secret{premaster_secret = PKEPMS}, #client_key_exchange{exchange_keys = PreSecret}; dec_hs(?CLIENT_KEY_EXCHANGE, <<>>, ?KEY_EXCHANGE_DIFFIE_HELLMAN, _) -> - %% TODO: Should check whether the cert already contains a suitable DH-key (7.4.7.2) - throw(?ALERT_REC(?FATAL, implicit_public_value_encoding)); + throw(?ALERT_REC(?FATAL, ?UNSUPPORTED_CERTIFICATE)); dec_hs(?CLIENT_KEY_EXCHANGE, <<?UINT16(DH_YLen), DH_Y:DH_YLen/binary>>, ?KEY_EXCHANGE_DIFFIE_HELLMAN, _) -> #client_key_exchange{exchange_keys = @@ -707,6 +840,32 @@ dec_hs(?FINISHED, VerifyData, _, _) -> dec_hs(_, _, _, _) -> throw(?ALERT_REC(?FATAL, ?HANDSHAKE_FAILURE)). +dec_hello_extensions(<<>>) -> + []; +dec_hello_extensions(<<?UINT16(ExtLen), Extensions:ExtLen/binary>>) -> + dec_hello_extensions(Extensions, []); +dec_hello_extensions(_) -> + []. + +dec_hello_extensions(<<>>, Acc) -> + Acc; +dec_hello_extensions(<<?UINT16(?RENEGOTIATION_EXT), ?UINT16(Len), Info:Len/binary, Rest/binary>>, Acc) -> + RenegotiateInfo = case Len of + 1 -> % Initial handshake + Info; % should be <<0>> will be matched in handle_renegotiation_info + _ -> + VerifyLen = Len - 1, + <<?BYTE(VerifyLen), VerifyInfo/binary>> = Info, + VerifyInfo + end, + dec_hello_extensions(Rest, [{renegotiation_info, + #renegotiation_info{renegotiated_connection = RenegotiateInfo}} | Acc]); +dec_hello_extensions(<<?UINT16(_), ?UINT16(Len), _Unknown:Len, Rest/binary>>, Acc) -> + dec_hello_extensions(Rest, Acc); +%% Need this clause? +dec_hello_extensions(_, Acc) -> + Acc. + encrypted_premaster_secret(Secret, RSAPublicKey) -> try PreMasterSecret = public_key:encrypt_public(Secret, RSAPublicKey, @@ -743,45 +902,40 @@ certs_from_list(ACList) -> enc_hs(#hello_request{}, _Version, _) -> {?HELLO_REQUEST, <<>>}; -enc_hs(#client_hello{ - client_version = {Major, Minor}, - random = Random, - session_id = SessionID, - cipher_suites = CipherSuites, - compression_methods = CompMethods}, _Version, _) -> +enc_hs(#client_hello{client_version = {Major, Minor}, + random = Random, + session_id = SessionID, + cipher_suites = CipherSuites, + compression_methods = CompMethods, + renegotiation_info = RenegotiationInfo}, _Version, _) -> SIDLength = byte_size(SessionID), BinCompMethods = list_to_binary(CompMethods), CmLength = byte_size(BinCompMethods), BinCipherSuites = list_to_binary(CipherSuites), CsLength = byte_size(BinCipherSuites), + Extensions = hello_extensions(RenegotiationInfo), + ExtensionsBin = enc_hello_extensions(Extensions), {?CLIENT_HELLO, <<?BYTE(Major), ?BYTE(Minor), Random:32/binary, ?BYTE(SIDLength), SessionID/binary, ?UINT16(CsLength), BinCipherSuites/binary, - ?BYTE(CmLength), BinCompMethods/binary>>}; -enc_hs(#server_hello{ - server_version = {Major, Minor}, - random = Random, - session_id = Session_ID, - cipher_suite = Cipher_suite, - compression_method = Comp_method}, _Version, _) -> + ?BYTE(CmLength), BinCompMethods/binary, ExtensionsBin/binary>>}; + +enc_hs(#server_hello{server_version = {Major, Minor}, + random = Random, + session_id = Session_ID, + cipher_suite = Cipher_suite, + compression_method = Comp_method, + renegotiation_info = RenegotiationInfo}, _Version, _) -> SID_length = byte_size(Session_ID), + Extensions = hello_extensions(RenegotiationInfo), + ExtensionsBin = enc_hello_extensions(Extensions), {?SERVER_HELLO, <<?BYTE(Major), ?BYTE(Minor), Random:32/binary, ?BYTE(SID_length), Session_ID/binary, - Cipher_suite/binary, ?BYTE(Comp_method)>>}; + Cipher_suite/binary, ?BYTE(Comp_method), ExtensionsBin/binary>>}; enc_hs(#certificate{asn1_certificates = ASN1CertList}, _Version, _) -> ASN1Certs = certs_from_list(ASN1CertList), ACLen = erlang:iolist_size(ASN1Certs), {?CERTIFICATE, <<?UINT24(ACLen), ASN1Certs:ACLen/binary>>}; -enc_hs(#server_key_exchange{params = #server_rsa_params{rsa_modulus = Mod, - rsa_exponent = Exp}, - signed_params = SignedParams}, _Version, _) -> - ModLen = byte_size(Mod), - ExpLen = byte_size(Exp), - SignedLen = byte_size(SignedParams), - {?SERVER_KEY_EXCHANGE, <<?UINT16(ModLen),Mod/binary, - ?UINT16(ExpLen), Exp/binary, - ?UINT16(SignedLen), SignedParams/binary>> - }; enc_hs(#server_key_exchange{params = #server_dh_params{ dh_p = P, dh_g = G, dh_y = Y}, signed_params = SignedParams}, _Version, _) -> @@ -826,6 +980,29 @@ enc_bin_sig(BinSig) -> Size = byte_size(BinSig), <<?UINT16(Size), BinSig/binary>>. +%% Renegotiation info, only current extension +hello_extensions(#renegotiation_info{renegotiated_connection = undefined}) -> + []; +hello_extensions(#renegotiation_info{} = Info) -> + [Info]. + +enc_hello_extensions(Extensions) -> + enc_hello_extensions(Extensions, <<>>). +enc_hello_extensions([], <<>>) -> + <<>>; +enc_hello_extensions([], Acc) -> + Size = byte_size(Acc), + <<?UINT16(Size), Acc/binary>>; + +enc_hello_extensions([#renegotiation_info{renegotiated_connection = ?byte(0) = Info} | Rest], Acc) -> + Len = byte_size(Info), + enc_hello_extensions(Rest, <<?UINT16(?RENEGOTIATION_EXT), ?UINT16(Len), Info/binary, Acc/binary>>); + +enc_hello_extensions([#renegotiation_info{renegotiated_connection = Info} | Rest], Acc) -> + InfoLen = byte_size(Info), + Len = InfoLen +1, + enc_hello_extensions(Rest, <<?UINT16(?RENEGOTIATION_EXT), ?UINT16(Len), ?BYTE(InfoLen), Info/binary, Acc/binary>>). + init_hashes() -> T = {crypto:md5_init(), crypto:sha_init()}, {T, T}. @@ -868,16 +1045,11 @@ from_2bytes(<<?UINT16(N), Rest/binary>>, Acc) -> certificate_types({KeyExchange, _, _, _}) when KeyExchange == rsa; - KeyExchange == dh_dss; - KeyExchange == dh_rsa; KeyExchange == dhe_dss; KeyExchange == dhe_rsa -> <<?BYTE(?RSA_SIGN), ?BYTE(?DSS_SIGN)>>; certificate_types(_) -> - %%TODO: Is this a good default, - %% is there a case where we like to request - %% a RSA_FIXED_DH or DSS_FIXED_DH <<?BYTE(?RSA_SIGN)>>. certificate_authorities(CertDbRef) -> @@ -896,7 +1068,7 @@ certificate_authorities_from_db(CertDbRef) -> certificate_authorities_from_db(CertDbRef, no_candidate, []). certificate_authorities_from_db(CertDbRef, PrevKey, Acc) -> - case ssl_certificate_db:issuer_candidate(PrevKey) of + case ssl_manager:issuer_candidate(PrevKey) of no_more_candidates -> lists:reverse(Acc); {{CertDbRef, _, _} = Key, Cert} -> @@ -920,20 +1092,15 @@ calc_master_secret({3,N},PremasterSecret, ClientRandom, ServerRandom) when N == 1; N == 2 -> ssl_tls1:master_secret(PremasterSecret, ClientRandom, ServerRandom). -setup_keys({3,0}, Exportable, MasterSecret, +setup_keys({3,0}, MasterSecret, ServerRandom, ClientRandom, HashSize, KML, EKML, IVS) -> - ssl_ssl3:setup_keys(Exportable, MasterSecret, ServerRandom, + ssl_ssl3:setup_keys(MasterSecret, ServerRandom, ClientRandom, HashSize, KML, EKML, IVS); -setup_keys({3,1}, _Exportable, MasterSecret, +setup_keys({3,1}, MasterSecret, ServerRandom, ClientRandom, HashSize, KML, _EKML, IVS) -> ssl_tls1:setup_keys(MasterSecret, ServerRandom, ClientRandom, HashSize, - KML, IVS); - -setup_keys({3,2}, _Exportable, MasterSecret, - ServerRandom, ClientRandom, HashSize, KML, _EKML, _IVS) -> - ssl_tls1:setup_keys(MasterSecret, ServerRandom, - ClientRandom, HashSize, KML). + KML, IVS). calc_finished({3, 0}, Role, MasterSecret, Hashes) -> ssl_ssl3:finished(Role, MasterSecret, Hashes); @@ -948,7 +1115,6 @@ calc_certificate_verify({3, N}, _, Algorithm, Hashes) ssl_tls1:certificate_verify(Algorithm, Hashes). server_key_exchange_hash(Algorithm, Value) when Algorithm == rsa; - Algorithm == dh_rsa; Algorithm == dhe_rsa -> MD5Context = crypto:md5_init(), NewMD5Context = crypto:md5_update(MD5Context, Value), @@ -960,9 +1126,7 @@ server_key_exchange_hash(Algorithm, Value) when Algorithm == rsa; <<MD5/binary, SHA/binary>>; -server_key_exchange_hash(Algorithm, Value) when Algorithm == dh_dss; - Algorithm == dhe_dss -> - +server_key_exchange_hash(dhe_dss, Value) -> SHAContext = crypto:sha_init(), NewSHAContext = crypto:sha_update(SHAContext, Value), crypto:sha_final(NewSHAContext). @@ -970,9 +1134,9 @@ server_key_exchange_hash(Algorithm, Value) when Algorithm == dh_dss; sig_alg(dh_anon) -> ?SIGNATURE_ANONYMOUS; -sig_alg(Alg) when Alg == dhe_rsa; Alg == rsa; Alg == dh_rsa -> +sig_alg(Alg) when Alg == dhe_rsa; Alg == rsa -> ?SIGNATURE_RSA; -sig_alg(Alg) when Alg == dh_dss; Alg == dhe_dss -> +sig_alg(dhe_dss) -> ?SIGNATURE_DSA; sig_alg(_) -> ?NULL. diff --git a/lib/ssl/src/ssl_handshake.hrl b/lib/ssl/src/ssl_handshake.hrl index 889d39f2af..74fba3786c 100644 --- a/lib/ssl/src/ssl_handshake.hrl +++ b/lib/ssl/src/ssl_handshake.hrl @@ -81,7 +81,8 @@ random, session_id, % opaque SessionID<0..32> cipher_suites, % cipher_suites<2..2^16-1> - compression_methods % compression_methods<1..2^8-1> + compression_methods, % compression_methods<1..2^8-1>, + renegotiation_info }). -record(server_hello, { @@ -89,7 +90,8 @@ random, session_id, % opaque SessionID<0..32> cipher_suite, % cipher_suites - compression_method % compression_method + compression_method, % compression_method + renegotiation_info }). %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% @@ -195,6 +197,15 @@ verify_data %opaque verify_data[12] }). +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +%% Renegotiation info RFC 5746 section 3.2 +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +-define(RENEGOTIATION_EXT, 16#ff01). + +-record(renegotiation_info,{ + renegotiated_connection + }). + -endif. % -ifdef(ssl_handshake). diff --git a/lib/ssl/src/ssl_internal.hrl b/lib/ssl/src/ssl_internal.hrl index 8d19abfe1e..fdc0c33750 100644 --- a/lib/ssl/src/ssl_internal.hrl +++ b/lib/ssl/src/ssl_internal.hrl @@ -75,6 +75,7 @@ %% will be reused if possible. reuse_sessions, % boolean() renegotiate_at, + secure_renegotiate, debug % }). diff --git a/lib/ssl/src/ssl_manager.erl b/lib/ssl/src/ssl_manager.erl index 0151426d43..7a0192a80f 100644 --- a/lib/ssl/src/ssl_manager.erl +++ b/lib/ssl/src/ssl_manager.erl @@ -27,7 +27,7 @@ %% Internal application API -export([start_link/0, start_link/1, connection_init/2, cache_pem_file/1, - lookup_trusted_cert/3, client_session_id/3, server_session_id/3, + lookup_trusted_cert/3, issuer_candidate/1, client_session_id/3, server_session_id/3, register_session/2, register_session/3, invalidate_session/2, invalidate_session/3]). @@ -85,13 +85,20 @@ cache_pem_file(File) -> %% Function: %% Description: %%-------------------------------------------------------------------- -lookup_trusted_cert(SerialNumber, Issuer, Ref) -> +lookup_trusted_cert(Ref, SerialNumber, Issuer) -> ssl_certificate_db:lookup_trusted_cert(Ref, SerialNumber, Issuer). %%-------------------------------------------------------------------- %% Function: %% Description: %%-------------------------------------------------------------------- +issuer_candidate(PrevCandidateKey) -> + ssl_certificate_db:issuer_candidate(PrevCandidateKey). + +%%-------------------------------------------------------------------- +%% Function: +%% Description: +%%-------------------------------------------------------------------- client_session_id(Host, Port, SslOpts) -> call({client_session_id, Host, Port, SslOpts}). @@ -172,10 +179,8 @@ handle_call({{connection_init, TrustedcertsFile, _Role}, Pid}, _From, {ok, Ref} = ssl_certificate_db:add_trusted_certs(Pid, TrustedcertsFile, Db), {ok, Ref, Cache} catch - _:{badmatch, Error} -> - {error, Error}; - _E:_R -> - {error, {_R,erlang:get_stacktrace()}} + _:Reason -> + {error, Reason} end, {reply, Result, State}; @@ -197,14 +202,10 @@ handle_call({{cache_pem, File},Pid}, _, State = #state{certificate_db = Db}) -> try ssl_certificate_db:cache_pem_file(Pid,File,Db) of Result -> {reply, Result, State} - catch _:{badmatch, Reason} -> - {reply, Reason, State}; - _:Reason -> + catch + _:Reason -> {reply, {error, Reason}, State} - end; - -handle_call(_,_, State) -> - {reply, ok, State}. + end. %%-------------------------------------------------------------------- %% Function: handle_cast(Msg, State) -> {noreply, State} | %% {noreply, State, Timeout} | @@ -332,7 +333,7 @@ init_session_validator([Cache, CacheCb, LifeTime]) -> CacheCb:foldl(fun session_validation/2, LifeTime, Cache). -session_validation({{Host, Port, _}, Session}, LifeTime) -> +session_validation({{{Host, Port}, _}, Session}, LifeTime) -> validate_session(Host, Port, Session, LifeTime), LifeTime; session_validation({{Port, _}, Session}, LifeTime) -> diff --git a/lib/ssl/src/ssl_record.erl b/lib/ssl/src/ssl_record.erl index da48f049f6..43f18d95a0 100644 --- a/lib/ssl/src/ssl_record.erl +++ b/lib/ssl/src/ssl_record.erl @@ -29,6 +29,7 @@ -include("ssl_internal.hrl"). -include("ssl_alert.hrl"). -include("ssl_handshake.hrl"). +-include("ssl_cipher.hrl"). -include("ssl_debug.hrl"). %% Connection state handling @@ -38,7 +39,10 @@ set_mac_secret/4, set_master_secret/2, activate_pending_connection_state/2, - set_pending_cipher_state/4]). + set_pending_cipher_state/4, + set_renegotiation_flag/2, + set_client_verify_data/3, + set_server_verify_data/3]). %% Handling of incoming data -export([get_tls_records/2]). @@ -175,6 +179,98 @@ set_master_secret(MasterSecret, master_secret = MasterSecret}}, States#connection_states{pending_read = Read1, pending_write = Write1}. +%%-------------------------------------------------------------------- +%% Function: set_renegotiation_flag(Flag, States) -> +%% #connection_states{} +%% Flag = boolean() +%% States = #connection_states{} +%% +%% Set master_secret in pending connection states +%%-------------------------------------------------------------------- +set_renegotiation_flag(Flag, #connection_states{ + current_read = CurrentRead0, + current_write = CurrentWrite0, + pending_read = PendingRead0, + pending_write = PendingWrite0} + = ConnectionStates) -> + CurrentRead = CurrentRead0#connection_state{secure_renegotiation = Flag}, + CurrentWrite = CurrentWrite0#connection_state{secure_renegotiation = Flag}, + PendingRead = PendingRead0#connection_state{secure_renegotiation = Flag}, + PendingWrite = PendingWrite0#connection_state{secure_renegotiation = Flag}, + ConnectionStates#connection_states{current_read = CurrentRead, + current_write = CurrentWrite, + pending_read = PendingRead, + pending_write = PendingWrite}. + +%%-------------------------------------------------------------------- +%% Function: set_client_verify_data(State, Data, States) -> +%% #connection_states{} +%% State = atom() +%% Data = binary() +%% States = #connection_states{} +%% +%% Set verify data in connection states. +%%-------------------------------------------------------------------- +set_client_verify_data(current_read, Data, + #connection_states{current_read = CurrentRead0, + pending_write = PendingWrite0} + = ConnectionStates) -> + CurrentRead = CurrentRead0#connection_state{client_verify_data = Data}, + PendingWrite = PendingWrite0#connection_state{client_verify_data = Data}, + ConnectionStates#connection_states{current_read = CurrentRead, + pending_write = PendingWrite}; +set_client_verify_data(current_write, Data, + #connection_states{pending_read = PendingRead0, + current_write = CurrentWrite0} + = ConnectionStates) -> + PendingRead = PendingRead0#connection_state{client_verify_data = Data}, + CurrentWrite = CurrentWrite0#connection_state{client_verify_data = Data}, + ConnectionStates#connection_states{pending_read = PendingRead, + current_write = CurrentWrite}; +set_client_verify_data(current_both, Data, + #connection_states{current_read = CurrentRead0, + current_write = CurrentWrite0} + = ConnectionStates) -> + CurrentRead = CurrentRead0#connection_state{client_verify_data = Data}, + CurrentWrite = CurrentWrite0#connection_state{client_verify_data = Data}, + ConnectionStates#connection_states{current_read = CurrentRead, + current_write = CurrentWrite}. + +%%-------------------------------------------------------------------- +%% Function: set_server_verify_data(State, Data, States) -> +%% #connection_states{} +%% State = atom() +%% Data = binary() +%% States = #connection_states{} +%% +%% Set verify data in pending connection states. +%%-------------------------------------------------------------------- +set_server_verify_data(current_write, Data, + #connection_states{pending_read = PendingRead0, + current_write = CurrentWrite0} + = ConnectionStates) -> + PendingRead = PendingRead0#connection_state{server_verify_data = Data}, + CurrentWrite = CurrentWrite0#connection_state{server_verify_data = Data}, + ConnectionStates#connection_states{pending_read = PendingRead, + current_write = CurrentWrite}; + +set_server_verify_data(current_read, Data, + #connection_states{current_read = CurrentRead0, + pending_write = PendingWrite0} + = ConnectionStates) -> + CurrentRead = CurrentRead0#connection_state{server_verify_data = Data}, + PendingWrite = PendingWrite0#connection_state{server_verify_data = Data}, + ConnectionStates#connection_states{current_read = CurrentRead, + pending_write = PendingWrite}; + +set_server_verify_data(current_both, Data, + #connection_states{current_read = CurrentRead0, + current_write = CurrentWrite0} + = ConnectionStates) -> + CurrentRead = CurrentRead0#connection_state{server_verify_data = Data}, + CurrentWrite = CurrentWrite0#connection_state{server_verify_data = Data}, + ConnectionStates#connection_states{current_read = CurrentRead, + current_write = CurrentWrite}. %%-------------------------------------------------------------------- %% Function: activate_pending_connection_state(States, Type) -> @@ -191,7 +287,9 @@ activate_pending_connection_state(States = NewCurrent = Pending#connection_state{sequence_number = 0}, SecParams = Pending#connection_state.security_parameters, ConnectionEnd = SecParams#security_parameters.connection_end, - NewPending = empty_connection_state(ConnectionEnd), + EmptyPending = empty_connection_state(ConnectionEnd), + SecureRenegotation = NewCurrent#connection_state.secure_renegotiation, + NewPending = EmptyPending#connection_state{secure_renegotiation = SecureRenegotation}, States#connection_states{current_read = NewCurrent, pending_read = NewPending }; @@ -202,7 +300,9 @@ activate_pending_connection_state(States = NewCurrent = Pending#connection_state{sequence_number = 0}, SecParams = Pending#connection_state.security_parameters, ConnectionEnd = SecParams#security_parameters.connection_end, - NewPending = empty_connection_state(ConnectionEnd), + EmptyPending = empty_connection_state(ConnectionEnd), + SecureRenegotation = NewCurrent#connection_state.secure_renegotiation, + NewPending = EmptyPending#connection_state{secure_renegotiation = SecureRenegotation}, States#connection_states{current_write = NewCurrent, pending_write = NewPending }. @@ -311,16 +411,14 @@ protocol_version(tlsv1) -> {3, 1}; protocol_version(sslv3) -> {3, 0}; -protocol_version(sslv2) -> +protocol_version(sslv2) -> %% Backwards compatibility {2, 0}; protocol_version({3, 2}) -> 'tlsv1.1'; protocol_version({3, 1}) -> tlsv1; protocol_version({3, 0}) -> - sslv3; -protocol_version({2, 0}) -> - sslv2. + sslv3. %%-------------------------------------------------------------------- %% Function: protocol_version(Version1, Version2) -> #protocol_version{} %% Version1 = Version2 = #protocol_version{} @@ -368,7 +466,7 @@ highest_protocol_version(_, [Version | Rest]) -> %%-------------------------------------------------------------------- supported_protocol_versions() -> Fun = fun(Version) -> - protocol_version(Version) + protocol_version(Version) end, case application:get_env(ssl, protocol_version) of undefined -> @@ -376,11 +474,18 @@ supported_protocol_versions() -> {ok, []} -> lists:map(Fun, ?DEFAULT_SUPPORTED_VERSIONS); {ok, Vsns} when is_list(Vsns) -> - lists:map(Fun, Vsns); + Versions = lists:filter(fun is_acceptable_version/1, lists:map(Fun, Vsns)), + supported_protocol_versions(Versions); {ok, Vsn} -> - [Fun(Vsn)] + Versions = lists:filter(fun is_acceptable_version/1, [Fun(Vsn)]), + supported_protocol_versions(Versions) end. +supported_protocol_versions([]) -> + ?DEFAULT_SUPPORTED_VERSIONS; +supported_protocol_versions([_|_] = Vsns) -> + Vsns. + %%-------------------------------------------------------------------- %% Function: is_acceptable_version(Version) -> true | false %% Version = #protocol_version{} @@ -433,12 +538,10 @@ initial_connection_state(ConnectionEnd) -> }. initial_security_params(ConnectionEnd) -> - #security_parameters{connection_end = ConnectionEnd, - bulk_cipher_algorithm = ?NULL, - mac_algorithm = ?NULL, - compression_algorithm = ?NULL, - cipher_type = ?NULL - }. + SecParams = #security_parameters{connection_end = ConnectionEnd, + compression_algorithm = ?NULL}, + ssl_cipher:security_parameters(?TLS_NULL_WITH_NULL_NULL, + SecParams). empty_connection_state(ConnectionEnd) -> SecParams = empty_security_params(ConnectionEnd), @@ -590,7 +693,7 @@ hash_and_bump_seqno(#connection_state{sequence_number = SeqNo, check_hash(_, _) -> ok. %% TODO check this -mac_hash(?NULL, {_,_}, _MacSecret, _SeqNo, _Type, +mac_hash({_,_}, ?NULL, _MacSecret, _SeqNo, _Type, _Length, _Fragment) -> <<>>; mac_hash({3, 0}, MacAlg, MacSecret, SeqNo, Type, Length, Fragment) -> diff --git a/lib/ssl/src/ssl_record.hrl b/lib/ssl/src/ssl_record.hrl index 362b7039d4..5fb0070b91 100644 --- a/lib/ssl/src/ssl_record.hrl +++ b/lib/ssl/src/ssl_record.hrl @@ -60,7 +60,11 @@ compression_state, cipher_state, mac_secret, - sequence_number + sequence_number, + %% RFC 5746 + secure_renegotiation, + client_verify_data, + server_verify_data }). -define(MAX_SEQENCE_NUMBER, 18446744073709552000). %% math:pow(2, 64) - 1 = 1.8446744073709552e19 diff --git a/lib/ssl/src/ssl_ssl3.erl b/lib/ssl/src/ssl_ssl3.erl index df809ce275..1bf8c2b458 100644 --- a/lib/ssl/src/ssl_ssl3.erl +++ b/lib/ssl/src/ssl_ssl3.erl @@ -30,7 +30,7 @@ -include("ssl_record.hrl"). % MD5 and SHA -export([master_secret/3, finished/3, certificate_verify/3, - mac_hash/6, setup_keys/8, + mac_hash/6, setup_keys/7, suites/0]). -compile(inline). @@ -76,7 +76,7 @@ finished(Role, MasterSecret, {MD5Hash, SHAHash}) -> <<MD5/binary, SHA/binary>>. certificate_verify(Algorithm, MasterSecret, {MD5Hash, SHAHash}) - when Algorithm == rsa; Algorithm == dh_rsa; Algorithm == dhe_rsa -> + when Algorithm == rsa; Algorithm == dhe_rsa -> %% md5_hash %% MD5(master_secret + pad_2 + %% MD5(handshake_messages + master_secret + pad_1)); @@ -88,8 +88,7 @@ certificate_verify(Algorithm, MasterSecret, {MD5Hash, SHAHash}) SHA = handshake_hash(?SHA, MasterSecret, undefined, SHAHash), <<MD5/binary, SHA/binary>>; -certificate_verify(Algorithm, MasterSecret, {_, SHAHash}) - when Algorithm == dh_dss; Algorithm == dhe_dss -> +certificate_verify(dhe_dss, MasterSecret, {_, SHAHash}) -> %% sha_hash %% SHA(master_secret + pad_2 + %% SHA(handshake_messages + master_secret + pad_1)); @@ -114,9 +113,7 @@ mac_hash(Method, Mac_write_secret, Seq_num, Type, Length, Fragment) -> ?DBG_HEX(Mac), Mac. -setup_keys(Exportable, MasterSecret, ServerRandom, ClientRandom, - HS, KML, _EKML, IVS) - when Exportable == no_export; Exportable == ignore -> +setup_keys(MasterSecret, ServerRandom, ClientRandom, HS, KML, _EKML, IVS) -> KeyBlock = generate_keyblock(MasterSecret, ServerRandom, ClientRandom, 2*(HS+KML+IVS)), %% draft-ietf-tls-ssl-version3-00 - 6.2.2 @@ -137,47 +134,7 @@ setup_keys(Exportable, MasterSecret, ServerRandom, ClientRandom, ?DBG_HEX(ClientIV), ?DBG_HEX(ServerIV), {ClientWriteMacSecret, ServerWriteMacSecret, ClientWriteKey, - ServerWriteKey, ClientIV, ServerIV}; - -setup_keys(export, MasterSecret, ServerRandom, ClientRandom, - HS, KML, EKML, IVS) -> - KeyBlock = generate_keyblock(MasterSecret, ServerRandom, ClientRandom, - 2*(HS+KML)), - %% draft-ietf-tls-ssl-version3-00 - 6.2.2 - %% Exportable encryption algorithms (for which - %% CipherSpec.is_exportable is true) require additional processing as - %% follows to derive their final write keys: - - %% final_client_write_key = MD5(client_write_key + - %% ClientHello.random + - %% ServerHello.random); - %% final_server_write_key = MD5(server_write_key + - %% ServerHello.random + - %% ClientHello.random); - - %% Exportable encryption algorithms derive their IVs from the random - %% messages: - %% client_write_IV = MD5(ClientHello.random + ServerHello.random); - %% server_write_IV = MD5(ServerHello.random + ClientHello.random); - - <<ClientWriteMacSecret:HS/binary, ServerWriteMacSecret:HS/binary, - ClientWriteKey:KML/binary, ServerWriteKey:KML/binary>> = KeyBlock, - <<ClientIV:IVS/binary, _/binary>> = - hash(?MD5, [ClientRandom, ServerRandom]), - <<ServerIV:IVS/binary, _/binary>> = - hash(?MD5, [ServerRandom, ClientRandom]), - <<FinalClientWriteKey:EKML/binary, _/binary>> = - hash(?MD5, [ClientWriteKey, ClientRandom, ServerRandom]), - <<FinalServerWriteKey:EKML/binary, _/binary>> = - hash(?MD5, [ServerWriteKey, ServerRandom, ClientRandom]), - ?DBG_HEX(ClientWriteMacSecret), - ?DBG_HEX(ServerWriteMacSecret), - ?DBG_HEX(FinalClientWriteKey), - ?DBG_HEX(FinalServerWriteKey), - ?DBG_HEX(ClientIV), - ?DBG_HEX(ServerIV), - {ClientWriteMacSecret, ServerWriteMacSecret, FinalClientWriteKey, - FinalServerWriteKey, ClientIV, ServerIV}. + ServerWriteKey, ClientIV, ServerIV}. suites() -> [ @@ -191,25 +148,12 @@ suites() -> ?TLS_DHE_RSA_WITH_AES_128_CBC_SHA, %% ?TLS_DHE_DSS_WITH_AES_128_CBC_SHA, ?TLS_RSA_WITH_AES_128_CBC_SHA, - %%?TLS_DHE_DSS_WITH_RC4_128_SHA, TODO: Support this? + %%?TLS_DHE_DSS_WITH_RC4_128_SHA, %% ?TLS_RSA_WITH_IDEA_CBC_SHA, Not supported: in later openssl version than OTP requires - ?TLS_RSA_WITH_RC4_128_SHA, ?TLS_RSA_WITH_RC4_128_MD5, - %%?TLS_RSA_EXPORT1024_WITH_RC4_56_MD5, - %%?TLS_RSA_EXPORT1024_WITH_RC2_CBC_56_MD5, - %%?TLS_RSA_EXPORT1024_WITH_DES_CBC_SHA, - %%?TLS_DHE_DSS_EXPORT1024_WITH_DES_CBC_SHA, - %%?TLS_RSA_EXPORT1024_WITH_RC4_56_SHA, - %%?TLS_DHE_DSS_EXPORT1024_WITH_RC4_56_SHA, %%?TLS_DHE_DSS_WITH_RC4_128_SHA, - ?TLS_RSA_WITH_DES_CBC_SHA - %% ?TLS_DHE_RSA_EXPORT_WITH_DES40_CBC_SHA, - %% ?TLS_DHE_DSS_EXPORT_WITH_DES40_CBC_SHA, - %% ?TLS_RSA_EXPORT_WITH_DES40_CBC_SHA, - %%?TLS_RSA_EXPORT_WITH_RC2_CBC_40_MD5, - %%?TLS_RSA_EXPORT_WITH_RC4_40_MD5 ]. %%-------------------------------------------------------------------- @@ -269,8 +213,7 @@ handshake_hash(Method, MasterSecret, Sender, HandshakeHash) -> hash(Method, [MasterSecret, pad_2(Method), InnerHash]). get_sender(client) -> "CLNT"; -get_sender(server) -> "SRVR"; -get_sender(none) -> "". +get_sender(server) -> "SRVR". generate_keyblock(MasterSecret, ServerRandom, ClientRandom, WantedLength) -> gen(MasterSecret, [MasterSecret, ServerRandom, ClientRandom], diff --git a/lib/ssl/src/ssl_tls1.erl b/lib/ssl/src/ssl_tls1.erl index ce9a135168..900b8e166d 100644 --- a/lib/ssl/src/ssl_tls1.erl +++ b/lib/ssl/src/ssl_tls1.erl @@ -30,7 +30,7 @@ -include("ssl_debug.hrl"). -export([master_secret/3, finished/3, certificate_verify/2, mac_hash/7, - setup_keys/5, setup_keys/6, suites/0]). + setup_keys/6, suites/0]). %%==================================================================== %% Internal application API @@ -58,14 +58,12 @@ finished(Role, MasterSecret, {MD5Hash, SHAHash}) -> certificate_verify(Algorithm, {MD5Hash, SHAHash}) when Algorithm == rsa; - Algorithm == dh_rsa; Algorithm == dhe_rsa -> MD5 = hash_final(?MD5, MD5Hash), SHA = hash_final(?SHA, SHAHash), <<MD5/binary, SHA/binary>>; -certificate_verify(Algorithm, {_, SHAHash}) when Algorithm == dh_dss; - Algorithm == dhe_dss -> +certificate_verify(dhe_dss, {_, SHAHash}) -> hash_final(?SHA, SHAHash). setup_keys(MasterSecret, ServerRandom, ClientRandom, HashSize, @@ -92,26 +90,27 @@ setup_keys(MasterSecret, ServerRandom, ClientRandom, HashSize, {ClientWriteMacSecret, ServerWriteMacSecret, ClientWriteKey, ServerWriteKey, ClientIV, ServerIV}. -setup_keys(MasterSecret, ServerRandom, ClientRandom, HashSize, KeyMatLen) -> - %% RFC 4346 - 6.3. Key calculation - %% key_block = PRF(SecurityParameters.master_secret, - %% "key expansion", - %% SecurityParameters.server_random + - %% SecurityParameters.client_random); - %% Then the key_block is partitioned as follows: - %% client_write_MAC_secret[SecurityParameters.hash_size] - %% server_write_MAC_secret[SecurityParameters.hash_size] - %% client_write_key[SecurityParameters.key_material_length] - %% server_write_key[SecurityParameters.key_material_length] - WantedLength = 2 * (HashSize + KeyMatLen), - KeyBlock = prf(MasterSecret, "key expansion", - [ServerRandom, ClientRandom], WantedLength), - <<ClientWriteMacSecret:HashSize/binary, - ServerWriteMacSecret:HashSize/binary, - ClientWriteKey:KeyMatLen/binary, ServerWriteKey:KeyMatLen/binary>> - = KeyBlock, - {ClientWriteMacSecret, ServerWriteMacSecret, ClientWriteKey, - ServerWriteKey, undefined, undefined}. +%% TLS v1.1 uncomment when supported. +%% setup_keys(MasterSecret, ServerRandom, ClientRandom, HashSize, KeyMatLen) -> +%% %% RFC 4346 - 6.3. Key calculation +%% %% key_block = PRF(SecurityParameters.master_secret, +%% %% "key expansion", +%% %% SecurityParameters.server_random + +%% %% SecurityParameters.client_random); +%% %% Then the key_block is partitioned as follows: +%% %% client_write_MAC_secret[SecurityParameters.hash_size] +%% %% server_write_MAC_secret[SecurityParameters.hash_size] +%% %% client_write_key[SecurityParameters.key_material_length] +%% %% server_write_key[SecurityParameters.key_material_length] +%% WantedLength = 2 * (HashSize + KeyMatLen), +%% KeyBlock = prf(MasterSecret, "key expansion", +%% [ServerRandom, ClientRandom], WantedLength), +%% <<ClientWriteMacSecret:HashSize/binary, +%% ServerWriteMacSecret:HashSize/binary, +%% ClientWriteKey:KeyMatLen/binary, ServerWriteKey:KeyMatLen/binary>> +%% = KeyBlock, +%% {ClientWriteMacSecret, ServerWriteMacSecret, ClientWriteKey, +%% ServerWriteKey, undefined, undefined}. mac_hash(Method, Mac_write_secret, Seq_num, Type, {Major, Minor}, Length, Fragment) -> @@ -140,30 +139,18 @@ suites() -> %%?TLS_DHE_DSS_WITH_AES_256_CBC_SHA, ?TLS_RSA_WITH_AES_256_CBC_SHA, ?TLS_DHE_RSA_WITH_3DES_EDE_CBC_SHA, - %% ?TLS_DHE_DSS_WITH_3DES_EDE_CBC_SHA, + %%?TLS_DHE_DSS_WITH_3DES_EDE_CBC_SHA, ?TLS_RSA_WITH_3DES_EDE_CBC_SHA, ?TLS_DHE_RSA_WITH_AES_128_CBC_SHA, - %% ?TLS_DHE_DSS_WITH_AES_128_CBC_SHA, + %%?TLS_DHE_DSS_WITH_AES_128_CBC_SHA, ?TLS_RSA_WITH_AES_128_CBC_SHA, - %%?TLS_DHE_DSS_WITH_RC4_128_SHA, TODO: Support this? - %% ?TLS_RSA_WITH_IDEA_CBC_SHA, + %%?TLS_DHE_DSS_WITH_RC4_128_SHA, + %%?TLS_RSA_WITH_IDEA_CBC_SHA, ?TLS_RSA_WITH_RC4_128_SHA, ?TLS_RSA_WITH_RC4_128_MD5, - %%?TLS_RSA_EXPORT1024_WITH_RC4_56_MD5, - %%?TLS_RSA_EXPORT1024_WITH_RC2_CBC_56_MD5, - %%?TLS_RSA_EXPORT1024_WITH_DES_CBC_SHA, - %%?TLS_DHE_DSS_EXPORT1024_WITH_DES_CBC_SHA, - %%?TLS_RSA_EXPORT1024_WITH_RC4_56_SHA, - %%?TLS_DHE_DSS_EXPORT1024_WITH_RC4_56_SHA, - %%?TLS_DHE_DSS_WITH_RC4_128_SHA, - %%?TLS_DHE_RSA_WITH_DES_CBC_SHA, - %% EDH-DSS-DES-CBC-SHA TODO: ?? + ?TLS_DHE_RSA_WITH_DES_CBC_SHA, + %%TLS_DHE_DSS_WITH_3DES_EDE_CBC_SHA ?TLS_RSA_WITH_DES_CBC_SHA - %% ?TLS_DHE_RSA_EXPORT_WITH_DES40_CBC_SHA, - %% ?TLS_DHE_DSS_EXPORT_WITH_DES40_CBC_SHA, - %%?TLS_RSA_EXPORT_WITH_DES40_CBC_SHA, - %%?TLS_RSA_EXPORT_WITH_RC2_CBC_40_MD5, - %%?TLS_RSA_EXPORT_WITH_RC4_40_MD5 ]. %%-------------------------------------------------------------------- @@ -245,7 +232,3 @@ hash_final(?MD5, Conntext) -> crypto:md5_final(Conntext); hash_final(?SHA, Conntext) -> crypto:sha_final(Conntext). - - - - diff --git a/lib/ssl/test/ssl.cover b/lib/ssl/test/ssl.cover index 138bf96b9d..e8daa363c5 100644 --- a/lib/ssl/test/ssl.cover +++ b/lib/ssl/test/ssl.cover @@ -3,5 +3,17 @@ 'PKIX1Explicit88', 'PKIX1Implicit88', 'PKIXAttributeCertificate', - 'SSL-PKIX']}. + 'SSL-PKIX', + ssl_pem, + ssl_pkix, + ssl_base64, + ssl_broker, + ssl_broker_int, + ssl_broker_sup, + ssl_debug, + ssl_server, + ssl_prim, + inet_ssl_dist, + 'OTP-PKIX' + ]}. diff --git a/lib/ssl/test/ssl_basic_SUITE.erl b/lib/ssl/test/ssl_basic_SUITE.erl index 7f33efd7e1..ab0a394f93 100644 --- a/lib/ssl/test/ssl_basic_SUITE.erl +++ b/lib/ssl/test/ssl_basic_SUITE.erl @@ -27,13 +27,13 @@ -include("test_server.hrl"). -include("test_server_line.hrl"). -include_lib("public_key/include/public_key.hrl"). +-include("ssl_alert.hrl"). -define('24H_in_sec', 86400). -define(TIMEOUT, 60000). -define(EXPIRE, 10). -define(SLEEP, 500). - -behaviour(ssl_session_cache_api). %% For the session cache tests @@ -98,6 +98,37 @@ init_per_testcase(reuse_session_expired, Config0) -> ssl:start(), [{watchdog, Dog} | Config]; +init_per_testcase(no_authority_key_identifier, Config) -> + %% Clear cach so that root cert will not + %% be found. + ssl:stop(), + ssl:start(), + Config; + +init_per_testcase(TestCase, Config) when TestCase == ciphers_ssl3; + TestCase == ciphers_ssl3_openssl_names -> + ssl:stop(), + application:load(ssl), + application:set_env(ssl, protocol_version, sslv3), + ssl:start(), + Config; + +init_per_testcase(protocol_versions, Config) -> + ssl:stop(), + application:load(ssl), + %% For backwards compatibility sslv2 should be filtered out. + application:set_env(ssl, protocol_version, [sslv2, sslv3, tlsv1]), + ssl:start(), + Config; + +init_per_testcase(empty_protocol_versions, Config) -> + ssl:stop(), + application:load(ssl), + %% For backwards compatibility sslv2 should be filtered out. + application:set_env(ssl, protocol_version, []), + ssl:start(), + Config; + init_per_testcase(_TestCase, Config0) -> Config = lists:keydelete(watchdog, 1, Config0), Dog = test_server:timetrap(?TIMEOUT), @@ -130,6 +161,12 @@ end_per_testcase(session_cache_process_mnesia, Config) -> end_per_testcase(reuse_session_expired, Config) -> application:unset_env(ssl, session_lifetime), end_per_testcase(default_action, Config); +end_per_testcase(TestCase, Config) when TestCase == ciphers_ssl3; + TestCase == ciphers_ssl3_openssl_names; + TestCase == protocol_versions; + TestCase == empty_protocol_versions-> + application:unset_env(ssl, protocol_version), + end_per_testcase(default_action, Config); end_per_testcase(_TestCase, Config) -> Dog = ?config(watchdog, Config), case Dog of @@ -151,28 +188,31 @@ all(doc) -> ["Test the basic ssl functionality"]; all(suite) -> - [app, connection_info, controlling_process, controller_dies, - peercert, connect_dist, - peername, sockname, socket_options, misc_ssl_options, versions, cipher_suites, - upgrade, upgrade_with_timeout, tcp_connect, - ipv6, ekeyfile, ecertfile, ecacertfile, eoptions, shutdown, - shutdown_write, shutdown_both, shutdown_error, ciphers, - send_close, close_transport_accept, dh_params, - server_verify_peer_passive, - server_verify_peer_active, server_verify_peer_active_once, - server_verify_none_passive, server_verify_none_active, - server_verify_none_active_once, server_verify_no_cacerts, - server_require_peer_cert_ok, server_require_peer_cert_fail, - server_verify_client_once_passive, - server_verify_client_once_active, - server_verify_client_once_active_once, - client_verify_none_passive, - client_verify_none_active, client_verify_none_active_once - %%, session_cache_process_list, session_cache_process_mnesia - ,reuse_session, reuse_session_expired, server_does_not_want_to_reuse_session, - client_renegotiate, server_renegotiate, - client_no_wrap_sequence_number, server_no_wrap_sequence_number, - extended_key_usage, validate_extensions_fun + [app, alerts, connection_info, protocol_versions, + empty_protocol_versions, controlling_process, controller_dies, + client_closes_socket, peercert, connect_dist, peername, sockname, + socket_options, misc_ssl_options, versions, cipher_suites, + upgrade, upgrade_with_timeout, tcp_connect, ipv6, ekeyfile, + ecertfile, ecacertfile, eoptions, shutdown, shutdown_write, + shutdown_both, shutdown_error, ciphers, ciphers_ssl3, + ciphers_openssl_names, ciphers_ssl3_openssl_names, send_close, + close_transport_accept, dh_params, server_verify_peer_passive, + server_verify_peer_active, server_verify_peer_active_once, + server_verify_none_passive, server_verify_none_active, + server_verify_none_active_once, server_verify_no_cacerts, + server_require_peer_cert_ok, server_require_peer_cert_fail, + server_verify_client_once_passive, + server_verify_client_once_active, + server_verify_client_once_active_once, client_verify_none_passive, + client_verify_none_active, client_verify_none_active_once, + %session_cache_process_list, session_cache_process_mnesia, + reuse_session, reuse_session_expired, + server_does_not_want_to_reuse_session, client_renegotiate, + server_renegotiate, client_renegotiate_reused_session, + server_renegotiate_reused_session, client_no_wrap_sequence_number, + server_no_wrap_sequence_number, extended_key_usage, + validate_extensions_fun, no_authority_key_identifier, + invalid_signature_client, invalid_signature_server, cert_expired ]. %% Test cases starts here. @@ -183,7 +223,31 @@ app(suite) -> []; app(Config) when is_list(Config) -> ok = test_server:app_test(ssl). - +%%-------------------------------------------------------------------- +alerts(doc) -> + "Test ssl_alert:alert_txt/1"; +alerts(suite) -> + []; +alerts(Config) when is_list(Config) -> + Descriptions = [?CLOSE_NOTIFY, ?UNEXPECTED_MESSAGE, ?BAD_RECORD_MAC, + ?DECRYPTION_FAILED, ?RECORD_OVERFLOW, ?DECOMPRESSION_FAILURE, + ?HANDSHAKE_FAILURE, ?BAD_CERTIFICATE, ?UNSUPPORTED_CERTIFICATE, + ?CERTIFICATE_REVOKED,?CERTIFICATE_EXPIRED, ?CERTIFICATE_UNKNOWN, + ?ILLEGAL_PARAMETER, ?UNKNOWN_CA, ?ACCESS_DENIED, ?DECODE_ERROR, + ?DECRYPT_ERROR, ?EXPORT_RESTRICTION, ?PROTOCOL_VERSION, + ?INSUFFICIENT_SECURITY, ?INTERNAL_ERROR, ?USER_CANCELED, + ?NO_RENEGOTIATION], + Alerts = [?ALERT_REC(?WARNING, ?CLOSE_NOTIFY) | + [?ALERT_REC(?FATAL, Desc) || Desc <- Descriptions]], + lists:foreach(fun(Alert) -> + case ssl_alert:alert_txt(Alert) of + Txt when is_list(Txt) -> + ok; + Other -> + test_server:fail({unexpected, Other}) + end + end, Alerts). +%%-------------------------------------------------------------------- connection_info(doc) -> ["Test the API function ssl:connection_info/1"]; connection_info(suite) -> @@ -212,7 +276,7 @@ connection_info(Config) when is_list(Config) -> Version = ssl_record:protocol_version(ssl_record:highest_protocol_version([])), - ServerMsg = ClientMsg = {ok, {Version, {rsa,rc4_128,sha,no_export}}}, + ServerMsg = ClientMsg = {ok, {Version, {rsa,rc4_128,sha}}}, ssl_test_lib:check_result(Server, ServerMsg, Client, ClientMsg), @@ -224,6 +288,49 @@ connection_info_result(Socket) -> %%-------------------------------------------------------------------- +protocol_versions(doc) -> + ["Test to set a list of protocol versions in app environment."]; + +protocol_versions(suite) -> + []; + +protocol_versions(Config) when is_list(Config) -> + basic_test(Config). + +empty_protocol_versions(doc) -> + ["Test to set an empty list of protocol versions in app environment."]; + +empty_protocol_versions(suite) -> + []; + +empty_protocol_versions(Config) when is_list(Config) -> + basic_test(Config). + + +basic_test(Config) -> + ClientOpts = ?config(client_opts, Config), + ServerOpts = ?config(server_opts, Config), + + {ClientNode, ServerNode, Hostname} = ssl_test_lib:run_where(Config), + + Server = ssl_test_lib:start_server([{node, ServerNode}, {port, 0}, + {from, self()}, + {mfa, {?MODULE, send_recv_result_active, []}}, + {options, ServerOpts}]), + Port = ssl_test_lib:inet_port(Server), + Client = ssl_test_lib:start_client([{node, ClientNode}, {port, Port}, + {host, Hostname}, + {from, self()}, + {mfa, {?MODULE, send_recv_result_active, []}}, + {options, ClientOpts}]), + + ssl_test_lib:check_result(Server, ok, Client, ok), + + ssl_test_lib:close(Server), + ssl_test_lib:close(Client). + +%%-------------------------------------------------------------------- + controlling_process(doc) -> ["Test API function controlling_process/2"]; @@ -281,7 +388,7 @@ controlling_process_result(Socket, Pid, Msg) -> ssl:send(Socket, Msg), no_result_msg. - +%%-------------------------------------------------------------------- controller_dies(doc) -> ["Test that the socket is closed after controlling process dies"]; controller_dies(suite) -> []; @@ -322,6 +429,10 @@ controller_dies(Config) when is_list(Config) -> Connect = fun(Pid) -> {ok, Socket} = ssl:connect(Hostname, Port, [{reuseaddr,true},{ssl_imp,new}]), + %% Make sure server finishes and verification + %% and is in coonection state before + %% killing client + test_server:sleep(?SLEEP), Pid ! {self(), connected, Socket}, receive die_nice -> normal end end, @@ -393,6 +504,36 @@ get_close(Pid, Where) -> end. %%-------------------------------------------------------------------- +client_closes_socket(doc) -> + ["Test what happens when client closes socket before handshake is compleated"]; +client_closes_socket(suite) -> []; +client_closes_socket(Config) when is_list(Config) -> + ServerOpts = ?config(server_opts, Config), + {ClientNode, ServerNode, Hostname} = ssl_test_lib:run_where(Config), + TcpOpts = [binary, {reuseaddr, true}], + + Server = ssl_test_lib:start_upgrade_server_error([{node, ServerNode}, {port, 0}, + {from, self()}, + {tcp_options, TcpOpts}, + {ssl_options, ServerOpts}]), + Port = ssl_test_lib:inet_port(Server), + + Connect = fun() -> + {ok, _Socket} = rpc:call(ClientNode, gen_tcp, connect, + [Hostname, Port, TcpOpts]), + %% Make sure that ssl_accept is called before + %% client process ends and closes socket. + test_server:sleep(?SLEEP) + end, + + _Client = spawn_link(Connect), + + ssl_test_lib:check_result(Server, {error,closed}), + + ssl_test_lib:close(Server). + +%%-------------------------------------------------------------------- + peercert(doc) -> [""]; @@ -562,9 +703,12 @@ cipher_suites(suite) -> []; cipher_suites(Config) when is_list(Config) -> - MandatoryCipherSuite = {rsa,'3des_ede_cbc',sha,no_export}, + MandatoryCipherSuite = {rsa,'3des_ede_cbc',sha}, [_|_] = Suites = ssl:cipher_suites(), - true = lists:member(MandatoryCipherSuite, Suites). + true = lists:member(MandatoryCipherSuite, Suites), + Suites = ssl:cipher_suites(erlang), + [_|_] =ssl:cipher_suites(openssl). + %%-------------------------------------------------------------------- socket_options(doc) -> ["Test API function getopts/2 and setopts/2"]; @@ -599,9 +743,16 @@ socket_options(Config) when is_list(Config) -> {options, ClientOpts}]), ssl_test_lib:check_result(Server, ok, Client, ok), - + ssl_test_lib:close(Server), - ssl_test_lib:close(Client). + ssl_test_lib:close(Client), + + {ok, Listen} = ssl:listen(0, ServerOpts), + {ok,[{mode,list}]} = ssl:getopts(Listen, [mode]), + ok = ssl:setopts(Listen, [{mode, binary}]), + {ok,[{mode, binary}]} = ssl:getopts(Listen, [mode]), + {ok,[{recbuf, _}]} = ssl:getopts(Listen, [recbuf]), + ssl:close(Listen). socket_options_result(Socket, Options, DefaultValues, NewOptions, NewValues) -> %% Test get/set emulated opts @@ -610,6 +761,8 @@ socket_options_result(Socket, Options, DefaultValues, NewOptions, NewValues) -> {ok, NewValues} = ssl:getopts(Socket, NewOptions), %% Test get/set inet opts {ok,[{nodelay,false}]} = ssl:getopts(Socket, [nodelay]), + ssl:setopts(Socket, [{nodelay, true}]), + {ok,[{nodelay, true}]} = ssl:getopts(Socket, [nodelay]), ok. %%-------------------------------------------------------------------- @@ -630,7 +783,7 @@ misc_ssl_options(Config) when is_list(Config) -> {password, []}, {reuse_session, fun(_,_,_,_) -> true end}, {debug, []}, - {cb_info, {gen_tcp, tcp, tcp_closed}}], + {cb_info, {gen_tcp, tcp, tcp_closed, tcp_error}}], Server = ssl_test_lib:start_server([{node, ServerNode}, {port, 0}, @@ -796,11 +949,12 @@ upgrade(Config) when is_list(Config) -> TcpOpts = [binary, {reuseaddr, true}], Server = ssl_test_lib:start_upgrade_server([{node, ServerNode}, {port, 0}, - {from, self()}, - {mfa, {?MODULE, - upgrade_result, []}}, - {tcp_options, TcpOpts}, - {ssl_options, ServerOpts}]), + {from, self()}, + {mfa, {?MODULE, + upgrade_result, []}}, + {tcp_options, + [{active, false} | TcpOpts]}, + {ssl_options, ServerOpts}]), Port = ssl_test_lib:inet_port(Server), Client = ssl_test_lib:start_upgrade_client([{node, ClientNode}, {port, Port}, @@ -819,6 +973,7 @@ upgrade(Config) when is_list(Config) -> ssl_test_lib:close(Client). upgrade_result(Socket) -> + ssl:setopts(Socket, [{active, true}]), ok = ssl:send(Socket, "Hello world"), %% Make sure binary is inherited from tcp socket and that we do %% not get the list default! @@ -845,7 +1000,8 @@ upgrade_with_timeout(Config) when is_list(Config) -> {timeout, 5000}, {mfa, {?MODULE, upgrade_result, []}}, - {tcp_options, TcpOpts}, + {tcp_options, + [{active, false} | TcpOpts]}, {ssl_options, ServerOpts}]), Port = ssl_test_lib:inet_port(Server), Client = ssl_test_lib:start_upgrade_client([{node, ClientNode}, @@ -1233,9 +1389,9 @@ shutdown_error(Config) when is_list(Config) -> ok = ssl:close(Listen), {error, closed} = ssl:shutdown(Listen, read_write). -%%-------------------------------------------------------------------- +%%------------------------------------------------------------------- ciphers(doc) -> - [""]; + ["Test all ssl cipher suites in highest support ssl/tls version"]; ciphers(suite) -> []; @@ -1245,6 +1401,7 @@ ciphers(Config) when is_list(Config) -> ssl_record:protocol_version(ssl_record:highest_protocol_version([])), Ciphers = ssl:cipher_suites(), + test_server:format("tls1 erlang cipher suites ~p~n", [Ciphers]), Result = lists:map(fun(Cipher) -> cipher(Cipher, Version, Config) end, Ciphers), @@ -1255,7 +1412,74 @@ ciphers(Config) when is_list(Config) -> test_server:format("Cipher suite errors: ~p~n", [Error]), test_server:fail(cipher_suite_failed_see_test_case_log) end. - + +ciphers_ssl3(doc) -> + ["Test all ssl cipher suites in ssl3"]; + +ciphers_ssl3(suite) -> + []; + +ciphers_ssl3(Config) when is_list(Config) -> + Version = + ssl_record:protocol_version({3,0}), + + Ciphers = ssl:cipher_suites(), + test_server:format("ssl3 erlang cipher suites ~p~n", [Ciphers]), + Result = lists:map(fun(Cipher) -> + cipher(Cipher, Version, Config) end, + Ciphers), + case lists:flatten(Result) of + [] -> + ok; + Error -> + test_server:format("Cipher suite errors: ~p~n", [Error]), + test_server:fail(cipher_suite_failed_see_test_case_log) + end. + +ciphers_openssl_names(doc) -> + ["Test all ssl cipher suites in highest support ssl/tls version"]; + +ciphers_openssl_names(suite) -> + []; + +ciphers_openssl_names(Config) when is_list(Config) -> + Version = + ssl_record:protocol_version(ssl_record:highest_protocol_version([])), + + Ciphers = ssl:cipher_suites(openssl), + test_server:format("tls1 openssl cipher suites ~p~n", [Ciphers]), + Result = lists:map(fun(Cipher) -> + cipher(Cipher, Version, Config) end, + Ciphers), + case lists:flatten(Result) of + [] -> + ok; + Error -> + test_server:format("Cipher suite errors: ~p~n", [Error]), + test_server:fail(cipher_suite_failed_see_test_case_log) + end. + + +ciphers_ssl3_openssl_names(doc) -> + ["Test all ssl cipher suites in ssl3"]; + +ciphers_ssl3_openssl_names(suite) -> + []; + +ciphers_ssl3_openssl_names(Config) when is_list(Config) -> + Version = ssl_record:protocol_version({3,0}), + Ciphers = ssl:cipher_suites(openssl), + Result = lists:map(fun(Cipher) -> + cipher(Cipher, Version, Config) end, + Ciphers), + case lists:flatten(Result) of + [] -> + ok; + Error -> + test_server:format("Cipher suite errors: ~p~n", [Error]), + test_server:fail(cipher_suite_failed_see_test_case_log) + end. + cipher(CipherSuite, Version, Config) -> process_flag(trap_exit, true), test_server:format("Testing CipherSuite ~p~n", [CipherSuite]), @@ -1275,7 +1499,9 @@ cipher(CipherSuite, Version, Config) -> [{ciphers,[CipherSuite]} | ClientOpts]}]), - ServerMsg = ClientMsg = {ok, {Version, CipherSuite}}, + ErlangCipherSuite = erlang_cipher_suite(CipherSuite), + + ServerMsg = ClientMsg = {ok, {Version, ErlangCipherSuite}}, Result = ssl_test_lib:wait_for_result(Server, ServerMsg, Client, ClientMsg), @@ -1294,9 +1520,14 @@ cipher(CipherSuite, Version, Config) -> ok -> []; Error -> - [{CipherSuite, Error}] + [{ErlangCipherSuite, Error}] end. +erlang_cipher_suite(Suite) when is_list(Suite)-> + ssl_cipher:suite_definition(ssl_cipher:openssl_suite(Suite)); +erlang_cipher_suite(Suite) -> + Suite. + %%-------------------------------------------------------------------- reuse_session(doc) -> ["Test reuse of sessions (short handshake)"]; @@ -1884,7 +2115,6 @@ server_require_peer_cert_fail(Config) when is_list(Config) -> Server = ssl_test_lib:start_server_error([{node, ServerNode}, {port, 0}, {from, self()}, - {mfa, {?MODULE, no_result, []}}, {options, [{active, false} | ServerOpts]}]), Port = ssl_test_lib:inet_port(Server), @@ -1892,7 +2122,6 @@ server_require_peer_cert_fail(Config) when is_list(Config) -> Client = ssl_test_lib:start_client_error([{node, ClientNode}, {port, Port}, {host, Hostname}, {from, self()}, - {mfa, {?MODULE, no_result, []}}, {options, [{active, false} | BadClientOpts]}]), ssl_test_lib:check_result(Server, {error, esslaccept}, @@ -2076,6 +2305,76 @@ server_renegotiate(Config) when is_list(Config) -> ok. %%-------------------------------------------------------------------- +client_renegotiate_reused_session(doc) -> + ["Test ssl:renegotiate/1 on client when the ssl session will be reused."]; + +client_renegotiate_reused_session(suite) -> + []; + +client_renegotiate_reused_session(Config) when is_list(Config) -> + process_flag(trap_exit, true), + ServerOpts = ?config(server_opts, Config), + ClientOpts = ?config(client_opts, Config), + + {ClientNode, ServerNode, Hostname} = ssl_test_lib:run_where(Config), + + Data = "From erlang to erlang", + + Server = + ssl_test_lib:start_server([{node, ServerNode}, {port, 0}, + {from, self()}, + {mfa, {?MODULE, erlang_ssl_receive, [Data]}}, + {options, ServerOpts}]), + Port = ssl_test_lib:inet_port(Server), + + Client = ssl_test_lib:start_client([{node, ClientNode}, {port, Port}, + {host, Hostname}, + {from, self()}, + {mfa, {?MODULE, + renegotiate_reuse_session, [Data]}}, + {options, [{reuse_sessions, true} | ClientOpts]}]), + + ssl_test_lib:check_result(Client, ok, Server, ok), + + ssl_test_lib:close(Server), + ssl_test_lib:close(Client), + process_flag(trap_exit, false), + ok. +%%-------------------------------------------------------------------- +server_renegotiate_reused_session(doc) -> + ["Test ssl:renegotiate/1 on server when the ssl session will be reused."]; + +server_renegotiate_reused_session(suite) -> + []; + +server_renegotiate_reused_session(Config) when is_list(Config) -> + process_flag(trap_exit, true), + ServerOpts = ?config(server_opts, Config), + ClientOpts = ?config(client_opts, Config), + + {ClientNode, ServerNode, Hostname} = ssl_test_lib:run_where(Config), + + Data = "From erlang to erlang", + + Server = ssl_test_lib:start_server([{node, ServerNode}, {port, 0}, + {from, self()}, + {mfa, {?MODULE, + renegotiate_reuse_session, [Data]}}, + {options, ServerOpts}]), + Port = ssl_test_lib:inet_port(Server), + + Client = ssl_test_lib:start_client([{node, ClientNode}, {port, Port}, + {host, Hostname}, + {from, self()}, + {mfa, {?MODULE, erlang_ssl_receive, [Data]}}, + {options, [{reuse_sessions, true} | ClientOpts]}]), + + ssl_test_lib:check_result(Server, ok, Client, ok), + ssl_test_lib:close(Server), + ssl_test_lib:close(Client), + ok. + +%%-------------------------------------------------------------------- client_no_wrap_sequence_number(doc) -> ["Test that erlang client will renegotiate session when", "max sequence number celing is about to be reached. Although" @@ -2162,48 +2461,54 @@ extended_key_usage(suite) -> []; extended_key_usage(Config) when is_list(Config) -> - ClientOpts = ?config(client_opts, Config), - ServerOpts = ?config(server_opts, Config), + ClientOpts = ?config(client_verification_opts, Config), + ServerOpts = ?config(server_verification_opts, Config), PrivDir = ?config(priv_dir, Config), - CertFile = proplists:get_value(certfile, ServerOpts), - KeyFile = proplists:get_value(keyfile, ServerOpts), - NewCertFile = filename:join(PrivDir, "cert.pem"), - - {ok, [{cert, DerCert, _}]} = public_key:pem_to_der(CertFile), - + KeyFile = filename:join(PrivDir, "otpCA/private/key.pem"), {ok, [KeyInfo]} = public_key:pem_to_der(KeyFile), - {ok, Key} = public_key:decode_private_key(KeyInfo), - {ok, OTPCert} = public_key:pkix_decode_cert(DerCert, otp), - - ExtKeyUsageExt = {'Extension', ?'id-ce-extKeyUsage', true, [?'id-kp-serverAuth']}, - - OTPTbsCert = OTPCert#'OTPCertificate'.tbsCertificate, - - Extensions = OTPTbsCert#'OTPTBSCertificate'.extensions, - - NewOTPTbsCert = OTPTbsCert#'OTPTBSCertificate'{extensions = [ExtKeyUsageExt |Extensions]}, - - NewDerCert = public_key:sign(NewOTPTbsCert, Key), - - public_key:der_to_pem(NewCertFile, [{cert, NewDerCert}]), - - NewServerOpts = [{certfile, NewCertFile} | proplists:delete(certfile, ServerOpts)], + ServerCertFile = proplists:get_value(certfile, ServerOpts), + NewServerCertFile = filename:join(PrivDir, "server/new_cert.pem"), + {ok, [{cert, ServerDerCert, _}]} = public_key:pem_to_der(ServerCertFile), + {ok, ServerOTPCert} = public_key:pkix_decode_cert(ServerDerCert, otp), + ServerExtKeyUsageExt = {'Extension', ?'id-ce-extKeyUsage', true, [?'id-kp-serverAuth']}, + ServerOTPTbsCert = ServerOTPCert#'OTPCertificate'.tbsCertificate, + ServerExtensions = ServerOTPTbsCert#'OTPTBSCertificate'.extensions, + NewServerOTPTbsCert = ServerOTPTbsCert#'OTPTBSCertificate'{extensions = + [ServerExtKeyUsageExt | + ServerExtensions]}, + NewServerDerCert = public_key:sign(NewServerOTPTbsCert, Key), + public_key:der_to_pem(NewServerCertFile, [{cert, NewServerDerCert}]), + NewServerOpts = [{certfile, NewServerCertFile} | proplists:delete(certfile, ServerOpts)], + + ClientCertFile = proplists:get_value(certfile, ClientOpts), + NewClientCertFile = filename:join(PrivDir, "client/new_cert.pem"), + {ok, [{cert, ClientDerCert, _}]} = public_key:pem_to_der(ClientCertFile), + {ok, ClientOTPCert} = public_key:pkix_decode_cert(ClientDerCert, otp), + ClientExtKeyUsageExt = {'Extension', ?'id-ce-extKeyUsage', true, [?'id-kp-clientAuth']}, + ClientOTPTbsCert = ClientOTPCert#'OTPCertificate'.tbsCertificate, + ClientExtensions = ClientOTPTbsCert#'OTPTBSCertificate'.extensions, + NewClientOTPTbsCert = ClientOTPTbsCert#'OTPTBSCertificate'{extensions = + [ClientExtKeyUsageExt | + ClientExtensions]}, + NewClientDerCert = public_key:sign(NewClientOTPTbsCert, Key), + public_key:der_to_pem(NewClientCertFile, [{cert, NewClientDerCert}]), + NewClientOpts = [{certfile, NewClientCertFile} | proplists:delete(certfile, ClientOpts)], {ClientNode, ServerNode, Hostname} = ssl_test_lib:run_where(Config), Server = ssl_test_lib:start_server([{node, ServerNode}, {port, 0}, {from, self()}, {mfa, {?MODULE, send_recv_result_active, []}}, - {options, NewServerOpts}]), + {options, [{verify, verify_peer} | NewServerOpts]}]), Port = ssl_test_lib:inet_port(Server), Client = ssl_test_lib:start_client([{node, ClientNode}, {port, Port}, {host, Hostname}, {from, self()}, {mfa, {?MODULE, send_recv_result_active, []}}, - {options, ClientOpts}]), + {options, [{verify, verify_peer} | NewClientOpts]}]), ssl_test_lib:check_result(Server, ok, Client, ok), @@ -2246,6 +2551,217 @@ validate_extensions_fun(Config) when is_list(Config) -> ssl_test_lib:close(Client). %%-------------------------------------------------------------------- +no_authority_key_identifier(doc) -> + ["Test cert that does not have authorityKeyIdentifier extension"]; + +no_authority_key_identifier(suite) -> + []; +no_authority_key_identifier(Config) when is_list(Config) -> + ClientOpts = ?config(client_opts, Config), + ServerOpts = ?config(server_opts, Config), + PrivDir = ?config(priv_dir, Config), + + KeyFile = filename:join(PrivDir, "otpCA/private/key.pem"), + {ok, [KeyInfo]} = public_key:pem_to_der(KeyFile), + {ok, Key} = public_key:decode_private_key(KeyInfo), + + CertFile = proplists:get_value(certfile, ServerOpts), + NewCertFile = filename:join(PrivDir, "server/new_cert.pem"), + {ok, [{cert, DerCert, _}]} = public_key:pem_to_der(CertFile), + {ok, OTPCert} = public_key:pkix_decode_cert(DerCert, otp), + OTPTbsCert = OTPCert#'OTPCertificate'.tbsCertificate, + Extensions = OTPTbsCert#'OTPTBSCertificate'.extensions, + NewExtensions = delete_authority_key_extension(Extensions, []), + NewOTPTbsCert = OTPTbsCert#'OTPTBSCertificate'{extensions = NewExtensions}, + + test_server:format("Extensions ~p~n, NewExtensions: ~p~n", [Extensions, NewExtensions]), + + NewDerCert = public_key:sign(NewOTPTbsCert, Key), + public_key:der_to_pem(NewCertFile, [{cert, NewDerCert}]), + NewServerOpts = [{certfile, NewCertFile} | proplists:delete(certfile, ServerOpts)], + + {ClientNode, ServerNode, Hostname} = ssl_test_lib:run_where(Config), + + Server = ssl_test_lib:start_server([{node, ServerNode}, {port, 0}, + {from, self()}, + {mfa, {?MODULE, send_recv_result_active, []}}, + {options, NewServerOpts}]), + Port = ssl_test_lib:inet_port(Server), + Client = ssl_test_lib:start_client([{node, ClientNode}, {port, Port}, + {host, Hostname}, + {from, self()}, + {mfa, {?MODULE, send_recv_result_active, []}}, + {options, [{verify, verify_peer} | ClientOpts]}]), + + ssl_test_lib:check_result(Server, ok, Client, ok), + + ssl_test_lib:close(Server), + ssl_test_lib:close(Client). + +delete_authority_key_extension([], Acc) -> + lists:reverse(Acc); +delete_authority_key_extension([#'Extension'{extnID = ?'id-ce-authorityKeyIdentifier'} | Rest], + Acc) -> + delete_authority_key_extension(Rest, Acc); +delete_authority_key_extension([Head | Rest], Acc) -> + delete_authority_key_extension(Rest, [Head | Acc]). + +%%-------------------------------------------------------------------- + +invalid_signature_server(doc) -> + ["Test server with invalid signature"]; + +invalid_signature_server(suite) -> + []; + +invalid_signature_server(Config) when is_list(Config) -> + ClientOpts = ?config(client_opts, Config), + ServerOpts = ?config(server_verification_opts, Config), + PrivDir = ?config(priv_dir, Config), + + KeyFile = filename:join(PrivDir, "server/key.pem"), + {ok, [KeyInfo]} = public_key:pem_to_der(KeyFile), + {ok, Key} = public_key:decode_private_key(KeyInfo), + + ServerCertFile = proplists:get_value(certfile, ServerOpts), + NewServerCertFile = filename:join(PrivDir, "server/invalid_cert.pem"), + {ok, [{cert, ServerDerCert, _}]} = public_key:pem_to_der(ServerCertFile), + {ok, ServerOTPCert} = public_key:pkix_decode_cert(ServerDerCert, otp), + ServerOTPTbsCert = ServerOTPCert#'OTPCertificate'.tbsCertificate, + NewServerDerCert = public_key:sign(ServerOTPTbsCert, Key), + public_key:der_to_pem(NewServerCertFile, [{cert, NewServerDerCert}]), + NewServerOpts = [{certfile, NewServerCertFile} | proplists:delete(certfile, ServerOpts)], + + {ClientNode, ServerNode, Hostname} = ssl_test_lib:run_where(Config), + + Server = ssl_test_lib:start_server_error([{node, ServerNode}, {port, 0}, + {from, self()}, + {options, NewServerOpts}]), + Port = ssl_test_lib:inet_port(Server), + Client = ssl_test_lib:start_client_error([{node, ClientNode}, {port, Port}, + {host, Hostname}, + {from, self()}, + {options, [{verify, verify_peer} | ClientOpts]}]), + + ssl_test_lib:check_result(Server, {error, "bad certificate"}, + Client, {error,"bad certificate"}), + + ssl_test_lib:close(Server), + ssl_test_lib:close(Client). + +%%-------------------------------------------------------------------- + +invalid_signature_client(doc) -> + ["Test server with invalid signature"]; + +invalid_signature_client(suite) -> + []; + +invalid_signature_client(Config) when is_list(Config) -> + ClientOpts = ?config(client_verification_opts, Config), + ServerOpts = ?config(server_verification_opts, Config), + PrivDir = ?config(priv_dir, Config), + + KeyFile = filename:join(PrivDir, "client/key.pem"), + {ok, [KeyInfo]} = public_key:pem_to_der(KeyFile), + {ok, Key} = public_key:decode_private_key(KeyInfo), + + ClientCertFile = proplists:get_value(certfile, ClientOpts), + NewClientCertFile = filename:join(PrivDir, "client/invalid_cert.pem"), + {ok, [{cert, ClientDerCert, _}]} = public_key:pem_to_der(ClientCertFile), + {ok, ClientOTPCert} = public_key:pkix_decode_cert(ClientDerCert, otp), + ClientOTPTbsCert = ClientOTPCert#'OTPCertificate'.tbsCertificate, + NewClientDerCert = public_key:sign(ClientOTPTbsCert, Key), + public_key:der_to_pem(NewClientCertFile, [{cert, NewClientDerCert}]), + NewClientOpts = [{certfile, NewClientCertFile} | proplists:delete(certfile, ClientOpts)], + + {ClientNode, ServerNode, Hostname} = ssl_test_lib:run_where(Config), + + Server = ssl_test_lib:start_server_error([{node, ServerNode}, {port, 0}, + {from, self()}, + {options, [{verify, verify_peer} | ServerOpts]}]), + Port = ssl_test_lib:inet_port(Server), + Client = ssl_test_lib:start_client_error([{node, ClientNode}, {port, Port}, + {host, Hostname}, + {from, self()}, + {options, NewClientOpts}]), + + ssl_test_lib:check_result(Server, {error, "bad certificate"}, + Client, {error,"bad certificate"}), + + ssl_test_lib:close(Server), + ssl_test_lib:close(Client). + +%%-------------------------------------------------------------------- +cert_expired(doc) -> + ["Test server with invalid signature"]; + +cert_expired(suite) -> + []; + +cert_expired(Config) when is_list(Config) -> + ClientOpts = ?config(client_opts, Config), + ServerOpts = ?config(server_verification_opts, Config), + PrivDir = ?config(priv_dir, Config), + + KeyFile = filename:join(PrivDir, "otpCA/private/key.pem"), + {ok, [KeyInfo]} = public_key:pem_to_der(KeyFile), + {ok, Key} = public_key:decode_private_key(KeyInfo), + + ServerCertFile = proplists:get_value(certfile, ServerOpts), + NewServerCertFile = filename:join(PrivDir, "server/expired_cert.pem"), + {ok, [{cert, DerCert, _}]} = public_key:pem_to_der(ServerCertFile), + {ok, OTPCert} = public_key:pkix_decode_cert(DerCert, otp), + OTPTbsCert = OTPCert#'OTPCertificate'.tbsCertificate, + + {Year, Month, Day} = date(), + {Hours, Min, Sec} = time(), + NotBeforeStr = lists:flatten(io_lib:format("~p~s~s~s~s~sZ",[Year-2, + two_digits_str(Month), + two_digits_str(Day), + two_digits_str(Hours), + two_digits_str(Min), + two_digits_str(Sec)])), + NotAfterStr = lists:flatten(io_lib:format("~p~s~s~s~s~sZ",[Year-1, + two_digits_str(Month), + two_digits_str(Day), + two_digits_str(Hours), + two_digits_str(Min), + two_digits_str(Sec)])), + NewValidity = {'Validity', {generalTime, NotBeforeStr}, {generalTime, NotAfterStr}}, + + test_server:format("Validity: ~p ~n NewValidity: ~p ~n", + [OTPTbsCert#'OTPTBSCertificate'.validity, NewValidity]), + + NewOTPTbsCert = OTPTbsCert#'OTPTBSCertificate'{validity = NewValidity}, + NewServerDerCert = public_key:sign(NewOTPTbsCert, Key), + public_key:der_to_pem(NewServerCertFile, [{cert, NewServerDerCert}]), + NewServerOpts = [{certfile, NewServerCertFile} | proplists:delete(certfile, ServerOpts)], + + {ClientNode, ServerNode, Hostname} = ssl_test_lib:run_where(Config), + + Server = ssl_test_lib:start_server_error([{node, ServerNode}, {port, 0}, + {from, self()}, + {options, NewServerOpts}]), + Port = ssl_test_lib:inet_port(Server), + Client = ssl_test_lib:start_client_error([{node, ClientNode}, {port, Port}, + {host, Hostname}, + {from, self()}, + {options, [{verify, verify_peer} | ClientOpts]}]), + + ssl_test_lib:check_result(Server, {error, "certificate expired"}, + Client, {error, "certificate expired"}), + + ssl_test_lib:close(Server), + ssl_test_lib:close(Client). + + +two_digits_str(N) when N < 10 -> + lists:flatten(io_lib:format("0~p", [N])); +two_digits_str(N) -> + lists:flatten(io_lib:format("~p", [N])). + +%%-------------------------------------------------------------------- %%% Internal functions %%-------------------------------------------------------------------- send_recv_result(Socket) -> @@ -2278,14 +2794,14 @@ renegotiate(Socket, Data) -> case Result of ok -> ok; - %% It is not an error in erlang ssl - %% if peer rejects renegotiation. - %% Connection will stay up - {error, renegotiation_rejected} -> - ok; Other -> Other end. + +renegotiate_reuse_session(Socket, Data) -> + %% Make sure session is registerd + test_server:sleep(?SLEEP), + renegotiate(Socket, Data). session_cache_process_list(doc) -> ["Test reuse of sessions (short handshake)"]; diff --git a/lib/ssl/test/ssl_packet_SUITE.erl b/lib/ssl/test/ssl_packet_SUITE.erl index 1bcb9a657b..a019e660e9 100644 --- a/lib/ssl/test/ssl_packet_SUITE.erl +++ b/lib/ssl/test/ssl_packet_SUITE.erl @@ -42,7 +42,6 @@ -define(MANY, 1000). -define(SOME, 50). - %% Test server callback functions %%-------------------------------------------------------------------- %% Function: init_per_suite(Config) -> Config @@ -144,9 +143,20 @@ all(suite) -> packet_wait_passive, packet_wait_active, packet_baddata_passive, packet_baddata_active, packet_size_passive, packet_size_active, - packet_erl_decode, + packet_cdr_decode, packet_http_decode, - packet_http_bin_decode_multi + packet_http_decode_list, + packet_http_bin_decode_multi, + packet_line_decode, + packet_asn1_decode, + packet_tpkt_decode, + %packet_fcgi_decode, + packet_sunrm_decode, + header_decode_one_byte, + header_decode_two_bytes, + header_decode_two_bytes_one_sent, + header_decode_two_bytes_two_sent + ]. %% Test cases starts here. @@ -503,7 +513,8 @@ packet_raw_active_once_many_small(Config) when is_list(Config) -> Client = ssl_test_lib:start_client([{node, ServerNode}, {port, Port}, {host, Hostname}, {from, self()}, - {mfa, {?MODULE, active_once_raw, [Data, ?MANY]}}, + {mfa, {?MODULE, active_once_raw, + [Data, ?MANY]}}, {options, [{active, once}, {packet, raw} | ClientOpts]}]), @@ -535,7 +546,8 @@ packet_raw_active_once_some_big(Config) when is_list(Config) -> Client = ssl_test_lib:start_client([{node, ServerNode}, {port, Port}, {host, Hostname}, {from, self()}, - {mfa, {?MODULE, active_once_raw, [Data, ?SOME]}}, + {mfa, {?MODULE, active_once_raw, + [Data, ?SOME]}}, {options, [{active, once}, {packet, raw} | ClientOpts]}]), @@ -1191,7 +1203,8 @@ packet_send_to_large(Config) when is_list(Config) -> {mfa, {?MODULE, active_packet, [Data, 1]}}, {options, [{active, true} | ClientOpts]}]), - ssl_test_lib:check_result(Server, {error, {badarg, {packet_to_large, 300, 255}}}), + ssl_test_lib:check_result(Server, {error, {badarg, + {packet_to_large, 300, 255}}}), ssl_test_lib:close(Server), ssl_test_lib:close(Client). @@ -1216,7 +1229,8 @@ packet_wait_active(Config) when is_list(Config) -> Server = ssl_test_lib:start_server([{node, ClientNode}, {port, 0}, {from, self()}, - {mfa, {?MODULE, send_incomplete ,[Data, ?SOME]}}, + {mfa, {?MODULE, send_incomplete, + [Data, ?SOME]}}, {options, ServerOpts}]), Port = ssl_test_lib:inet_port(Server), Client = ssl_test_lib:start_client([{node, ServerNode}, {port, Port}, @@ -1251,7 +1265,8 @@ packet_wait_passive(Config) when is_list(Config) -> Server = ssl_test_lib:start_server([{node, ClientNode}, {port, 0}, {from, self()}, - {mfa, {?MODULE, send_incomplete ,[Data, ?SOME]}}, + {mfa, {?MODULE, send_incomplete, + [Data, ?SOME]}}, {options, ServerOpts}]), Port = ssl_test_lib:inet_port(Server), Client = ssl_test_lib:start_client([{node, ServerNode}, {port, Port}, @@ -1293,7 +1308,8 @@ packet_baddata_active(Config) when is_list(Config) -> {packet, cdr} | ClientOpts]}]), receive - {Client, {other, {ssl_error, _Socket, {invalid_packet, _}},{error,closed},1}} -> ok; + {Client, {other, {ssl_error, _Socket, + {invalid_packet, _}},{error,closed},1}} -> ok; Unexpected -> test_server:fail({unexpected, Unexpected}) end, @@ -1338,8 +1354,11 @@ packet_baddata_passive(Config) when is_list(Config) -> ssl_test_lib:close(Server), ssl_test_lib:close(Client). %%-------------------------------------------------------------------- + packet_size_active(doc) -> - ["Test that if a packet of size larger than packet_size arrives error msg is sent and socket is closed"]; + ["Test that if a packet of size larger than + packet_size arrives error msg is sent and socket is closed"]; + packet_size_active(suite) -> []; @@ -1363,7 +1382,8 @@ packet_size_active(Config) when is_list(Config) -> {packet, 4}, {packet_size, 10} | ClientOpts]}]), receive - {Client, {other, {ssl_error, _Socket, {invalid_packet, _}},{error,closed},1}} -> ok; + {Client, {other, {ssl_error, _Socket, + {invalid_packet, _}},{error,closed},1}} -> ok; Unexpected -> test_server:fail({unexpected, Unexpected}) end, @@ -1371,10 +1391,11 @@ packet_size_active(Config) when is_list(Config) -> ssl_test_lib:close(Server), ssl_test_lib:close(Client). %%-------------------------------------------------------------------- + packet_size_passive(doc) -> - ["Test that if a packet of size larger than packet_size arrives error msg is sent and socket is closed"]; -packet_size_passive(suite) -> - []; + ["Test that if a packet of size larger + than packet_size arrives error msg is sent and socket is closed"]; +packet_size_passive(suite) -> []; packet_size_passive(Config) when is_list(Config) -> ClientOpts = ?config(client_opts, Config), @@ -1391,7 +1412,8 @@ packet_size_passive(Config) when is_list(Config) -> Client = ssl_test_lib:start_client([{node, ServerNode}, {port, Port}, {host, Hostname}, {from, self()}, - {mfa, {?MODULE, passive_recv_packet, [Data, 1]}}, + {mfa, {?MODULE, passive_recv_packet, + [Data, 1]}}, {options, [{active, false}, {packet, 4}, {packet_size, 30} | ClientOpts]}]), @@ -1405,14 +1427,11 @@ packet_size_passive(Config) when is_list(Config) -> ssl_test_lib:close(Client). %%-------------------------------------------------------------------- -packet_erl_decode(doc) -> - ["Test that packets of sent to erlang:decode_packet works, i.e. currently" - "asn1 | cdr | sunrm | fcgi | tpkt | line | http | http_bin" - ]; -packet_erl_decode(suite) -> +packet_cdr_decode(doc) -> + ["Test setting the packet option {packet, cdr}"]; +packet_cdr_decode(suite) -> []; - -packet_erl_decode(Config) when is_list(Config) -> +packet_cdr_decode(Config) when is_list(Config) -> ClientOpts = ?config(client_opts, Config), ServerOpts = ?config(server_opts, Config), {ClientNode, ServerNode, Hostname} = ssl_test_lib:run_where(Config), @@ -1423,54 +1442,28 @@ packet_erl_decode(Config) when is_list(Config) -> Server = ssl_test_lib:start_server([{node, ClientNode}, {port, 0}, {from, self()}, - {mfa, {?MODULE, server_packet_decode ,[Data]}}, - {options, [{active, true}, binary, {packet, cdr}|ServerOpts]}]), + {mfa, {?MODULE, server_packet_decode, + [Data]}}, + {options, [{active, true}, binary, + {packet, cdr}|ServerOpts]}]), Port = ssl_test_lib:inet_port(Server), Client = ssl_test_lib:start_client([{node, ServerNode}, {port, Port}, {host, Hostname}, {from, self()}, - {mfa, {?MODULE, client_packet_decode, [Data]}}, - {options, [{active, true}, binary | ClientOpts]}]), + {mfa, {?MODULE, client_packet_decode, + [Data]}}, + {options, [{active, true}, {packet, cdr}, + binary | ClientOpts]}]), ssl_test_lib:check_result(Server, ok, Client, ok), ssl_test_lib:close(Server), ssl_test_lib:close(Client). - -server_packet_decode(Socket, CDR) -> - receive - {ssl, Socket, CDR} -> ok; - Other1 -> exit({?LINE, Other1}) - end, - ok = ssl:send(Socket, CDR), - receive - {ssl, Socket, CDR} -> ok; - Other2 -> exit({?LINE, Other2}) - end, - ok = ssl:send(Socket, CDR), - ok. - -client_packet_decode(Socket, CDR) -> - <<P1:10/binary, P2/binary>> = CDR, - ok = ssl:send(Socket, P1), - ok = ssl:send(Socket, P2), - receive - {ssl, Socket, CDR} -> ok; - Other1 -> exit({?LINE, Other1}) - end, - ssl:setopts(Socket, [{packet, cdr}]), - ok = ssl:send(Socket, CDR), - receive - {ssl, Socket, CDR} -> ok; - Other2 -> exit({?LINE, Other2}) - end, - ok. - %%-------------------------------------------------------------------- packet_http_decode(doc) -> - ["Test setting the packet option {packet, http}"]; + ["Test setting the packet option {packet, http} {mode, binary}"]; packet_http_decode(suite) -> []; @@ -1489,16 +1482,19 @@ packet_http_decode(Config) when is_list(Config) -> Server = ssl_test_lib:start_server([{node, ClientNode}, {port, 0}, {from, self()}, - {mfa, {?MODULE, server_http_decode, [Response]}}, - {options, [{active, true}, binary, {packet, http} | - ServerOpts]}]), + {mfa, {?MODULE, server_http_decode, + [Response]}}, + {options, [{active, true}, binary, + {packet, http} | ServerOpts]}]), Port = ssl_test_lib:inet_port(Server), Client = ssl_test_lib:start_client([{node, ServerNode}, {port, Port}, {host, Hostname}, {from, self()}, - {mfa, {?MODULE, client_http_decode, [Request]}}, - {options, [{active, true}, binary, {packet, http} | + {mfa, {?MODULE, client_http_decode, + [Request]}}, + {options, [{active, true}, binary, + {packet, http} | ClientOpts]}]), ssl_test_lib:check_result(Server, ok, Client, ok), @@ -1550,6 +1546,65 @@ client_http_decode(Socket, HttpRequest) -> ok. %%-------------------------------------------------------------------- +packet_http_decode_list(doc) -> + ["Test setting the packet option {packet, http}, {mode, list}"]; +packet_http_decode_list(suite) -> + []; +packet_http_decode_list(Config) when is_list(Config) -> + ClientOpts = ?config(client_opts, Config), + ServerOpts = ?config(server_opts, Config), + {ClientNode, ServerNode, Hostname} = ssl_test_lib:run_where(Config), + + Request = "GET / HTTP/1.1\r\n" + "host: www.example.com\r\n" + "user-agent: HttpTester\r\n" + "\r\n", + Response = "HTTP/1.1 200 OK\r\n" + "\r\n" + "Hello!", + + Server = ssl_test_lib:start_server([{node, ClientNode}, {port, 0}, + {from, self()}, + {mfa, {?MODULE, server_http_decode, + [Response]}}, + {options, [{active, true}, binary, + {packet, http} | + ServerOpts]}]), + + Port = ssl_test_lib:inet_port(Server), + Client = ssl_test_lib:start_client([{node, ServerNode}, {port, Port}, + {host, Hostname}, + {from, self()}, + {mfa, {?MODULE, client_http_decode_list, + [Request]}}, + {options, [{active, true}, list, + {packet, http} | + ClientOpts]}]), + + ssl_test_lib:check_result(Server, ok, Client, ok), + + ssl_test_lib:close(Server), + ssl_test_lib:close(Client). + + +client_http_decode_list(Socket, HttpRequest) -> + ok = ssl:send(Socket, HttpRequest), + receive + {ssl, Socket, {http_response, {1,1}, 200, "OK"}} -> ok; + Other1 -> exit({?LINE, Other1}) + end, + receive + {ssl, Socket, http_eoh} -> ok; + Other2 -> exit({?LINE, Other2}) + end, + ok = ssl:setopts(Socket, [{packet, 0}]), + receive + {ssl, Socket, "Hello!"} -> ok; + Other3 -> exit({?LINE, Other3}) + end, + ok. + +%%-------------------------------------------------------------------- packet_http_bin_decode_multi(doc) -> ["Test setting the packet option {packet, http_bin} with multiple requests"]; packet_http_bin_decode_multi(suite) -> @@ -1571,16 +1626,20 @@ packet_http_bin_decode_multi(Config) when is_list(Config) -> Server = ssl_test_lib:start_server([{node, ClientNode}, {port, 0}, {from, self()}, - {mfa, {?MODULE, server_http_bin_decode, [Response, NumMsgs]}}, - {options, [{active, true}, binary, {packet, http_bin} | + {mfa, {?MODULE, server_http_bin_decode, + [Response, NumMsgs]}}, + {options, [{active, true}, binary, + {packet, http_bin} | ServerOpts]}]), Port = ssl_test_lib:inet_port(Server), Client = ssl_test_lib:start_client([{node, ServerNode}, {port, Port}, {host, Hostname}, {from, self()}, - {mfa, {?MODULE, client_http_bin_decode, [Request, NumMsgs]}}, - {options, [{active, true}, binary, {packet, http_bin} | + {mfa, {?MODULE, client_http_bin_decode, + [Request, NumMsgs]}}, + {options, [{active, true}, binary, + {packet, http_bin} | ClientOpts]}]), ssl_test_lib:check_result(Server, ok, Client, ok), @@ -1635,6 +1694,344 @@ client_http_bin_decode(Socket, HttpRequest, Count) when Count > 0 -> client_http_bin_decode(Socket, HttpRequest, Count - 1); client_http_bin_decode(_, _, _) -> ok. +%%-------------------------------------------------------------------- +packet_line_decode(doc) -> + ["Test setting the packet option {packet, line}"]; +packet_line_decode(suite) -> + []; +packet_line_decode(Config) when is_list(Config) -> + ClientOpts = ?config(client_opts, Config), + ServerOpts = ?config(server_opts, Config), + {ClientNode, ServerNode, Hostname} = ssl_test_lib:run_where(Config), + + Data = list_to_binary(lists:flatten(io_lib:format("Line ends here.~n" + "Now it is a new line.~n", + []))), + + Server = ssl_test_lib:start_server([{node, ClientNode}, {port, 0}, + {from, self()}, + {mfa, {?MODULE, server_line_packet_decode, + [Data]}}, + {options, [{active, true}, binary, + {packet, line}|ServerOpts]}]), + + Port = ssl_test_lib:inet_port(Server), + Client = ssl_test_lib:start_client([{node, ServerNode}, {port, Port}, + {host, Hostname}, + {from, self()}, + {mfa, {?MODULE, client_line_packet_decode, + [Data]}}, + {options, [{active, true}, + {packet, line}, + binary | ClientOpts]}]), + + ssl_test_lib:check_result(Server, ok, Client, ok), + + ssl_test_lib:close(Server), + ssl_test_lib:close(Client). + + +server_line_packet_decode(Socket, Lines) -> + receive + {ssl, Socket, <<"Line ends here.\n">>} -> ok; + Other1 -> exit({?LINE, Other1}) + end, + receive + {ssl, Socket, <<"Now it is a new line.\n">>} -> ok; + Other2 -> exit({?LINE, Other2}) + end, + ok = ssl:send(Socket, Lines). + +client_line_packet_decode(Socket, Lines) -> + <<P1:10/binary, P2/binary>> = Lines, + ok = ssl:send(Socket, P1), + ok = ssl:send(Socket, P2), + receive + {ssl, Socket, <<"Line ends here.\n">>} -> ok; + Other1 -> exit({?LINE, Other1}) + end, + receive + {ssl, Socket, <<"Now it is a new line.\n">>} -> ok; + Other2 -> exit({?LINE, Other2}) + end. + +%%-------------------------------------------------------------------- + +packet_asn1_decode(doc) -> + ["Test setting the packet option {packet, asn1}"]; +packet_asn1_decode(suite) -> + []; +packet_asn1_decode(Config) when is_list(Config) -> + ClientOpts = ?config(client_opts, Config), + ServerOpts = ?config(server_opts, Config), + {ClientNode, ServerNode, Hostname} = ssl_test_lib:run_where(Config), + + File = proplists:get_value(certfile, ServerOpts), + + %% A valid asn1 BER packet (DER is stricter BER) + {ok,[{cert, Data, _}]} = public_key:pem_to_der(File), + + Server = ssl_test_lib:start_server([{node, ClientNode}, {port, 0}, + {from, self()}, + {mfa, {?MODULE, server_packet_decode, + [Data]}}, + {options, [{active, true}, binary, + {packet, asn1}|ServerOpts]}]), + + Port = ssl_test_lib:inet_port(Server), + Client = ssl_test_lib:start_client([{node, ServerNode}, {port, Port}, + {host, Hostname}, + {from, self()}, + {mfa, {?MODULE, client_packet_decode, + [Data]}}, + {options, [{active, true}, {packet, asn1}, + binary | ClientOpts]}]), + + ssl_test_lib:check_result(Server, ok, Client, ok), + + ssl_test_lib:close(Server), + ssl_test_lib:close(Client). + +%%-------------------------------------------------------------------- +packet_tpkt_decode(doc) -> + ["Test setting the packet option {packet, tpkt}"]; +packet_tpkt_decode(suite) -> + []; +packet_tpkt_decode(Config) when is_list(Config) -> + ClientOpts = ?config(client_opts, Config), + ServerOpts = ?config(server_opts, Config), + {ClientNode, ServerNode, Hostname} = ssl_test_lib:run_where(Config), + + Data = list_to_binary(add_tpkt_header("TPKT data")), + + + Server = ssl_test_lib:start_server([{node, ClientNode}, {port, 0}, + {from, self()}, + {mfa, {?MODULE, server_packet_decode, + [Data]}}, + {options, [{active, true}, binary, + {packet, tpkt}|ServerOpts]}]), + + Port = ssl_test_lib:inet_port(Server), + Client = ssl_test_lib:start_client([{node, ServerNode}, {port, Port}, + {host, Hostname}, + {from, self()}, + {mfa, {?MODULE, client_packet_decode, + [Data]}}, + {options, [{active, true}, {packet, tpkt}, + binary | ClientOpts]}]), + + ssl_test_lib:check_result(Server, ok, Client, ok), + + ssl_test_lib:close(Server), + ssl_test_lib:close(Client). + +%%-------------------------------------------------------------------- + +%% packet_fcgi_decode(doc) -> +%% ["Test setting the packet option {packet, fcgi}"]; +%% packet_fcgi_decode(suite) -> +%% []; +%% packet_fcgi_decode(Config) when is_list(Config) -> +%% ClientOpts = ?config(client_opts, Config), +%% ServerOpts = ?config(server_opts, Config), +%% {ClientNode, ServerNode, Hostname} = ssl_test_lib:run_where(Config), + +%% Data = ... + +%% Server = ssl_test_lib:start_server([{node, ClientNode}, {port, 0}, +%% {from, self()}, +%% {mfa, {?MODULE, server_packet_decode, +%% [Data0, Data1]}}, +%% {options, [{active, true}, binary, +%% {packet, fcgi}|ServerOpts]}]), + +%% Port = ssl_test_lib:inet_port(Server), +%% Client = ssl_test_lib:start_client([{node, ServerNode}, {port, Port}, +%% {host, Hostname}, +%% {from, self()}, +%% {mfa, {?MODULE, client_packet_decode, +%% [Data0, Data1]}}, +%% {options, [{active, true}, {packet, fcgi}, +%% binary | ClientOpts]}]), + +%% ssl_test_lib:check_result(Server, ok, Client, ok), + +%% ssl_test_lib:close(Server), +%% ssl_test_lib:close(Client). + + +%%-------------------------------------------------------------------- + +packet_sunrm_decode(doc) -> + ["Test setting the packet option {packet, sunrm}"]; +packet_sunrm_decode(suite) -> + []; +packet_sunrm_decode(Config) when is_list(Config) -> + ClientOpts = ?config(client_opts, Config), + ServerOpts = ?config(server_opts, Config), + {ClientNode, ServerNode, Hostname} = ssl_test_lib:run_where(Config), + + Data = <<11:32, "Hello world">>, + + Server = ssl_test_lib:start_server([{node, ClientNode}, {port, 0}, + {from, self()}, + {mfa, {?MODULE, server_packet_decode, + [Data]}}, + {options, [{active, true}, binary, + {packet, sunrm}|ServerOpts]}]), + + Port = ssl_test_lib:inet_port(Server), + Client = ssl_test_lib:start_client([{node, ServerNode}, {port, Port}, + {host, Hostname}, + {from, self()}, + {mfa, {?MODULE, client_packet_decode, + [Data]}}, + {options, [{active, true}, {packet, sunrm}, + binary | ClientOpts]}]), + + ssl_test_lib:check_result(Server, ok, Client, ok), + + ssl_test_lib:close(Server), + ssl_test_lib:close(Client). +%%-------------------------------------------------------------------- + +header_decode_one_byte(doc) -> + ["Test setting the packet option {header, 1}"]; +header_decode_one_byte(suite) -> + []; +header_decode_one_byte(Config) when is_list(Config) -> + ClientOpts = ?config(client_opts, Config), + ServerOpts = ?config(server_opts, Config), + {ClientNode, ServerNode, Hostname} = ssl_test_lib:run_where(Config), + + Data = <<11:8, "Hello world">>, + + Server = ssl_test_lib:start_server([{node, ClientNode}, {port, 0}, + {from, self()}, + {mfa, {?MODULE, server_header_decode, + [Data, [11 | <<"Hello world">>]]}}, + {options, [{active, true}, binary, + {header,1}|ServerOpts]}]), + + Port = ssl_test_lib:inet_port(Server), + Client = ssl_test_lib:start_client([{node, ServerNode}, {port, Port}, + {host, Hostname}, + {from, self()}, + {mfa, {?MODULE, client_header_decode, + [Data, [11 | <<"Hello world">> ]]}}, + {options, [{active, true}, {header, 1}, + binary | ClientOpts]}]), + + ssl_test_lib:check_result(Server, ok, Client, ok), + + ssl_test_lib:close(Server), + ssl_test_lib:close(Client). + +%%-------------------------------------------------------------------- + +header_decode_two_bytes(doc) -> + ["Test setting the packet option {header, 2}"]; +header_decode_two_bytes(suite) -> + []; +header_decode_two_bytes(Config) when is_list(Config) -> + ClientOpts = ?config(client_opts, Config), + ServerOpts = ?config(server_opts, Config), + {ClientNode, ServerNode, Hostname} = ssl_test_lib:run_where(Config), + + Data = <<11:8, "Hello world">>, + + Server = ssl_test_lib:start_server([{node, ClientNode}, {port, 0}, + {from, self()}, + {mfa, {?MODULE, server_header_decode, + [Data, [11, $H | <<"ello world">> ]]}}, + {options, [{active, true}, binary, + {header,2}|ServerOpts]}]), + + Port = ssl_test_lib:inet_port(Server), + Client = ssl_test_lib:start_client([{node, ServerNode}, {port, Port}, + {host, Hostname}, + {from, self()}, + {mfa, {?MODULE, client_header_decode, + [Data, [11, $H | <<"ello world">> ]]}}, + {options, [{active, true}, {header, 2}, + binary | ClientOpts]}]), + + ssl_test_lib:check_result(Server, ok, Client, ok), + + ssl_test_lib:close(Server), + ssl_test_lib:close(Client). + + +%%-------------------------------------------------------------------- + +header_decode_two_bytes_two_sent(doc) -> + ["Test setting the packet option {header, 2} and sending on byte"]; +header_decode_two_bytes_two_sent(suite) -> + []; +header_decode_two_bytes_two_sent(Config) when is_list(Config) -> + ClientOpts = ?config(client_opts, Config), + ServerOpts = ?config(server_opts, Config), + {ClientNode, ServerNode, Hostname} = ssl_test_lib:run_where(Config), + + Data = <<"He">>, + + Server = ssl_test_lib:start_server([{node, ClientNode}, {port, 0}, + {from, self()}, + {mfa, {?MODULE, server_header_decode, + [Data, [$H, $e | <<>> ]]}}, + {options, [{active, true}, binary, + {header,2}|ServerOpts]}]), + + Port = ssl_test_lib:inet_port(Server), + Client = ssl_test_lib:start_client([{node, ServerNode}, {port, Port}, + {host, Hostname}, + {from, self()}, + {mfa, {?MODULE, client_header_decode, + [Data, [$H, $e | <<>> ]]}}, + {options, [{active, true}, {header, 2}, + binary | ClientOpts]}]), + + ssl_test_lib:check_result(Server, ok, Client, ok), + + ssl_test_lib:close(Server), + ssl_test_lib:close(Client). + + +%%-------------------------------------------------------------------- + +header_decode_two_bytes_one_sent(doc) -> + ["Test setting the packet option {header, 2} and sending on byte"]; +header_decode_two_bytes_one_sent(suite) -> + []; +header_decode_two_bytes_one_sent(Config) when is_list(Config) -> + ClientOpts = ?config(client_opts, Config), + ServerOpts = ?config(server_opts, Config), + {ClientNode, ServerNode, Hostname} = ssl_test_lib:run_where(Config), + + Data = <<"H">>, + + Server = ssl_test_lib:start_server([{node, ClientNode}, {port, 0}, + {from, self()}, + {mfa, {?MODULE, server_header_decode, + [Data, "H"]}}, + {options, [{active, true}, binary, + {header,2}|ServerOpts]}]), + + Port = ssl_test_lib:inet_port(Server), + Client = ssl_test_lib:start_client([{node, ServerNode}, {port, Port}, + {host, Hostname}, + {from, self()}, + {mfa, {?MODULE, client_header_decode, + [Data, "H"]}}, + {options, [{active, true}, {header, 2}, + binary | ClientOpts]}]), + + ssl_test_lib:check_result(Server, ok, Client, ok), + + ssl_test_lib:close(Server), + ssl_test_lib:close(Client). + %%-------------------------------------------------------------------- %% Internal functions @@ -1744,3 +2141,61 @@ active_packet(Socket, Data, N) -> assert_packet_opt(Socket, Type) -> {ok, [{packet, Type}]} = ssl:getopts(Socket, [packet]). + +server_packet_decode(Socket, Packet) -> + receive + {ssl, Socket, Packet} -> ok; + Other1 -> exit({?LINE, Other1}) + end, + ok = ssl:send(Socket, Packet), + receive + {ssl, Socket, Packet} -> ok; + Other2 -> exit({?LINE, Other2}) + end, + ok = ssl:send(Socket, Packet). + +client_packet_decode(Socket, Packet) -> + <<P1:10/binary, P2/binary>> = Packet, + ok = ssl:send(Socket, P1), + ok = ssl:send(Socket, P2), + receive + {ssl, Socket, Packet} -> ok; + Other1 -> exit({?LINE, Other1}) + end, + ok = ssl:send(Socket, Packet), + receive + {ssl, Socket, Packet} -> ok; + Other2 -> exit({?LINE, Other2}) + end. + +server_header_decode(Socket, Packet, Result) -> + receive + {ssl, Socket, Result} -> ok; + Other1 -> exit({?LINE, Other1}) + end, + ok = ssl:send(Socket, Packet), + receive + {ssl, Socket, Result} -> ok; + Other2 -> exit({?LINE, Other2}) + end, + ok = ssl:send(Socket, Packet). + +client_header_decode(Socket, Packet, Result) -> + ok = ssl:send(Socket, Packet), + receive + {ssl, Socket, Result} -> ok; + Other1 -> exit({?LINE, Other1}) + end, + ok = ssl:send(Socket, Packet), + receive + {ssl, Socket, Result} -> ok; + Other2 -> exit({?LINE, Other2}) + end. + +add_tpkt_header(Data) when is_binary(Data) -> + L = size(Data) + 4, + [3, 0, ((L) bsr 8) band 16#ff, (L) band 16#ff ,Data]; +add_tpkt_header(IOList) when is_list(IOList) -> + Binary = list_to_binary(IOList), + L = size(Binary) + 4, + [3, 0, ((L) bsr 8) band 16#ff, (L) band 16#ff , Binary]. diff --git a/lib/ssl/test/ssl_test_lib.erl b/lib/ssl/test/ssl_test_lib.erl index 00c5350ad0..46b6eb401d 100644 --- a/lib/ssl/test/ssl_test_lib.erl +++ b/lib/ssl/test/ssl_test_lib.erl @@ -394,6 +394,41 @@ run_upgrade_client(Opts) -> ok = rpc:call(Node, ssl, close, [SslSocket]) end. +start_upgrade_server_error(Args) -> + Result = spawn_link(?MODULE, run_upgrade_server_error, [Args]), + receive + {listen, up} -> + Result + end. + +run_upgrade_server_error(Opts) -> + Node = proplists:get_value(node, Opts), + Port = proplists:get_value(port, Opts), + TimeOut = proplists:get_value(timeout, Opts, infinity), + TcpOptions = proplists:get_value(tcp_options, Opts), + SslOptions = proplists:get_value(ssl_options, Opts), + Pid = proplists:get_value(from, Opts), + + test_server:format("gen_tcp:listen(~p, ~p)~n", [Port, TcpOptions]), + {ok, ListenSocket} = rpc:call(Node, gen_tcp, listen, [Port, TcpOptions]), + Pid ! {listen, up}, + send_selected_port(Pid, Port, ListenSocket), + test_server:format("gen_tcp:accept(~p)~n", [ListenSocket]), + {ok, AcceptSocket} = rpc:call(Node, gen_tcp, accept, [ListenSocket]), + Error = case TimeOut of + infinity -> + test_server:format("ssl:ssl_accept(~p, ~p)~n", + [AcceptSocket, SslOptions]), + rpc:call(Node, ssl, ssl_accept, + [AcceptSocket, SslOptions]); + _ -> + test_server:format("ssl:ssl_accept(~p, ~p, ~p)~n", + [AcceptSocket, SslOptions, TimeOut]), + rpc:call(Node, ssl, ssl_accept, + [AcceptSocket, SslOptions, TimeOut]) + end, + Pid ! {self(), Error}. + start_server_error(Args) -> Result = spawn_link(?MODULE, run_server_error, [Args]), receive diff --git a/lib/ssl/test/ssl_to_openssl_SUITE.erl b/lib/ssl/test/ssl_to_openssl_SUITE.erl index cbf0447bf0..82073c0735 100644 --- a/lib/ssl/test/ssl_to_openssl_SUITE.erl +++ b/lib/ssl/test/ssl_to_openssl_SUITE.erl @@ -33,6 +33,7 @@ -define(OPENSSL_RENEGOTIATE, "r\n"). -define(OPENSSL_QUIT, "Q\n"). -define(OPENSSL_GARBAGE, "P\n"). +-define(EXPIRE, 10). %% Test server callback functions %%-------------------------------------------------------------------- @@ -81,11 +82,29 @@ end_per_suite(_Config) -> %% variable, but should NOT alter/remove any existing entries. %% Description: Initialization before each test case %%-------------------------------------------------------------------- -init_per_testcase(_TestCase, Config0) -> +init_per_testcase(expired_session, Config0) -> + Config = lists:keydelete(watchdog, 1, Config0), + Dog = ssl_test_lib:timetrap(?EXPIRE * 1000 * 5), + ssl:stop(), + application:load(ssl), + application:set_env(ssl, session_lifetime, ?EXPIRE), + ssl:start(), + [{watchdog, Dog} | Config]; + +init_per_testcase(TestCase, Config0) -> Config = lists:keydelete(watchdog, 1, Config0), Dog = ssl_test_lib:timetrap(?TIMEOUT), - [{watchdog, Dog} | Config]. + special_init(TestCase, [{watchdog, Dog} | Config]). +special_init(TestCase, Config) + when TestCase == erlang_client_openssl_server_renegotiate; + TestCase == erlang_client_openssl_server_no_wrap_sequence_number; + TestCase == erlang_server_openssl_client_no_wrap_sequence_number -> + check_sane_openssl_renegotaite(Config); + +special_init(_, Config) -> + Config. + %%-------------------------------------------------------------------- %% Function: end_per_testcase(TestCase, Config) -> _ %% Case - atom() @@ -94,14 +113,20 @@ init_per_testcase(_TestCase, Config0) -> %% A list of key/value pairs, holding the test case configuration. %% Description: Cleanup after each test case %%-------------------------------------------------------------------- -end_per_testcase(_TestCase, Config) -> +end_per_testcase(reuse_session_expired, Config) -> + application:unset_env(ssl, session_lifetime), + end_per_testcase(default_action, Config); + +end_per_testcase(default_action, Config) -> Dog = ?config(watchdog, Config), case Dog of undefined -> ok; _ -> test_server:timetrap_cancel(Dog) - end. + end; +end_per_testcase(_, Config) -> + end_per_testcase(default_action, Config). %%-------------------------------------------------------------------- %% Function: all(Clause) -> TestCases @@ -133,7 +158,9 @@ all(suite) -> tls1_erlang_server_openssl_client_client_cert, tls1_erlang_server_erlang_client_client_cert, ciphers, - erlang_client_bad_openssl_server + erlang_client_bad_openssl_server, + expired_session, + ssl2_erlang_server_openssl_client ]. %% Test cases starts here. @@ -297,12 +324,8 @@ erlang_client_openssl_server_renegotiate(Config) when is_list(Config) -> test_server:sleep(?SLEEP), port_command(OpensslPort, OpenSslData), - %%ssl_test_lib:check_result(Client, ok), - %% Currently allow test case to not fail - %% if server requires secure renegotiation from RFC-5746 - %% This should be removed as soon as we have implemented it. - ssl_test_lib:check_result_ignore_renegotiation_reject(Client, ok), - + ssl_test_lib:check_result(Client, ok), + %% Clean close down! Server needs to be closed first !! close_port(OpensslPort), @@ -350,11 +373,7 @@ erlang_client_openssl_server_no_wrap_sequence_number(Config) when is_list(Config {options, [{reuse_sessions, false}, {renegotiate_at, N} | ClientOpts]}]), - %%ssl_test_lib:check_result(Client, ok), - %% Currently allow test case to not fail - %% if server requires secure renegotiation from RFC-5746 - %% This should be removed as soon as we have implemented it. - ssl_test_lib:check_result_ignore_renegotiation_reject(Client, ok), + ssl_test_lib:check_result(Client, ok), %% Clean close down! Server needs to be closed first !! close_port(OpensslPort), @@ -958,7 +977,7 @@ erlang_client_bad_openssl_server(Config) when is_list(Config) -> wait_for_openssl_server(), - Client = ssl_test_lib:start_client([{node, ClientNode}, {port, Port}, + Client0 = ssl_test_lib:start_client([{node, ClientNode}, {port, Port}, {host, Hostname}, {from, self()}, {mfa, {?MODULE, server_sent_garbage, []}}, @@ -970,15 +989,120 @@ erlang_client_bad_openssl_server(Config) when is_list(Config) -> test_server:sleep(?SLEEP), - Client ! server_sent_garbage, + Client0 ! server_sent_garbage, + + ssl_test_lib:check_result(Client0, true), + + ssl_test_lib:close(Client0), + + %% Make sure openssl does not hang and leave zombie process + Client1 = ssl_test_lib:start_client([{node, ClientNode}, {port, Port}, + {host, Hostname}, + {from, self()}, + {mfa, {ssl_test_lib, no_result_msg, []}}, + {options, + [{versions, [tlsv1]} | ClientOpts]}]), + + ssl_test_lib:close(Client1), + + %% Clean close down! + close_port(OpensslPort), + process_flag(trap_exit, false), + ok. + +%%-------------------------------------------------------------------- - ssl_test_lib:check_result(Client, true), +expired_session(doc) -> + ["Test our ssl client handling of expired sessions. Will make" + "better code coverage of the ssl_manager module"]; + +expired_session(suite) -> + []; + +expired_session(Config) when is_list(Config) -> + process_flag(trap_exit, true), + ClientOpts = ?config(client_opts, Config), + ServerOpts = ?config(server_opts, Config), + {ClientNode, _, Hostname} = ssl_test_lib:run_where(Config), + + Port = ssl_test_lib:inet_port(node()), + CertFile = proplists:get_value(certfile, ServerOpts), + KeyFile = proplists:get_value(keyfile, ServerOpts), + + Cmd = "openssl s_server -accept " ++ integer_to_list(Port) ++ + " -cert " ++ CertFile ++ " -key " ++ KeyFile ++ "", + + test_server:format("openssl cmd: ~p~n", [Cmd]), + + OpensslPort = open_port({spawn, Cmd}, [stderr_to_stdout]), + + wait_for_openssl_server(), + + Client0 = + ssl_test_lib:start_client([{node, ClientNode}, + {port, Port}, {host, Hostname}, + {mfa, {ssl_test_lib, no_result, []}}, + {from, self()}, {options, ClientOpts}]), + + ssl_test_lib:close(Client0), + + %% Make sure session is registered + test_server:sleep(?SLEEP), + + Client1 = + ssl_test_lib:start_client([{node, ClientNode}, + {port, Port}, {host, Hostname}, + {mfa, {ssl_test_lib, no_result, []}}, + {from, self()}, {options, ClientOpts}]), + + ssl_test_lib:close(Client1), + %% Make sure session is unregistered due to expiration + test_server:sleep((?EXPIRE+1) * 1000), + + Client2 = + ssl_test_lib:start_client([{node, ClientNode}, + {port, Port}, {host, Hostname}, + {mfa, {ssl_test_lib, no_result, []}}, + {from, self()}, {options, ClientOpts}]), - ssl_test_lib:close(Client), - %% Clean close down! close_port(OpensslPort), + ssl_test_lib:close(Client2), + process_flag(trap_exit, false). + +%%-------------------------------------------------------------------- +ssl2_erlang_server_openssl_client(doc) -> + ["Test that ssl v2 clients are rejected"]; +ssl2_erlang_server_openssl_client(suite) -> + []; +ssl2_erlang_server_openssl_client(Config) when is_list(Config) -> + process_flag(trap_exit, true), + ServerOpts = ?config(server_opts, Config), + + {_, ServerNode, _} = ssl_test_lib:run_where(Config), + + Data = "From openssl to erlang", + + Server = ssl_test_lib:start_server_error([{node, ServerNode}, {port, 0}, + {from, self()}, + {options, ServerOpts}]), + Port = ssl_test_lib:inet_port(Server), + + Cmd = "openssl s_client -port " ++ integer_to_list(Port) ++ + " -host localhost -ssl2 -msg", + + test_server:format("openssl cmd: ~p~n", [Cmd]), + + OpenSslPort = open_port({spawn, Cmd}, [stderr_to_stdout]), + port_command(OpenSslPort, Data), + + ssl_test_lib:check_result(Server, {error,"protocol version"}), + + ssl_test_lib:close(Server), + + close_port(OpenSslPort), process_flag(trap_exit, false), ok. + %%-------------------------------------------------------------------- erlang_ssl_receive(Socket, Data) -> @@ -1055,6 +1179,7 @@ server_sent_garbage(Socket) -> receive server_sent_garbage -> {error, closed} == ssl:send(Socket, "data") + end. wait_for_openssl_server() -> @@ -1068,3 +1193,10 @@ wait_for_openssl_server() -> test_server:sleep(?SLEEP) end. +check_sane_openssl_renegotaite(Config) -> + case os:cmd("openssl version") of + "OpenSSL 0.9.8l" ++ _ -> + {skip, "Known renegotiation bug in OppenSSL"}; + _ -> + Config + end. diff --git a/lib/ssl/vsn.mk b/lib/ssl/vsn.mk index 337ea4b380..e3db7008e3 100644 --- a/lib/ssl/vsn.mk +++ b/lib/ssl/vsn.mk @@ -17,14 +17,18 @@ # %CopyrightEnd% # -SSL_VSN = 3.11 - -TICKETS = OTP-8517 \ - OTP-7046 \ - OTP-8557 \ - OTP-8560 \ - OTP-8545 \ - OTP-8554 +SSL_VSN = 3.11.1 + +TICKETS = OTP-8588 \ + OTP-8568 \ + OTP-7049 + +#TICKETS_3.11 = OTP-8517 \ +# OTP-7046 \ +# OTP-8557 \ +# OTP-8560 \ +# OTP-8545 \ +# OTP-8554 #TICKETS_3.10.9 = OTP-8510 diff --git a/lib/stdlib/doc/src/Makefile b/lib/stdlib/doc/src/Makefile index 13b9b2ff18..b558697d63 100644 --- a/lib/stdlib/doc/src/Makefile +++ b/lib/stdlib/doc/src/Makefile @@ -1,19 +1,19 @@ # # %CopyrightBegin% -# -# Copyright Ericsson AB 1997-2009. All Rights Reserved. -# +# +# Copyright Ericsson AB 1997-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% # include $(ERL_TOP)/make/target.mk @@ -40,6 +40,7 @@ XML_REF3_FILES = \ array.xml \ base64.xml \ beam_lib.xml \ + binary.xml \ c.xml \ calendar.xml \ dets.xml \ diff --git a/lib/stdlib/doc/src/beam_lib.xml b/lib/stdlib/doc/src/beam_lib.xml index b9286f1402..27308e02f3 100644 --- a/lib/stdlib/doc/src/beam_lib.xml +++ b/lib/stdlib/doc/src/beam_lib.xml @@ -347,9 +347,10 @@ chunkref() = chunkname() | chunkid()</code> </type> <desc> <p>Compares the contents of two BEAM files. If the module names - are the same, and the chunks with the identifiers - <c>"Code"</c>, <c>"ExpT"</c>, <c>"ImpT"</c>, <c>"StrT"</c>, - and <c>"Atom"</c> have the same contents in both files, + are the same, and all chunks except for the <c>"CInf"</c> chunk + (the chunk containing the compilation information which is + returned by <c>Module:module_info(compile)</c>) + have the same contents in both files, <c>ok</c> is returned. Otherwise an error message is returned.</p> </desc> </func> diff --git a/lib/stdlib/doc/src/binary.xml b/lib/stdlib/doc/src/binary.xml new file mode 100644 index 0000000000..c5eb81a86a --- /dev/null +++ b/lib/stdlib/doc/src/binary.xml @@ -0,0 +1,729 @@ +<?xml version="1.0" encoding="latin1" ?> +<!DOCTYPE erlref SYSTEM "erlref.dtd"> + +<erlref> + <header> + <copyright> + <year>2009</year> + <year>2010</year> + <holder>Ericsson AB, All Rights Reserved</holder> + </copyright> + <legalnotice> + 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 on line 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. + + The Initial Developer of the Original Code is Ericsson AB. + </legalnotice> + + <title>binary</title> + <prepared>Patrik Nyblom</prepared> + <responsible>Kenneth Lundin</responsible> + <docno>1</docno> + <approved></approved> + <checked></checked> + <date>2010-05-05</date> + <rev>A</rev> + <file>binary.xml</file> + </header> + <module>binary</module> + <modulesummary>Library for handling binary data</modulesummary> + <description> + + <p>This module contains functions for manipulating byte-oriented + binaries. Although the majority of functions could be implemented + using bit-syntax, the functions in this library are highly + optimized and are expected to either execute faster or consume + less memory (or both) than a counterpart written in pure Erlang.</p> + + <p>The module is implemented according to the EEP (Erlang Enhancement Proposal) 31.</p> + + <note> + <p> + The library handles byte-oriented data. Bitstrings that are not + binaries (does not contain whole octets of bits) will result in a <c>badarg</c> + exception being thrown from any of the functions in this + module. + </p> + </note> + + + </description> + <section> + <title>DATA TYPES</title> + <code type="none"> + cp() + - Opaque data-type representing a compiled search-pattern. Guaranteed to be a tuple() + to allow programs to distinguish it from non precompiled search patterns. + </code> + <code type="none"> + part() = {Start,Length} + Start = int() + Length = int() + - A representaion of a part (or range) in a binary. Start is a + zero-based offset into a binary() and Length is the length of + that part. As input to functions in this module, a reverse + part specification is allowed, constructed with a negative + Length, so that the part of the binary begins at Start + + Length and is -Length long. This is useful for referencing the + last N bytes of a binary as {size(Binary), -N}. The functions + in this module always return part()'s with positive Length. + </code> + </section> + <funcs> + <func> + <name>at(Subject, Pos) -> int()</name> + <fsummary>Returns the byte at a specific position in a binary</fsummary> + <type> + <v>Subject = binary()</v> + <v>Pos = int() >= 0</v> + </type> + <desc> + + <p>Returns the byte at position <c>Pos</c> (zero-based) in the binary + <c>Subject</c> as an integer. If <c>Pos</c> >= <c>byte_size(Subject)</c>, + a <c>badarg</c> + exception is raised.</p> + + </desc> + </func> + <func> + <name>bin_to_list(Subject) -> list()</name> + <fsummary>Convert a binary to a list of integers</fsummary> + <type> + <v>Subject = binary()</v> + </type> + <desc> + <p>The same as <c>bin_to_list(Subject,{0,byte_size(Subject)})</c>.</p> + </desc> + </func> + <func> + <name>bin_to_list(Subject, PosLen) -> list()</name> + <fsummary>Convert a binary to a list of integers</fsummary> + <type> + <v>Subject = binary()</v> + <v>PosLen = part()</v> + </type> + <desc> + + <p>Converts <c>Subject</c> to a list of <c>int()</c>s, each representing + the value of one byte. The <c>part()</c> denotes which part of the + <c>binary()</c> to convert. Example:</p> + +<code> +1> binary:bin_to_list(<<"erlang">>,{1,3}). +"rla" +%% or [114,108,97] in list notation. +</code> + <p>If <c>PosLen</c> in any way references outside the binary, a <c>badarg</c> exception is raised.</p> + </desc> + </func> + <func> + <name>bin_to_list(Subject, Pos, Len) -> list()</name> + <fsummary>Convert a binary to a list of integers</fsummary> + <type> + <v>Subject = binary()</v> + <v>Pos = int()</v> + <v>Len = int()</v> + </type> + <desc> + <p>The same as<c> bin_to_list(Subject,{Pos,Len})</c>.</p> + </desc> + </func> + <func> + <name>compile_pattern(Pattern) -> cp()</name> + <fsummary>Pre-compiles a binary search pattern</fsummary> + <type> + <v>Pattern = binary() | [ binary() ]</v> + </type> + <desc> + + <p>Builds an internal structure representing a compilation of a + search-pattern, later to be used in the <seealso marker="#match-3">match/3</seealso>, + <seealso marker="#matches-3">matches/3</seealso>, + <seealso marker="#split-3">split/3</seealso> or + <seealso marker="#replace-4">replace/4</seealso> + functions. The <c>cp()</c> returned is guaranteed to be a + <c>tuple()</c> to allow programs to distinguish it from non + pre-compiled search patterns</p> + + <p>When a list of binaries is given, it denotes a set of + alternative binaries to search for. I.e if + <c>[<<"functional">>,<<"programming">>]</c> + is given as <c>Pattern</c>, this + means "either <c><<"functional">></c> or + <c><<"programming">></c>". The pattern is a set of + alternatives; when only a single binary is given, the set has + only one element. The order of alternatives in a pattern is not significant.</p> + + <p>The list of binaries used for search alternatives shall be flat and proper.</p> + + <p>If <c>Pattern</c> is not a binary or a flat proper list of binaries with length > 0, + a <c>badarg</c> exception will be raised.</p> + + </desc> + </func> + <func> + <name>copy(Subject) -> binary()</name> + <fsummary>Creates a duplicate of a binary</fsummary> + <type> + <v>Subject = binary()</v> + </type> + <desc> + <p>The same as <c>copy(Subject, 1)</c>.</p> + </desc> + </func> + <func> + <name>copy(Subject,N) -> binary()</name> + <fsummary>Duplicates a binary N times and creates a new</fsummary> + <type> + <v>Subject = binary()</v> + <v>N = int() >= 0</v> + </type> + <desc> + <p>Creates a binary with the content of <c>Subject</c> duplicated <c>N</c> times.</p> + + <p>This function will always create a new binary, even if <c>N = + 1</c>. By using <c>copy/1</c> on a binary referencing a larger binary, one + might free up the larger binary for garbage collection.</p> + + <note> + <p>By deliberately copying a single binary to avoid referencing + a larger binary, one might, instead of freeing up the larger + binary for later garbage collection, create much more binary + data than needed. Sharing binary data is usually good. Only in + special cases, when small parts reference large binaries and the + large binaries are no longer used in any process, deliberate + copying might be a good idea.</p> </note> + + <p>If <c>N</c> < <c>0</c>, a <c>badarg</c> exception is raised.</p> + </desc> + </func> + <func> + <name>decode_unsigned(Subject) -> Unsigned</name> + <fsummary>Decode a whole binary into an integer of arbitrary size</fsummary> + <type> + <v>Subject = binary()</v> + <v>Unsigned = int() >= 0</v> + </type> + <desc> + <p>The same as <c>decode_unsigned(Subject,big)</c>.</p> + </desc> + </func> + <func> + <name>decode_unsigned(Subject, Endianess) -> Unsigned</name> + <fsummary>Decode a whole binary into an integer of arbitrary size</fsummary> + <type> + <v>Subject = binary()</v> + <v>Endianess = big | little</v> + <v>Unsigned = int() >= 0</v> + </type> + <desc> + + <p>Converts the binary digit representation, in big or little + endian, of a positive integer in <c>Subject</c> to an Erlang <c>int()</c>.</p> + + <p>Example:</p> + + <code> +1> binary:decode_unsigned(<<169,138,199>>,big). +11111111 + </code> + </desc> + </func> + <func> + <name>encode_unsigned(Unsigned) -> binary()</name> + <fsummary>Encodes an unsigned integer into the minimal binary</fsummary> + <type> + <v>Unsigned = int() >= 0</v> + </type> + <desc> + <p>The same as <c>encode_unsigned(Unsigned,big)</c>.</p> + </desc> + </func> + <func> + <name>encode_unsigned(Unsigned,Endianess) -> binary()</name> + <fsummary>Encodes an unsigned integer into the minimal binary</fsummary> + <type> + <v>Unsigned = int() >= 0</v> + <v>Endianess = big | little</v> + </type> + <desc> + + <p>Converts a positive integer to the smallest possible + representation in a binary digit representation, either big + or little endian.</p> + + <p>Example:</p> + + <code> +1> binary:encode_unsigned(11111111,big). +<<169,138,199>> + </code> + </desc> + </func> + <func> + <name>first(Subject) -> int()</name> + <fsummary>Returns the first byte of a binary</fsummary> + <type> + <v>Subject = binary()</v> + </type> + <desc> + + <p>Returns the first byte of the binary <c>Subject</c> as an integer. If the + size of <c>Subject</c> is zero, a <c>badarg</c> exception is raised.</p> + + </desc> + </func> + <func> + <name>last(Subject) -> int()</name> + <fsummary>Returns the last byte of a binary</fsummary> + <type> + <v>Subject = binary()</v> + </type> + <desc> + + <p>Returns the last byte of the binary <c>Subject</c> as an integer. If the + size of <c>Subject</c> is zero, a <c>badarg</c> exception is raised.</p> + + </desc> + </func> + <func> + <name>list_to_bin(ByteList) -> binary()</name> + <fsummary>Convert a list of integers and binaries to a binary</fsummary> + <type> + <v>ByteList = iodata() (see module erlang)</v> + </type> + <desc> + <p>Works exactly as <c>erlang:list_to_binary/1</c>, added for completeness.</p> + </desc> + </func> + <func> + <name>longest_common_prefix(Binaries) -> int()</name> + <fsummary>Returns length of longest common prefix for a set of binaries</fsummary> + <type> + <v>Binaries = [ binary() ]</v> + </type> + <desc> + + <p>Returns the length of the longest common prefix of the + binaries in the list <c>Binaries</c>. Example:</p> + +<code> +1> binary:longest_common_prefix([<<"erlang">>,<<"ergonomy">>]). +2 +2> binary:longest_common_prefix([<<"erlang">>,<<"perl">>]). +0 +</code> + + <p>If <c>Binaries</c> is not a flat list of binaries, a <c>badarg</c> exception is raised.</p> + </desc> + </func> + <func> + <name>longest_common_suffix(Binaries) -> int()</name> + <fsummary>Returns length of longest common suffix for a set of binaries</fsummary> + <type> + <v>Binaries = [ binary() ]</v> + </type> + <desc> + + <p>Returns the length of the longest common suffix of the + binaries in the list <c>Binaries</c>. Example:</p> + +<code> +1> binary:longest_common_suffix([<<"erlang">>,<<"fang">>]). +3 +2> binary:longest_common_suffix([<<"erlang">>,<<"perl">>]). +0 +</code> + + <p>If <c>Binaries</c> is not a flat list of binaries, a <c>badarg</c> exception is raised.</p> + + </desc> + </func> + <func> + <name>match(Subject, Pattern) -> Found | <c>nomatch</c></name> + <fsummary>Searches for the first match of a pattern in a binary</fsummary> + <type> + <v>Subject = binary()</v> + <v>Pattern = binary() | [ binary() ] | cp()</v> + <v>Found = part()</v> + </type> + <desc> + <p>The same as <c>match(Subject, Pattern, [])</c>.</p> + </desc> + </func> + <func> + <name>match(Subject,Pattern,Options) -> Found | <c>nomatch</c></name> + <fsummary>Searches for the first match of a pattern in a binary</fsummary> + <type> + <v>Subject = binary()</v> + <v>Pattern = binary() | [ binary() ] | cp()</v> + <v>Found = part()</v> + <v>Options = [ Option ]</v> + <v>Option = {scope, part()}</v> + </type> + <desc> + + <p>Searches for the first occurrence of <c>Pattern</c> in <c>Subject</c> and + returns the position and length.</p> + + <p>The function will return <c>{Pos,Length}</c> for the binary + in <c>Pattern</c> starting at the lowest position in + <c>Subject</c>, Example:</p> + +<code> +1> binary:match(<<"abcde">>, [<<"bcde">>,<<"cd">>],[]). +{1,4} +</code> + + <p>Even though <c><<"cd">></c> ends before + <c><<"bcde">></c>, <c><<"bcde">></c> + begins first and is therefore the first match. If two + overlapping matches begin at the same position, the longest is + returned.</p> + + <p>Summary of the options:</p> + + <taglist> + <tag>{scope, {Start, Length}}</tag> + <item><p>Only the given part is searched. Return values still have + offsets from the beginning of <c>Subject</c>. A negative <c>Length</c> is + allowed as described in the <c>TYPES</c> section of this manual.</p></item> + </taglist> + + <p>If none of the strings in + <c>Pattern</c> is found, the atom <c>nomatch</c> is returned.</p> + + <p>For a description of <c>Pattern</c>, see + <seealso marker="#compile_pattern-1">compile_pattern/1</seealso>.</p> + + <p>If <c>{scope, {Start,Length}}</c> is given in the options + such that <c>Start</c> is larger than the size of + <c>Subject</c>, <c>Start + Length</c> is less than zero or + <c>Start + Length</c> is larger than the size of + <c>Subject</c>, a <c>badarg</c> exception is raised.</p> + + </desc> + </func> + <func> + <name>matches(Subject, Pattern) -> Found</name> + <fsummary>Searches for all matches of a pattern in a binary</fsummary> + <type> + <v>Subject = binary()</v> + <v>Pattern = binary() | [ binary() ] | cp()</v> + <v>Found = [ part() ] | []</v> + </type> + <desc> + <p>The same as <c>matches(Subject, Pattern, [])</c>.</p> + </desc> + </func> + <func> + <name>matches(Subject,Pattern,Options) -> Found</name> + <fsummary>Searches for all matches of a pattern in a binary</fsummary> + <type> + <v>Subject = binary()</v> + <v>Pattern = binary() | [ binary() ] | cp()</v> + <v>Found = [ part() ] | []</v> + <v>Options = [ Option ]</v> + <v>Option = {scope, part()}</v> + </type> + <desc> + + <p>Works like match, but the <c>Subject</c> is searched until + exhausted and a list of all non-overlapping parts matching + <c>Pattern</c> is returned (in order). </p> + + <p>The first and longest match is preferred to a shorter, + which is illustrated by the following example:</p> + +<code> +1> binary:matches(<<"abcde">>, + [<<"bcde">>,<<"bc">>>,<<"de">>],[]). +[{1,4}] +</code> + + <p>The result shows that <<bcde">> is selected instead of the + shorter match <<"bc">> (which would have given raise to one + more match,<<"de">>). This corresponds to the behavior of posix + regular expressions (and programs like awk), but is not + consistent with alternative matches in re (and Perl), where + instead lexical ordering in the search pattern selects which + string matches.</p> + + <p>If none of the strings in pattern is found, an empty list is returned.</p> + + <p>For a description of <c>Pattern</c>, see <seealso marker="#compile_pattern-1">compile_pattern/1</seealso> and for a + description of available options, see <seealso marker="#match-3">match/3</seealso>.</p> + + <p>If <c>{scope, {Start,Length}}</c> is given in the options such that + <c>Start</c> is larger than the size of <c>Subject</c>, <c>Start + Length</c> is + less than zero or <c>Start + Length</c> is larger than the size of + <c>Subject</c>, a <c>badarg</c> exception is raised.</p> + + </desc> + </func> + <func> + <name>part(Subject, PosLen) -> binary()</name> + <fsummary>Extracts a part of a binary</fsummary> + <type> + <v>Subject = binary()</v> + <v>PosLen = part()</v> + </type> + <desc> + + <p>Extracts the part of the binary <c>Subject</c> described by <c>PosLen</c>.</p> + + <p>Negative length can be used to extract bytes at the end of a binary:</p> + +<code> +1> Bin = <<1,2,3,4,5,6,7,8,9,10>>. +2> binary:part(Bin,{byte_size(Bin), -5)). +<<6,7,8,9,10>> +</code> + + <note> + <p><seealso marker="#part-2">part/2</seealso>and <seealso + marker="#part-3">part/3</seealso> are also available in the + <c>erlang</c> module under the names <c>binary_part/2</c> and + <c>binary_part/3</c>. Those BIFs are allowed in guard tests.</p> + </note> + + <p>If <c>PosLen</c> in any way references outside the binary, a <c>badarg</c> exception + is raised.</p> + + </desc> + </func> + <func> + <name>part(Subject, Pos, Len) -> binary()</name> + <fsummary>Extracts a part of a binary</fsummary> + <type> + <v>Subject = binary()</v> + <v>Pos = int()</v> + <v>Len = int()</v> + </type> + <desc> + <p>The same as <c>part(Subject, {Pos, Len})</c>.</p> + </desc> + </func> + <func> + <name>referenced_byte_size(binary()) -> int()</name> + <fsummary>Determines the size of the actual binary pointed out by a sub-binary</fsummary> + <desc> + + <p>If a binary references a larger binary (often described as + being a sub-binary), it can be useful to get the size of the + actual referenced binary. This function can be used in a program + to trigger the use of <c>copy/1</c>. By copying a binary, one might + dereference the original, possibly large, binary which a smaller + binary is a reference to.</p> + + <p>Example:</p> + + <code> +store(Binary, GBSet) -> + NewBin = + case binary:referenced_byte_size(Binary) of + Large when Large > 2 * byte_size(Binary) -> + binary:copy(Binary); + _ -> + Binary + end, + gb_sets:insert(NewBin,GBSet). + </code> + + <p>In this example, we chose to copy the binary content before + inserting it in the <c>gb_set()</c> if it references a binary more than + twice the size of the data we're going to keep. Of course + different rules for when copying will apply to different + programs.</p> + + <p>Binary sharing will occur whenever binaries are taken apart, + this is the fundamental reason why binaries are fast, + decomposition can always be done with O(1) complexity. In rare + circumstances this data sharing is however undesirable, why this + function together with <c>copy/1</c> might be useful when optimizing + for memory use.</p> + + <p>Example of binary sharing:</p> + + <code> +1> A = binary:copy(<<1>>,100). +<<1,1,1,1,1 ... +2> byte_size(A). +100 +3> binary:referenced_byte_size(A) +100 +4> <<_:10/binary,B:10/binary,_/binary>> = A. +<<1,1,1,1,1 ... +5> byte_size(B). +10 +6> binary:referenced_byte_size(B) +100 + </code> + + <note> + <p>Binary data is shared among processes. If another process + still references the larger binary, copying the part this + process uses only consumes more memory and will not free up the + larger binary for garbage collection. Use this kind of intrusive + functions with extreme care, and only if a real problem is + detected.</p> + </note> + + </desc> + </func> + <func> + <name>replace(Subject,Pattern,Replacement) -> Result</name> + <fsummary>Replaces bytes in a binary according to a pattern</fsummary> + <type> + <v>Subject = binary()</v> + <v>Pattern = binary() | [ binary() ] | cp()</v> + <v>Replacement = binary()</v> + <v>Result = binary()</v> + </type> + <desc> + <p>The same as <c>replace(Subject,Pattern,Replacement,[])</c>.</p> + </desc> + </func> + <func> + <name>replace(Subject,Pattern,Replacement,Options) -> Result</name> + <fsummary>Replaces bytes in a binary according to a pattern</fsummary> + <type> + <v>Subject = binary()</v> + <v>Pattern = binary() | [ binary() ] | cp()</v> + <v>Replacement = binary()</v> + <v>Result = binary()</v> + <v>Options = [ Option ]</v> + <v>Option = global | {scope, part()} | {insert_replaced, InsPos}</v> + <v>InsPos = OnePos | [ OnePos ]</v> + <v>OnePos = int() =< byte_size(Replacement)</v> + </type> + <desc> + + <p>Constructs a new binary by replacing the parts in + <c>Subject</c> matching <c>Pattern</c> with the content of + <c>Replacement</c>.</p> + + <p>If the matching sub-part of <c>Subject</c> giving raise to the + replacement is to be inserted in the result, the option + <c>{insert_replaced, InsPos}</c> will insert the matching part into + <c>Replacement</c> at the given position (or positions) before actually + inserting <c>Replacement</c> into the <c>Subject</c>. Example:</p> + +<code> +1> binary:replace(<<"abcde">>,<<"b">>,<<"[]">>,[{insert_replaced,1}]). +<<"a[b]cde">> +2> binary:replace(<<"abcde">>,[<<"b">>,<<"d">>],<<"[]">>, + [global,{insert_replaced,1}]). +<<"a[b]c[d]e">> +3> binary:replace(<<"abcde">>,[<<"b">>,<<"d">>],<<"[]">>, + [global,{insert_replaced,[1,1]}]). +<<"a[bb]c[dd]e">> +4> binary:replace(<<"abcde">>,[<<"b">>,<<"d">>],<<"[-]">>, + [global,{insert_replaced,[1,2]}]). +<<"a[b-b]c[d-d]e">> +</code> + + <p>If any position given in <c>InsPos</c> is greater than the size of the replacement binary, a <c>badarg</c> exception is raised.</p> + + <p>The options <c>global</c> and <c>{scope, part()}</c> work as for <seealso marker="#split-3">split/3</seealso>. The return type is always a <c>binary()</c>.</p> + + <p>For a description of <c>Pattern</c>, see <seealso marker="#compile_pattern-1">compile_pattern/1</seealso>.</p> + </desc> + </func> + <func> + <name>split(Subject,Pattern) -> Parts</name> + <fsummary>Splits a binary according to a pattern</fsummary> + <type> + <v>Subject = binary()</v> + <v>Pattern = binary() | [ binary() ] | cp()</v> + <v>Parts = [ binary() ]</v> + </type> + <desc> + <p>The same as <c>split(Subject, Pattern, [])</c>.</p> + </desc> + </func> + <func> + <name>split(Subject,Pattern,Options) -> Parts</name> + <fsummary>Splits a binary according to a pattern</fsummary> + <type> + <v>Subject = binary()</v> + <v>Pattern = binary() | [ binary() ] | cp()</v> + <v>Parts = [ binary() ]</v> + <v>Options = [ Option ]</v> + <v>Option = {scope, part()} | trim | global</v> + </type> + <desc> + + <p>Splits Binary into a list of binaries based on Pattern. If + the option global is not given, only the first occurrence of + Pattern in Subject will give rise to a split.</p> + + <p>The parts of Pattern actually found in Subject are not included in the result.</p> + + <p>Example:</p> + +<code> +1> binary:split(<<1,255,4,0,0,0,2,3>>, [<<0,0,0>>,<<2>>],[]). +[<<1,255,4>>, <<2,3>>] +2> binary:split(<<0,1,0,0,4,255,255,9>>, [<<0,0>>, <<255,255>>],[global]). +[<<0,1>>,<<4>>,<<9>>] +</code> + + <p>Summary of options:</p> + <taglist> + + <tag>{scope, part()}</tag> + + <item><p>Works as in <seealso marker="#match-3">match/3</seealso> and + <seealso marker="#matches-3">matches/3</seealso>. Note that + this only defines the scope of the search for matching strings, + it does not cut the binary before splitting. The bytes before + and after the scope will be kept in the result. See example + below.</p></item> + + <tag>trim</tag> + + <item><p>Removes trailing empty parts of the result (as does trim in <c>re:split/3</c>)</p></item> + + <tag>global</tag> + + <item><p>Repeats the split until the <c>Subject</c> is + exhausted. Conceptually the global option makes split work on + the positions returned by <seealso marker="#matches-3">matches/3</seealso>, + while it normally + works on the position returned by + <seealso marker="#match-3">match/3</seealso>.</p></item> + + </taglist> + + <p>Example of the difference between a scope and taking the + binary apart before splitting:</p> + +<code> +1> binary:split(<<"banana">>,[<<"a">>],[{scope,{2,3}}]). +[<<"ban">>,<<"na">>] +2> binary:split(binary:part(<<"banana">>,{2,3}),[<<"a">>],[]). +[<<"n">>,<<"n">>] +</code> + + <p>The return type is always a list of binaries that are all + referencing <c>Subject</c>. This means that the data in <c>Subject</c> is not + actually copied to new binaries and that <c>Subject</c> cannot be + garbage collected until the results of the split are no longer + referenced.</p> + + <p>For a description of <c>Pattern</c>, see <seealso marker="#compile_pattern-1">compile_pattern/1</seealso>.</p> + + </desc> + </func> + </funcs> +</erlref> diff --git a/lib/stdlib/doc/src/gen_event.xml b/lib/stdlib/doc/src/gen_event.xml index df09294de6..2234a62ac3 100644 --- a/lib/stdlib/doc/src/gen_event.xml +++ b/lib/stdlib/doc/src/gen_event.xml @@ -4,7 +4,7 @@ <erlref> <header> <copyright> - <year>1996</year><year>2009</year> + <year>1996</year><year>2010</year> <holder>Ericsson AB. All Rights Reserved.</holder> </copyright> <legalnotice> @@ -13,12 +13,12 @@ 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. - + </legalnotice> <title>gen_event</title> @@ -630,12 +630,66 @@ gen_event:stop -----> Module:terminate/2 <p>The function should return the updated internal state.</p> </desc> </func> + <func> + <name>Module:format_status(Opt, [PDict, State]) -> Status</name> + <fsummary>Optional function for providing a term describing the + current event handler state.</fsummary> + <type> + <v>Opt = normal | terminate</v> + <v>PDict = [{Key, Value}]</v> + <v>State = term()</v> + <v>Status = term()</v> + </type> + <desc> + <note> + <p>This callback is optional, so event handler modules need + not export it. If a handler does not export this function, + the gen_event module uses the handler state directly for + the purposes described below.</p> + </note> + <p>This function is called by a gen_event process when:</p> + <list typed="bulleted"> + <item>One + of <seealso marker="sys#get_status/1">sys:get_status/1,2</seealso> + is invoked to get the gen_event status. <c>Opt</c> is set + to the atom <c>normal</c> for this case.</item> + <item>The event handler terminates abnormally and gen_event + logs an error. <c>Opt</c> is set to the + atom <c>terminate</c> for this case.</item> + </list> + <p>This function is useful for customising the form and + appearance of the event handler state for these cases. An + event handler callback module wishing to customise + the <c>sys:get_status/1,2</c> return value as well as how + its state appears in termination error logs exports an + instance of <c>format_status/2</c> that returns a term + describing the current state of the event handler.</p> + <p><c>PDict</c> is the current value of the gen_event's + process dictionary.</p> + <p><c>State</c> is the internal state of the event + handler.</p> + <p>The function should return <c>Status</c>, a term that + customises the details of the current state of the event + handler. Any term is allowed for <c>Status</c>. The + gen_event module uses <c>Status</c> as follows:</p> + <list typed="bulleted"> + <item>When <c>sys:get_status/1,2</c> is called, gen_event + ensures that its return value contains <c>Status</c> in + place of the event handler's actual state term.</item> + <item>When an event handler terminates abnormally, gen_event + logs <c>Status</c> in place of the event handler's actual + state term.</item> + </list> + <p>One use for this function is to return compact alternative + state representations to avoid having large state terms + printed in logfiles.</p> + </desc> + </func> </funcs> <section> <title>SEE ALSO</title> - <p><seealso marker="supervisor">supervisor(3)</seealso>, + <p><seealso marker="supervisor">supervisor(3)</seealso>, <seealso marker="sys">sys(3)</seealso></p> </section> </erlref> - diff --git a/lib/stdlib/doc/src/gen_fsm.xml b/lib/stdlib/doc/src/gen_fsm.xml index 739cd0bffd..d15383c621 100644 --- a/lib/stdlib/doc/src/gen_fsm.xml +++ b/lib/stdlib/doc/src/gen_fsm.xml @@ -4,7 +4,7 @@ <erlref> <header> <copyright> - <year>1996</year><year>2009</year> + <year>1996</year><year>2010</year> <holder>Ericsson AB. All Rights Reserved.</holder> </copyright> <legalnotice> @@ -13,12 +13,12 @@ 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. - + </legalnotice> <title>gen_fsm</title> @@ -730,33 +730,58 @@ gen_fsm:sync_send_all_state_event -----> Module:handle_sync_event/4 </desc> </func> <func> - <name>Module:format_status(normal, [PDict, StateData]) -> Status</name> + <name>Module:format_status(Opt, [PDict, StateData]) -> Status</name> <fsummary>Optional function for providing a term describing the current gen_fsm status.</fsummary> <type> + <v>Opt = normal | terminate</v> <v>PDict = [{Key, Value}]</v> <v>StateData = term()</v> - <v>Status = [term()]</v> + <v>Status = term()</v> </type> <desc> - <p><em>This callback is optional, so callback modules need not - export it. The gen_fsm module provides a default - implementation of this function that returns the callback - module state data.</em></p> - <p>This function is called by a gen_fsm process when one - of <seealso marker="sys#get_status/1">sys:get_status/1,2</seealso> - is invoked to get the gen_fsm status. A callback module - wishing to customise the <c>sys:get_status/1,2</c> return - value exports an instance of <c>format_status/2</c> that - returns a term describing the current status of the - gen_fsm.</p> + <note> + <p>This callback is optional, so callback modules need not + export it. The gen_fsm module provides a default + implementation of this function that returns the callback + module state data.</p> + </note> + <p>This function is called by a gen_fsm process when:</p> + <list typed="bulleted"> + <item>One + of <seealso marker="sys#get_status/1">sys:get_status/1,2</seealso> + is invoked to get the gen_fsm status. <c>Opt</c> is set to + the atom <c>normal</c> for this case.</item> + <item>The gen_fsm terminates abnormally and logs an + error. <c>Opt</c> is set to the atom <c>terminate</c> for + this case.</item> + </list> + <p>This function is useful for customising the form and + appearance of the gen_fsm status for these cases. A callback + module wishing to customise the <c>sys:get_status/1,2</c> + return value as well as how its status appears in + termination error logs exports an instance + of <c>format_status/2</c> that returns a term describing the + current status of the gen_fsm.</p> <p><c>PDict</c> is the current value of the gen_fsm's process dictionary.</p> <p><c>StateData</c> is the internal state data of the gen_fsm.</p> - <p>The function should return <c>Status</c>, a list of one or - more terms that customise the details of the current state - and status of the gen_fsm.</p> + <p>The function should return <c>Status</c>, a term that + customises the details of the current state and status of + the gen_fsm. There are no restrictions on the + form <c>Status</c> can take, but for + the <c>sys:get_status/1,2</c> case (when <c>Opt</c> + is <c>normal</c>), the recommended form for + the <c>Status</c> value is <c>[{data, [{"StateData", + Term}]}]</c> where <c>Term</c> provides relevant details of + the gen_fsm state data. Following this recommendation isn't + required, but doing so will make the callback module status + consistent with the rest of the <c>sys:get_status/1,2</c> + return value.</p> + <p>One use for this function is to return compact alternative + state data representations to avoid having large state terms + printed in logfiles.</p> </desc> </func> </funcs> @@ -770,4 +795,3 @@ gen_fsm:sync_send_all_state_event -----> Module:handle_sync_event/4 <seealso marker="sys">sys(3)</seealso></p> </section> </erlref> - diff --git a/lib/stdlib/doc/src/gen_server.xml b/lib/stdlib/doc/src/gen_server.xml index 30c04d1d52..1045766e01 100644 --- a/lib/stdlib/doc/src/gen_server.xml +++ b/lib/stdlib/doc/src/gen_server.xml @@ -4,7 +4,7 @@ <erlref> <header> <copyright> - <year>1996</year><year>2009</year> + <year>1996</year><year>2010</year> <holder>Ericsson AB. All Rights Reserved.</holder> </copyright> <legalnotice> @@ -13,12 +13,12 @@ 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. - + </legalnotice> <title>gen_server</title> @@ -599,32 +599,57 @@ gen_server:abcast -----> Module:handle_cast/2 </desc> </func> <func> - <name>Module:format_status(normal, [PDict, State]) -> Status</name> + <name>Module:format_status(Opt, [PDict, State]) -> Status</name> <fsummary>Optional function for providing a term describing the current gen_server status.</fsummary> <type> + <v>Opt = normal | terminate</v> <v>PDict = [{Key, Value}]</v> <v>State = term()</v> - <v>Status = [term()]</v> + <v>Status = term()</v> </type> <desc> - <p><em>This callback is optional, so callback modules need not - export it. The gen_server module provides a default - implementation of this function that returns the callback - module state.</em></p> - <p>This function is called by a gen_server process when one + <note> + <p>This callback is optional, so callback modules need not + export it. The gen_server module provides a default + implementation of this function that returns the callback + module state.</p> + </note> + <p>This function is called by a gen_server process when:</p> + <list typed="bulleted"> + <item>One of <seealso marker="sys#get_status/1">sys:get_status/1,2</seealso> - is invoked to get the gen_server status. A callback module - wishing to customise the <c>sys:get_status/1,2</c> return - value exports an instance of <c>format_status/2</c> that - returns a term describing the current status of the - gen_server.</p> + is invoked to get the gen_server status. <c>Opt</c> is set + to the atom <c>normal</c> for this case.</item> + <item>The gen_server terminates abnormally and logs an + error. <c>Opt</c> is set to the atom <c>terminate</c> for this + case.</item> + </list> + <p>This function is useful for customising the form and + appearance of the gen_server status for these cases. A + callback module wishing to customise + the <c>sys:get_status/1,2</c> return value as well as how + its status appears in termination error logs exports an + instance of <c>format_status/2</c> that returns a term + describing the current status of the gen_server.</p> <p><c>PDict</c> is the current value of the gen_server's process dictionary.</p> <p><c>State</c> is the internal state of the gen_server.</p> - <p>The function should return <c>Status</c>, a list of one or - more terms that customise the details of the current state - and status of the gen_server.</p> + <p>The function should return <c>Status</c>, a term that + customises the details of the current state and status of + the gen_server. There are no restrictions on the + form <c>Status</c> can take, but for + the <c>sys:get_status/1,2</c> case (when <c>Opt</c> + is <c>normal</c>), the recommended form for + the <c>Status</c> value is <c>[{data, [{"State", + Term}]}]</c> where <c>Term</c> provides relevant details of + the gen_server state. Following this recommendation isn't + required, but doing so will make the callback module status + consistent with the rest of the <c>sys:get_status/1,2</c> + return value.</p> + <p>One use for this function is to return compact alternative + state representations to avoid having large state terms + printed in logfiles.</p> </desc> </func> </funcs> diff --git a/lib/stdlib/doc/src/lists.xml b/lib/stdlib/doc/src/lists.xml index 855a7e0244..a273a2301f 100644 --- a/lib/stdlib/doc/src/lists.xml +++ b/lib/stdlib/doc/src/lists.xml @@ -443,7 +443,7 @@ flatmap(Fun, List1) -> <desc> <p>Returns a list containing the sorted elements of the list <c>TupleList1</c>. Sorting is performed on the <c>N</c>th - element of the tuples.</p> + element of the tuples. The sort is stable.</p> </desc> </func> <func> @@ -466,7 +466,7 @@ flatmap(Fun, List1) -> </desc> </func> <func> - <name>keytake(Key, N, TupleList1) -> {value, Tuple, TupleList2} + <name>keytake(Key, N, TupleList1) -> {value, Tuple, TupleList2} | false</name> <fsummary>Extract an element from a list of tuples</fsummary> <type> @@ -840,7 +840,7 @@ length(lists:seq(From, To, Incr)) == (To-From+Incr) div Incr</code> <c>Pred</c>. <c>splitwith/2</c> behaves as if it is defined as follows:</p> <code type="none"> -splitwith(Pred, List) -> +splitwith(Pred, List) -> {takewhile(Pred, List), dropwhile(Pred, List)}.</code> <p>Examples:</p> <pre> diff --git a/lib/stdlib/doc/src/ref_man.xml b/lib/stdlib/doc/src/ref_man.xml index f6ae368e92..85aae6151d 100644 --- a/lib/stdlib/doc/src/ref_man.xml +++ b/lib/stdlib/doc/src/ref_man.xml @@ -4,7 +4,7 @@ <application xmlns:xi="http://www.w3.org/2001/XInclude"> <header> <copyright> - <year>1996</year><year>2009</year> + <year>1996</year><year>2010</year> <holder>Ericsson AB. All Rights Reserved.</holder> </copyright> <legalnotice> @@ -13,12 +13,12 @@ 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. - + </legalnotice> <title>STDLIB Reference Manual</title> @@ -37,6 +37,7 @@ <xi:include href="array.xml"/> <xi:include href="base64.xml"/> <xi:include href="beam_lib.xml"/> + <xi:include href="binary.xml"/> <xi:include href="c.xml"/> <xi:include href="calendar.xml"/> <xi:include href="dets.xml"/> diff --git a/lib/stdlib/src/Makefile b/lib/stdlib/src/Makefile index 237818c08b..600303d7e1 100644 --- a/lib/stdlib/src/Makefile +++ b/lib/stdlib/src/Makefile @@ -43,6 +43,7 @@ MODULES= \ array \ base64 \ beam_lib \ + binary \ c \ calendar \ dets \ diff --git a/lib/stdlib/src/beam_lib.erl b/lib/stdlib/src/beam_lib.erl index 820afd3739..c71dad6163 100644 --- a/lib/stdlib/src/beam_lib.erl +++ b/lib/stdlib/src/beam_lib.erl @@ -1,19 +1,19 @@ %% %% %CopyrightBegin% -%% -%% Copyright Ericsson AB 2000-2009. All Rights Reserved. -%% +%% +%% Copyright Ericsson AB 2000-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% %% -module(beam_lib). @@ -44,9 +44,6 @@ -import(lists, [append/1, delete/2, foreach/2, keysort/2, member/2, reverse/1, sort/1, splitwith/2]). --include_lib("kernel/include/file.hrl"). --include("erl_compile.hrl"). - %%------------------------------------------------------------------------- -type beam() :: module() | file:filename() | binary(). @@ -331,13 +328,11 @@ beam_files(Dir) -> %% -> ok | throw(Error) cmp_files(File1, File2) -> - {ok, {M1, L1}} = read_significant_chunks(File1), - {ok, {M2, L2}} = read_significant_chunks(File2), + {ok, {M1, L1}} = read_all_but_useless_chunks(File1), + {ok, {M2, L2}} = read_all_but_useless_chunks(File2), if M1 =:= M2 -> - List1 = filter_funtab(L1), - List2 = filter_funtab(L2), - cmp_lists(List1, List2); + cmp_lists(L1, L2); true -> error({modules_different, M1, M2}) end. @@ -408,6 +403,20 @@ pad(Size) -> end. %% -> {ok, {Module, Chunks}} | throw(Error) +read_all_but_useless_chunks(File0) when is_atom(File0); + is_list(File0); + is_binary(File0) -> + File = beam_filename(File0), + {ok, Module, ChunkIds0} = scan_beam(File, info), + ChunkIds = [Name || {Name,_,_} <- ChunkIds0, + not is_useless_chunk(Name)], + {ok, Module, Chunks} = scan_beam(File, ChunkIds), + {ok, {Module, lists:reverse(Chunks)}}. + +is_useless_chunk("CInf") -> true; +is_useless_chunk(_) -> false. + +%% -> {ok, {Module, Chunks}} | throw(Error) read_significant_chunks(File) -> case read_chunk_data(File, significant_chunks(), [allow_missing_chunks]) of {ok, {Module, Chunks0}} -> diff --git a/lib/stdlib/src/binary.erl b/lib/stdlib/src/binary.erl new file mode 100644 index 0000000000..f6489788b2 --- /dev/null +++ b/lib/stdlib/src/binary.erl @@ -0,0 +1,177 @@ +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 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% +%% +-module(binary). +%% +%% The following functions implemented as BIF's +%% binary:compile_pattern/1 +%% binary:match/{2,3} +%% binary:matches/{2,3} +%% binary:longest_common_prefix/1 +%% binary:longest_common_suffix/1 +%% binary:first/1 +%% binary:last/1 +%% binary:at/2 +%% binary:part/{2,3} +%% binary:bin_to_list/{1,2,3} +%% binary:list_to_bin/1 +%% binary:copy/{1,2} +%% binary:referenced_byte_size/1 +%% binary:decode_unsigned/{1,2} +%% - Not yet: +%% +%% Implemented in this module: +-export([split/2,split/3,replace/3,replace/4]). + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +%% split +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +split(H,N) -> + split(H,N,[]). +split(Haystack,Needles,Options) -> + try + {Part,Global,Trim} = get_opts_split(Options,{no,false,false}), + Moptlist = case Part of + no -> + []; + {A,B} -> + [{scope,{A,B}}] + end, + MList = if + Global -> + binary:matches(Haystack,Needles,Moptlist); + true -> + case binary:match(Haystack,Needles,Moptlist) of + nomatch -> []; + Match -> [Match] + end + end, + do_split(Haystack,MList,0,Trim) + catch + _:_ -> + erlang:error(badarg) + end. + +do_split(H,[],N,true) when N >= byte_size(H) -> + []; +do_split(H,[],N,_) -> + [binary:part(H,{N,byte_size(H)-N})]; +do_split(H,[{A,B}|T],N,Trim) -> + case binary:part(H,{N,A-N}) of + <<>> -> + Rest = do_split(H,T,A+B,Trim), + case {Trim, Rest} of + {true,[]} -> + []; + _ -> + [<<>> | Rest] + end; + Oth -> + [Oth | do_split(H,T,A+B,Trim)] + end. + + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +%% replace +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +replace(H,N,R) -> + replace(H,N,R,[]). +replace(Haystack,Needles,Replacement,Options) -> + try + true = is_binary(Replacement), % Make badarg instead of function clause + {Part,Global,Insert} = get_opts_replace(Options,{no,false,[]}), + Moptlist = case Part of + no -> + []; + {A,B} -> + [{scope,{A,B}}] + end, + MList = if + Global -> + binary:matches(Haystack,Needles,Moptlist); + true -> + case binary:match(Haystack,Needles,Moptlist) of + nomatch -> []; + Match -> [Match] + end + end, + ReplList = case Insert of + [] -> + Replacement; + Y when is_integer(Y) -> + splitat(Replacement,0,[Y]); + Li when is_list(Li) -> + splitat(Replacement,0,lists:sort(Li)) + end, + erlang:iolist_to_binary(do_replace(Haystack,MList,ReplList,0)) + catch + _:_ -> + erlang:error(badarg) + end. + + +do_replace(H,[],_,N) -> + [binary:part(H,{N,byte_size(H)-N})]; +do_replace(H,[{A,B}|T],Replacement,N) -> + [binary:part(H,{N,A-N}), + if + is_list(Replacement) -> + do_insert(Replacement, binary:part(H,{A,B})); + true -> + Replacement + end + | do_replace(H,T,Replacement,A+B)]. + +do_insert([X],_) -> + [X]; +do_insert([H|T],R) -> + [H,R|do_insert(T,R)]. + +splitat(H,N,[]) -> + [binary:part(H,{N,byte_size(H)-N})]; +splitat(H,N,[I|T]) -> + [binary:part(H,{N,I-N})|splitat(H,I,T)]. + + + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +%% Simple helper functions +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% + +get_opts_split([],{Part,Global,Trim}) -> + {Part,Global,Trim}; +get_opts_split([{scope,{A,B}} | T],{_Part,Global,Trim}) -> + get_opts_split(T,{{A,B},Global,Trim}); +get_opts_split([global | T],{Part,_Global,Trim}) -> + get_opts_split(T,{Part,true,Trim}); +get_opts_split([trim | T],{Part,Global,_Trim}) -> + get_opts_split(T,{Part,Global,true}); +get_opts_split(_,_) -> + throw(badopt). + +get_opts_replace([],{Part,Global,Insert}) -> + {Part,Global,Insert}; +get_opts_replace([{scope,{A,B}} | T],{_Part,Global,Insert}) -> + get_opts_replace(T,{{A,B},Global,Insert}); +get_opts_replace([global | T],{Part,_Global,Insert}) -> + get_opts_replace(T,{Part,true,Insert}); +get_opts_replace([{insert_replaced,N} | T],{Part,Global,_Insert}) -> + get_opts_replace(T,{Part,Global,N}); +get_opts_replace(_,_) -> + throw(badopt). + diff --git a/lib/stdlib/src/edlin.erl b/lib/stdlib/src/edlin.erl index 6cb441dbed..026bd9038f 100644 --- a/lib/stdlib/src/edlin.erl +++ b/lib/stdlib/src/edlin.erl @@ -24,6 +24,7 @@ -export([init/0,start/1,edit_line/2,prefix_arg/1]). -export([erase_line/1,erase_inp/1,redraw_line/1]). -export([length_before/1,length_after/1,prompt/1]). +-export([current_line/1]). %%-export([expand/1]). -export([edit_line1/2]). @@ -421,6 +422,7 @@ over_paren_auto([], _, _, _) -> %% length_before(Line) %% length_after(Line) %% prompt(Line) +%% current_line(Line) %% Various functions for accessing bits of a line. erase_line({line,Pbs,{Bef,Aft},_}) -> @@ -447,6 +449,9 @@ length_after({line,_,{_Bef,Aft},_}) -> prompt({line,Pbs,_,_}) -> Pbs. +current_line({line,_,{Bef, Aft},_}) -> + reverse(Bef, Aft ++ "\n"). + %% %% expand(CurrentBefore) -> %% %% {yes,Expansion} | no %% %% Try to expand the word before as either a module name or a function diff --git a/lib/stdlib/src/erl_internal.erl b/lib/stdlib/src/erl_internal.erl index 16173d8210..2471c545dd 100644 --- a/lib/stdlib/src/erl_internal.erl +++ b/lib/stdlib/src/erl_internal.erl @@ -1,19 +1,19 @@ %% %% %CopyrightBegin% -%% -%% Copyright Ericsson AB 1998-2009. All Rights Reserved. -%% +%% +%% Copyright Ericsson AB 1998-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% %% -module(erl_internal). @@ -87,6 +87,8 @@ guard_bif(is_reference, 1) -> true; guard_bif(is_tuple, 1) -> true; guard_bif(is_record, 2) -> true; guard_bif(is_record, 3) -> true; +guard_bif(binary_part, 2) -> true; +guard_bif(binary_part, 3) -> true; guard_bif(Name, A) when is_atom(Name), is_integer(A) -> false. %% Erlang type tests. @@ -229,6 +231,8 @@ bif(apply, 2) -> true; bif(apply, 3) -> true; bif(atom_to_binary, 2) -> true; bif(atom_to_list, 1) -> true; +bif(binary_part, 2) -> true; +bif(binary_part, 3) -> true; bif(binary_to_atom, 2) -> true; bif(binary_to_existing_atom, 2) -> true; bif(binary_to_list, 1) -> true; diff --git a/lib/stdlib/src/erl_parse.yrl b/lib/stdlib/src/erl_parse.yrl index 69807aad83..5287f55e59 100644 --- a/lib/stdlib/src/erl_parse.yrl +++ b/lib/stdlib/src/erl_parse.yrl @@ -112,6 +112,7 @@ type_guards -> type_guard ',' type_guards : ['$1'|'$3']. type_guard -> atom '(' top_types ')' : {type, ?line('$1'), constraint, ['$1', '$3']}. +type_guard -> var '::' top_type : build_def('$1', '$3'). top_types -> top_type : ['$1']. top_types -> top_type ',' top_types : ['$1'|'$3']. @@ -597,6 +598,10 @@ find_arity_from_specs([Spec|_]) -> {type, _, 'fun', [{type, _, product, Args},_]} = Fun, length(Args). +build_def(LHS, Types) -> + IsSubType = {atom, ?line(LHS), is_subtype}, + {type, ?line(LHS), constraint, [IsSubType, [LHS, Types]]}. + lift_unions(T1, {type, _La, union, List}) -> {type, ?line(T1), union, [T1|List]}; lift_unions(T1, T2) -> diff --git a/lib/stdlib/src/ets.erl b/lib/stdlib/src/ets.erl index ef9c8f0cfb..d7b5dbc636 100644 --- a/lib/stdlib/src/ets.erl +++ b/lib/stdlib/src/ets.erl @@ -230,7 +230,7 @@ from_dets(EtsTable, DetsTable) -> erlang:error(Unexpected,[EtsTable,DetsTable]) end. --spec to_dets(tab(), dets:tab_name()) -> dets:tabname(). +-spec to_dets(tab(), dets:tab_name()) -> dets:tab_name(). to_dets(EtsTable, DetsTable) -> case (catch dets:from_ets(DetsTable, EtsTable)) of diff --git a/lib/stdlib/src/gen.erl b/lib/stdlib/src/gen.erl index 5aab547644..43df6f621d 100644 --- a/lib/stdlib/src/gen.erl +++ b/lib/stdlib/src/gen.erl @@ -1,19 +1,19 @@ %% %% %CopyrightBegin% -%% -%% Copyright Ericsson AB 1996-2009. All Rights Reserved. -%% +%% +%% Copyright Ericsson AB 1996-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% %% -module(gen). @@ -212,7 +212,22 @@ do_call(Process, Label, Request, Timeout) -> catch erlang:send(Process, {Label, {self(), Mref}, Request}, [noconnect]), - wait_resp_mon(Node, Mref, Timeout) + receive + {Mref, Reply} -> + erlang:demonitor(Mref, [flush]), + {ok, Reply}; + {'DOWN', Mref, _, _, noconnection} -> + exit({nodedown, Node}); + {'DOWN', Mref, _, _, Reason} -> + exit(Reason) + after Timeout -> + erlang:demonitor(Mref), + receive + {'DOWN', Mref, _, _, _} -> true + after 0 -> true + end, + exit(timeout) + end catch error:_ -> %% Node (C/Java?) is not supporting the monitor. @@ -233,24 +248,6 @@ do_call(Process, Label, Request, Timeout) -> end end. -wait_resp_mon(Node, Mref, Timeout) -> - receive - {Mref, Reply} -> - erlang:demonitor(Mref, [flush]), - {ok, Reply}; - {'DOWN', Mref, _, _, noconnection} -> - exit({nodedown, Node}); - {'DOWN', Mref, _, _, Reason} -> - exit(Reason) - after Timeout -> - erlang:demonitor(Mref), - receive - {'DOWN', Mref, _, _, _} -> true - after 0 -> true - end, - exit(timeout) - end. - wait_resp(Node, Tag, Timeout) -> receive {Tag, Reply} -> diff --git a/lib/stdlib/src/gen_event.erl b/lib/stdlib/src/gen_event.erl index 27ff9441e6..b1e9e3a02f 100644 --- a/lib/stdlib/src/gen_event.erl +++ b/lib/stdlib/src/gen_event.erl @@ -677,12 +677,23 @@ report_error(Handler, Reason, State, LastIn, SName) -> _ -> Reason end, + Mod = Handler#handler.module, + FmtState = case erlang:function_exported(Mod, format_status, 2) of + true -> + Args = [get(), State], + case catch Mod:format_status(terminate, Args) of + {'EXIT', _} -> State; + Else -> Else + end; + _ -> + State + end, error_msg("** gen_event handler ~p crashed.~n" "** Was installed in ~p~n" "** Last event was: ~p~n" "** When handler state == ~p~n" "** Reason == ~p~n", - [handler(Handler),SName,LastIn,State,Reason1]). + [handler(Handler),SName,LastIn,FmtState,Reason1]). handler(Handler) when not Handler#handler.id -> Handler#handler.module; @@ -711,10 +722,20 @@ get_modules(MSL) -> %%----------------------------------------------------------------- %% Status information %%----------------------------------------------------------------- -format_status(_Opt, StatusData) -> - [_PDict, SysState, Parent, _Debug, [ServerName, MSL, _Hib]] = StatusData, +format_status(Opt, StatusData) -> + [PDict, SysState, Parent, _Debug, [ServerName, MSL, _Hib]] = StatusData, Header = lists:concat(["Status for event handler ", ServerName]), + FmtMSL = [case erlang:function_exported(Mod, format_status, 2) of + true -> + Args = [PDict, State], + case catch Mod:format_status(Opt, Args) of + {'EXIT', _} -> MSL; + Else -> MS#handler{state = Else} + end; + _ -> + MS + end || #handler{module = Mod, state = State} = MS <- MSL], [{header, Header}, {data, [{"Status", SysState}, {"Parent", Parent}]}, - {items, {"Installed handlers", MSL}}]. + {items, {"Installed handlers", FmtMSL}}]. diff --git a/lib/stdlib/src/gen_fsm.erl b/lib/stdlib/src/gen_fsm.erl index 9961646418..8d1b46d6ab 100644 --- a/lib/stdlib/src/gen_fsm.erl +++ b/lib/stdlib/src/gen_fsm.erl @@ -542,7 +542,18 @@ terminate(Reason, Name, Msg, Mod, StateName, StateData, Debug) -> {shutdown,_}=Shutdown -> exit(Shutdown); _ -> - error_info(Reason, Name, Msg, StateName, StateData, Debug), + FmtStateData = + case erlang:function_exported(Mod, format_status, 2) of + true -> + Args = [get(), StateData], + case catch Mod:format_status(terminate, Args) of + {'EXIT', _} -> StateData; + Else -> Else + end; + _ -> + StateData + end, + error_info(Reason,Name,Msg,StateName,FmtStateData,Debug), exit(Reason) end end. @@ -610,15 +621,17 @@ format_status(Opt, StatusData) -> end, Header = lists:concat(["Status for state machine ", NameTag]), Log = sys:get_debug(log, Debug, []), - Specfic = + DefaultStatus = [{data, [{"StateData", StateData}]}], + Specfic = case erlang:function_exported(Mod, format_status, 2) of true -> case catch Mod:format_status(Opt,[PDict,StateData]) of - {'EXIT', _} -> [{data, [{"StateData", StateData}]}]; - Else -> Else + {'EXIT', _} -> DefaultStatus; + StatusList when is_list(StatusList) -> StatusList; + Else -> [Else] end; _ -> - [{data, [{"StateData", StateData}]}] + DefaultStatus end, [{header, Header}, {data, [{"Status", SysState}, diff --git a/lib/stdlib/src/gen_server.erl b/lib/stdlib/src/gen_server.erl index 1c9e5270b6..dc8e7ecd16 100644 --- a/lib/stdlib/src/gen_server.erl +++ b/lib/stdlib/src/gen_server.erl @@ -705,7 +705,18 @@ terminate(Reason, Name, Msg, Mod, State, Debug) -> {shutdown,_}=Shutdown -> exit(Shutdown); _ -> - error_info(Reason, Name, Msg, State, Debug), + FmtState = + case erlang:function_exported(Mod, format_status, 2) of + true -> + Args = [get(), State], + case catch Mod:format_status(terminate, Args) of + {'EXIT', _} -> State; + Else -> Else + end; + _ -> + State + end, + error_info(Reason, Name, Msg, FmtState, Debug), exit(Reason) end end. @@ -836,15 +847,17 @@ format_status(Opt, StatusData) -> end, Header = lists:concat(["Status for generic server ", NameTag]), Log = sys:get_debug(log, Debug, []), - Specfic = + DefaultStatus = [{data, [{"State", State}]}], + Specfic = case erlang:function_exported(Mod, format_status, 2) of true -> case catch Mod:format_status(Opt, [PDict, State]) of - {'EXIT', _} -> [{data, [{"State", State}]}]; - Else -> Else + {'EXIT', _} -> DefaultStatus; + StatusList when is_list(StatusList) -> StatusList; + Else -> [Else] end; _ -> - [{data, [{"State", State}]}] + DefaultStatus end, [{header, Header}, {data, [{"Status", SysState}, diff --git a/lib/stdlib/src/otp_internal.erl b/lib/stdlib/src/otp_internal.erl index 17948e1faa..f3cfd78d54 100644 --- a/lib/stdlib/src/otp_internal.erl +++ b/lib/stdlib/src/otp_internal.erl @@ -236,32 +236,50 @@ obsolete_1(erlang, fault, 2) -> obsolete_1(file, rawopen, 2) -> {removed, "deprecated (will be removed in R13B); use file:open/2 with the raw option"}; -obsolete_1(httpd, start, 0) -> {deprecated,{inets,start,[2,3]},"R14B"}; -obsolete_1(httpd, start, 1) -> {deprecated,{inets,start,[2,3]},"R14B"}; -obsolete_1(httpd, start_link, 1) -> {deprecated,{inets,start,[2,3]},"R14B"}; -obsolete_1(httpd, start_child, 0) -> {deprecated,{inets,start,[2,3]},"R14B"}; -obsolete_1(httpd, start_child, 1) -> {deprecated,{inets,start,[2,3]},"R14B"}; -obsolete_1(httpd, stop, 0) -> {deprecated,{inets,stop,2},"R14B"}; -obsolete_1(httpd, stop, 1) -> {deprecated,{inets,stop,2},"R14B"}; -obsolete_1(httpd, stop, 2) -> {deprecated,{inets,stop,2},"R14B"}; -obsolete_1(httpd, stop_child, 0) -> {deprecated,{inets,stop,2},"R14B"}; -obsolete_1(httpd, stop_child, 1) -> {deprecated,{inets,stop,2},"R14B"}; -obsolete_1(httpd, stop_child, 2) -> {deprecated,{inets,stop,2},"R14B"}; -obsolete_1(httpd, restart, 0) -> {deprecated,{httpd,reload_config,2},"R14B"}; -obsolete_1(httpd, restart, 1) -> {deprecated,{httpd,reload_config,2},"R14B"}; -obsolete_1(httpd, restart, 2) -> {deprecated,{httpd,reload_config,2},"R14B"}; -obsolete_1(httpd, block, 0) -> {deprecated,{httpd,reload_config,2},"R14B"}; -obsolete_1(httpd, block, 1) -> {deprecated,{httpd,reload_config,2},"R14B"}; -obsolete_1(httpd, block, 2) -> {deprecated,{httpd,reload_config,2},"R14B"}; -obsolete_1(httpd, block, 3) -> {deprecated,{httpd,reload_config,2},"R14B"}; -obsolete_1(httpd, block, 4) -> {deprecated,{httpd,reload_config,2},"R14B"}; -obsolete_1(httpd, unblock, 0) -> {deprecated,{httpd,reload_config,2},"R14B"}; -obsolete_1(httpd, unblock, 1) -> {deprecated,{httpd,reload_config,2},"R14B"}; -obsolete_1(httpd, unblock, 2) -> {deprecated,{httpd,reload_config,2},"R14B"}; +obsolete_1(http, request, 1) -> {deprecated,{httpc,request,1},"R15B"}; +obsolete_1(http, request, 2) -> {deprecated,{httpc,request,2},"R15B"}; +obsolete_1(http, request, 4) -> {deprecated,{httpc,request,4},"R15B"}; +obsolete_1(http, request, 5) -> {deprecated,{httpc,request,5},"R15B"}; +obsolete_1(http, cancel_request, 1) -> {deprecated,{httpc,cancel_request,1},"R15B"}; +obsolete_1(http, cancel_request, 2) -> {deprecated,{httpc,cancel_request,2},"R15B"}; +obsolete_1(http, set_option, 2) -> {deprecated,{httpc,set_option,2},"R15B"}; +obsolete_1(http, set_option, 3) -> {deprecated,{httpc,set_option,3},"R15B"}; +obsolete_1(http, set_options, 1) -> {deprecated,{httpc,set_options,1},"R15B"}; +obsolete_1(http, set_options, 2) -> {deprecated,{httpc,set_options,2},"R15B"}; +obsolete_1(http, verify_cookies, 2) -> {deprecated,{httpc,verify_cookies,2},"R15B"}; +obsolete_1(http, verify_cookies, 3) -> {deprecated,{httpc,verify_cookies,3},"R15B"}; +obsolete_1(http, cookie_header, 1) -> {deprecated,{httpc,cookie_header,1},"R15B"}; +obsolete_1(http, cookie_header, 2) -> {deprecated,{httpc,cookie_header,2},"R15B"}; +obsolete_1(http, stream_next, 1) -> {deprecated,{httpc,stream_next,1},"R15B"}; +obsolete_1(http, default_profile, 0) -> {deprecated,{httpc,default_profile,0},"R15B"}; + +obsolete_1(httpd, start, 0) -> {removed,{inets,start,[2,3]},"R14B"}; +obsolete_1(httpd, start, 1) -> {removed,{inets,start,[2,3]},"R14B"}; +obsolete_1(httpd, start_link, 0) -> {removed,{inets,start,[2,3]},"R14B"}; +obsolete_1(httpd, start_link, 1) -> {removed,{inets,start,[2,3]},"R14B"}; +obsolete_1(httpd, start_child, 0) -> {removed,{inets,start,[2,3]},"R14B"}; +obsolete_1(httpd, start_child, 1) -> {removed,{inets,start,[2,3]},"R14B"}; +obsolete_1(httpd, stop, 0) -> {removed,{inets,stop,2},"R14B"}; +obsolete_1(httpd, stop, 1) -> {removed,{inets,stop,2},"R14B"}; +obsolete_1(httpd, stop, 2) -> {removed,{inets,stop,2},"R14B"}; +obsolete_1(httpd, stop_child, 0) -> {removed,{inets,stop,2},"R14B"}; +obsolete_1(httpd, stop_child, 1) -> {removed,{inets,stop,2},"R14B"}; +obsolete_1(httpd, stop_child, 2) -> {removed,{inets,stop,2},"R14B"}; +obsolete_1(httpd, restart, 0) -> {removed,{httpd,reload_config,2},"R14B"}; +obsolete_1(httpd, restart, 1) -> {removed,{httpd,reload_config,2},"R14B"}; +obsolete_1(httpd, restart, 2) -> {removed,{httpd,reload_config,2},"R14B"}; +obsolete_1(httpd, block, 0) -> {removed,{httpd,reload_config,2},"R14B"}; +obsolete_1(httpd, block, 1) -> {removed,{httpd,reload_config,2},"R14B"}; +obsolete_1(httpd, block, 2) -> {removed,{httpd,reload_config,2},"R14B"}; +obsolete_1(httpd, block, 3) -> {removed,{httpd,reload_config,2},"R14B"}; +obsolete_1(httpd, block, 4) -> {removed,{httpd,reload_config,2},"R14B"}; +obsolete_1(httpd, unblock, 0) -> {removed,{httpd,reload_config,2},"R14B"}; +obsolete_1(httpd, unblock, 1) -> {removed,{httpd,reload_config,2},"R14B"}; +obsolete_1(httpd, unblock, 2) -> {removed,{httpd,reload_config,2},"R14B"}; obsolete_1(httpd_util, key1search, 2) -> {removed,{proplists,get_value,2},"R13B"}; obsolete_1(httpd_util, key1search, 3) -> {removed,{proplists,get_value,3},"R13B"}; -obsolete_1(ftp, open, 3) -> {deprecated,{inets,start,[2,3]},"R14B"}; -obsolete_1(ftp, force_active, 1) -> {deprecated,{inets,start,[2,3]},"R14B"}; +obsolete_1(ftp, open, 3) -> {removed,{inets,start,[2,3]},"R14B"}; +obsolete_1(ftp, force_active, 1) -> {removed,{inets,start,[2,3]},"R14B"}; %% Added in R12B-4. obsolete_1(ssh_cm, connect, A) when 1 =< A, A =< 3 -> diff --git a/lib/stdlib/src/stdlib.app.src b/lib/stdlib/src/stdlib.app.src index 3e52c48e42..9d15f01683 100644 --- a/lib/stdlib/src/stdlib.app.src +++ b/lib/stdlib/src/stdlib.app.src @@ -1,20 +1,20 @@ %% This is an -*- erlang -*- file. %% %% %CopyrightBegin% -%% -%% Copyright Ericsson AB 1996-2009. All Rights Reserved. -%% +%% +%% Copyright Ericsson AB 1996-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% %% {application, stdlib, @@ -23,6 +23,7 @@ {modules, [array, base64, beam_lib, + binary, c, calendar, dets, diff --git a/lib/stdlib/src/timer.erl b/lib/stdlib/src/timer.erl index 36fdb48c75..6ee837c3e6 100644 --- a/lib/stdlib/src/timer.erl +++ b/lib/stdlib/src/timer.erl @@ -1,19 +1,19 @@ %% %% %CopyrightBegin% -%% -%% Copyright Ericsson AB 1996-2009. All Rights Reserved. -%% +%% +%% Copyright Ericsson AB 1996-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% %% -module(timer). @@ -41,54 +41,54 @@ %% %% Time is in milliseconds. %% --opaque tref() :: any(). +-opaque tref() :: {integer(), reference()}. -type time() :: non_neg_integer(). -type timestamp() :: {non_neg_integer(), non_neg_integer(), non_neg_integer()}. %% %% Interface functions %% --spec apply_after(time(), atom(), atom(), [_]) -> {'ok', tref()} | {'error', _}. +-spec apply_after(time(), atom(), atom(), [term()]) -> {'ok', tref()} | {'error', term()}. apply_after(Time, M, F, A) -> req(apply_after, {Time, {M, F, A}}). --spec send_after(time(), pid() | atom(), term()) -> {'ok', tref()} | {'error', _}. +-spec send_after(time(), pid() | atom(), term()) -> {'ok', tref()} | {'error', term()}. send_after(Time, Pid, Message) -> req(apply_after, {Time, {?MODULE, send, [Pid, Message]}}). --spec send_after(time(), _) -> {'ok', tref()} | {'error', _}. +-spec send_after(time(), term()) -> {'ok', tref()} | {'error', term()}. send_after(Time, Message) -> send_after(Time, self(), Message). --spec exit_after(time(), pid() | atom(), _) -> {'ok', tref()} | {'error', _}. +-spec exit_after(time(), pid() | atom(), term()) -> {'ok', tref()} | {'error', term()}. exit_after(Time, Pid, Reason) -> req(apply_after, {Time, {erlang, exit, [Pid, Reason]}}). --spec exit_after(time(), term()) -> {'ok', tref()} | {'error', _}. +-spec exit_after(time(), term()) -> {'ok', tref()} | {'error', term()}. exit_after(Time, Reason) -> exit_after(Time, self(), Reason). --spec kill_after(time(), pid() | atom()) -> {'ok', tref()} | {'error', _}. +-spec kill_after(time(), pid() | atom()) -> {'ok', tref()} | {'error', term()}. kill_after(Time, Pid) -> exit_after(Time, Pid, kill). --spec kill_after(time()) -> {'ok', tref()} | {'error', _}. +-spec kill_after(time()) -> {'ok', tref()} | {'error', term()}. kill_after(Time) -> exit_after(Time, self(), kill). --spec apply_interval(time(), atom(), atom(), [_]) -> {'ok', tref()} | {'error', _}. +-spec apply_interval(time(), atom(), atom(), [term()]) -> {'ok', tref()} | {'error', term()}. apply_interval(Time, M, F, A) -> req(apply_interval, {Time, self(), {M, F, A}}). --spec send_interval(time(), pid() | atom(), term()) -> {'ok', tref()} | {'error', _}. +-spec send_interval(time(), pid() | atom(), term()) -> {'ok', tref()} | {'error', term()}. send_interval(Time, Pid, Message) -> req(apply_interval, {Time, Pid, {?MODULE, send, [Pid, Message]}}). --spec send_interval(time(), term()) -> {'ok', tref()} | {'error', _}. +-spec send_interval(time(), term()) -> {'ok', tref()} | {'error', term()}. send_interval(Time, Message) -> send_interval(Time, self(), Message). --spec cancel(tref()) -> {'ok', 'cancel'} | {'error', _}. +-spec cancel(tref()) -> {'ok', 'cancel'} | {'error', term()}. cancel(BRef) -> req(cancel, BRef). @@ -101,7 +101,7 @@ sleep(T) -> %% %% Measure the execution time (in microseconds) for an MFA. %% --spec tc(atom(), atom(), [_]) -> {time(), term()}. +-spec tc(atom(), atom(), [term()]) -> {time(), term()}. tc(M, F, A) -> Before = erlang:now(), Val = (catch apply(M, F, A)), @@ -141,7 +141,7 @@ hms(H, M, S) -> start() -> ensure_started(). --spec start_link() -> {'ok', pid()} | {'error', _}. +-spec start_link() -> {'ok', pid()} | {'error', term()}. start_link() -> gen_server:start_link({local, timer_server}, ?MODULE, [], []). @@ -152,6 +152,7 @@ init([]) -> ?INTERVAL_TAB = ets:new(?INTERVAL_TAB, [named_table,protected]), {ok, [], infinity}. +-spec ensure_started() -> 'ok'. ensure_started() -> case whereis(timer_server) of undefined -> @@ -175,6 +176,10 @@ req(Req, Arg) -> %% %% Time and Timeout is in milliseconds. Started is in microseconds. %% +-type timers() :: term(). % XXX: refine? + +-spec handle_call(term(), term(), timers()) -> + {'reply', term(), timers(), timeout()} | {'noreply', timers(), timeout()}. handle_call({apply_after, {Time, Op}, Started}, _From, _Ts) when is_integer(Time), Time >= 0 -> BRef = {Started + 1000*Time, make_ref()}, @@ -194,7 +199,7 @@ handle_call({apply_interval, {Time, To, MFA}, Started}, _From, _Ts) Interval = Time*1000, BRef2 = {Started + Interval, Ref}, Timer = {BRef2, {repeat, Interval, Pid}, MFA}, - ets:insert(?INTERVAL_TAB,{BRef1,BRef2,Pid}), + ets:insert(?INTERVAL_TAB, {BRef1,BRef2,Pid}), ets:insert(?TIMER_TAB, Timer), Timeout = timer_timeout(SysTime), {reply, {ok, BRef1}, [], Timeout}; @@ -202,7 +207,7 @@ handle_call({apply_interval, {Time, To, MFA}, Started}, _From, _Ts) {reply, {error, badarg}, [], next_timeout()} end; handle_call({cancel, BRef = {_Time, Ref}, _}, _From, Ts) - when is_reference(Ref) -> + when is_reference(Ref) -> delete_ref(BRef), {reply, {ok, cancel}, Ts, next_timeout()}; handle_call({cancel, _BRef, _}, _From, Ts) -> @@ -214,6 +219,7 @@ handle_call({apply_interval, _, _}, _From, Ts) -> handle_call(_Else, _From, Ts) -> % Catch anything else {noreply, Ts, next_timeout()}. +-spec handle_info(term(), timers()) -> {'noreply', timers(), timeout()}. handle_info(timeout, Ts) -> % Handle timeouts Timeout = timer_timeout(system_time()), {noreply, Ts, Timeout}; @@ -223,19 +229,21 @@ handle_info({'EXIT', Pid, _Reason}, Ts) -> % Oops, someone died handle_info(_OtherMsg, Ts) -> % Other Msg's {noreply, Ts, next_timeout()}. +-spec handle_cast(term(), timers()) -> {'noreply', timers(), timeout()}. handle_cast(_Req, Ts) -> % Not predicted but handled {noreply, Ts, next_timeout()}. --spec terminate(_, _) -> 'ok'. +-spec terminate(term(), _State) -> 'ok'. terminate(_Reason, _State) -> ok. +-spec code_change(term(), State, term()) -> {'ok', State}. code_change(_OldVsn, State, _Extra) -> %% According to the man for gen server no timer can be set here. {ok, State}. %% -%% timer_timeout(Timers, SysTime) +%% timer_timeout(SysTime) %% %% Apply and remove already timed-out timers. A timer is a tuple %% {Time, BRef, Op, MFA}, where Time is in microseconds. @@ -279,12 +287,13 @@ delete_ref(BRef = {interval, _}) -> ok end; delete_ref(BRef) -> - ets:delete(?TIMER_TAB,BRef). + ets:delete(?TIMER_TAB, BRef). %% %% pid_delete %% +-spec pid_delete(pid()) -> 'ok'. pid_delete(Pid) -> IntervalTimerList = ets:select(?INTERVAL_TAB, @@ -292,13 +301,14 @@ pid_delete(Pid) -> [{'==','$1',Pid}], ['$_']}]), lists:foreach(fun({IntKey, TimerKey, _ }) -> - ets:delete(?INTERVAL_TAB,IntKey), - ets:delete(?TIMER_TAB,TimerKey) + ets:delete(?INTERVAL_TAB, IntKey), + ets:delete(?TIMER_TAB, TimerKey) end, IntervalTimerList). %% Calculate time to the next timeout. Returned timeout must fit in a %% small int. +-spec next_timeout() -> timeout(). next_timeout() -> case ets:first(?TIMER_TAB) of '$end_of_table' -> @@ -358,7 +368,7 @@ get_pid(_) -> get_status() -> Info1 = ets:info(?TIMER_TAB), - {value,{size,TotalNumTimers}} = lists:keysearch(size, 1, Info1), + {size,TotalNumTimers} = lists:keyfind(size, 1, Info1), Info2 = ets:info(?INTERVAL_TAB), - {value,{size,NumIntervalTimers}} = lists:keysearch(size, 1, Info2), + {size,NumIntervalTimers} = lists:keyfind(size, 1, Info2), {{?TIMER_TAB,TotalNumTimers},{?INTERVAL_TAB,NumIntervalTimers}}. diff --git a/lib/stdlib/test/Makefile b/lib/stdlib/test/Makefile index 9beac93eb8..3bbd9ce318 100644 --- a/lib/stdlib/test/Makefile +++ b/lib/stdlib/test/Makefile @@ -9,6 +9,8 @@ MODULES= \ array_SUITE \ base64_SUITE \ beam_lib_SUITE \ + binary_module_SUITE \ + binref \ c_SUITE \ calendar_SUITE \ dets_SUITE \ diff --git a/lib/stdlib/test/binary_module_SUITE.erl b/lib/stdlib/test/binary_module_SUITE.erl new file mode 100644 index 0000000000..16ed9a2c26 --- /dev/null +++ b/lib/stdlib/test/binary_module_SUITE.erl @@ -0,0 +1,1323 @@ +-module(binary_module_SUITE). + +-export([all/1, interesting/1,random_ref_comp/1,random_ref_sr_comp/1, + random_ref_fla_comp/1,parts/1, bin_to_list/1, list_to_bin/1, + copy/1, referenced/1,guard/1,encode_decode/1,badargs/1,longest_common_trap/1]). + +-export([random_number/1, make_unaligned/1]). + + + +%%-define(STANDALONE,1). + +-ifdef(STANDALONE). + +-define(line,erlang:display({?MODULE,?LINE}),). + +-else. + +-include("test_server.hrl"). +-export([init_per_testcase/2, fin_per_testcase/2]). +% Default timetrap timeout (set in init_per_testcase). +% Some of these testcases are really heavy... +-define(default_timeout, ?t:minutes(20)). + +-endif. + + + +-ifdef(STANDALONE). +-export([run/0]). + +run() -> + [ apply(?MODULE,X,[[]]) || X <- all(suite) ]. + +-else. + +init_per_testcase(_Case, Config) -> + ?line Dog = ?t:timetrap(?default_timeout), + [{watchdog, Dog} | Config]. + +fin_per_testcase(_Case, Config) -> + ?line Dog = ?config(watchdog, Config), + ?line test_server:timetrap_cancel(Dog), + ok. +-endif. + +all(suite) -> [interesting,random_ref_fla_comp,random_ref_sr_comp, + random_ref_comp,parts,bin_to_list, list_to_bin, copy, + referenced,guard,encode_decode,badargs,longest_common_trap]. + +-define(MASK_ERROR(EXPR),mask_error((catch (EXPR)))). + + +badargs(doc) -> + ["Tests various badarg exceptions in the module"]; +badargs(Config) when is_list(Config) -> + ?line badarg = ?MASK_ERROR(binary:compile_pattern([<<1,2,3:3>>])), + ?line badarg = ?MASK_ERROR(binary:compile_pattern([<<1,2,3>>|<<1,2>>])), + ?line badarg = ?MASK_ERROR(binary:compile_pattern(<<1,2,3:3>>)), + ?line badarg = ?MASK_ERROR(binary:compile_pattern(<<>>)), + ?line badarg = ?MASK_ERROR(binary:match(<<1,2,3:3>>,<<1>>)), + ?line badarg = ?MASK_ERROR(binary:matches(<<1,2,3:3>>,<<1>>)), + ?line badarg = ?MASK_ERROR(binary:match(<<1,2,3>>,<<1>>, + [{scope,{0,1},1}])), + ?line badarg = ?MASK_ERROR(binary:match(<<1,2,3>>,<<1>>, + [{scape,{0,1}}])), + ?line badarg = ?MASK_ERROR(binary:match(<<1,2,3>>,<<1>>, + [{scope,{0,1,1}}])), + ?line badarg = ?MASK_ERROR(binary:match(<<1,2,3>>,<<1>>,[{scope,0,1}])), + ?line badarg = ?MASK_ERROR(binary:match(<<1,2,3>>,<<1>>,[{scope,[0,1]}])), + ?line badarg = ?MASK_ERROR(binary:match(<<1,2,3>>,<<1>>, + [{scope,{0.1,1}}])), + ?line badarg = ?MASK_ERROR(binary:match(<<1,2,3>>,<<1>>, + [{scope,{1,1.1}}])), + ?line badarg = + ?MASK_ERROR( + binary:match(<<1,2,3>>,<<1>>, + [{scope,{16#FF, + 16#FFFFFFFFFFFFFFFF}}])), + ?line badarg = + ?MASK_ERROR( + binary:match(<<1,2,3>>,<<1>>, + [{scope,{16#FFFFFFFFFFFFFFFF, + -16#7FFFFFFFFFFFFFFF-1}}])), + ?line badarg = + ?MASK_ERROR( + binary:match(<<1,2,3>>,<<1>>, + [{scope,{16#FFFFFFFFFFFFFFFF, + 16#7FFFFFFFFFFFFFFF}}])), + ?line badarg = + ?MASK_ERROR( + binary:part(<<1,2,3>>,{16#FF, + 16#FFFFFFFFFFFFFFFF})), + ?line badarg = + ?MASK_ERROR( + binary:part(<<1,2,3>>,{16#FFFFFFFFFFFFFFFF, + -16#7FFFFFFFFFFFFFFF-1})), + ?line badarg = + ?MASK_ERROR( + binary:part(<<1,2,3>>,{16#FFFFFFFFFFFFFFFF, + 16#7FFFFFFFFFFFFFFF})), + ?line badarg = + ?MASK_ERROR( + binary:part(make_unaligned(<<1,2,3>>),{1,1,1})), + ?line badarg = + ?MASK_ERROR( + binary_part(make_unaligned(<<1,2,3>>),{1,1,1})), + ?line badarg = + ?MASK_ERROR( + binary_part(make_unaligned(<<1,2,3>>),{16#FFFFFFFFFFFFFFFF, + -16#7FFFFFFFFFFFFFFF-1})), + ?line badarg = + ?MASK_ERROR( + binary_part(make_unaligned(<<1,2,3>>),{16#FF, + 16#FFFFFFFFFFFFFFFF})), + ?line badarg = + ?MASK_ERROR( + binary_part(make_unaligned(<<1,2,3>>),{16#FFFFFFFFFFFFFFFF, + 16#7FFFFFFFFFFFFFFF})), + ?line badarg = + ?MASK_ERROR( + binary_part(make_unaligned(<<1,2,3>>),{16#FFFFFFFFFFFFFFFFFF, + -16#7FFF})), + ?line badarg = + ?MASK_ERROR( + binary_part(make_unaligned(<<1,2,3>>),{16#FF, + -16#7FFF})), + ?line badarg = + ?MASK_ERROR( + binary:bin_to_list(<<1,2,3>>,{16#FF, + 16#FFFFFFFFFFFFFFFF})), + ?line badarg = + ?MASK_ERROR( + binary:bin_to_list(<<1,2,3>>,{16#FFFFFFFFFFFFFFFF, + -16#7FFFFFFFFFFFFFFF-1})), + ?line badarg = + ?MASK_ERROR( + binary:bin_to_list(<<1,2,3>>,{16#FFFFFFFFFFFFFFFF, + 16#7FFFFFFFFFFFFFFF})), + ?line [1,2,3] = + ?MASK_ERROR( + binary:bin_to_list(<<1,2,3>>)), + ?line badarg = + ?MASK_ERROR( + binary:bin_to_list(<<1,2,3>>,[])), + ?line badarg = + ?MASK_ERROR( + binary:bin_to_list(<<1,2,3>>,{1,2,3})), + ?line badarg = + ?MASK_ERROR( + binary:bin_to_list(<<1,2,3>>,{1.0,1})), + ?line badarg = + ?MASK_ERROR( + binary:bin_to_list(<<1,2,3>>,{1,1.0})), + ?line badarg = + ?MASK_ERROR( + binary:bin_to_list(<<1,2,3:3>>,{1,1})), + ?line badarg = + ?MASK_ERROR( + binary:bin_to_list(<<1,2,3:3>>)), + ?line badarg = + ?MASK_ERROR( + binary:bin_to_list([1,2,3])), + + ?line nomatch = + ?MASK_ERROR(binary:match(<<1,2,3>>,<<1>>,[{scope,{0,0}}])), + ?line badarg = + ?MASK_ERROR(binary:match(<<1,2,3>>,{bm,<<>>},[{scope,{0,1}}])), + ?line badarg = + ?MASK_ERROR(binary:match(<<1,2,3>>,[],[{scope,{0,1}}])), + ?line badarg = + ?MASK_ERROR(binary:match(<<1,2,3>>,{ac,<<>>},[{scope,{0,1}}])), + ?line {bm,BMMagic} = binary:compile_pattern([<<1,2,3>>]), + ?line {ac,ACMagic} = binary:compile_pattern([<<1,2,3>>,<<4,5>>]), + ?line badarg = + ?MASK_ERROR(binary:match(<<1,2,3>>,{bm,ACMagic},[{scope,{0,1}}])), + ?line badarg = + ?MASK_ERROR(binary:match(<<1,2,3>>,{ac,BMMagic},[{scope,{0,1}}])), + ?line badarg = + ?MASK_ERROR( + binary:match(<<1,2,3>>, + {bm,ets:match_spec_compile([{'_',[],['$_']}])}, + [{scope,{0,1}}])), + ?line badarg = + ?MASK_ERROR( + binary:match(<<1,2,3>>, + {ac,ets:match_spec_compile([{'_',[],['$_']}])}, + [{scope,{0,1}}])), + ?line nomatch = + ?MASK_ERROR(binary:matches(<<1,2,3>>,<<1>>,[{scope,{0,0}}])), + ?line badarg = + ?MASK_ERROR(binary:matches(<<1,2,3>>,{bm,<<>>},[{scope,{0,1}}])), + ?line badarg = + ?MASK_ERROR(binary:matches(<<1,2,3>>,[],[{scope,{0,1}}])), + ?line badarg = + ?MASK_ERROR(binary:matches(<<1,2,3>>,{ac,<<>>},[{scope,{0,1}}])), + ?line badarg = + ?MASK_ERROR(binary:matches(<<1,2,3>>,{bm,ACMagic},[{scope,{0,1}}])), + ?line badarg = + ?MASK_ERROR(binary:matches(<<1,2,3>>,{ac,BMMagic},[{scope,{0,1}}])), + ?line badarg = + ?MASK_ERROR( + binary:matches(<<1,2,3>>, + {bm,ets:match_spec_compile([{'_',[],['$_']}])}, + [{scope,{0,1}}])), + ?line badarg = + ?MASK_ERROR( + binary:matches(<<1,2,3>>, + {ac,ets:match_spec_compile([{'_',[],['$_']}])}, + [{scope,{0,1}}])), + ?line badarg = + ?MASK_ERROR(binary:longest_common_prefix( + [<<0:10000,1,2,4,1:3>>, + <<0:10000,1,2,3>>])), + ?line badarg = + ?MASK_ERROR(binary:longest_common_suffix( + [<<0:10000,1,2,4,1:3>>, + <<0:10000,1,2,3>>])), + ?line badarg = + ?MASK_ERROR(binary:encode_unsigned(-1)), + ?line badarg = + ?MASK_ERROR( + binary:encode_unsigned(-16#FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF)), + ?line badarg = + ?MASK_ERROR( + binary:first(<<1,2,4,1:3>>)), + ?line badarg = + ?MASK_ERROR( + binary:first([1,2,4])), + ?line badarg = + ?MASK_ERROR( + binary:last(<<1,2,4,1:3>>)), + ?line badarg = + ?MASK_ERROR( + binary:last([1,2,4])), + ?line badarg = + ?MASK_ERROR( + binary:at(<<1,2,4,1:3>>,2)), + ?line badarg = + ?MASK_ERROR( + binary:at(<<>>,2)), + ?line badarg = + ?MASK_ERROR( + binary:at([1,2,4],2)), + ok. + +longest_common_trap(doc) -> + ["Whitebox test to force special trap conditions in longest_common_{prefix,suffix}"]; +longest_common_trap(Config) when is_list(Config) -> + ?line erts_debug:set_internal_state(available_internal_state,true), + ?line io:format("oldlimit: ~p~n", + [erts_debug:set_internal_state(binary_loop_limit,10)]), + erlang:bump_reductions(10000000), + ?line _ = binary:longest_common_prefix( + [<<0:10000,1,2,4>>, + <<0:10000,1,2,3>>, + <<0:10000,1,3,3>>, + <<0:10000,1,2,4>>, + <<0:10000,1,2,4>>, + <<0:10000,1,2,3>>, + <<0:10000,1,3,3>>, + <<0:10000,1,2,3>>, + <<0:10000,1,3,3>>, + <<0:10000,1,2,4>>, + <<0:10000,1,2,4>>, + <<0:10000,1,2,3>>, + <<0,0,0,0,0,0,0,0,0,0,0,0,0,0,1,0:10000,1,3,3>>, + <<0:10000,1,2,4>>]), + ?line _ = binary:longest_common_prefix( + [<<0:10000,1,2,4>>, + <<0:10000,1,2,3>>, + <<0:10000,1,3,3>>, + <<0:10000,1,2,4>>, + <<0:10000,1,2,4>>, + <<0:10000,1,2,3>>, + <<0:10000,1,3,3>>, + <<0:10000,1,2,3>>, + <<0:10000,1,3,3>>, + <<0:10000,1,2,4>>, + <<0:10000,1,2,4>>, + <<0:10000,1,2,3>>, + <<0,0,0,0,0,0,0,0,0,0,0,0,0,0>>, + <<0:10000,1,2,4>>]), + erlang:bump_reductions(10000000), + ?line _ = binary:longest_common_suffix( + [<<1,2,4,0:10000>>, + <<1,2,4,0:10000>>, + <<1,2,4,0:10000>>, + <<1,2,4,0:10000>>, + <<1,2,4,0:10000>>, + <<1,2,4,0:10000>>, + <<1,2,4,0:10000>>, + <<1,2,4,0:10000>>, + <<1,2,4,0:10000>>, + <<1,2,4,0:10000>>, + <<1,2,4,0:10000>>, + <<1,2,4,0:10000>>, + <<1,3,3,0:10000,0,1,0,0,0,0,0,0,0,0,0,0,0,0,0,0>>, + <<1,2,4,0:10000>>]), + ?line _ = binary:longest_common_suffix( + [<<1,2,4,0:10000>>, + <<1,2,4,0:10000>>, + <<1,2,4,0:10000>>, + <<1,2,4,0:10000>>, + <<1,2,4,0:10000>>, + <<1,2,4,0:10000>>, + <<1,2,4,0:10000>>, + <<1,2,4,0:10000>>, + <<1,2,4,0:10000>>, + <<1,2,4,0:10000>>, + <<1,2,4,0:10000>>, + <<1,2,4,0:10000>>, + <<0,0,0,0,0,0,0,0,0,0,0,0,0,0>>, + <<1,2,4,0:10000>>]), + Subj = subj(), + Len = byte_size(Subj), + ?line Len = binary:longest_common_suffix( + [Subj,Subj,Subj]), + ?line io:format("limit was: ~p~n", + [erts_debug:set_internal_state(binary_loop_limit, + default)]), + ?line erts_debug:set_internal_state(available_internal_state,false), + ok. + +subj() -> + Me = self(), + spawn(fun() -> + X0 = iolist_to_binary([ + "1234567890", + %lists:seq(16#21, 16#7e), + lists:duplicate(100, $x) + ]), + Me ! X0, + receive X -> X end + end), + X0 = receive A -> A end, + <<X1:32/binary,_/binary>> = X0, + Subject= <<X1/binary>>, + Subject. + + +interesting(doc) -> + ["Try some interesting patterns"]; +interesting(Config) when is_list(Config) -> + X = do_interesting(binary), + X = do_interesting(binref). + +do_interesting(Module) -> + ?line {0,4} = Module:match(<<"123456">>, + Module:compile_pattern([<<"12">>,<<"1234">>, + <<"23">>,<<"3">>, + <<"34">>,<<"456">>, + <<"45">>,<<"6">>])), + ?line [{0,4},{5,1}] = Module:matches(<<"123456">>, + Module:compile_pattern([<<"12">>,<<"1234">>, + <<"23">>,<<"3">>, + <<"34">>,<<"456">>, + <<"45">>,<<"6">>])), + ?line [{0,4}] = Module:matches(<<"123456">>, + Module:compile_pattern([<<"12">>,<<"1234">>, + <<"23">>,<<"3">>, + <<"34">>,<<"456">>, + <<"45">>])), + ?line [{0,2},{2,2}] = Module:matches(<<"123456">>, + Module:compile_pattern([<<"12">>, + <<"23">>,<<"3">>, + <<"34">>,<<"456">>, + <<"45">>])), + ?line {1,4} = Module:match(<<"123456">>, + Module:compile_pattern([<<"34">>,<<"34">>, + <<"12347">>,<<"2345">>])), + ?line [{1,4}] = Module:matches(<<"123456">>, + Module:compile_pattern([<<"34">>,<<"34">>, + <<"12347">>,<<"2345">>])), + ?line [{2,2}] = Module:matches(<<"123456">>, + Module:compile_pattern([<<"34">>,<<"34">>, + <<"12347">>,<<"2346">>])), + + ?line {0,4} = Module:match(<<"123456">>, + [<<"12">>,<<"1234">>, + <<"23">>,<<"3">>, + <<"34">>,<<"456">>, + <<"45">>,<<"6">>]), + ?line [{0,4},{5,1}] = Module:matches(<<"123456">>, + [<<"12">>,<<"1234">>, + <<"23">>,<<"3">>, + <<"34">>,<<"456">>, + <<"45">>,<<"6">>]), + ?line [{0,4}] = Module:matches(<<"123456">>, + [<<"12">>,<<"1234">>, + <<"23">>,<<"3">>, + <<"34">>,<<"456">>, + <<"45">>]), + ?line [{0,2},{2,2}] = Module:matches(<<"123456">>, + [<<"12">>, + <<"23">>,<<"3">>, + <<"34">>,<<"456">>, + <<"45">>]), + ?line {1,4} = Module:match(<<"123456">>, + [<<"34">>,<<"34">>, + <<"12347">>,<<"2345">>]), + ?line [{1,4}] = Module:matches(<<"123456">>, + [<<"34">>,<<"34">>, + <<"12347">>,<<"2345">>]), + ?line [{2,2}] = Module:matches(<<"123456">>, + [<<"34">>,<<"34">>, + <<"12347">>,<<"2346">>]), + ?line nomatch = Module:match(<<1,2,3,4>>,<<2>>,[{scope,{0,1}}]), + ?line {1,1} = Module:match(<<1,2,3,4>>,<<2>>,[{scope,{0,2}}]), + ?line nomatch = Module:match(<<1,2,3,4>>,<<2,3>>,[{scope,{0,2}}]), + ?line {1,2} = Module:match(<<1,2,3,4>>,<<2,3>>,[{scope,{0,3}}]), + ?line {1,2} = Module:match(<<1,2,3,4>>,<<2,3>>,[{scope,{0,4}}]), + ?line badarg = ?MASK_ERROR(Module:match(<<1,2,3,4>>,<<2,3>>, + [{scope,{0,5}}])), + ?line {1,2} = Module:match(<<1,2,3,4>>,<<2,3>>,[{scope,{4,-4}}]), + ?line {0,3} = Module:match(<<1,2,3,4>>,<<1,2,3>>,[{scope,{4,-4}}]), + ?line {0,4} = Module:match(<<1,2,3,4>>,<<1,2,3,4>>,[{scope,{4,-4}}]), + ?line badarg = ?MASK_ERROR(Module:match(<<1,2,3,4>>,<<1,2,3,4>>, + [{scope,{3,-4}}])), + ?line [] = Module:matches(<<1,2,3,4>>,<<2>>,[{scope,{0,1}}]), + ?line [{1,1}] = Module:matches(<<1,2,3,4>>,[<<2>>,<<3>>],[{scope,{0,2}}]), + ?line [] = Module:matches(<<1,2,3,4>>,<<2,3>>,[{scope,{0,2}}]), + ?line [{1,2}] = Module:matches(<<1,2,3,4>>,<<2,3>>,[{scope,{0,3}}]), + ?line [{1,2}] = Module:matches(<<1,2,3,4>>,<<2,3>>,[{scope,{0,4}}]), + ?line [{1,2}] = Module:matches(<<1,2,3,4>>,[<<2,3>>,<<4>>], + [{scope,{0,3}}]), + ?line [{1,2},{3,1}] = Module:matches(<<1,2,3,4>>,[<<2,3>>,<<4>>], + [{scope,{0,4}}]), + ?line badarg = ?MASK_ERROR(Module:matches(<<1,2,3,4>>,<<2,3>>, + [{scope,{0,5}}])), + ?line [{1,2}] = Module:matches(<<1,2,3,4>>,<<2,3>>,[{scope,{4,-4}}]), + ?line [{1,2},{3,1}] = Module:matches(<<1,2,3,4>>,[<<2,3>>,<<4>>], + [{scope,{4,-4}}]), + ?line [{0,3}] = Module:matches(<<1,2,3,4>>,<<1,2,3>>,[{scope,{4,-4}}]), + ?line [{0,4}] = Module:matches(<<1,2,3,4>>,<<1,2,3,4>>,[{scope,{4,-4}}]), + ?line badarg = ?MASK_ERROR(Module:matches(<<1,2,3,4>>,<<1,2,3,4>>, + [{scope,{3,-4}}])), + ?line badarg = ?MASK_ERROR(Module:matches(<<1,2,3,4>>,[<<1,2,3,4>>], + [{scope,{3,-4}}])), + ?line [<<1,2,3>>,<<6,7,8>>] = Module:split(<<1,2,3,4,5,6,7,8>>,<<4,5>>), + ?line [<<1,2,3>>,<<6,7,8>>] = Module:split(<<1,2,3,4,5,6,7,8>>, + [<<4,5>>,<<7>>]), + ?line [<<1,2,3>>,<<6>>,<<8>>] = Module:split(<<1,2,3,4,5,6,7,8>>, + [<<4,5>>,<<7>>],[global]), + ?line [<<1,2,3>>,<<6>>,<<>>,<<>>] = Module:split(<<1,2,3,4,5,6,7,8>>, + [<<4,5>>,<<7>>,<<8>>], + [global]), + ?line [<<1,2,3>>,<<6>>] = Module:split(<<1,2,3,4,5,6,7,8>>, + [<<4,5>>,<<7>>,<<8>>], + [global,trim]), + ?line [<<1,2,3,4,5,6,7,8>>] = Module:split(<<1,2,3,4,5,6,7,8>>, + [<<4,5>>,<<7>>,<<8>>], + [global,trim,{scope,{0,4}}]), + ?line [<<1,2,3>>,<<6,7,8>>] = Module:split(<<1,2,3,4,5,6,7,8>>, + [<<4,5>>,<<7>>,<<8>>], + [global,trim,{scope,{0,5}}]), + ?line badarg = ?MASK_ERROR( + Module:replace(<<1,2,3,4,5,6,7,8>>, + [<<4,5>>,<<7>>,<<8>>],<<99>>, + [global,trim,{scope,{0,5}}])), + ?line <<1,2,3,99,6,7,8>> = Module:replace(<<1,2,3,4,5,6,7,8>>, + [<<4,5>>,<<7>>,<<8>>],<<99>>,[]), + ?line <<1,2,3,99,6,99,99>> = Module:replace(<<1,2,3,4,5,6,7,8>>, + [<<4,5>>,<<7>>,<<8>>],<<99>>, + [global]), + ?line <<1,2,3,99,6,7,8>> = Module:replace(<<1,2,3,4,5,6,7,8>>, + [<<4,5>>,<<7>>,<<8>>],<<99>>, + [global,{scope,{0,5}}]), + ?line <<1,2,3,99,6,7,8>> = Module:replace(<<1,2,3,4,5,6,7,8>>, + [<<4,5>>,<<7>>,<<8>>],<<99>>, + [global,{scope,{0,5}}]), + ?line <<1,2,3,99,6,7,8>> = Module:replace(<<1,2,3,4,5,6,7,8>>, + [<<4,5>>,<<7>>,<<8>>],<<99>>, + [global,{scope,{0,5}}]), + ?line badarg = ?MASK_ERROR(Module:replace(<<1,2,3,4,5,6,7,8>>, + [<<4,5>>,<<7>>,<<8>>],<<99>>, + [global,{scope,{0,5}}, + {insert,1}])), + ?line <<1,2,3,99,4,5,6,7,8>> = Module:replace(<<1,2,3,4,5,6,7,8>>, + [<<4,5>>,<<7>>,<<8>>],<<99>>, + [global,{scope,{0,5}}, + {insert_replaced,1}]), + ?line <<1,2,3,9,4,5,9,6,7,8>> = Module:replace(<<1,2,3,4,5,6,7,8>>, + [<<4,5>>,<<7>>,<<8>>], + <<9,9>>, + [global,{scope,{0,5}}, + {insert_replaced,1}]), + ?line badarg = ?MASK_ERROR(Module:replace(<<1,2,3,4,5,6,7,8>>, + [<<4,5>>,<<7>>,<<8>>],<<>>, + [global,{scope,{0,5}}, + {insert_replaced,1}])), + ?line 2 = Module:longest_common_prefix([<<1,2,4>>,<<1,2,3>>]), + ?line 2 = Module:longest_common_prefix([<<1,2,4>>,<<1,2>>]), + ?line 1 = Module:longest_common_prefix([<<1,2,4>>,<<1>>]), + ?line 0 = Module:longest_common_prefix([<<1,2,4>>,<<>>]), + ?line 1 = Module:longest_common_prefix([<<1,2,4>>,<<1,2,3>>,<<1,3,3>>]), + ?line 1 = Module:longest_common_prefix([<<1,2,4>>,<<1,2,3>>,<<1,3,3>>,<<1,2,4>>]), + ?line 1251 = Module:longest_common_prefix([<<0:10000,1,2,4>>, + <<0:10000,1,2,3>>, + <<0:10000,1,3,3>>, + <<0:10000,1,2,4>>]), + ?line 12501 = Module:longest_common_prefix([<<0:100000,1,2,4>>, + <<0:100000,1,2,3>>, + <<0:100000,1,3,3>>, + <<0:100000,1,2,4>>]), + ?line 1251 = Module:longest_common_prefix( + [make_unaligned(<<0:10000,1,2,4>>), + <<0:10000,1,2,3>>, + make_unaligned(<<0:10000,1,3,3>>), + <<0:10000,1,2,4>>]), + ?line 12501 = Module:longest_common_prefix( + [<<0:100000,1,2,4>>, + make_unaligned(<<0:100000,1,2,3>>), + <<0:100000,1,3,3>>, + make_unaligned(<<0:100000,1,2,4>>)]), + ?line 1250001 = Module:longest_common_prefix([<<0:10000000,1,2,4>>, + <<0:10000000,1,2,3>>, + <<0:10000000,1,3,3>>, + <<0:10000000,1,2,4>>]), + if % Too cruel for the reference implementation + Module =:= binary -> + ?line erts_debug:set_internal_state(available_internal_state,true), + ?line io:format("oldlimit: ~p~n", + [erts_debug:set_internal_state( + binary_loop_limit,100)]), + ?line 1250001 = Module:longest_common_prefix( + [<<0:10000000,1,2,4>>, + <<0:10000000,1,2,3>>, + <<0:10000000,1,3,3>>, + <<0:10000000,1,2,4>>]), + ?line io:format("limit was: ~p~n", + [erts_debug:set_internal_state(binary_loop_limit, + default)]), + ?line erts_debug:set_internal_state(available_internal_state, + false); + true -> + ok + end, + ?line 1 = Module:longest_common_suffix([<<0:100000000,1,2,4,5>>, + <<0:100000000,1,2,3,5>>, + <<0:100000000,1,3,3,5>>, + <<0:100000000,1,2,4,5>>]), + ?line 1 = Module:longest_common_suffix([<<1,2,4,5>>, + <<0:100000000,1,2,3,5>>, + <<0:100000000,1,3,3,5>>, + <<0:100000000,1,2,4,5>>]), + ?line 1 = Module:longest_common_suffix([<<1,2,4,5,5>>,<<5,5>>, + <<0:100000000,1,3,3,5,5>>, + <<0:100000000,1,2,4,5>>]), + ?line 0 = Module:longest_common_suffix([<<1,2,4,5,5>>,<<5,5>>, + <<0:100000000,1,3,3,5,5>>, + <<0:100000000,1,2,4>>]), + ?line 2 = Module:longest_common_suffix([<<1,2,4,5,5>>,<<5,5>>, + <<0:100000000,1,3,3,5,5>>, + <<0:100000000,1,2,4,5,5>>]), + ?line 1 = Module:longest_common_suffix([<<1,2,4,5,5>>,<<5>>, + <<0:100000000,1,3,3,5,5>>, + <<0:100000000,1,2,4,5,5>>]), + ?line 0 = Module:longest_common_suffix([<<1,2,4,5,5>>,<<>>, + <<0:100000000,1,3,3,5,5>>, + <<0:100000000,1,2,4,5,5>>]), + ?line 0 = Module:longest_common_suffix([<<>>,<<0:100000000,1,3,3,5,5>>, + <<0:100000000,1,2,4,5,5>>]), + ?line 0 = Module:longest_common_suffix([<<>>,<<0:100000000,1,3,3,5,5>>, + <<0:100000000,1,2,4,5,5>>]), + ?line 2 = Module:longest_common_suffix([<<5,5>>,<<0:100000000,1,3,3,5,5>>, + <<0:100000000,1,2,4,5,5>>]), + ?line 2 = Module:longest_common_suffix([<<5,5>>,<<5,5>>,<<4,5,5>>]), + ?line 2 = Module:longest_common_suffix([<<5,5>>,<<5,5>>,<<5,5>>]), + ?line 3 = Module:longest_common_suffix([<<4,5,5>>,<<4,5,5>>,<<4,5,5>>]), + ?line 0 = Module:longest_common_suffix([<<>>]), + ?line badarg = ?MASK_ERROR(Module:longest_common_suffix([])), + ?line badarg = ?MASK_ERROR(Module:longest_common_suffix([apa])), + ?line badarg = ?MASK_ERROR(Module:longest_common_suffix([[<<>>]])), + ?line badarg = ?MASK_ERROR(Module:longest_common_suffix([[<<0>>, + <<1:9>>]])), + ?line 0 = Module:longest_common_prefix([<<>>]), + ?line badarg = ?MASK_ERROR(Module:longest_common_prefix([])), + ?line badarg = ?MASK_ERROR(Module:longest_common_prefix([apa])), + ?line badarg = ?MASK_ERROR(Module:longest_common_prefix([[<<>>]])), + ?line badarg = ?MASK_ERROR(Module:longest_common_prefix([[<<0>>, + <<1:9>>]])), + + ?line <<1:6,Bin:3/binary,_:2>> = <<1:6,1,2,3,1:2>>, + ?line <<1,2,3>> = Bin, + ?line 1 = Module:first(Bin), + ?line 1 = Module:first(<<1>>), + ?line 1 = Module:first(<<1,2,3>>), + ?line badarg = ?MASK_ERROR(Module:first(<<>>)), + ?line badarg = ?MASK_ERROR(Module:first(apa)), + ?line 3 = Module:last(Bin), + ?line 1 = Module:last(<<1>>), + ?line 3 = Module:last(<<1,2,3>>), + ?line badarg = ?MASK_ERROR(Module:last(<<>>)), + ?line badarg = ?MASK_ERROR(Module:last(apa)), + ?line 1 = Module:at(Bin,0), + ?line 1 = Module:at(<<1>>,0), + ?line 1 = Module:at(<<1,2,3>>,0), + ?line 2 = Module:at(<<1,2,3>>,1), + ?line 3 = Module:at(<<1,2,3>>,2), + ?line badarg = ?MASK_ERROR(Module:at(<<1,2,3>>,3)), + ?line badarg = ?MASK_ERROR(Module:at(<<1,2,3>>,-1)), + ?line badarg = ?MASK_ERROR(Module:at(<<1,2,3>>,apa)), + ?line "hejsan" = [ Module:at(<<"hejsan">>,I) || I <- lists:seq(0,5) ], + + ?line badarg = ?MASK_ERROR(Module:bin_to_list(<<1,2,3>>,3,-4)), + ?line [1,2,3] = ?MASK_ERROR(Module:bin_to_list(<<1,2,3>>,3,-3)), + + ?line badarg = ?MASK_ERROR(Module:decode_unsigned(<<1,2,1:2>>,big)), + ?line badarg = ?MASK_ERROR(Module:decode_unsigned(<<1,2,1:2>>,little)), + ?line badarg = ?MASK_ERROR(Module:decode_unsigned(apa)), + ?line badarg = ?MASK_ERROR(Module:decode_unsigned(125,little)), + ?line 0 = ?MASK_ERROR(Module:decode_unsigned(<<>>,little)), + ?line 0 = ?MASK_ERROR(Module:decode_unsigned(<<>>,big)), + ?line 0 = ?MASK_ERROR(Module:decode_unsigned(<<0>>,little)), + ?line 0 = ?MASK_ERROR(Module:decode_unsigned(<<0>>,big)), + ?line 0 = ?MASK_ERROR(Module:decode_unsigned(make_unaligned(<<0>>), + little)), + ?line 0 = ?MASK_ERROR(Module:decode_unsigned(make_unaligned(<<0>>),big)), + ?line badarg = ?MASK_ERROR(Module:encode_unsigned(apa)), + ?line badarg = ?MASK_ERROR(Module:encode_unsigned(125.3,little)), + ?line badarg = ?MASK_ERROR(Module:encode_unsigned({1},little)), + ?line badarg = ?MASK_ERROR(Module:encode_unsigned([1],little)), + ?line <<0>> = ?MASK_ERROR(Module:encode_unsigned(0,little)), + ?line <<0>> = ?MASK_ERROR(Module:encode_unsigned(0,big)), + ok. + +encode_decode(doc) -> + ["test binary:encode_unsigned/1,2 and binary:decode_unsigned/1,2"]; +encode_decode(Config) when is_list(Config) -> + ?line random:seed({1271,769940,559934}), + ?line ok = encode_decode_loop({1,200},1000), % Need to be long enough + % to create offheap binaries + ok. + +encode_decode_loop(_Range,0) -> + ok; +encode_decode_loop(Range, X) -> + ?line N = random_number(Range), + ?line A = binary:encode_unsigned(N), + ?line B = binary:encode_unsigned(N,big), + ?line C = binref:encode_unsigned(N), + ?line D = binref:encode_unsigned(N,big), + ?line E = binary:encode_unsigned(N,little), + ?line F = binref:encode_unsigned(N,little), + ?line G = binary:decode_unsigned(A), + ?line H = binary:decode_unsigned(A,big), + ?line I = binref:decode_unsigned(A), + ?line J = binary:decode_unsigned(E,little), + ?line K = binref:decode_unsigned(E,little), + ?line L = binary:decode_unsigned(make_unaligned(A)), + ?line M = binary:decode_unsigned(make_unaligned(E),little), + ?line PaddedBig = <<0:48,A/binary>>, + ?line PaddedLittle = <<E/binary,0:48>>, + ?line O = binary:decode_unsigned(PaddedBig), + ?line P = binary:decode_unsigned(make_unaligned(PaddedBig)), + ?line Q = binary:decode_unsigned(PaddedLittle,little), + ?line R = binary:decode_unsigned(make_unaligned(PaddedLittle),little), + ?line S = binref:decode_unsigned(PaddedLittle,little), + ?line T = binref:decode_unsigned(PaddedBig), + case (((A =:= B) and (B =:= C) and (C =:= D)) and + ((E =:= F)) and + ((N =:= G) and (G =:= H) and (H =:= I) and + (I =:= J) and (J =:= K) and (K =:= L) and (L =:= M)) and + ((M =:= O) and (O =:= P) and (P =:= Q) and (Q =:= R) and + (R =:= S) and (S =:= T)))of + true -> + encode_decode_loop(Range,X-1); + _ -> + io:format("Failed to encode/decode ~w~n(Results ~p)~n", + [N,[A,B,C,D,E,F,G,H,I,J,K,L,M,x,O,P,Q,R,S,T]]), + exit(mismatch) + end. + +guard(doc) -> + ["Smoke test of the guard BIFs binary_part/2,3"]; +guard(Config) when is_list(Config) -> + {comment, "Guard tests are run in emulator test suite"}. + +referenced(doc) -> + ["Test refernced_byte_size/1 bif."]; +referenced(Config) when is_list(Config) -> + ?line badarg = ?MASK_ERROR(binary:referenced_byte_size([])), + ?line badarg = ?MASK_ERROR(binary:referenced_byte_size(apa)), + ?line badarg = ?MASK_ERROR(binary:referenced_byte_size({})), + ?line badarg = ?MASK_ERROR(binary:referenced_byte_size(1)), + ?line A = <<1,2,3>>, + ?line B = binary:copy(A,1000), + ?line 3 = binary:referenced_byte_size(A), + ?line 3000 = binary:referenced_byte_size(B), + ?line <<_:8,C:2/binary>> = A, + ?line 3 = binary:referenced_byte_size(C), + ?line 2 = binary:referenced_byte_size(binary:copy(C)), + ?line <<_:7,D:2/binary,_:1>> = A, + ?line 2 = binary:referenced_byte_size(binary:copy(D)), + ?line 3 = binary:referenced_byte_size(D), + ?line <<_:8,E:2/binary,_/binary>> = B, + ?line 3000 = binary:referenced_byte_size(E), + ?line 2 = binary:referenced_byte_size(binary:copy(E)), + ?line <<_:7,F:2/binary,_:1,_/binary>> = B, + ?line 2 = binary:referenced_byte_size(binary:copy(F)), + ?line 3000 = binary:referenced_byte_size(F), + ok. + + + +list_to_bin(doc) -> + ["Test list_to_bin/1 bif"]; +list_to_bin(Config) when is_list(Config) -> + %% Just some smoke_tests first, then go nuts with random cases + ?line badarg = ?MASK_ERROR(binary:list_to_bin({})), + ?line badarg = ?MASK_ERROR(binary:list_to_bin(apa)), + ?line badarg = ?MASK_ERROR(binary:list_to_bin(<<"apa">>)), + F1 = fun(L) -> + ?MASK_ERROR(binref:list_to_bin(L)) + end, + F2 = fun(L) -> + ?MASK_ERROR(binary:list_to_bin(L)) + end, + ?line random_iolist:run(1000,F1,F2), + ok. + +copy(doc) -> + ["Test copy/1,2 bif's"]; +copy(Config) when is_list(Config) -> + ?line <<1,2,3>> = binary:copy(<<1,2,3>>), + ?line RS = random_string({1,10000}), + ?line RS = RS2 = binary:copy(RS), + ?line false = erts_debug:same(RS,RS2), + ?line <<>> = ?MASK_ERROR(binary:copy(<<1,2,3>>,0)), + ?line badarg = ?MASK_ERROR(binary:copy(<<1,2,3:3>>,2)), + ?line badarg = ?MASK_ERROR(binary:copy([],0)), + ?line <<>> = ?MASK_ERROR(binary:copy(<<>>,0)), + ?line badarg = ?MASK_ERROR(binary:copy(<<1,2,3>>,1.0)), + ?line badarg = ?MASK_ERROR(binary:copy(<<1,2,3>>, + 16#FFFFFFFFFFFFFFFFFFFFFFFFFFFFFF)), + ?line <<>> = binary:copy(<<>>,10000), + ?line random:seed({1271,769940,559934}), + ?line ok = random_copy(3000), + ?line erts_debug:set_internal_state(available_internal_state,true), + ?line io:format("oldlimit: ~p~n", + [erts_debug:set_internal_state(binary_loop_limit,10)]), + ?line Subj = subj(), + ?line XX = binary:copy(Subj,1000), + ?line XX = binref:copy(Subj,1000), + ?line ok = random_copy(1000), + ?line kill_copy_loop(1000), + ?line io:format("limit was: ~p~n", + [erts_debug:set_internal_state(binary_loop_limit, + default)]), + ?line erts_debug:set_internal_state(available_internal_state,false), + ok. + +kill_copy_loop(0) -> + ok; +kill_copy_loop(N) -> + {Pid,Ref} = spawn_monitor(fun() -> + ok = random_copy(1000) + end), + receive + after 10 -> + ok + end, + exit(Pid,kill), + receive + {'DOWN',Ref,process,Pid,_} -> + kill_copy_loop(N-1) + after 1000 -> + exit(did_not_die) + end. + +random_copy(0) -> + ok; +random_copy(N) -> + Str = random_string({0,N}), + Num = random:uniform(N div 10+1), + A = ?MASK_ERROR(binary:copy(Str,Num)), + B = ?MASK_ERROR(binref:copy(Str,Num)), + C = ?MASK_ERROR(binary:copy(make_unaligned(Str),Num)), + case {(A =:= B), (B =:= C)} of + {true,true} -> + random_copy(N-1); + _ -> + io:format("Failed to pick copy ~s ~p times~n", + [Str,Num]), + io:format("A:~p,~nB:~p,~n,C:~p.~n", + [A,B,C]), + exit(mismatch) + end. + +bin_to_list(doc) -> + ["Test bin_to_list/1,2,3 bif's"]; +bin_to_list(Config) when is_list(Config) -> + %% Just some smoke_tests first, then go nuts with random cases + ?line X = <<1,2,3,4,0:1000000,5>>, + ?line Y = make_unaligned(X), + ?line LX = binary:bin_to_list(X), + ?line LX = binary:bin_to_list(X,0,byte_size(X)), + ?line LX = binary:bin_to_list(X,byte_size(X),-byte_size(X)), + ?line LX = binary:bin_to_list(X,{0,byte_size(X)}), + ?line LX = binary:bin_to_list(X,{byte_size(X),-byte_size(X)}), + ?line LY = binary:bin_to_list(Y), + ?line LY = binary:bin_to_list(Y,0,byte_size(Y)), + ?line LY = binary:bin_to_list(Y,byte_size(Y),-byte_size(Y)), + ?line LY = binary:bin_to_list(Y,{0,byte_size(Y)}), + ?line LY = binary:bin_to_list(Y,{byte_size(Y),-byte_size(Y)}), + ?line 1 = hd(LX), + ?line 5 = lists:last(LX), + ?line 1 = hd(LY), + ?line 5 = lists:last(LY), + ?line X = list_to_binary(LY), + ?line Y = list_to_binary(LY), + ?line X = list_to_binary(LY), + ?line [5] = lists:nthtail(byte_size(X)-1,LX), + ?line [0,5] = lists:nthtail(byte_size(X)-2,LX), + ?line [0,5] = lists:nthtail(byte_size(Y)-2,LY), + ?line random:seed({1271,769940,559934}), + ?line ok = random_bin_to_list(5000), + ok. + +random_bin_to_list(0) -> + ok; +random_bin_to_list(N) -> + Str = random_string({1,N}), + Parts0 = random_parts(10,N), + Parts1 = Parts0 ++ [ {X+Y,-Y} || {X,Y} <- Parts0 ], + [ begin + try + true = ?MASK_ERROR(binary:bin_to_list(Str,Z)) =:= + ?MASK_ERROR(binref:bin_to_list(Str,Z)), + true = ?MASK_ERROR(binary:bin_to_list(Str,Z)) =:= + ?MASK_ERROR(binary:bin_to_list(make_unaligned(Str),Z)) + catch + _:_ -> + io:format("Error, Str = <<\"~s\">>.~nZ = ~p.~n", + [Str,Z]), + exit(badresult) + end + end || Z <- Parts1 ], + [ begin + try + true = ?MASK_ERROR(binary:bin_to_list(Str,A,B)) =:= + ?MASK_ERROR(binref:bin_to_list(Str,A,B)), + true = ?MASK_ERROR(binary:bin_to_list(Str,A,B)) =:= + ?MASK_ERROR(binary:bin_to_list(make_unaligned(Str),A,B)) + catch + _:_ -> + io:format("Error, Str = <<\"~s\">>.~nA = ~p.~nB = ~p.~n", + [Str,A,B]), + exit(badresult) + end + end || {A,B} <- Parts1 ], + random_bin_to_list(N-1). + +parts(doc) -> + ["Test the part/2,3 bif's"]; +parts(Config) when is_list(Config) -> + %% Some simple smoke tests to begin with + ?line Simple = <<1,2,3,4,5,6,7,8>>, + ?line <<1,2>> = binary:part(Simple,0,2), + ?line <<1,2>> = binary:part(Simple,{0,2}), + ?line Simple = binary:part(Simple,0,8), + ?line Simple = binary:part(Simple,{0,8}), + ?line badarg = ?MASK_ERROR(binary:part(Simple,0,9)), + ?line badarg = ?MASK_ERROR(binary:part(Simple,{0,9})), + ?line badarg = ?MASK_ERROR(binary:part(Simple,1,8)), + ?line badarg = ?MASK_ERROR(binary:part(Simple,{1,8})), + ?line badarg = ?MASK_ERROR(binary:part(Simple,{3,-4})), + ?line badarg = ?MASK_ERROR(binary:part(Simple,{3.0,1})), + ?line badarg = ?MASK_ERROR( + binary:part(Simple,{16#FFFFFFFFFFFFFFFFFFFFFFFFFFFFF + ,1})), + ?line <<2,3,4,5,6,7,8>> = binary:part(Simple,{1,7}), + ?line <<2,3,4,5,6,7,8>> = binary:part(Simple,{8,-7}), + ?line Simple = binary:part(Simple,{8,-8}), + ?line badarg = ?MASK_ERROR(binary:part(Simple,{1,-8})), + ?line badarg = ?MASK_ERROR(binary:part(Simple,{8,-9})), + ?line badarg = ?MASK_ERROR(binary:part(Simple,{0,-1})), + ?line <<>> = binary:part(Simple,{8,0}), + ?line badarg = ?MASK_ERROR(binary:part(Simple,{9,0})), + ?line badarg = ?MASK_ERROR(binary:part(Simple,{-1,0})), + ?line badarg = ?MASK_ERROR(binary:part(Simple,{7,2})), + ?line <<8>> = binary:part(Simple,{7,1}), + ?line random:seed({1271,769940,559934}), + ?line random_parts(5000), + ok. + + +random_parts(0) -> + ok; +random_parts(N) -> + Str = random_string({1,N}), + Parts0 = random_parts(10,N), + Parts1 = Parts0 ++ [ {X+Y,-Y} || {X,Y} <- Parts0 ], + [ begin + true = ?MASK_ERROR(binary:part(Str,Z)) =:= + ?MASK_ERROR(binref:part(Str,Z)), + true = ?MASK_ERROR(binary:part(Str,Z)) =:= + ?MASK_ERROR(erlang:binary_part(Str,Z)), + true = ?MASK_ERROR(binary:part(Str,Z)) =:= + ?MASK_ERROR(binary:part(make_unaligned(Str),Z)) + end || Z <- Parts1 ], + random_parts(N-1). + +random_parts(0,_) -> + []; +random_parts(X,N) -> + Pos = random:uniform(N), + Len = random:uniform((Pos * 12) div 10), + [{Pos,Len} | random_parts(X-1,N)]. + +random_ref_comp(doc) -> + ["Test pseudorandomly generated cases against reference imlementation"]; +random_ref_comp(Config) when is_list(Config) -> + ?line put(success_counter,0), + ?line random:seed({1271,769940,559934}), + ?line do_random_match_comp(5000,{1,40},{30,1000}), + io:format("Number of successes: ~p~n",[get(success_counter)]), + ?line do_random_match_comp2(5000,{1,40},{30,1000}), + io:format("Number of successes: ~p~n",[get(success_counter)]), + ?line do_random_match_comp3(5000,{1,40},{30,1000}), + io:format("Number of successes: ~p~n",[get(success_counter)]), + ?line do_random_match_comp4(5000,{1,40},{30,1000}), + io:format("Number of successes: ~p~n",[get(success_counter)]), + ?line do_random_matches_comp(5000,{1,40},{30,1000}), + io:format("Number of successes: ~p~n",[get(success_counter)]), + ?line do_random_matches_comp2(5000,{1,40},{30,1000}), + io:format("Number of successes: ~p~n",[get(success_counter)]), + ?line do_random_matches_comp3(5,{1,40},{30,1000}), + ?line erts_debug:set_internal_state(available_internal_state,true), + ?line io:format("oldlimit: ~p~n",[ erts_debug:set_internal_state(binary_loop_limit,100)]), + ?line do_random_match_comp(5000,{1,40},{30,1000}), + ?line do_random_matches_comp3(5,{1,40},{30,1000}), + ?line io:format("limit was: ~p~n",[ erts_debug:set_internal_state(binary_loop_limit,default)]), + ?line erts_debug:set_internal_state(available_internal_state,false), + ok. + +random_ref_sr_comp(doc) -> + ["Test pseudorandomly generated cases against reference imlementation of split and replace"]; +random_ref_sr_comp(Config) when is_list(Config) -> + ?line put(success_counter,0), + ?line random:seed({1271,769940,559934}), + ?line do_random_split_comp(5000,{1,40},{30,1000}), + io:format("Number of successes: ~p~n",[get(success_counter)]), + ?line do_random_replace_comp(5000,{1,40},{30,1000}), + io:format("Number of successes: ~p~n",[get(success_counter)]), + ?line do_random_split_comp2(5000,{1,40},{30,1000}), + io:format("Number of successes: ~p~n",[get(success_counter)]), + ?line do_random_replace_comp2(5000,{1,40},{30,1000}), + io:format("Number of successes: ~p~n",[get(success_counter)]), + ok. +random_ref_fla_comp(doc) -> + ["Test pseudorandomly generated cases against reference imlementation of split and replace"]; +random_ref_fla_comp(Config) when is_list(Config) -> + ?line put(success_counter,0), + ?line random:seed({1271,769940,559934}), + ?line do_random_first_comp(5000,{1,1000}), + ?line do_random_last_comp(5000,{1,1000}), + ?line do_random_at_comp(5000,{1,1000}), + io:format("Number of successes: ~p~n",[get(success_counter)]), + ok. + +do_random_first_comp(0,_) -> + ok; +do_random_first_comp(N,Range) -> + S = random_string(Range), + A = ?MASK_ERROR(binref:first(S)), + B = ?MASK_ERROR(binary:first(S)), + C = ?MASK_ERROR(binary:first(make_unaligned(S))), + case {(A =:= B), (B =:= C)} of + {true,true} -> + do_random_first_comp(N-1,Range); + _ -> + io:format("Failed to pick first of ~s~n", + [S]), + io:format("A:~p,~nB:~p,~n,C:~p.~n", + [A,B,C]), + exit(mismatch) + end. + +do_random_last_comp(0,_) -> + ok; +do_random_last_comp(N,Range) -> + S = random_string(Range), + A = ?MASK_ERROR(binref:last(S)), + B = ?MASK_ERROR(binary:last(S)), + C = ?MASK_ERROR(binary:last(make_unaligned(S))), + case {(A =:= B), (B =:= C)} of + {true,true} -> + do_random_last_comp(N-1,Range); + _ -> + io:format("Failed to pick last of ~s~n", + [S]), + io:format("A:~p,~nB:~p,~n,C:~p.~n", + [A,B,C]), + exit(mismatch) + end. +do_random_at_comp(0,_) -> + ok; +do_random_at_comp(N,{Min,Max}=Range) -> + S = random_string(Range), + XMax = Min + ((Max - Min) * 3) div 4, + Pos = random_length({Min,XMax}), %% some out of range + A = ?MASK_ERROR(binref:at(S,Pos)), + B = ?MASK_ERROR(binary:at(S,Pos)), + C = ?MASK_ERROR(binary:at(make_unaligned(S),Pos)), + if + A =/= badarg -> + put(success_counter,get(success_counter)+1); + true -> + ok + end, + case {(A =:= B), (B =:= C)} of + {true,true} -> + do_random_at_comp(N-1,Range); + _ -> + io:format("Failed to pick last of ~s~n", + [S]), + io:format("A:~p,~nB:~p,~n,C:~p.~n", + [A,B,C]), + exit(mismatch) + end. + +do_random_matches_comp(0,_,_) -> + ok; +do_random_matches_comp(N,NeedleRange,HaystackRange) -> + NumNeedles = element(2,HaystackRange) div element(2,NeedleRange), + Needles = [random_string(NeedleRange) || + _ <- lists:duplicate(NumNeedles,a)], + Haystack = random_string(HaystackRange), + true = do_matches_comp(Needles,Haystack), + do_random_matches_comp(N-1,NeedleRange,HaystackRange). + +do_random_matches_comp2(0,_,_) -> + ok; +do_random_matches_comp2(N,NeedleRange,HaystackRange) -> + NumNeedles = element(2,HaystackRange) div element(2,NeedleRange), + Haystack = random_string(HaystackRange), + Needles = [random_substring(NeedleRange,Haystack) || + _ <- lists:duplicate(NumNeedles,a)], + true = do_matches_comp(Needles,Haystack), + do_random_matches_comp2(N-1,NeedleRange,HaystackRange). + +do_random_matches_comp3(0,_,_) -> + ok; +do_random_matches_comp3(N,NeedleRange,HaystackRange) -> + NumNeedles = element(2,HaystackRange) div element(2,NeedleRange), + Haystack = random_string(HaystackRange), + Needles = [random_substring(NeedleRange,Haystack) || + _ <- lists:duplicate(NumNeedles,a)], + RefRes = binref:matches(Haystack,Needles), + true = do_matches_comp_loop(10000,Needles,Haystack, RefRes), + do_random_matches_comp3(N-1,NeedleRange,HaystackRange). + +do_matches_comp_loop(0,_,_,_) -> + true; +do_matches_comp_loop(N, Needles, Haystack0,RR) -> + DummySize=N*8, + Haystack1 = <<0:DummySize,Haystack0/binary>>, + RR1=[{X+N,Y} || {X,Y} <- RR], + true = do_matches_comp2(Needles,Haystack1,RR1), + Haystack2 = <<Haystack0/binary,Haystack1/binary>>, + RR2 = RR ++ [{X2+N+byte_size(Haystack0),Y2} || {X2,Y2} <- RR], + true = do_matches_comp2(Needles,Haystack2,RR2), + do_matches_comp_loop(N-1, Needles, Haystack0,RR). + + +do_matches_comp2(N,H,A) -> + C = ?MASK_ERROR(binary:matches(H,N)), + case (A =:= C) of + true -> + true; + _ -> + io:format("Failed to match ~p (needle) against ~s (haystack)~n", + [N,H]), + io:format("A:~p,~n,C:~p.~n", + [A,C]), + exit(mismatch) + end. +do_matches_comp(N,H) -> + A = ?MASK_ERROR(binref:matches(H,N)), + B = ?MASK_ERROR(binref:matches(H,binref:compile_pattern(N))), + C = ?MASK_ERROR(binary:matches(H,N)), + D = ?MASK_ERROR(binary:matches(make_unaligned(H), + binary:compile_pattern([make_unaligned2(X) || X <- N]))), + if + A =/= nomatch -> + put(success_counter,get(success_counter)+1); + true -> + ok + end, + case {(A =:= B), (B =:= C),(C =:= D)} of + {true,true,true} -> + true; + _ -> + io:format("Failed to match ~p (needle) against ~s (haystack)~n", + [N,H]), + io:format("A:~p,~nB:~p,~n,C:~p,~n,D:~p.~n", + [A,B,C,D]), + exit(mismatch) + end. + +do_random_match_comp(0,_,_) -> + ok; +do_random_match_comp(N,NeedleRange,HaystackRange) -> + Needle = random_string(NeedleRange), + Haystack = random_string(HaystackRange), + true = do_match_comp(Needle,Haystack), + do_random_match_comp(N-1,NeedleRange,HaystackRange). + +do_random_match_comp2(0,_,_) -> + ok; +do_random_match_comp2(N,NeedleRange,HaystackRange) -> + Haystack = random_string(HaystackRange), + Needle = random_substring(NeedleRange,Haystack), + true = do_match_comp(Needle,Haystack), + do_random_match_comp2(N-1,NeedleRange,HaystackRange). + +do_random_match_comp3(0,_,_) -> + ok; +do_random_match_comp3(N,NeedleRange,HaystackRange) -> + NumNeedles = element(2,HaystackRange) div element(2,NeedleRange), + Haystack = random_string(HaystackRange), + Needles = [random_substring(NeedleRange,Haystack) || + _ <- lists:duplicate(NumNeedles,a)], + true = do_match_comp3(Needles,Haystack), + do_random_match_comp3(N-1,NeedleRange,HaystackRange). + +do_random_match_comp4(0,_,_) -> + ok; +do_random_match_comp4(N,NeedleRange,HaystackRange) -> + NumNeedles = element(2,HaystackRange) div element(2,NeedleRange), + Haystack = random_string(HaystackRange), + Needles = [random_string(NeedleRange) || + _ <- lists:duplicate(NumNeedles,a)], + true = do_match_comp3(Needles,Haystack), + do_random_match_comp4(N-1,NeedleRange,HaystackRange). + +do_match_comp(N,H) -> + A = ?MASK_ERROR(binref:match(H,N)), + B = ?MASK_ERROR(binref:match(H,binref:compile_pattern([N]))), + C = ?MASK_ERROR(binary:match(make_unaligned(H),N)), + D = ?MASK_ERROR(binary:match(H,binary:compile_pattern([N]))), + E = ?MASK_ERROR(binary:match(H,binary:compile_pattern(make_unaligned(N)))), + if + A =/= nomatch -> + put(success_counter,get(success_counter)+1); + true -> + ok + end, + case {(A =:= B), (B =:= C),(C =:= D),(D =:= E)} of + {true,true,true,true} -> + true; + _ -> + io:format("Failed to match ~s (needle) against ~s (haystack)~n", + [N,H]), + io:format("A:~p,~nB:~p,~n,C:~p,~n,D:~p,E:~p.~n", + [A,B,C,D,E]), + exit(mismatch) + end. + +do_match_comp3(N,H) -> + A = ?MASK_ERROR(binref:match(H,N)), + B = ?MASK_ERROR(binref:match(H,binref:compile_pattern(N))), + C = ?MASK_ERROR(binary:match(H,N)), + D = ?MASK_ERROR(binary:match(H,binary:compile_pattern(N))), + if + A =/= nomatch -> + put(success_counter,get(success_counter)+1); + true -> + ok + end, + case {(A =:= B), (B =:= C),(C =:= D)} of + {true,true,true} -> + true; + _ -> + io:format("Failed to match ~s (needle) against ~s (haystack)~n", + [N,H]), + io:format("A:~p,~nB:~p,~n,C:~p,~n,D:~p.~n", + [A,B,C,D]), + exit(mismatch) + end. + +do_random_split_comp(0,_,_) -> + ok; +do_random_split_comp(N,NeedleRange,HaystackRange) -> + Haystack = random_string(HaystackRange), + Needle = random_substring(NeedleRange,Haystack), + true = do_split_comp(Needle,Haystack,[]), + true = do_split_comp(Needle,Haystack,[global]), + true = do_split_comp(Needle,Haystack,[global,trim]), + do_random_split_comp(N-1,NeedleRange,HaystackRange). +do_random_split_comp2(0,_,_) -> + ok; +do_random_split_comp2(N,NeedleRange,HaystackRange) -> + NumNeedles = element(2,HaystackRange) div element(2,NeedleRange), + Haystack = random_string(HaystackRange), + Needles = [random_substring(NeedleRange,Haystack) || + _ <- lists:duplicate(NumNeedles,a)], + true = do_split_comp(Needles,Haystack,[]), + true = do_split_comp(Needles,Haystack,[global]), + do_random_split_comp2(N-1,NeedleRange,HaystackRange). + +do_split_comp(N,H,Opts) -> + A = ?MASK_ERROR(binref:split(H,N,Opts)), + D = ?MASK_ERROR(binary:split(H,binary:compile_pattern(N),Opts)), + if + (A =/= [N]) and is_list(A) -> + put(success_counter,get(success_counter)+1); + true -> + ok + end, + case (A =:= D) of + true -> + true; + _ -> + io:format("Failed to split ~n~p ~n(haystack) with ~n~p ~n(needle) " + "~nand options ~p~n", + [H,N,Opts]), + io:format("A:~p,D:~p.~n", + [A,D]), + exit(mismatch) + end. + +do_random_replace_comp(0,_,_) -> + ok; +do_random_replace_comp(N,NeedleRange,HaystackRange) -> + Haystack = random_string(HaystackRange), + Needle = random_substring(NeedleRange,Haystack), + Repl = random_string(NeedleRange), + Insertat = random_length(NeedleRange), %Sometimes larger than Repl + true = do_replace_comp(Needle,Haystack,Repl,[]), + true = do_replace_comp(Needle,Haystack,Repl,[global]), + true = do_replace_comp(Needle,Haystack,Repl, + [global,{insert_replaced,Insertat}]), + do_random_replace_comp(N-1,NeedleRange,HaystackRange). +do_random_replace_comp2(0,_,_) -> + ok; +do_random_replace_comp2(N,NeedleRange,HaystackRange) -> + NumNeedles = element(2,HaystackRange) div element(2,NeedleRange), + Haystack = random_string(HaystackRange), + Needles = [random_substring(NeedleRange,Haystack) || + _ <- lists:duplicate(NumNeedles,a)], + Repl = random_string(NeedleRange), + Insertat = random_length(NeedleRange), %Sometimes larger than Repl + true = do_replace_comp(Needles,Haystack,Repl,[]), + true = do_replace_comp(Needles,Haystack,Repl,[global]), + true = do_replace_comp(Needles,Haystack,Repl, + [global,{insert_replaced,Insertat}]), + do_random_replace_comp2(N-1,NeedleRange,HaystackRange). + +do_replace_comp(N,H,R,Opts) -> + A = ?MASK_ERROR(binref:replace(H,N,R,Opts)), + D = ?MASK_ERROR(binary:replace(H,binary:compile_pattern(N),R,Opts)), + if + (A =/= N) and is_binary(A) -> + put(success_counter,get(success_counter)+1); + true -> + ok + end, + case (A =:= D) of + true -> + true; + _ -> + io:format("Failed to replace ~s (haystack) by ~s (needle) " + "inserting ~s (replacement) and options ~p~n", + [H,N,R,Opts]), + io:format("A:~p,D:~p.~n", + [A,D]), + exit(mismatch) + end. + +one_random_number(N) -> + M = ((N - 1) rem 10) + 1, + element(M,{$0,$1,$2,$3,$4,$5,$6,$7,$8,$9}). + +one_random(N) -> + M = ((N - 1) rem 68) + 1, + element(M,{$a,$b,$c,$d,$e,$f,$g,$h,$i,$j,$k,$l,$m,$n,$o,$p,$q,$r,$s,$t, + $u,$v,$w,$x,$y,$z,$�,$�,$�,$A,$B,$C,$D,$E,$F,$G,$H, + $I,$J,$K,$L,$M,$N,$O,$P,$Q,$R,$S,$T,$U,$V,$W,$X,$Y,$Z,$�, + $�,$�,$0,$1,$2,$3,$4,$5,$6,$7,$8,$9}). + +random_number({Min,Max}) -> % Min and Max are *length* of number in + % decimal positions + X = random:uniform(Max - Min + 1) + Min - 1, + list_to_integer([one_random_number(random:uniform(10)) || _ <- lists:seq(1,X)]). + + +random_length({Min,Max}) -> + random:uniform(Max - Min + 1) + Min - 1. +random_string({Min,Max}) -> + X = random:uniform(Max - Min + 1) + Min - 1, + list_to_binary([one_random(random:uniform(68)) || _ <- lists:seq(1,X)]). +random_substring({Min,Max},Hay) -> + X = random:uniform(Max - Min + 1) + Min - 1, + Y = byte_size(Hay), + Z = if + X > Y -> Y; + true -> X + end, + PMax = Y - Z, + Pos = random:uniform(PMax + 1) - 1, + <<_:Pos/binary,Res:Z/binary,_/binary>> = Hay, + Res. + +mask_error({'EXIT',{Err,_}}) -> + Err; +mask_error(Else) -> + Else. + +make_unaligned(Bin0) when is_binary(Bin0) -> + Bin1 = <<0:3,Bin0/binary,31:5>>, + Sz = byte_size(Bin0), + <<0:3,Bin:Sz/binary,31:5>> = id(Bin1), + Bin. +make_unaligned2(Bin0) when is_binary(Bin0) -> + Bin1 = <<31:5,Bin0/binary,0:3>>, + Sz = byte_size(Bin0), + <<31:5,Bin:Sz/binary,0:3>> = id(Bin1), + Bin. + +id(I) -> I. diff --git a/lib/stdlib/test/binref.erl b/lib/stdlib/test/binref.erl new file mode 100644 index 0000000000..6d96736ef3 --- /dev/null +++ b/lib/stdlib/test/binref.erl @@ -0,0 +1,588 @@ +-module(binref). + +-export([compile_pattern/1,match/2,match/3,matches/2,matches/3, + split/2,split/3,replace/3,replace/4,first/1,last/1,at/2, + part/2,part/3,copy/1,copy/2,encode_unsigned/1,encode_unsigned/2, + decode_unsigned/1,decode_unsigned/2,referenced_byte_size/1, + longest_common_prefix/1,longest_common_suffix/1,bin_to_list/1, + bin_to_list/2,bin_to_list/3,list_to_bin/1]). + + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +%% compile_pattern, a dummy +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +compile_pattern(Pattern) when is_binary(Pattern) -> + {[Pattern]}; +compile_pattern(Pattern) -> + try + [ true = is_binary(P) || P <- Pattern ], + {Pattern} + catch + _:_ -> + erlang:error(badarg) + end. + + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +%% match and matches +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +match(H,N) -> + match(H,N,[]). +match(Haystack,Needle,Options) when is_binary(Needle) -> + match(Haystack,[Needle],Options); +match(Haystack,{Needles},Options) -> + match(Haystack,Needles,Options); +match(Haystack,Needles,Options) -> + try + true = is_binary(Haystack) and is_list(Needles), % badarg, not function_clause + case get_opts_match(Options,nomatch) of + nomatch -> + mloop(Haystack,Needles); + {A,B} when B > 0 -> + <<_:A/binary,SubStack:B/binary,_/binary>> = Haystack, + mloop(SubStack,Needles,A,B+A); + {A,B} when B < 0 -> + Start = A + B, + Len = -B, + <<_:Start/binary,SubStack:Len/binary,_/binary>> = Haystack, + mloop(SubStack,Needles,Start,Len+Start); + _ -> + nomatch + end + catch + _:_ -> + erlang:error(badarg) + end. +matches(H,N) -> + matches(H,N,[]). +matches(Haystack,Needle,Options) when is_binary(Needle) -> + matches(Haystack,[Needle],Options); +matches(Haystack,{Needles},Options) -> + matches(Haystack,Needles,Options); +matches(Haystack,Needles,Options) -> + try + true = is_binary(Haystack) and is_list(Needles), % badarg, not function_clause + case get_opts_match(Options,nomatch) of + nomatch -> + msloop(Haystack,Needles); + {A,B} when B > 0 -> + <<_:A/binary,SubStack:B/binary,_/binary>> = Haystack, + msloop(SubStack,Needles,A,B+A); + {A,B} when B < 0 -> + Start = A + B, + Len = -B, + <<_:Start/binary,SubStack:Len/binary,_/binary>> = Haystack, + msloop(SubStack,Needles,Start,Len+Start); + _ -> + [] + end + catch + _:_ -> + erlang:error(badarg) + end. + +mloop(Haystack,Needles) -> + mloop(Haystack,Needles,0,byte_size(Haystack)). + +mloop(_Haystack,_Needles,N,M) when N >= M -> + nomatch; +mloop(Haystack,Needles,N,M) -> + case mloop2(Haystack,Needles,N,nomatch) of + nomatch -> + % Not found + <<_:8,NewStack/binary>> = Haystack, + mloop(NewStack,Needles,N+1,M); + {N,Len} -> + {N,Len} + end. + +msloop(Haystack,Needles) -> + msloop(Haystack,Needles,0,byte_size(Haystack)). + +msloop(_Haystack,_Needles,N,M) when N >= M -> + []; +msloop(Haystack,Needles,N,M) -> + case mloop2(Haystack,Needles,N,nomatch) of + nomatch -> + % Not found + <<_:8,NewStack/binary>> = Haystack, + msloop(NewStack,Needles,N+1,M); + {N,Len} -> + NewN = N+Len, + if + NewN >= M -> + [{N,Len}]; + true -> + <<_:Len/binary,NewStack/binary>> = Haystack, + [{N,Len} | msloop(NewStack,Needles,NewN,M)] + end + end. + +mloop2(_Haystack,[],_N,Res) -> + Res; +mloop2(Haystack,[Needle|Tail],N,Candidate) -> + NS = byte_size(Needle), + case Haystack of + <<Needle:NS/binary,_/binary>> -> + NewCandidate = case Candidate of + nomatch -> + {N,NS}; + {N,ONS} when ONS < NS -> + {N,NS}; + Better -> + Better + end, + mloop2(Haystack,Tail,N,NewCandidate); + _ -> + mloop2(Haystack,Tail,N,Candidate) + end. + + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +%% split +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +split(H,N) -> + split(H,N,[]). +split(Haystack,{Needles},Options) -> + split(Haystack, Needles, Options); +split(Haystack,Needles0,Options) -> + try + Needles = if + is_list(Needles0) -> + Needles0; + is_binary(Needles0) -> + [Needles0]; + true -> + exit(badtype) + end, + {Part,Global,Trim} = get_opts_split(Options,{nomatch,false,false}), + {Start,End,NewStack} = + case Part of + nomatch -> + {0,byte_size(Haystack),Haystack}; + {A,B} when B >= 0 -> + <<_:A/binary,SubStack:B/binary,_/binary>> = Haystack, + {A,A+B,SubStack}; + {A,B} when B < 0 -> + S = A + B, + L = -B, + <<_:S/binary,SubStack:L/binary,_/binary>> = Haystack, + {S,S+L,SubStack} + end, + MList = if + Global -> + msloop(NewStack,Needles,Start,End); + true -> + case mloop(NewStack,Needles,Start,End) of + nomatch -> + []; + X -> + [X] + end + end, + do_split(Haystack,MList,0,Trim) + catch + _:_ -> + erlang:error(badarg) + end. + +do_split(H,[],N,true) when N >= byte_size(H) -> + []; +do_split(H,[],N,_) -> + [part(H,{N,byte_size(H)-N})]; +do_split(H,[{A,B}|T],N,Trim) -> + case part(H,{N,A-N}) of + <<>> -> + Rest = do_split(H,T,A+B,Trim), + case {Trim, Rest} of + {true,[]} -> + []; + _ -> + [<<>> | Rest] + end; + Oth -> + [Oth | do_split(H,T,A+B,Trim)] + end. + + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +%% replace +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +replace(H,N,R) -> + replace(H,N,R,[]). +replace(Haystack,{Needles},Replacement,Options) -> + replace(Haystack,Needles,Replacement,Options); + +replace(Haystack,Needles0,Replacement,Options) -> + try + Needles = if + is_list(Needles0) -> + Needles0; + is_binary(Needles0) -> + [Needles0]; + true -> + exit(badtype) + end, + true = is_binary(Replacement), % Make badarg instead of function clause + {Part,Global,Insert} = get_opts_replace(Options,{nomatch,false,[]}), + {Start,End,NewStack} = + case Part of + nomatch -> + {0,byte_size(Haystack),Haystack}; + {A,B} when B >= 0 -> + <<_:A/binary,SubStack:B/binary,_/binary>> = Haystack, + {A,A+B,SubStack}; + {A,B} when B < 0 -> + S = A + B, + L = -B, + <<_:S/binary,SubStack:L/binary,_/binary>> = Haystack, + {S,S+L,SubStack} + end, + MList = if + Global -> + msloop(NewStack,Needles,Start,End); + true -> + case mloop(NewStack,Needles,Start,End) of + nomatch -> + []; + X -> + [X] + end + end, + ReplList = case Insert of + [] -> + Replacement; + Y when is_integer(Y) -> + splitat(Replacement,0,[Y]); + Li when is_list(Li) -> + splitat(Replacement,0,lists:sort(Li)) + end, + erlang:iolist_to_binary(do_replace(Haystack,MList,ReplList,0)) + catch + _:_ -> + erlang:error(badarg) + end. + + +do_replace(H,[],_,N) -> + [part(H,{N,byte_size(H)-N})]; +do_replace(H,[{A,B}|T],Replacement,N) -> + [part(H,{N,A-N}), + if + is_list(Replacement) -> + do_insert(Replacement, part(H,{A,B})); + true -> + Replacement + end + | do_replace(H,T,Replacement,A+B)]. + +do_insert([X],_) -> + [X]; +do_insert([H|T],R) -> + [H,R|do_insert(T,R)]. + +splitat(H,N,[]) -> + [part(H,{N,byte_size(H)-N})]; +splitat(H,N,[I|T]) -> + [part(H,{N,I-N})|splitat(H,I,T)]. + + + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +%% first, last and at +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +first(Subject) -> + try + <<A:8,_/binary>> = Subject, + A + catch + _:_ -> + erlang:error(badarg) + end. + +last(Subject) -> + try + N = byte_size(Subject) - 1, + <<_:N/binary,A:8>> = Subject, + A + catch + _:_ -> + erlang:error(badarg) + end. + +at(Subject,X) -> + try + <<_:X/binary,A:8,_/binary>> = Subject, + A + catch + _:_ -> + erlang:error(badarg) + end. + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +% bin_to_list +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +bin_to_list(Subject) -> + try + binary_to_list(Subject) + catch + _:_ -> + erlang:error(badarg) + end. + +bin_to_list(Subject,T) -> + try + {A0,B0} = T, + {A,B} = if + B0 < 0 -> + {A0+B0,-B0}; + true -> + {A0,B0} + end, + binary_to_list(Subject,A+1,A+B) + catch + _:_ -> + erlang:error(badarg) + end. + +bin_to_list(Subject,A,B) -> + try + bin_to_list(Subject,{A,B}) + catch + _:_ -> + erlang:error(badarg) + end. +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +% list_to_bin +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +list_to_bin(List) -> + try + erlang:list_to_binary(List) + catch + _:_ -> + erlang:error(badarg) + end. + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +%% longest_common_prefix +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +longest_common_prefix(LB) -> + try + true = is_list(LB) and (length(LB) > 0), % Make badarg instead of function clause + do_longest_common_prefix(LB,0) + catch + _:_ -> + erlang:error(badarg) + end. + +do_longest_common_prefix(LB,X) -> + case do_lcp(LB,X,no) of + true -> + do_longest_common_prefix(LB,X+1); + false -> + X + end. +do_lcp([],_,_) -> + true; +do_lcp([Bin|_],X,_) when byte_size(Bin) =< X -> + false; +do_lcp([Bin|T],X,no) -> + Ch = at(Bin,X), + do_lcp(T,X,Ch); +do_lcp([Bin|T],X,Ch) -> + Ch2 = at(Bin,X), + if + Ch =:= Ch2 -> + do_lcp(T,X,Ch); + true -> + false + end. + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +%% longest_common_suffix +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +longest_common_suffix(LB) -> + try + true = is_list(LB) and (length(LB) > 0), % Make badarg instead of function clause + do_longest_common_suffix(LB,0) + catch + _:_ -> + erlang:error(badarg) + end. + +do_longest_common_suffix(LB,X) -> + case do_lcs(LB,X,no) of + true -> + do_longest_common_suffix(LB,X+1); + false -> + X + end. +do_lcs([],_,_) -> + true; +do_lcs([Bin|_],X,_) when byte_size(Bin) =< X -> + false; +do_lcs([Bin|T],X,no) -> + Ch = at(Bin,byte_size(Bin) - 1 - X), + do_lcs(T,X,Ch); +do_lcs([Bin|T],X,Ch) -> + Ch2 = at(Bin,byte_size(Bin) - 1 - X), + if + Ch =:= Ch2 -> + do_lcs(T,X,Ch); + true -> + false + end. + + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +%% part +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +part(Subject,Part) -> + try + do_part(Subject,Part) + catch + _:_ -> + erlang:error(badarg) + end. + +part(Subject,Pos,Len) -> + part(Subject,{Pos,Len}). + +do_part(Bin,{A,B}) when B >= 0 -> + <<_:A/binary,Sub:B/binary,_/binary>> = Bin, + Sub; +do_part(Bin,{A,B}) when B < 0 -> + S = A + B, + L = -B, + <<_:S/binary,Sub:L/binary,_/binary>> = Bin, + Sub. + + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +%% copy +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +copy(Subject) -> + copy(Subject,1). +copy(Subject,N) -> + try + true = is_integer(N) and (N >= 0) and is_binary(Subject), % Badarg, not function clause + erlang:list_to_binary(lists:duplicate(N,Subject)) + catch + _:_ -> + erlang:error(badarg) + end. + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +%% encode_unsigned +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +encode_unsigned(Unsigned) -> + encode_unsigned(Unsigned,big). +encode_unsigned(Unsigned,Endian) -> + try + true = is_integer(Unsigned) and (Unsigned >= 0), + if + Unsigned =:= 0 -> + <<0>>; + true -> + case Endian of + big -> + list_to_binary(do_encode(Unsigned,[])); + little -> + list_to_binary(do_encode_r(Unsigned)) + end + end + catch + _:_ -> + erlang:error(badarg) + end. + +do_encode(0,L) -> + L; +do_encode(N,L) -> + Byte = N band 255, + NewN = N bsr 8, + do_encode(NewN,[Byte|L]). + +do_encode_r(0) -> + []; +do_encode_r(N) -> + Byte = N band 255, + NewN = N bsr 8, + [Byte|do_encode_r(NewN)]. +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +%% decode_unsigned +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +decode_unsigned(Subject) -> + decode_unsigned(Subject,big). + +decode_unsigned(Subject,Endian) -> + try + true = is_binary(Subject), + case Endian of + big -> + do_decode(Subject,0); + little -> + do_decode_r(Subject,0) + end + catch + _:_ -> + erlang:error(badarg) + end. + +do_decode(<<>>,N) -> + N; +do_decode(<<X:8,Bin/binary>>,N) -> + do_decode(Bin,(N bsl 8) bor X). + +do_decode_r(<<>>,N) -> + N; +do_decode_r(Bin,N) -> + Sz = byte_size(Bin) - 1, + <<NewBin:Sz/binary,X>> = Bin, + do_decode_r(NewBin, (N bsl 8) bor X). + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +%% referenced_byte_size cannot +%% be implemented in pure +%% erlang +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +referenced_byte_size(Bin) when is_binary(Bin) -> + erlang:error(not_implemented); +referenced_byte_size(_) -> + erlang:error(badarg). + + + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +%% Simple helper functions +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% + +%% Option "parsing" +get_opts_match([],Part) -> + Part; +get_opts_match([{scope,{A,B}} | T],_Part) -> + get_opts_match(T,{A,B}); +get_opts_match(_,_) -> + throw(badopt). + +get_opts_split([],{Part,Global,Trim}) -> + {Part,Global,Trim}; +get_opts_split([{scope,{A,B}} | T],{_Part,Global,Trim}) -> + get_opts_split(T,{{A,B},Global,Trim}); +get_opts_split([global | T],{Part,_Global,Trim}) -> + get_opts_split(T,{Part,true,Trim}); +get_opts_split([trim | T],{Part,Global,_Trim}) -> + get_opts_split(T,{Part,Global,true}); +get_opts_split(_,_) -> + throw(badopt). + +get_opts_replace([],{Part,Global,Insert}) -> + {Part,Global,Insert}; +get_opts_replace([{scope,{A,B}} | T],{_Part,Global,Insert}) -> + get_opts_replace(T,{{A,B},Global,Insert}); +get_opts_replace([global | T],{Part,_Global,Insert}) -> + get_opts_replace(T,{Part,true,Insert}); +get_opts_replace([{insert_replaced,N} | T],{Part,Global,_Insert}) -> + get_opts_replace(T,{Part,Global,N}); +get_opts_replace(_,_) -> + throw(badopt). diff --git a/lib/stdlib/test/dummy1_h.erl b/lib/stdlib/test/dummy1_h.erl index 4377d774a3..5b503d5984 100644 --- a/lib/stdlib/test/dummy1_h.erl +++ b/lib/stdlib/test/dummy1_h.erl @@ -1,19 +1,19 @@ %% %% %CopyrightBegin% -%% -%% Copyright Ericsson AB 1996-2009. All Rights Reserved. -%% +%% +%% Copyright Ericsson AB 1996-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% %% -module(dummy1_h). @@ -21,7 +21,7 @@ %% Test event handler for gen_event_SUITE.erl -export([init/1, handle_event/2, handle_call/2, handle_info/2, - terminate/2]). + terminate/2, format_status/2]). init(make_error) -> {error, my_error}; @@ -67,4 +67,5 @@ terminate(remove_handler, Parent) -> terminate(_Reason, _State) -> ok. - +format_status(_Opt, [_PDict, _State]) -> + "dummy1_h handler state". diff --git a/lib/stdlib/test/gen_event_SUITE.erl b/lib/stdlib/test/gen_event_SUITE.erl index 8cbffaca56..4f7de451e3 100644 --- a/lib/stdlib/test/gen_event_SUITE.erl +++ b/lib/stdlib/test/gen_event_SUITE.erl @@ -23,9 +23,11 @@ -export([all/1]). -export([start/1, test_all/1, add_handler/1, add_sup_handler/1, delete_handler/1, swap_handler/1, swap_sup_handler/1, - notify/1, sync_notify/1, call/1, info/1, hibernate/1]). + notify/1, sync_notify/1, call/1, info/1, hibernate/1, + call_format_status/1, error_format_status/1]). -all(suite) -> {req, [stdlib], [start, test_all, hibernate]}. +all(suite) -> {req, [stdlib], [start, test_all, hibernate, + call_format_status, error_format_status]}. %% -------------------------------------- %% Start an event manager. @@ -844,3 +846,56 @@ info(Config) when is_list(Config) -> ?line ok = gen_event:stop(my_dummy_handler), ok. + +call_format_status(suite) -> + []; +call_format_status(doc) -> + ["Test that sys:get_status/1,2 calls format_status/2"]; +call_format_status(Config) when is_list(Config) -> + ?line {ok, Pid} = gen_event:start({local, my_dummy_handler}), + %% State here intentionally differs from what we expect from format_status + State = self(), + FmtState = "dummy1_h handler state", + ?line ok = gen_event:add_handler(my_dummy_handler, dummy1_h, [State]), + ?line Status1 = sys:get_status(Pid), + ?line Status2 = sys:get_status(Pid, 5000), + ?line ok = gen_event:stop(Pid), + ?line {status, Pid, _, [_, _, Pid, [], Data1]} = Status1, + ?line HandlerInfo1 = proplists:get_value(items, Data1), + ?line {"Installed handlers", [{_,dummy1_h,_,FmtState,_}]} = HandlerInfo1, + ?line {status, Pid, _, [_, _, Pid, [], Data2]} = Status2, + ?line HandlerInfo2 = proplists:get_value(items, Data2), + ?line {"Installed handlers", [{_,dummy1_h,_,FmtState,_}]} = HandlerInfo2, + ok. + +error_format_status(suite) -> + []; +error_format_status(doc) -> + ["Test that a handler error calls format_status/2"]; +error_format_status(Config) when is_list(Config) -> + ?line error_logger_forwarder:register(), + OldFl = process_flag(trap_exit, true), + State = self(), + ?line {ok, Pid} = gen_event:start({local, my_dummy_handler}), + ?line ok = gen_event:add_sup_handler(my_dummy_handler, dummy1_h, [State]), + ?line ok = gen_event:notify(my_dummy_handler, do_crash), + ?line receive + {gen_event_EXIT,dummy1_h,{'EXIT',_}} -> ok + after 5000 -> + ?t:fail(exit_gen_event) + end, + FmtState = "dummy1_h handler state", + receive + {error,_GroupLeader, {Pid, + "** gen_event handler"++_, + [dummy1_h,my_dummy_handler,do_crash, + FmtState, _]}} -> + ok; + Other -> + ?line io:format("Unexpected: ~p", [Other]), + ?line ?t:fail() + end, + ?t:messages_get(), + ?line ok = gen_event:stop(Pid), + process_flag(trap_exit, OldFl), + ok. diff --git a/lib/stdlib/test/gen_fsm_SUITE.erl b/lib/stdlib/test/gen_fsm_SUITE.erl index 23c1d9a193..d61eeb403b 100644 --- a/lib/stdlib/test/gen_fsm_SUITE.erl +++ b/lib/stdlib/test/gen_fsm_SUITE.erl @@ -1,19 +1,19 @@ %% %% %CopyrightBegin% -%% -%% Copyright Ericsson AB 1996-2009. All Rights Reserved. -%% +%% +%% Copyright Ericsson AB 1996-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% %% -module(gen_fsm_SUITE). @@ -30,7 +30,7 @@ -export([shutdown/1]). --export([sys/1, sys1/1, call_format_status/1]). +-export([sys/1, sys1/1, call_format_status/1, error_format_status/1]). -export([hibernate/1,hiber_idle/3,hiber_wakeup/3,hiber_idle/2,hiber_wakeup/2]). @@ -305,7 +305,7 @@ shutdown(Config) when is_list(Config) -> ok. -sys(suite) -> [sys1, call_format_status]. +sys(suite) -> [sys1, call_format_status, error_format_status]. sys1(Config) when is_list(Config) -> ?line {ok, Pid} = @@ -324,6 +324,27 @@ call_format_status(Config) when is_list(Config) -> ?line [format_status_called | _] = lists:reverse(Data), ?line stop_it(Pid). +error_format_status(Config) when is_list(Config) -> + ?line error_logger_forwarder:register(), + OldFl = process_flag(trap_exit, true), + StateData = "called format_status", + ?line {ok, Pid} = gen_fsm:start(gen_fsm_SUITE, {state_data, StateData}, []), + %% bad return value in the gen_fsm loop + ?line {'EXIT',{{bad_return_value, badreturn},_}} = + (catch gen_fsm:sync_send_event(Pid, badreturn)), + receive + {error,_GroupLeader,{Pid, + "** State machine"++_, + [Pid,{_,_,badreturn},idle,StateData,_]}} -> + ok; + Other -> + ?line io:format("Unexpected: ~p", [Other]), + ?line ?t:fail() + end, + ?t:messages_get(), + process_flag(trap_exit, OldFl), + ok. + %% Hibernation hibernate(suite) -> []; @@ -704,6 +725,8 @@ init(hiber) -> {ok, hiber_idle, []}; init(hiber_now) -> {ok, hiber_idle, [], hibernate}; +init({state_data, StateData}) -> + {ok, idle, StateData}; init(_) -> {ok, idle, state_data}. @@ -844,5 +867,7 @@ handle_sync_event(stop_shutdown_reason, _From, _State, Data) -> handle_sync_event({get, _Pid}, _From, State, Data) -> {reply, {state, State, Data}, State, Data}. -format_status(_Opt, [_Pdict, _StateData]) -> +format_status(terminate, [_Pdict, StateData]) -> + StateData; +format_status(normal, [_Pdict, _StateData]) -> [format_status_called]. diff --git a/lib/stdlib/test/gen_server_SUITE.erl b/lib/stdlib/test/gen_server_SUITE.erl index 6efdce78a1..0966734c89 100644 --- a/lib/stdlib/test/gen_server_SUITE.erl +++ b/lib/stdlib/test/gen_server_SUITE.erl @@ -1,19 +1,19 @@ %% %% %CopyrightBegin% -%% -%% Copyright Ericsson AB 1996-2009. All Rights Reserved. -%% +%% +%% Copyright Ericsson AB 1996-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% %% -module(gen_server_SUITE). @@ -30,7 +30,8 @@ call_remote_n1/1, call_remote_n2/1, call_remote_n3/1, spec_init/1, spec_init_local_registered_parent/1, spec_init_global_registered_parent/1, - otp_5854/1, hibernate/1, otp_7669/1, call_format_status/1 + otp_5854/1, hibernate/1, otp_7669/1, call_format_status/1, + error_format_status/1, call_with_huge_message_queue/1 ]). % spawn export @@ -51,7 +52,9 @@ all(suite) -> call_remote_n2, call_remote_n3, spec_init, spec_init_local_registered_parent, spec_init_global_registered_parent, - otp_5854, hibernate, otp_7669, call_format_status]. + otp_5854, hibernate, otp_7669, + call_format_status, error_format_status, + call_with_huge_message_queue]. -define(default_timeout, ?t:minutes(1)). @@ -895,7 +898,7 @@ call_format_status(doc) -> ["Test that sys:get_status/1,2 calls format_status/2"]; call_format_status(Config) when is_list(Config) -> ?line {ok, Pid} = gen_server:start_link({local, call_format_status}, - gen_server_SUITE, [], []), + ?MODULE, [], []), ?line Status1 = sys:get_status(call_format_status), ?line {status, Pid, _Mod, [_PDict, running, _Parent, _, Data1]} = Status1, ?line [format_status_called | _] = lists:reverse(Data1), @@ -904,6 +907,74 @@ call_format_status(Config) when is_list(Config) -> ?line [format_status_called | _] = lists:reverse(Data2), ok. +%% Verify that error termination correctly calls our format_status/2 fun +%% +error_format_status(suite) -> + []; +error_format_status(doc) -> + ["Test that an error termination calls format_status/2"]; +error_format_status(Config) when is_list(Config) -> + ?line error_logger_forwarder:register(), + OldFl = process_flag(trap_exit, true), + State = "called format_status", + ?line {ok, Pid} = gen_server:start_link(?MODULE, {state, State}, []), + ?line {'EXIT',{crashed,_}} = (catch gen_server:call(Pid, crash)), + receive + {'EXIT', Pid, crashed} -> + ok + end, + receive + {error,_GroupLeader,{Pid, + "** Generic server"++_, + [Pid,crash,State,crashed]}} -> + ok; + Other -> + ?line io:format("Unexpected: ~p", [Other]), + ?line ?t:fail() + end, + ?t:messages_get(), + process_flag(trap_exit, OldFl), + ok. + +%% Test that the time for a huge message queue is not +%% significantly slower than with an empty message queue. +call_with_huge_message_queue(Config) when is_list(Config) -> + ?line Pid = spawn_link(fun echo_loop/0), + + ?line {Time,ok} = tc(fun() -> calls(10, Pid) end), + + ?line [self() ! {msg,N} || N <- lists:seq(1, 500000)], + erlang:garbage_collect(), + ?line {NewTime,ok} = tc(fun() -> calls(10, Pid) end), + io:format("Time for empty message queue: ~p", [Time]), + io:format("Time for huge message queue: ~p", [NewTime]), + + case (NewTime+1) / (Time+1) of + Q when Q < 10 -> + ok; + Q -> + io:format("Q = ~p", [Q]), + ?line ?t:fail() + end, + ok. + +calls(0, _) -> ok; +calls(N, Pid) -> + {ultimate_answer,42} = call(Pid, {ultimate_answer,42}), + calls(N-1, Pid). + +call(Pid, Msg) -> + gen_server:call(Pid, Msg, infinity). + +tc(Fun) -> + timer:tc(erlang, apply, [Fun,[]]). + +echo_loop() -> + receive + {'$gen_call',{Pid,Ref},Msg} -> + Pid ! {Ref,Msg}, + echo_loop() + end. %%-------------------------------------------------------------- %% Help functions to spec_init_* @@ -1064,5 +1135,7 @@ terminate({From, stopped_info}, _State) -> terminate(_Reason, _State) -> ok. -format_status(_Opt, [_PDict, _State]) -> - [format_status_called]. +format_status(terminate, [_PDict, State]) -> + State; +format_status(normal, [_PDict, _State]) -> + format_status_called. diff --git a/lib/stdlib/test/io_proto_SUITE.erl b/lib/stdlib/test/io_proto_SUITE.erl index 93159fbd5b..d9672a8c7b 100644 --- a/lib/stdlib/test/io_proto_SUITE.erl +++ b/lib/stdlib/test/io_proto_SUITE.erl @@ -17,6 +17,7 @@ %% %CopyrightEnd% %% -module(io_proto_SUITE). +-compile(r12). -export([all/1]). diff --git a/lib/stdlib/test/qlc_SUITE.erl b/lib/stdlib/test/qlc_SUITE.erl index ff11ebc6bf..aa12ed57da 100644 --- a/lib/stdlib/test/qlc_SUITE.erl +++ b/lib/stdlib/test/qlc_SUITE.erl @@ -1,25 +1,26 @@ %% %% %CopyrightBegin% -%% -%% Copyright Ericsson AB 2004-2009. All Rights Reserved. -%% +%% +%% Copyright Ericsson AB 2004-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% %% %%%---------------------------------------------------------------- %%% Purpose:Test Suite for the 'qlc' module. %%%----------------------------------------------------------------- -module(qlc_SUITE). +-compile(r12). -define(QLC, qlc). -define(QLCs, "qlc"). diff --git a/lib/syntax_tools/src/erl_comment_scan.erl b/lib/syntax_tools/src/erl_comment_scan.erl index 09ce21a428..e2c6976a2b 100644 --- a/lib/syntax_tools/src/erl_comment_scan.erl +++ b/lib/syntax_tools/src/erl_comment_scan.erl @@ -273,12 +273,8 @@ join_lines([], Txt, L, Col, Ind) -> filename([C|T]) when is_integer(C), C > 0, C =< 255 -> [C | filename(T)]; -filename([H|T]) -> - filename(H) ++ filename(T); filename([]) -> []; -filename(N) when is_atom(N) -> - atom_to_list(N); filename(N) -> report_error("bad filename: `~P'.", [N, 25]), exit(error). diff --git a/lib/syntax_tools/src/erl_prettypr.erl b/lib/syntax_tools/src/erl_prettypr.erl index 606441bcf1..c2c72d1ed2 100644 --- a/lib/syntax_tools/src/erl_prettypr.erl +++ b/lib/syntax_tools/src/erl_prettypr.erl @@ -384,7 +384,7 @@ lay_postcomments(Cs, D) -> beside(D, floating(break(stack_comments(Cs, true)), 1, 0)). %% Format (including padding, if `Pad' is `true', otherwise not) -%% and stack the listed comments above each other, +%% and stack the listed comments above each other. stack_comments([C | Cs], Pad) -> D = stack_comment_lines(erl_syntax:comment_text(C)), @@ -405,9 +405,7 @@ stack_comments([C | Cs], Pad) -> D1; % done _ -> above(D1, stack_comments(Cs, Pad)) - end; -stack_comments([], _) -> - empty(). + end. %% Stack lines of text above each other and prefix each string in %% the list with a single `%' character. diff --git a/lib/syntax_tools/src/igor.erl b/lib/syntax_tools/src/igor.erl index e92e9593b6..702b399615 100644 --- a/lib/syntax_tools/src/igor.erl +++ b/lib/syntax_tools/src/igor.erl @@ -699,7 +699,7 @@ merge_files(Name, Trees, Files, Opts) -> options :: [option()] }). --spec merge_sources(atom(), erl_syntax:forms(), [option()]) -> +-spec merge_sources(atom(), [erl_syntax:forms()], [option()]) -> {erl_syntax:syntaxTree(), [stubDescriptor()]}. merge_sources(Name, Sources, Opts) -> @@ -782,12 +782,12 @@ merge_sources_1(Name, Modules, Trees, Opts) -> %% however not "safe" by default. If no modules are explicitly %% specified as static, it is assumed that *all* are static. Static0 = ordsets:from_list(proplists:append_values(static, Opts)), - case proplists:is_defined(static, Opts) of - false -> - Static = All; - true -> - Static = ordsets:add_element(Name, Static0) - end, + Static = case proplists:is_defined(static, Opts) of + false -> + All; + true -> + ordsets:add_element(Name, Static0) + end, check_module_names(Static, All, "declared 'static'"), verbose("static modules: ~p.", [Static], Opts), @@ -806,8 +806,8 @@ merge_sources_1(Name, Modules, Trees, Opts) -> verbose("safe modules: ~p.", [Safe], Opts), Preserved = (ordsets:is_element(Name, Sources) - and ordsets:is_element(Name, Export)) - or proplists:get_bool(no_banner, Opts), + andalso ordsets:is_element(Name, Export)) + orelse proplists:get_bool(no_banner, Opts), NoHeaders = proplists:get_bool(no_headers, Opts), Notes = proplists:get_value(notes, Opts, always), Rs = proplists:append_values(redirect, Opts), @@ -2924,9 +2924,7 @@ make_attribute({Name, Term}) -> [erl_syntax:abstract(Term)]). is_auto_import({F, A}) -> - erl_internal:bif(F, A); -is_auto_import(_) -> - false. + erl_internal:bif(F, A). timestamp() -> {{Yr, Mth, Dy}, {Hr, Mt, Sc}} = erlang:localtime(), diff --git a/lib/test_server/doc/src/test_server_ctrl.xml b/lib/test_server/doc/src/test_server_ctrl.xml index 4a778bcaf7..8b60849b61 100644 --- a/lib/test_server/doc/src/test_server_ctrl.xml +++ b/lib/test_server/doc/src/test_server_ctrl.xml @@ -538,9 +538,6 @@ Optional, if not given the test server controller node test server controller node. The log must be formatted using <c>ttb:format/1/2</c>. </p> - <p>This is valid for all targets except the OSE/Delta target - for which all nodes will be logged and automatically formatted - in one single text file called <c>allnodes-test_server</c>.</p> </desc> </func> <func> diff --git a/lib/test_server/doc/src/ts.xml b/lib/test_server/doc/src/ts.xml index 0f91d3eea2..f60c79aadd 100644 --- a/lib/test_server/doc/src/ts.xml +++ b/lib/test_server/doc/src/ts.xml @@ -250,7 +250,7 @@ running test suites. If a remote host is to be used, the <c>TargetSystem</c> argument must be given so that "cross installation" can be done. This should be used for testing on - VxWorks or OSE/Delta. Installation is required for any of the + VxWorks. Installation is required for any of the functions in <c>ts</c> to work. </p> <p>Opts may be one or more of @@ -275,7 +275,7 @@ strings. </item> <item><c>{slavetargets, SlaveTarges}</c><br></br> - For VxWorks and OSE/Delta only. This is a list of + For VxWorks only. This is a list of available hosts where slave nodes can be started. This is necessary because only one node can run per host in the VxWorks environment. This is not the same as diff --git a/lib/test_server/src/test_server.erl b/lib/test_server/src/test_server.erl index f918f47415..7db103a4c6 100644 --- a/lib/test_server/src/test_server.erl +++ b/lib/test_server/src/test_server.erl @@ -1763,7 +1763,7 @@ call_crash(Time,Crash,M,F,A) -> %% Slave and Peer: %% {remote, true} - Start the node on a remote host. If not specified, %% the node will be started on the local host (with -%% some exceptions, as for the case of VxWorks and OSE, +%% some exceptions, for instance VxWorks, %% where all nodes are started on a remote host). %% {args, Arguments} - Arguments passed directly to the node. %% {cleanup, false} - Nodes started with this option will not be killed @@ -2014,14 +2014,8 @@ temp_name(Stem) -> app_test(App) -> app_test(App, pedantic). app_test(App, Mode) -> - case os:type() of - {ose,_} -> - Comment = "Skipping app_test on OSE", - comment(Comment), % in case user ignores the return value - {skip,Comment}; - _other -> - test_server_sup:app_test(App, Mode) - end. + test_server_sup:app_test(App, Mode). + %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% diff --git a/lib/test_server/src/test_server_internal.hrl b/lib/test_server/src/test_server_internal.hrl index 6fa5ef75b1..c9c52854e3 100644 --- a/lib/test_server/src/test_server_internal.hrl +++ b/lib/test_server/src/test_server_internal.hrl @@ -1,19 +1,19 @@ %% %% %CopyrightBegin% -%% -%% Copyright Ericsson AB 2002-2009. All Rights Reserved. -%% +%% +%% Copyright Ericsson AB 2002-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% %% @@ -37,7 +37,7 @@ username, % string() cookie, % string(); Cookie for target node naming, % string(); "-name" | "-sname" - master, % string(); For OSE this is the master + master, % string(); Was used for OSE's master % node for main target and slave nodes. % For other platforms the target node % itself is master for slave nodes diff --git a/lib/test_server/src/test_server_node.erl b/lib/test_server/src/test_server_node.erl index 32886b6765..49025b1a3d 100644 --- a/lib/test_server/src/test_server_node.erl +++ b/lib/test_server/src/test_server_node.erl @@ -17,6 +17,7 @@ %% %CopyrightEnd% %% -module(test_server_node). +-compile(r12). %%% %%% The same compiled code for this module must be possible to load diff --git a/lib/test_server/src/ts.erl b/lib/test_server/src/ts.erl index 1b750c3858..e23b891392 100644 --- a/lib/test_server/src/ts.erl +++ b/lib/test_server/src/ts.erl @@ -1,19 +1,19 @@ %% %% %CopyrightBegin% -%% -%% Copyright Ericsson AB 1997-2009. All Rights Reserved. -%% +%% +%% Copyright Ericsson AB 1997-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% %% @@ -112,7 +112,7 @@ " Mandatory for remote targets\n" " {master, {MasterHost, MasterCookie}}\n" " - Master host and cookie for targets which are\n" - " started as slave nodes (i.e. OSE/Delta targets\n" + " started as slave nodes.\n" " erl_boot_server must be started on master before\n" " test is run.\n" " Optional, default is controller host and then\n" diff --git a/lib/test_server/src/ts_erl_config.erl b/lib/test_server/src/ts_erl_config.erl index 4fc46fc5d6..5cdbf0fbb8 100644 --- a/lib/test_server/src/ts_erl_config.erl +++ b/lib/test_server/src/ts_erl_config.erl @@ -1,19 +1,19 @@ %% %% %CopyrightBegin% -%% -%% Copyright Ericsson AB 1997-2009. All Rights Reserved. -%% +%% +%% Copyright Ericsson AB 1997-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% %% @@ -161,7 +161,6 @@ system_include(Root, Vars) -> case ts_lib:var(os, Vars) of "Windows" ++ _T -> "sys/win32"; "VxWorks" -> "sys.vxworks"; - "OSE" -> "sys/ose"; _ -> "sys/unix" end, " -I" ++ filename:nativename(filename:join([Root, "erts", "emulator", SysDir])). @@ -219,7 +218,7 @@ erl_interface(Vars,OsType) -> {unix,_} -> "-lpthread"; _ -> - "" % VxWorks or OSE + "" % VxWorks end, CrossCompile = case OsType of vxworks -> "true"; diff --git a/lib/test_server/src/ts_run.erl b/lib/test_server/src/ts_run.erl index 1d611f501c..888ac98973 100644 --- a/lib/test_server/src/ts_run.erl +++ b/lib/test_server/src/ts_run.erl @@ -198,8 +198,6 @@ get_spec_filename_1(Vars, TestDir, File) -> case ts_lib:var(os, Vars) of "VxWorks" -> check_spec_filename(TestDir, File, ".spec.vxworks"); - "OSE" -> - check_spec_filename(TestDir, File, ".spec.ose"); "Windows"++_ -> check_spec_filename(TestDir, File, ".spec.win"); _Other -> @@ -306,53 +304,36 @@ make_make(Vars, Spec, State) -> add_make_testcase(Vars, Spec, St) -> Makefile = St#state.makefile, Dir = filename:dirname(Makefile), - case ts_lib:var(os, Vars) of - "OSE" -> - %% For OSE, C code in datadir must be linked in the image file, - %% and erlang code is sent as binaries from test_server_ctrl - %% Making erlang code here because the Makefile.src probably won't - %% work. - Erl_flags=[{i, "../../test_server"}|ts_lib:var(erl_flags,Vars)], - {ok, Cwd} = file:get_cwd(), - ok = file:set_cwd(Dir), - Result = (catch make:all(Erl_flags)), - ok = file:set_cwd(Cwd), - case Result of - up_to_date -> {ok, Vars, Spec, St}; - _error -> {error, {erlang_make_failed,Dir}} - end; + Shortname = filename:basename(Makefile), + Suite = filename:basename(Dir, "_data"), + Config = [{data_dir,Dir},{makefile,Shortname}], + MakeModule = Suite ++ "_make", + MakeModuleSrc = filename:join(filename:dirname(Dir), + MakeModule ++ ".erl"), + MakeMod = list_to_atom(MakeModule), + case filelib:is_file(MakeModuleSrc) of + true -> ok; + false -> generate_make_module(ts_lib:var(make_command, Vars), + MakeModuleSrc, + MakeModule) + end, + case Suite of + "all_SUITE" -> + {ok,Vars,Spec,St#state{all={MakeMod,Config}}}; _ -> - Shortname = filename:basename(Makefile), - Suite = filename:basename(Dir, "_data"), - Config = [{data_dir,Dir},{makefile,Shortname}], - MakeModule = Suite ++ "_make", - MakeModuleSrc = filename:join(filename:dirname(Dir), - MakeModule ++ ".erl"), - MakeMod = list_to_atom(MakeModule), - case filelib:is_file(MakeModuleSrc) of - true -> ok; - false -> generate_make_module(ts_lib:var(make_command, Vars), - MakeModuleSrc, - MakeModule) - end, - case Suite of - "all_SUITE" -> - {ok,Vars,Spec,St#state{all={MakeMod,Config}}}; - _ -> - %% Avoid duplicates of testcases. There is no longer - %% a check for this in test_server_ctrl. - TestCase = {list_to_atom(Suite),all}, - TopCase0 = case St#state.topcase of - List when is_list(List) -> - List -- [TestCase]; - Top -> - [Top] -- [TestCase] - end, - TopCase = [{make,{MakeMod,make,[Config]}, - TestCase, - {MakeMod,unmake,[Config]}}|TopCase0], - {ok,Vars,Spec,St#state{topcase=TopCase}} - end + %% Avoid duplicates of testcases. There is no longer + %% a check for this in test_server_ctrl. + TestCase = {list_to_atom(Suite),all}, + TopCase0 = case St#state.topcase of + List when is_list(List) -> + List -- [TestCase]; + Top -> + [Top] -- [TestCase] + end, + TopCase = [{make,{MakeMod,make,[Config]}, + TestCase, + {MakeMod,unmake,[Config]}}|TopCase0], + {ok,Vars,Spec,St#state{topcase=TopCase}} end. generate_make_module(MakeCmd, Name, ModuleString) -> @@ -629,9 +610,6 @@ make_test_server_args(Args0,Options,Vars) -> "VxWorks" -> F = write_parameterfile(vxworks,Vars), " PARAMETERS " ++ F; - "OSE" -> - F = write_parameterfile(ose,Vars), - " PARAMETERS " ++ F; _ -> "" end, diff --git a/lib/test_server/vsn.mk b/lib/test_server/vsn.mk index e3aac682ec..3c6efeffde 100644 --- a/lib/test_server/vsn.mk +++ b/lib/test_server/vsn.mk @@ -1,2 +1,2 @@ -TEST_SERVER_VSN = 3.3.6 +TEST_SERVER_VSN = 3.3.7 diff --git a/lib/tools/emacs/erlang-eunit.el b/lib/tools/emacs/erlang-eunit.el index 49d1bc8b0c..970afe2e9f 100644 --- a/lib/tools/emacs/erlang-eunit.el +++ b/lib/tools/emacs/erlang-eunit.el @@ -1,25 +1,28 @@ ;; ;; %CopyrightBegin% -;; -;; Copyright Ericsson AB 2009. All Rights Reserved. -;; +;; +;; Copyright Ericsson AB 2009-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% ;;; ;;; Purpose: Provide EUnit utilities. ;;; ;;; Author: Klas Johansson +(eval-when-compile + (require 'cl)) + (defvar erlang-eunit-separate-src-and-test-directories t "*Whether or not to keep source and EUnit test files in separate directories") diff --git a/lib/tools/emacs/erlang.el b/lib/tools/emacs/erlang.el index a84f40244d..c31f76025e 100644 --- a/lib/tools/emacs/erlang.el +++ b/lib/tools/emacs/erlang.el @@ -885,15 +885,54 @@ files written in other languages than Erlang.") If nil, the inferior shell replaces the window. This is the traditional behaviour.") -(defvar erlang-mode-map nil +(defconst inferior-erlang-use-cmm (boundp 'minor-mode-overriding-map-alist) + "Non-nil means use `compilation-minor-mode' in Erlang shell.") + +(defvar erlang-mode-map + (let ((map (make-sparse-keymap))) + (unless (boundp 'indent-line-function) + (define-key map "\t" 'erlang-indent-command)) + (define-key map ";" 'erlang-electric-semicolon) + (define-key map "," 'erlang-electric-comma) + (define-key map "<" 'erlang-electric-lt) + (define-key map ">" 'erlang-electric-gt) + (define-key map "\C-m" 'erlang-electric-newline) + (if (not (boundp 'delete-key-deletes-forward)) + (define-key map "\177" 'backward-delete-char-untabify) + (define-key map [(backspace)] 'backward-delete-char-untabify)) + ;;(unless (boundp 'fill-paragraph-function) + (define-key map "\M-q" 'erlang-fill-paragraph) + (unless (boundp 'beginning-of-defun-function) + (define-key map "\M-\C-a" 'erlang-beginning-of-function) + (define-key map "\M-\C-e" 'erlang-end-of-function) + (define-key map '(meta control h) 'erlang-mark-function)) ; Xemacs + (define-key map "\M-\t" 'erlang-complete-tag) + (define-key map "\C-c\M-\t" 'tempo-complete-tag) + (define-key map "\M-+" 'erlang-find-next-tag) + (define-key map "\C-c\M-a" 'erlang-beginning-of-clause) + (define-key map "\C-c\M-b" 'tempo-backward-mark) + (define-key map "\C-c\M-e" 'erlang-end-of-clause) + (define-key map "\C-c\M-f" 'tempo-forward-mark) + (define-key map "\C-c\M-h" 'erlang-mark-clause) + (define-key map "\C-c\C-c" 'comment-region) + (define-key map "\C-c\C-j" 'erlang-generate-new-clause) + (define-key map "\C-c\C-k" 'erlang-compile) + (define-key map "\C-c\C-l" 'erlang-compile-display) + (define-key map "\C-c\C-s" 'erlang-show-syntactic-information) + (define-key map "\C-c\C-q" 'erlang-indent-function) + (define-key map "\C-c\C-u" 'erlang-uncomment-region) + (define-key map "\C-c\C-y" 'erlang-clone-arguments) + (define-key map "\C-c\C-a" 'erlang-align-arrows) + (define-key map "\C-c\C-z" 'erlang-shell-display) + (unless inferior-erlang-use-cmm + (define-key map "\C-x`" 'erlang-next-error)) + map) "*Keymap used in Erlang mode.") (defvar erlang-mode-abbrev-table nil "Abbrev table in use in Erlang-mode buffers.") (defvar erlang-mode-syntax-table nil "Syntax table in use in Erlang-mode buffers.") -(defconst inferior-erlang-use-cmm (boundp 'minor-mode-overriding-map-alist) - "Non-nil means use `compilation-minor-mode' in Erlang shell.") (defvar erlang-skel-file "erlang-skels" @@ -988,7 +1027,7 @@ behaviour.") (list (concat "^\\(-" erlang-atom-regexp "\\)\\(\\s-\\|\\.\\|(\\)") 1 (if (boundp 'font-lock-preprocessor-face) 'font-lock-preprocessor-face - 'font-lock-function-name-face))) + 'font-lock-constant-face))) "Font lock keyword highlighting attributes.") (defvar erlang-font-lock-keywords-quotes @@ -1019,10 +1058,12 @@ are highlighted by syntactic analysis.") (list (list (concat "?\\s-*\\(" erlang-atom-regexp "\\|" erlang-variable-regexp "\\)") - 1 'font-lock-type-face) + 1 'font-lock-constant-face) (list (concat "^\\(-\\(?:define\\|ifn?def\\)\\)\\s-*(\\s-*\\(" erlang-atom-regexp "\\|" erlang-variable-regexp "\\)") - (list 1 'font-lock-preprocessor-face t) + (if (boundp 'font-lock-preprocessor-face) + (list 1 'font-lock-preprocessor-face t) + (list 1 'font-lock-constant-face t)) (list 3 'font-lock-type-face t t)) (list "^-e\\(lse\\|ndif\\)\\>" 0 'font-lock-preprocessor-face t)) "Font lock keyword highlighting macros. @@ -1245,7 +1286,7 @@ Other commands: (setq major-mode 'erlang-mode) (setq mode-name "Erlang") (erlang-syntax-table-init) - (erlang-keymap-init) + (use-local-map erlang-mode-map) (erlang-electric-init) (erlang-menu-init) (erlang-mode-variables) @@ -1300,53 +1341,6 @@ Other commands: (set-syntax-table erlang-mode-syntax-table)) -(defun erlang-keymap-init () - (if erlang-mode-map - nil - (setq erlang-mode-map (make-sparse-keymap)) - (erlang-mode-commands erlang-mode-map)) - (use-local-map erlang-mode-map)) - - -(defun erlang-mode-commands (map) - (unless (boundp 'indent-line-function) - (define-key map "\t" 'erlang-indent-command)) - (define-key map ";" 'erlang-electric-semicolon) - (define-key map "," 'erlang-electric-comma) - (define-key map "<" 'erlang-electric-lt) - (define-key map ">" 'erlang-electric-gt) - (define-key map "\C-m" 'erlang-electric-newline) - (if (not (boundp 'delete-key-deletes-forward)) - (define-key map "\177" 'backward-delete-char-untabify) - (define-key map [(backspace)] 'backward-delete-char-untabify)) - ;;(unless (boundp 'fill-paragraph-function) - (define-key map "\M-q" 'erlang-fill-paragraph) - (unless (boundp 'beginning-of-defun-function) - (define-key map "\M-\C-a" 'erlang-beginning-of-function) - (define-key map "\M-\C-e" 'erlang-end-of-function) - (define-key map '(meta control h) 'erlang-mark-function)) ; Xemacs - (define-key map "\M-\t" 'erlang-complete-tag) - (define-key map "\C-c\M-\t" 'tempo-complete-tag) - (define-key map "\M-+" 'erlang-find-next-tag) - (define-key map "\C-c\M-a" 'erlang-beginning-of-clause) - (define-key map "\C-c\M-b" 'tempo-backward-mark) - (define-key map "\C-c\M-e" 'erlang-end-of-clause) - (define-key map "\C-c\M-f" 'tempo-forward-mark) - (define-key map "\C-c\M-h" 'erlang-mark-clause) - (define-key map "\C-c\C-c" 'comment-region) - (define-key map "\C-c\C-j" 'erlang-generate-new-clause) - (define-key map "\C-c\C-k" 'erlang-compile) - (define-key map "\C-c\C-l" 'erlang-compile-display) - (define-key map "\C-c\C-s" 'erlang-show-syntactic-information) - (define-key map "\C-c\C-q" 'erlang-indent-function) - (define-key map "\C-c\C-u" 'erlang-uncomment-region) - (define-key map "\C-c\C-y" 'erlang-clone-arguments) - (define-key map "\C-c\C-a" 'erlang-align-arrows) - (define-key map "\C-c\C-z" 'erlang-shell-display) - (unless inferior-erlang-use-cmm - (define-key map "\C-x`" 'erlang-next-error))) - - (defun erlang-electric-init () ;; Set up electric character functions to work with ;; delsel/pending-del mode. Also, set up text properties for bit @@ -1400,7 +1394,7 @@ Other commands: (set (make-local-variable 'imenu-prev-index-position-function) 'erlang-beginning-of-function) (set (make-local-variable 'imenu-extract-index-name-function) - 'erlang-get-function-name) + 'erlang-get-function-name-and-arity) (set (make-local-variable 'tempo-match-finder) "[^-a-zA-Z0-9_]\\([-a-zA-Z0-9_]*\\)\\=") (set (make-local-variable 'beginning-of-defun-function) @@ -2931,10 +2925,16 @@ This assumes that the preceding expression is either simple (skip-chars-backward " \t") ;; Needed to match the colon in "'foo':'bar'". (if (not (memq (preceding-char) '(?# ?:))) - col - (backward-char 1) - (forward-sexp -1) - (current-column))))) + col + ;; Special hack to handle: (note line break) + ;; [#myrecord{ + ;; foo = foo}] + (or + (ignore-errors + (backward-char 1) + (forward-sexp -1) + (current-column)) + col))))) (defun erlang-indent-parenthesis (stack-position) (let ((previous (erlang-indent-find-preceding-expr))) @@ -3503,6 +3503,13 @@ Normally used in conjunction with `erlang-beginning-of-clause', e.g.: res) (error nil))))) +(defun erlang-get-function-name-and-arity () + "Return the name and arity of the function at point, or nil. +The return value is a string of the form \"foo/1\"." + (let ((name (erlang-get-function-name)) + (arity (erlang-get-function-arity))) + (and name arity (format "%s/%d" name arity)))) + (defun erlang-get-function-arguments () "Return arguments of current function, or nil." (if (not (looking-at (eval-when-compile @@ -4899,9 +4906,14 @@ a prompt. When nil, we will wait forever, or until \\[keyboard-quit].") (defvar inferior-erlang-buffer nil "Buffer of last invoked inferior Erlang, or nil.") +;; Enable uniquifying Erlang shell buffers based on directory name. +(eval-after-load "uniquify" + '(add-to-list 'uniquify-list-buffers-directory-modes 'erlang-shell-mode)) + ;;;###autoload -(defun inferior-erlang () +(defun inferior-erlang (&optional command) "Run an inferior Erlang. +With prefix command, prompt for command to start Erlang with. This is just like running Erlang in a normal shell, except that an Emacs buffer is used for input and output. @@ -4915,17 +4927,37 @@ Entry to this mode calls the functions in the variables The following commands imitate the usual Unix interrupt and editing control characters: \\{erlang-shell-mode-map}" - (interactive) + (interactive + (when current-prefix-arg + (list (if (fboundp 'read-shell-command) + ;; `read-shell-command' is a new function in Emacs 23. + (read-shell-command "Erlang command: ") + (read-string "Erlang command: "))))) (require 'comint) - (let ((opts inferior-erlang-machine-options)) - (cond ((eq inferior-erlang-shell-type 'oldshell) - (setq opts (cons "-oldshell" opts))) - ((eq inferior-erlang-shell-type 'newshell) - (setq opts (append '("-newshell" "-env" "TERM" "vt100") opts)))) - (setq inferior-erlang-buffer - (apply 'make-comint - inferior-erlang-process-name inferior-erlang-machine - nil opts))) + (let (cmd opts) + (if command + (setq cmd "sh" + opts (list "-c" command)) + (setq cmd inferior-erlang-machine + opts inferior-erlang-machine-options) + (cond ((eq inferior-erlang-shell-type 'oldshell) + (setq opts (cons "-oldshell" opts))) + ((eq inferior-erlang-shell-type 'newshell) + (setq opts (append '("-newshell" "-env" "TERM" "vt100") opts))))) + + ;; Using create-file-buffer and list-buffers-directory in this way + ;; makes uniquify give each buffer a unique name based on the + ;; directory. + (let ((fake-file-name (expand-file-name inferior-erlang-buffer-name default-directory))) + (setq inferior-erlang-buffer (create-file-buffer fake-file-name)) + (apply 'make-comint-in-buffer + inferior-erlang-process-name + inferior-erlang-buffer + cmd + nil opts) + (with-current-buffer inferior-erlang-buffer + (setq list-buffers-directory fake-file-name)))) + (setq inferior-erlang-process (get-buffer-process inferior-erlang-buffer)) (if (> 21 erlang-emacs-major-version) ; funcalls to avoid compiler warnings @@ -4938,10 +4970,6 @@ editing control characters: (if (and (not (eq system-type 'windows-nt)) (eq inferior-erlang-shell-type 'newshell)) (setq comint-process-echoes t)) - ;; `rename-buffer' takes only one argument in Emacs 18. - (condition-case nil - (rename-buffer inferior-erlang-buffer-name t) - (error (rename-buffer inferior-erlang-buffer-name))) (erlang-shell-mode)) diff --git a/lib/tools/emacs/test.erl.indented b/lib/tools/emacs/test.erl.indented index d0ea4c29cf..1dc976d8dc 100644 --- a/lib/tools/emacs/test.erl.indented +++ b/lib/tools/emacs/test.erl.indented @@ -588,3 +588,8 @@ indent_comprehensions() -> true = (X rem 2) >>, ok. + +%% This causes an error in earlier erlang-mode versions. +foo() -> + [#foo{ + foo = foo}]. diff --git a/lib/tools/emacs/test.erl.orig b/lib/tools/emacs/test.erl.orig index 70e97a2e91..feb9e4e5a1 100644 --- a/lib/tools/emacs/test.erl.orig +++ b/lib/tools/emacs/test.erl.orig @@ -588,3 +588,8 @@ Binary2 = << <<X:8>> || <<X:32,_:32>> <= <<0:512>>, true = (X rem 2) >>, ok. + +%% This causes an error in earlier erlang-mode versions. +foo() -> +[#foo{ +foo = foo}]. diff --git a/lib/wx/c_src/Makefile.in b/lib/wx/c_src/Makefile.in index 5a0b4ce8ef..8710641b57 100644 --- a/lib/wx/c_src/Makefile.in +++ b/lib/wx/c_src/Makefile.in @@ -167,7 +167,7 @@ release_spec: opt $(INSTALL_DIR) $(RELSYSDIR)/priv/$(SYS_TYPE) $(INSTALL_DATA) ../priv/erlang-logo32.png $(RELSYSDIR)/priv/ $(INSTALL_DATA) ../priv/erlang-logo64.png $(RELSYSDIR)/priv/ - $(INSTALL_DATA) $(TARGET_DIR)/$(TARGET_API)$(SO_EXT) $(RELSYSDIR)/priv/$(SYS_TYPE) + $(INSTALL_PROGRAM) $(TARGET_DIR)/$(TARGET_API)$(SO_EXT) $(RELSYSDIR)/priv/$(SYS_TYPE) release_docs_spec: diff --git a/lib/wx/src/wx_object.erl b/lib/wx/src/wx_object.erl index 1f0b7922a0..71041ff558 100644 --- a/lib/wx/src/wx_object.erl +++ b/lib/wx/src/wx_object.erl @@ -1,19 +1,19 @@ %% %% %CopyrightBegin% -%% -%% Copyright Ericsson AB 2008-2009. All Rights Reserved. -%% +%% +%% 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% %%%------------------------------------------------------------------- %%% File : wx_object.erl @@ -321,7 +321,8 @@ loop(Parent, Name, State, Mod, Time, Debug) -> _Msg when Debug =:= [] -> handle_msg(Msg, Parent, Name, State, Mod); _Msg -> - Debug1 = sys:handle_debug(Debug, {gen_server, print_event}, Name, {in, Msg}), + Debug1 = sys:handle_debug(Debug, fun print_event/3, + Name, {in, Msg}), handle_msg(Msg, Parent, Name, State, Mod, Debug1) end. @@ -410,12 +411,12 @@ handle_msg({'$gen_call', From, Msg}, Parent, Name, State, Mod, Debug) -> Debug1 = reply(Name, From, Reply, NState, Debug), loop(Parent, Name, NState, Mod, Time1, Debug1); {noreply, NState} -> - Debug1 = sys:handle_debug(Debug, {gen_server, print_event}, Name, - {noreply, NState}), + Debug1 = sys:handle_debug(Debug, fun print_event/3, + Name, {noreply, NState}), loop(Parent, Name, NState, Mod, infinity, Debug1); {noreply, NState, Time1} -> - Debug1 = sys:handle_debug(Debug, {gen_server, print_event}, Name, - {noreply, NState}), + Debug1 = sys:handle_debug(Debug, fun print_event/3, + Name, {noreply, NState}), loop(Parent, Name, NState, Mod, Time1, Debug1); {stop, Reason, Reply, NState} -> {'EXIT', R} = @@ -437,12 +438,12 @@ handle_no_reply({noreply, NState}, Parent, Name, _Msg, Mod, _State, []) -> handle_no_reply({noreply, NState, Time1}, Parent, Name, _Msg, Mod, _State, []) -> loop(Parent, Name, NState, Mod, Time1, []); handle_no_reply({noreply, NState}, Parent, Name, _Msg, Mod, _State, Debug) -> - Debug1 = sys:handle_debug(Debug, {gen_server, print_event}, Name, - {noreply, NState}), + Debug1 = sys:handle_debug(Debug, fun print_event/3, + Name, {noreply, NState}), loop(Parent, Name, NState, Mod, infinity, Debug1); handle_no_reply({noreply, NState, Time1}, Parent, Name, _Msg, Mod, _State, Debug) -> - Debug1 = sys:handle_debug(Debug, {gen_server, print_event}, Name, - {noreply, NState}), + Debug1 = sys:handle_debug(Debug, fun print_event/3, + Name, {noreply, NState}), loop(Parent, Name, NState, Mod, Time1, Debug1); handle_no_reply(Reply, _Parent, Name, Msg, Mod, State, Debug) -> handle_common_reply(Reply, Name, Msg, Mod, State,Debug). @@ -462,8 +463,8 @@ handle_common_reply(Reply, Name, Msg, Mod, State, Debug) -> %% @hidden reply(Name, {To, Tag}, Reply, State, Debug) -> reply({To, Tag}, Reply), - sys:handle_debug(Debug, {gen_server, print_event}, Name, - {out, Reply, To, State} ). + sys:handle_debug(Debug, fun print_event/3, + Name, {out, Reply, To, State}). %%----------------------------------------------------------------- @@ -485,6 +486,29 @@ system_code_change([Name, State, Mod, Time], _Module, OldVsn, Extra) -> Else -> Else end. +%%----------------------------------------------------------------- +%% Format debug messages. Print them as the call-back module sees +%% them, not as the real erlang messages. Use trace for that. +%%----------------------------------------------------------------- +print_event(Dev, {in, Msg}, Name) -> + case Msg of + {'$gen_call', {From, _Tag}, Call} -> + io:format(Dev, "*DBG* ~p got call ~p from ~w~n", + [Name, Call, From]); + {'$gen_cast', Cast} -> + io:format(Dev, "*DBG* ~p got cast ~p~n", + [Name, Cast]); + _ -> + io:format(Dev, "*DBG* ~p got ~p~n", [Name, Msg]) + end; +print_event(Dev, {out, Msg, To, State}, Name) -> + io:format(Dev, "*DBG* ~p sent ~p to ~w, new state ~w~n", + [Name, Msg, To, State]); +print_event(Dev, {noreply, State}, Name) -> + io:format(Dev, "*DBG* ~p new state ~w~n", [Name, State]); +print_event(Dev, Event, Name) -> + io:format(Dev, "*DBG* ~p dbg ~p~n", [Name, Event]). + %%% --------------------------------------------------- %%% Terminate the server. %%% --------------------------------------------------- |