← Back to branch summary

~ubuntu-branches/ubuntu/karmic/erlang/karmic-security

« back to all changes in this revision

Viewing changes to lib/test_server/src/test_server_node.erl

  • Committer: Bazaar Package Importer
  • Author(s): Sergei Golovan
  • Date: 2009-05-01 10:14:38 UTC
  • mfrom: (3.1.4 sid)
  • Revision ID: james.westby@ubuntu.com-20090501101438-6qlr6rsdxgyzrg2z
Tags: 1:13.b-dfsg-2
* Cleaned up patches: removed unneeded patch which helped to support
  different SCTP library versions, made sure that changes for m68k
  architecture applied only when building on this architecture.
* Removed duplicated information from binary packages descriptions.
* Don't require libsctp-dev build-dependency on solaris-i386 architecture
  which allows to build Erlang on Nexenta (thanks to Tim Spriggs for
  the suggestion).

Show diffs side-by-side

added added

removed removed

Lines of Context:
lib/test_server/src/test_server_node.erl
1
 
%%<copyright>
2
 
%% <year>2002-2008</year>
3
 
%% <holder>Ericsson AB, All Rights Reserved</holder>
4
 
%%</copyright>
5
 
%%<legalnotice>
6
 
%% ``The contents of this file are subject to the Erlang Public License,
 
1
%%
 
2
%% %CopyrightBegin%
 
3
%% 
 
4
%% Copyright Ericsson AB 2002-2009. All Rights Reserved.
 
5
%% 
 
6
%% The contents of this file are subject to the Erlang Public License,
7
7
%% Version 1.1, (the "License"); you may not use this file except in
8
8
%% compliance with the License. You should have received a copy of the
9
9
%% Erlang Public License along with this software. If not, it can be
10
10
%% retrieved online at http://www.erlang.org/.
11
 
%%
 
11
%% 
12
12
%% Software distributed under the License is distributed on an "AS IS"
13
13
%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See
14
14
%% the License for the specific language governing rights and limitations
15
15
%% under the License.
16
 
%%
17
 
%% The Initial Developer of the Original Code is Ericsson AB.
18
 
%%</legalnotice>
 
16
%% 
 
17
%% %CopyrightEnd%
19
18
%%
20
19
-module(test_server_node).
21
 
-compile(r10).
 
20
-compile(r11).
22
21
 
23
22
%%%
24
 
%%% This code must be possible to load in both R10B and R11B.
25
 
%%% To make that possible:
26
 
%%%
27
 
%%% 1) No arithmetic instructions must be used. Use (id(erlang)):'+'/2
28
 
%%%    etc instead.
29
 
%%% 2) No bit syntax must be used.
 
23
%%% The same compiled code for this module must be possible to load
 
24
%%% in R11B, R12B and later. To make that possible no bit syntax
 
25
%%% must be used.
30
26
%%%
31
27
 
32
28
 
54
50
    is_release_available(atom_to_list(Rel));
55
51
is_release_available(Rel) ->
56
52
    case os:type() of
57
 
        {unix,sunos} ->
 
53
        {unix,_} ->
58
54
            Erl = find_release(Rel),
59
 
            filelib:is_regular(Erl);
 
55
            case Erl of
 
56
                none -> false;
 
57
                _ -> filelib:is_regular(Erl)
 
58
            end;
60
59
        _ ->
61
60
            false
62
61
    end.
98
97
                {ok,Sock} -> 
99
98
                    gen_tcp:close(LSock),
100
99
                    receive 
101
 
                        {tcp,Sock,Bin} when binary(Bin) ->
 
100
                        {tcp,Sock,Bin} when is_binary(Bin) ->
102
101
                            case unpack(Bin) of
103
102
                                error ->
104
103
                                    gen_tcp:close(Sock),
196
195
        {ok,Sock} -> 
197
196
            gen_tcp:close(LSock),
198
197
            receive 
199
 
                {tcp,Sock,Result} when binary(Result) ->
 
198
                {tcp,Sock,Result} when is_binary(Result) ->
