The R13B03 release.OTP_R13B03

5 files changed, 660 insertions, 0 deletions

diff --git a/lib/kernel/examples/uds_dist/src/Makefile b/lib/kernel/examples/uds_dist/src/Makefile
new file mode 100644
index 0000000000..338d29b23d
--- /dev/null
+++ b/lib/kernel/examples/uds_dist/src/Makefile
@@ -0,0 +1,27 @@
+# Example makefile
+
+RM=rm -f
+CP=cp
+EBIN=../ebin
+EMULATOR=beam
+ERLC=erlc
+# Works if building in open source source tree
+KERNEL_INCLUDE=$(ERL_TOP)/lib/kernel/src
+ERLCFLAGS+= -W -b$(EMULATOR) -I$(KERNEL_INCLUDE)
+APP=uds_dist.app
+
+MODULES=uds_server uds uds_dist
+
+TARGET_FILES=$(MODULES:%=$(EBIN)/%.$(EMULATOR))
+
+opt: $(TARGET_FILES) $(EBIN)/$(APP) 
+
+$(EBIN)/%.$(EMULATOR): %.erl
+	$(ERLC) $(ERLCFLAGS) -o$(EBIN) $<
+
+$(EBIN)/$(APP): $(APP)
+	$(CP) $(APP) $(EBIN)/$(APP)
+
+clean:
+	$(RM) $(TARGET_FILES) $(EBIN)/$(APP)
+
diff --git a/lib/kernel/examples/uds_dist/src/uds.erl b/lib/kernel/examples/uds_dist/src/uds.erl
new file mode 100644
index 0000000000..ae1a78c44b
--- /dev/null
+++ b/lib/kernel/examples/uds_dist/src/uds.erl
@@ -0,0 +1,166 @@
+-module(uds).
+
+-export([listen/1, connect/1, accept/1, send/2, recv/1, close/1,
+	 get_port/1, get_status_counters/1, set_mode/2, controlling_process/2,
+	 tick/1, get_creation/1]).
+
+-define(decode(A,B,C,D), (((A) bsl 24) bor 
+			  ((B) bsl 16) bor ((C) bsl 8) bor (D))).
+-define(encode(N), [(((N) bsr 24) band 16#FF), (((N) bsr 16) band 16#FF),  
+		    (((N) bsr 8) band 16#FF), ((N) band 16#FF)]).  
+-define(check_server(), case whereis(uds_server) of 
+			    undefined ->
+				exit(uds_server_not_started);
+			    _ ->
+				ok
+			end).
+
+listen(Name) ->
+    ?check_server(),
+    command(port(),$L,Name).
+    
+
+connect(Name) ->
+    ?check_server(),
+    command(port(),$C,Name).
+
+accept(Port) ->
+    ?check_server(),
+    case control(Port,$N) of
+	{ok, N} ->
+	    command(port(),$A,N);
+	Else ->
+	    Else
+    end.
+
+send(Port,Data) ->
+    ?check_server(),
+    command(Port, $S, Data).
+
+recv(Port) ->
+    ?check_server(),
+    command(Port, $R, []).
+
+close(Port) ->
+    ?check_server(),
+    (catch unlink(Port)), %% Avoids problem with trap exits.
+    case (catch erlang:port_close(Port)) of
+	{'EXIT', Reason} ->
+	    {error, closed};
+	_ ->
+	    ok
+    end.
+
+get_port(Port) ->
+    ?check_server(),
+    {ok,Port}.
+
+get_status_counters(Port) ->
+    ?check_server(),
+    case control(Port, $S) of
+	{ok, {C0, C1, C2}} ->
+	    {ok, C0, C1, C2};
+	Other ->
+	    Other
+    end.
+
+get_creation(Port) ->
+    ?check_server(),
+    case control(Port, $R) of
+	{ok, [A]} ->
+	    A;
+	Else ->
+	    Else
+    end.
+    
+
+set_mode(Port, command) -> 
+    ?check_server(),
+    control(Port,$C);
+set_mode(Port,intermediate) ->
+    ?check_server(),
+    control(Port,$I);
+set_mode(Port,data) ->
+    ?check_server(),
+    control(Port,$D).
+
+tick(Port) ->
+    ?check_server(),
+    control(Port,$T).
+
+controlling_process(Port, Pid) ->
+    ?check_server(),
+    case (catch erlang:port_connect(Port, Pid)) of
+	true ->
+	    (catch unlink(Port)),
+	    ok;
+	{'EXIT', {badarg, _}} ->
+	    {error, closed};
+	Else ->
+	    exit({unexpected_driver_response, Else})
+    end.
+    
+
+control(Port, Command) ->
+    case (catch erlang:port_control(Port, Command, [])) of
+	[0] ->
+	    ok;
+	[0,A] ->
+	    {ok, [A]};
+	[0,A,B,C,D] ->
+	    {ok, [A,B,C,D]};
+	[0,A1,B1,C1,D1,A2,B2,C2,D2,A3,B3,C3,D3] ->
+	    {ok, {?decode(A1,B1,C1,D1),?decode(A2,B2,C2,D2),
+		  ?decode(A3,B3,C3,D3)}};
+	[1|Error] ->
+	    exit({error, list_to_atom(Error)});
+	{'EXIT', {badarg, _}} ->
+	    {error, closed};
+	Else ->
+	    exit({unexpected_driver_response, Else})
+    end.
+	    
+
+command(Port, Command, Parameters) ->
+    SavedTrapExit = process_flag(trap_exit,true),
+    case (catch erlang:port_command(Port,[Command | Parameters])) of
+	true ->
+	    receive
+		{Port, {data, [Command, $o, $k]}} ->
+		    process_flag(trap_exit,SavedTrapExit),
+		    {ok, Port};
+		{Port, {data, [Command |T]}} ->
+		    process_flag(trap_exit,SavedTrapExit),
+		    {ok, T};
+		{Port, Else} ->
+		    process_flag(trap_exit,SavedTrapExit),
+		    exit({unexpected_driver_response, Else});
+		{'EXIT', Port, normal} ->
+		    process_flag(trap_exit,SavedTrapExit),
+		    {error, closed};
+		{'EXIT', Port, Error} -> 
+		    process_flag(trap_exit,SavedTrapExit),
+		    exit(Error)
+	    end;
+	{'EXIT', {badarg, _}} ->
+	    process_flag(trap_exit,SavedTrapExit),
+	    {error, closed};
+	Unexpected ->
+	    process_flag(trap_exit,SavedTrapExit),
+	    exit({unexpected_driver_response, Unexpected})
+    end.
+
+port() ->
+    SavedTrapExit = process_flag(trap_exit,true),
+    case open_port({spawn, "uds_drv"},[]) of
+	P when port(P) ->
+	    process_flag(trap_exit,SavedTrapExit),
+	    P;
+	{'EXIT',Error} ->
+	    process_flag(trap_exit,SavedTrapExit),
+	    exit(Error);
+	Else ->
+	    process_flag(trap_exit,SavedTrapExit),
+	    exit({unexpected_driver_response, Else})
+    end.
+
diff --git a/lib/kernel/examples/uds_dist/src/uds_dist.app b/lib/kernel/examples/uds_dist/src/uds_dist.app
new file mode 100644
index 0000000000..2a58694c94
--- /dev/null
+++ b/lib/kernel/examples/uds_dist/src/uds_dist.app
@@ -0,0 +1,7 @@
+{application, uds_dist,
+   [{description, "SSL socket version 2"},
+    {vsn, "1.0"},
+    {modules, [uds_server]},
+    {registered, [uds_server]},
+    {applications, [kernel, stdlib]},
+    {env, []}]}.
diff --git a/lib/kernel/examples/uds_dist/src/uds_dist.erl b/lib/kernel/examples/uds_dist/src/uds_dist.erl
new file mode 100644
index 0000000000..7a9c15a3c8
--- /dev/null
+++ b/lib/kernel/examples/uds_dist/src/uds_dist.erl
@@ -0,0 +1,304 @@
+%% ``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 via the world wide web 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 Utvecklings AB.
+%% Portions created by Ericsson are Copyright 1999, Ericsson Utvecklings
+%% AB. All Rights Reserved.''
+%% 
+%%     $Id$
+%%
+-module(uds_dist).
+
+%% Handles the connection setup phase with other Erlang nodes.
+
+-export([childspecs/0, listen/1, accept/1, accept_connection/5,
+	 setup/4, close/1, select/1, is_node_name/1]).
+
+%% internal exports
+
+-export([accept_loop/2,do_accept/6,do_setup/5, getstat/1,tick/1]).
+
+-import(error_logger,[error_msg/2]).
+
+-include("net_address.hrl").
+
+
+
+-define(to_port(Socket, Data),
+	case uds:send(Socket, Data) of
+	    {error, closed} ->
+		self() ! {uds_closed, Socket},
+	        {error, closed};
+	    R ->
+	        R
+        end).
+
+
+-include("dist.hrl").
+-include("dist_util.hrl").
+-record(tick, {read = 0,
+	       write = 0,
+	       tick = 0,
+	       ticked = 0
+	       }).
+
+
+%% -------------------------------------------------------------
+%% This function should return a valid childspec, so that 
+%% the primitive ssl_server gets supervised
+%% -------------------------------------------------------------
+childspecs() ->
+    {ok, [{uds_server,{uds_server, start_link, []},
+	   permanent, 2000, worker, [uds_server]}]}.
+
+
+%% ------------------------------------------------------------
+%%  Select this protocol based on node name
+%%  select(Node) => Bool
+%% ------------------------------------------------------------
+
+select(Node) ->
+    {ok, MyHost} = inet:gethostname(),
+    case split_node(atom_to_list(Node), $@, []) of
+	[_, MyHost] ->
+	    true;
+	_ -> 
+	    false
+    end.
+
+%% ------------------------------------------------------------
+%% Create the listen socket, i.e. the port that this erlang
+%% node is accessible through.
+%% ------------------------------------------------------------
+
+listen(Name) ->
+    case uds:listen(atom_to_list(Name)) of
+	{ok, Socket} ->
+	    {ok, {Socket, 
+		  #net_address{address = [], 
+			       host = inet:gethostname(),
+			       protocol = uds, 
+			       family = uds}, 
+		  uds:get_creation(Socket)}};
+	Error ->
+	    Error
+    end.
+
+%% ------------------------------------------------------------
+%% Accepts new connection attempts from other Erlang nodes.
+%% ------------------------------------------------------------
+
+accept(Listen) ->
+    spawn_link(?MODULE, accept_loop, [self(), Listen]).
+
+accept_loop(Kernel, Listen) ->
+    process_flag(priority, max),
+    case uds:accept(Listen) of
+	{ok, Socket} ->
+	    Kernel ! {accept,self(),Socket,uds,uds},
+	    controller(Kernel, Socket),
+	    accept_loop(Kernel, Listen);
+	Error ->
+	    exit(Error)
+    end.
+
+controller(Kernel, Socket) ->
+    receive
+	{Kernel, controller, Pid} ->
+	    uds:controlling_process(Socket, Pid),
+	    Pid ! {self(), controller};
+	{Kernel, unsupported_protocol} ->
+	    exit(unsupported_protocol)
+    end.
+
+%% ------------------------------------------------------------
+%% Accepts a new connection attempt from another Erlang node.
+%% Performs the handshake with the other side.
+%% ------------------------------------------------------------
+
+accept_connection(AcceptPid, Socket, MyNode, Allowed, SetupTime) ->
+    spawn_link(?MODULE, do_accept,
+	       [self(), AcceptPid, Socket, MyNode,
+		Allowed, SetupTime]).
+
+do_accept(Kernel, AcceptPid, Socket, MyNode, Allowed, SetupTime) ->
+    process_flag(priority, max),
+    receive
+	{AcceptPid, controller} ->
+	    Timer = dist_util:start_timer(SetupTime),
+	    HSData = #hs_data{
+	      kernel_pid = Kernel,
+	      this_node = MyNode,
+	      socket = Socket,
+	      timer = Timer,
+	      this_flags = ?DFLAG_PUBLISHED bor
+	      ?DFLAG_ATOM_CACHE bor
+	      ?DFLAG_EXTENDED_REFERENCES bor
+	      ?DFLAG_DIST_MONITOR bor
+	      ?DFLAG_FUN_TAGS,
+	      allowed = Allowed,
+	      f_send = fun(S,D) -> uds:send(S,D) end,
+	      f_recv = fun(S,N,T) -> uds:recv(S) 
+		       end,
+	      f_setopts_pre_nodeup = 
+	      fun(S) ->
+		      uds:set_mode(S, intermediate)
+	      end,
+	      f_setopts_post_nodeup = 
+	      fun(S) ->
+		      uds:set_mode(S, data)
+	      end,
+	      f_getll = fun(S) ->
+				uds:get_port(S)
+			end,
+	      f_address = fun get_remote_id/2,
+	      mf_tick = {?MODULE, tick},
+	      mf_getstat = {?MODULE,getstat}
+	     },
+	    dist_util:handshake_other_started(HSData)
+    end.
+
+%% ------------------------------------------------------------
+%% Get remote information about a Socket.
+%% ------------------------------------------------------------
+
+get_remote_id(Socket, Node) ->
+    [_, Host] = split_node(atom_to_list(Node), $@, []),
+    #net_address {
+		  address = [],
+		  host = Host,
+		  protocol = uds,
+		  family = uds }.
+
+%% ------------------------------------------------------------
+%% Setup a new connection to another Erlang node.
+%% Performs the handshake with the other side.
+%% ------------------------------------------------------------
+
+setup(Node, MyNode, LongOrShortNames,SetupTime) ->
+    spawn_link(?MODULE, do_setup, [self(),
+				   Node,
+				   MyNode,
+				   LongOrShortNames,
+				   SetupTime]).
+
+do_setup(Kernel, Node, MyNode, LongOrShortNames,SetupTime) ->
+    process_flag(priority, max),
+    ?trace("~p~n",[{uds_dist,self(),setup,Node}]),
+    [Name, Address] = splitnode(Node, LongOrShortNames),
+    {ok, MyName} = inet:gethostname(), 
+    case Address of
+	MyName ->
+	    Timer = dist_util:start_timer(SetupTime),
+	    case uds:connect(Name) of
+		{ok, Socket} ->
+		    HSData = #hs_data{
+		      kernel_pid = Kernel,
+		      other_node = Node,
+		      this_node = MyNode,
+		      socket = Socket,
+		      timer = Timer,
+		      this_flags = ?DFLAG_PUBLISHED bor
+		      ?DFLAG_ATOM_CACHE bor
+		      ?DFLAG_EXTENDED_REFERENCES bor
+		      ?DFLAG_DIST_MONITOR bor
+		      ?DFLAG_FUN_TAGS,
+		      other_version = 1,
+		      f_send = fun(S,D) -> 
+				       uds:send(S,D) 
+			       end,
+			      f_recv = fun(S,N,T) -> 
+					       uds:recv(S) 
+				       end,
+		      f_setopts_pre_nodeup = 
+		      fun(S) ->
+			      uds:set_mode(S, intermediate)
+		      end,
+		      f_setopts_post_nodeup = 
+		      fun(S) ->
+			      uds:set_mode(S, data)
+		      end,
+		      f_getll = fun(S) ->
+					uds:get_port(S)
+				end,
+		      f_address = 
+		      fun(_,_) ->
+			      #net_address{
+			        address = [],
+			        host = Address,
+			        protocol = uds,
+			        family = uds}
+		      end,
+		      mf_tick = {?MODULE, tick},
+		      mf_getstat = {?MODULE,getstat}
+		     },
+		    dist_util:handshake_we_started(HSData);
+		_ ->
+		    ?shutdown(Node)
+	    end;
+	Other ->
+	    ?shutdown(Node)
+    end.
+
+%%
+%% Close a socket.
+%%
+close(Socket) ->
+    uds:close(Socket).
+
+
+%% If Node is illegal terminate the connection setup!!
+splitnode(Node, LongOrShortNames) ->
+    case split_node(atom_to_list(Node), $@, []) of
+	[Name|Tail] when Tail /= [] ->
+	    Host = lists:append(Tail),
+	    case split_node(Host, $., []) of
+		[_] when LongOrShortNames == longnames ->
+		    error_msg("** System running to use "
+			      "fully qualified "
+			      "hostnames **~n"
+			      "** Hostname ~s is illegal **~n",
+			      [Host]),
+		    ?shutdown(Node);
+		L when length(L) > 1, LongOrShortNames == shortnames ->
+		    error_msg("** System NOT running to use fully qualified "
+			      "hostnames **~n"
+			      "** Hostname ~s is illegal **~n",
+			      [Host]),
+		    ?shutdown(Node);
+		_ ->
+		    [Name, Host]
+	    end;
+	[_] ->
+	    error_msg("** Nodename ~p illegal, no '@' character **~n",
+		      [Node]),
+	    ?shutdown(Node);
+	_ ->
+	    error_msg("** Nodename ~p illegal **~n", [Node]),
+	    ?shutdown(Node)
+    end.
+
+split_node([Chr|T], Chr, Ack) -> [lists:reverse(Ack)|split_node(T, Chr, [])];
+split_node([H|T], Chr, Ack)   -> split_node(T, Chr, [H|Ack]);
+split_node([], _, Ack)        -> [lists:reverse(Ack)].
+
+is_node_name(Node) when atom(Node) ->
+    case split_node(atom_to_list(Node), $@, []) of
+	[_, Host] -> true;
+	_ -> false
+    end;
+is_node_name(Node) ->
+    false.
+
+tick(Sock) ->
+    uds:tick(Sock).
+getstat(Socket) ->
+    uds:get_status_counters(Socket).
diff --git a/lib/kernel/examples/uds_dist/src/uds_server.erl b/lib/kernel/examples/uds_dist/src/uds_server.erl
new file mode 100644
index 0000000000..c060130f9d
--- /dev/null
+++ b/lib/kernel/examples/uds_dist/src/uds_server.erl
@@ -0,0 +1,156 @@
+%%%----------------------------------------------------------------------
+%%% File    : uds_server.erl
+%%% Purpose : Holder for the uds_drv ddll driver.
+%%% Created : 15 Mar 2000 
+%%%----------------------------------------------------------------------
+
+-module(uds_server).
+
+-behaviour(gen_server).
+
+%% External exports
+-export([start_link/0]).
+
+%% gen_server callbacks
+-export([init/1, handle_call/3, handle_cast/2, handle_info/2, terminate/2, code_change/3]).
+
+-define(DRIVER_NAME,"uds_drv").
+
+%%%----------------------------------------------------------------------
+%%% API
+%%%----------------------------------------------------------------------
+start_link() ->
+    gen_server:start_link({local, ?MODULE}, ?MODULE, [], []).
+
+%%%----------------------------------------------------------------------
+%%% Callback functions from gen_server
+%%%----------------------------------------------------------------------
+
+%%----------------------------------------------------------------------
+%% Func: init/1
+%% Returns: {ok, State}          |
+%%          {ok, State, Timeout} |
+%%          ignore               |
+%%          {stop, Reason}
+%%----------------------------------------------------------------------
+init([]) ->
+    process_flag(trap_exit,true),
+    case load_driver() of
+	ok ->
+	    {ok, []};
+	{error, already_loaded} ->
+	    {ok, []};
+	Error ->
+	    exit(Error)
+    end.
+
+
+%%----------------------------------------------------------------------
+%% Func: handle_call/3
+%% Returns: {reply, Reply, State}          |
+%%          {reply, Reply, State, Timeout} |
+%%          {noreply, State}               |
+%%          {noreply, State, Timeout}      |
+%%          {stop, Reason, Reply, State}   | (terminate/2 is called)
+%%          {stop, Reason, State}            (terminate/2 is called)
+%%----------------------------------------------------------------------
+handle_call(Request, From, State) ->
+    Reply = ok,
+    {reply, Reply, State}.
+
+%%----------------------------------------------------------------------
+%% Func: handle_cast/2
+%% Returns: {noreply, State}          |
+%%          {noreply, State, Timeout} |
+%%          {stop, Reason, State}            (terminate/2 is called)
+%%----------------------------------------------------------------------
+handle_cast(Msg, State) ->
+    {noreply, State}.
+
+%%----------------------------------------------------------------------
+%% Func: handle_info/2
+%% Returns: {noreply, State}          |
+%%          {noreply, State, Timeout} |
+%%          {stop, Reason, State}            (terminate/2 is called)
+%%----------------------------------------------------------------------
+handle_info(Info, State) ->
+    {noreply, State}.
+
+%%----------------------------------------------------------------------
+%% Func: terminate/2
+%% Purpose: Shutdown the server
+%% Returns: any (ignored by gen_server)
+%%----------------------------------------------------------------------
+terminate(Reason, State) ->
+    erl_ddll:unload_driver(?DRIVER_NAME),
+    ok.
+
+%%----------------------------------------------------------------------
+%% Func: code_change/3
+%% Purpose: Convert process state when code is changed
+%% Returns: {ok, NewState}
+%%----------------------------------------------------------------------
+code_change(OldVsn, State, Extra) ->
+    {ok, State}.
+
+%%%----------------------------------------------------------------------
+%%% Internal functions
+%%%----------------------------------------------------------------------
+
+%%
+%% Actually load the driver.
+%%
+load_driver() ->
+    Dir = find_priv_lib(),
+    erl_ddll:load_driver(Dir,?DRIVER_NAME).
+
+%%
+%% As this server may be started by the distribution, it is not safe to assume 
+%% a working code server, neither a working file server.
+%% I try to utilize the most primitive interfaces available to determine
+%% the directory of the port_program.
+%%
+find_priv_lib() ->
+    PrivDir = case (catch code:priv_dir(uds_dist)) of
+		  {'EXIT', _} ->
+		      %% Code server probably not startet yet
+		      {ok, P} = erl_prim_loader:get_path(),
+		      ModuleFile = atom_to_list(?MODULE) ++ extension(),
+		      Pd = (catch lists:foldl
+			    (fun(X,Acc) ->
+				     M = filename:join([X, ModuleFile]),
+				     %% The file server probably not started
+				     %% either, has to use raw interface.
+				     case file:raw_read_file_info(M) of 
+					 {ok,_} -> 
+					     %% Found our own module in the
+					     %% path, lets bail out with
+					     %% the priv_dir of this directory
+					     Y = filename:split(X),
+					     throw(filename:join
+						   (lists:sublist
+						    (Y,length(Y) - 1) 
+						    ++ ["priv"])); 
+					 _ -> 
+					     Acc 
+				     end 
+			     end,
+			     false,P)),
+		      case Pd of
+			  false ->
+			      exit(uds_dist_priv_lib_indeterminate);
+			  _ ->
+			      Pd
+		      end;
+		  Dir ->
+		      Dir
+	      end,
+    filename:join([PrivDir, "lib"]).
+
+extension() ->
+    %% erlang:info(machine) returns machine name as text in all uppercase
+    "." ++ lists:map(fun(X) ->
+			     X + $a - $A
+		     end,
+		     erlang:info(machine)).
+