From 84adefa331c4159d432d22840663c38f155cd4c1 Mon Sep 17 00:00:00 2001 From: Erlang/OTP Date: Fri, 20 Nov 2009 14:54:40 +0000 Subject: The R13B03 release. --- lib/kernel/examples/uds_dist/src/Makefile | 27 +++ lib/kernel/examples/uds_dist/src/uds.erl | 166 +++++++++++++ lib/kernel/examples/uds_dist/src/uds_dist.app | 7 + lib/kernel/examples/uds_dist/src/uds_dist.erl | 304 ++++++++++++++++++++++++ lib/kernel/examples/uds_dist/src/uds_server.erl | 156 ++++++++++++ 5 files changed, 660 insertions(+) create mode 100644 lib/kernel/examples/uds_dist/src/Makefile create mode 100644 lib/kernel/examples/uds_dist/src/uds.erl create mode 100644 lib/kernel/examples/uds_dist/src/uds_dist.app create mode 100644 lib/kernel/examples/uds_dist/src/uds_dist.erl create mode 100644 lib/kernel/examples/uds_dist/src/uds_server.erl (limited to 'lib/kernel/examples/uds_dist/src') 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)). + -- cgit v1.2.3