200
199
                    case unpack(Result) of
201
200
                        error ->
202
201
                            gen_tcp:close(Sock),
230
229
 
231
230
receive_ack(Sock) ->
232
231
    receive
233
 
        {tcp,Sock,Bin} when binary(Bin) ->
 
232
        {tcp,Sock,Bin} when is_binary(Bin) ->
234
233
            case unpack(Bin) of
235
234
                error -> receive_ack(Sock);
236
235
                {ok,_} -> ok
334
333
    N;
335
334
handle_debug(Out,Trace,_TI,N) ->
336
335
    print_trc(Out,Trace,N),
337
 
    (id(erlang)):'+'(N, 1).
 
336
    N+1.
338
337
 
339
338
print_trc(Out,{trace_ts,P,call,{M,F,A},C,Ts},N) ->
340
339
    io:format(Out,
379
378
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
380
379
%%% Start slave/peer nodes (initiated by test_server:start_node/5)
381
380
%%%
382
 
start_node(SlaveName, slave, Options, From, TI) when list(SlaveName) ->
 
381
start_node(SlaveName, slave, Options, From, TI) when is_list(SlaveName) ->
383
382
    start_node_slave(list_to_atom(SlaveName), Options, From, TI);
384
383
start_node(SlaveName, slave, Options, From, TI) ->
385
384
    start_node_slave(SlaveName, Options, From, TI);
386
 
start_node(SlaveName, peer, Options, From, TI) when atom(SlaveName) ->
 
385
start_node(SlaveName, peer, Options, From, TI) when is_atom(SlaveName) ->
387
386
    start_node_peer(atom_to_list(SlaveName), Options, From, TI);
388
387
start_node(SlaveName, peer, Options, From, TI) ->
389
388
    start_node_peer(SlaveName, Options, From, TI);
615
614
        {ok,Sock} -> 
616
615
            gen_tcp:close(LSock),
617
616
            receive 
618
 
                {tcp,Sock,Started0} when binary(Started0) ->
 
617
                {tcp,Sock,Started0} when is_binary(Started0) ->
619
618
                    case unpack(Started0) of
620
619
                        error ->
621
620
                            gen_tcp:close(Sock),
860
859
%%% X = list() | atom() | void()
861
860
%%% Returns a string representation of whatever was input
862
861
 
863
 
cast_to_list(X) when list(X) -> X;
864
 
cast_to_list(X) when atom(X) -> atom_to_list(X);
 
862
cast_to_list(X) when is_list(X) -> X;
 
863
cast_to_list(X) when is_atom(X) -> atom_to_list(X);
865
864
cast_to_list(X) -> lists:flatten(io_lib:format("~w", [X])).
866
865
 
867
866
 
885
884
 
886
885
random_element(L) ->
887
886
    {A,B,C} = now(),
888
 
    E = (id(erlang)):'rem'(lists:sum([A,B,C]), length(L)),
889
 
    lists:nth((id(erlang)):'+'(E, 1), L).
 
887
    E = lists:sum([A,B,C]) rem length(L),
 
888
    lists:nth(E+1, L).
890
889
 
891
890
find_release(latest) ->
892
891
    "/usr/local/otp/releases/latest/bin/erl";
893
892
find_release(previous) ->
894
893
    "kaka";
895
894
find_release(Rel) ->
896
 
%% beam only
897
 
    "/usr/local/otp/releases/otp_beam_" ++ os(Rel) ++ "_" ++ Rel ++ "/bin/erl".
898
 
 
899
 
os(Rel) when Rel=="r5b01_patched";
900
 
             Rel=="r6b_patched";
901
 
             Rel=="r7b";
902
 
             Rel=="r7b01";
903
 
             Rel=="r7b01_patched";
904
 
             Rel=="r7b_patched";
905
 
             Rel=="r8b";
906
 
             Rel=="r8b_hipe";
907
 
             Rel=="r8b_oldsparc";
908
 
             Rel=="r8b_patched";
909
 
             Rel=="r9b";
910
 
             Rel=="r9b_patched" ->
911
 
    "sunos5";
912
 
os(_Rel) ->
913
 
    "solaris8".
 
895
    find_release(os:type(), Rel).
 
896
 
 
897
find_release({unix,sunos}, Rel) ->
 
898
    case os:cmd("uname -p") of
 
899
        "sparc" ++ _ ->
 
900
            "/usr/local/otp/releases/otp_beam_solaris8_" ++ Rel ++ "/bin/erl";
 
901
        _ ->
 
902
            none
 
903
    end;
 
904
find_release({unix,linux}, Rel) ->
 
905
    Candidates = find_rel_linux(Rel),
 
906
    case lists:dropwhile(fun(N) ->
 
907
                                 not filelib:is_regular(N)
 
908
                         end, Candidates) of
 
909
        [] -> none;
 
910
        [Erl|_] -> Erl
 
911
    end;
 
912
find_release(_, _) -> none.
 
913
 
 
914
find_rel_linux(Rel) ->
 
915
    case suse_release() of
 
916
        none -> [];
 
917
        SuseRel -> find_rel_suse(Rel, SuseRel)
 
918
    end.
 
919
 
 
920
find_rel_suse(Rel, SuseRel) ->
 
921
    Root = "/usr/local/otp/releases/otp_beam_linux_sles",
 
922
    case SuseRel of
 
923
        "11" ->
 
924
            %% Try both SuSE 11, SuSE 10 and SuSe 9 in that order.
 
925
            find_rel_suse_1(Rel, Root++"11") ++
 
926
                find_rel_suse_1(Rel, Root++"10") ++
 
927
                find_rel_suse_1(Rel, Root++"9");
 
928
        "10" ->
 
929
            %% Try both SuSE 10 and SuSe 9 in that order.
 
930
            find_rel_suse_1(Rel, Root++"10") ++
 
931
                find_rel_suse_1(Rel, Root++"9");
 
932
        "9" ->
 
933
            find_rel_suse_1(Rel, Root++"9");
 
934
        _ ->
 
935
            []
 
936
    end.
 
937
 
 
938
find_rel_suse_1(Rel, RootWc) ->
 
939
    case erlang:system_info(wordsize) of
 
940
        4 ->
 
941
            find_rel_suse_2(Rel, RootWc++"_i386");
 
942
        8 ->
 
943
            find_rel_suse_2(Rel, RootWc++"_x64") ++
 
944
                find_rel_suse_2(Rel, RootWc++"_i386")
 
945
    end.
 
946
 
 
947
find_rel_suse_2(Rel, RootWc) ->
 
948
    Wc = RootWc ++ "_" ++ Rel,
 
949
    case filelib:wildcard(Wc) of
 
950
        [] ->
 
951
            [];
 
952
        [R|_] ->
 
953
            [filename:join([R,"bin","erl"])]
 
954
    end.
 
955
 
 
956
%% suse_release() -> VersionString | none.
 
957
%%  Return the major SuSE version number for this platform or
 
958
%%  'none' if this is not a SuSE platform.
 
959
suse_release() ->
 
960
    case file:open("/etc/SuSE-release", [read]) of
 
961
        {ok,Fd} ->
 
962
            try
 
963
                suse_release(Fd)
 
964
            after
 
965
                file:close(Fd)
 
966
            end;
 
967
        {error,_} -> none
 
968
    end.
 
969
 
 
970
suse_release(Fd) ->
 
971
    case io:get_line(Fd, '') of
 
972
        eof -> none;
 
973
        Line when is_list(Line) ->
 
974
            case re:run(Line, "^VERSION\\s*=\\s*(\\d+)\s*",
 
975
                        [{capture,all_but_first,list}]) of
 
976
                nomatch ->
 
977
                    suse_release(Fd);
 
978
                {match,[Version]} ->
 
979
                    Version
 
980
            end
 
981
    end.
914
982
 
915
983
unpack(Bin) ->
916
984
    {One,Term} = split_binary(Bin, 1),