%% ``The contents of this file are subject to the Erlang Public License,
%% Version 1.0, (the "License"); you may not use this file except in
%% compliance with the License. You may obtain a copy of the License at
%% http://www.erlang.org/EPL1_0.txt
%% 
%% 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 Original Code is Erlang-4.7.3, December, 1998.
%% 
%% The Initial Developer of the Original Code is Ericsson Telecom
%% AB. Portions created by Ericsson are Copyright (C), 1998, Ericsson
%% Telecom AB. All Rights Reserved.
%% 
%% Contributor(s): ______________________________________.''
%%
%% Copyright (C) 1993, Ellemtel Telecommunications Systems Laboratories
%% File     : net_kernel.erl
%% Author   : Claes Wikstrom klacke@erix.ericsson.se
%% Date     : 9300915 (Modified 941101)
%% Modified : 961213 Magnus Fröberg, magnus@erix.ericsson.se
%%            Rewrite, use protocol ports instead of tcp_drv.
%% Purpose  : net_kernel 

-module(net_kernel).
-copyright('Copyright (c) 1991-97 Ericsson Telecom AB').
-vsn('$Revision: /main/release/free/5').

-behaviour(gen_server).

-define(nodedown(N, State), verbose({?MODULE, ?LINE, nodedown, N}, 1, State)).
-define(nodeup(N, State), verbose({?MODULE, ?LINE, nodeup, N}, 1, State)).

%% User Interface Exports
-export([start/1, start_link/1, stop/0,
	 kernel_apply/3,
	 monitor_nodes/1,
	 longnames/0,
	 allow/1
	]).

-export([connect/1, disconnect/1]).
-export([set_cookie/3, get_cookie/0, get_cookie/1]).

-export([node_info/1, node_info/2, nodes_info/0,
	 i/0, i/1, verbose/1]).
-export([gen_digest/2, gen_challenge/0]).

%% Internal Exports 
-export([do_spawn_link/5, ticker/2]).

-export([init/1,handle_call/3,handle_cast/2,handle_info/2,
	 terminate/2]).

-import(error_logger,[error_msg/2]).

-record(state, {
	  name,         %% The node name
	  node,         %% The node name including hostname
	  type,         %% long or short names
	  ticktime,     %% tick other nodes regularly
	  connecttime,  %% the connection setuptime.
	  connections,  %% table of connections
	  conn_owners = [], %% List of connection owner pids,
	  conn_pid    = [], %% All pending and up connection pids
	  %% used for cleanup of really crashed
	  %% (e.g. exit(Owner, kill)) connections !!
	  cookies,      %% private cookie table
	  listen,       %% list of  #listen
	  monitor,      %% list of monitors for nodeup/nodedown
	  allowed,       %% list of allowed nodes in a restricted system
	  verbose = 0   %def_verb()    %% level of verboseness
	 }).

-record(listen, {
		 listen,     %% listen pid
		 accept,     %% accepting pid
		 address,    %% #net_address
		 module      %% proto module
		}).

-define(LISTEN_ID, #listen.listen).
-define(ACCEPT_ID, #listen.accept).

-record(connection, {
		     node,          %% remote node name
		     state,         %% pending | up
		     owner,         %% owner pid
		     address,       %% #net_address
		     waiting = [],  %% queued processes
		     type           %% normal | hidden
		    }).

%% Default connection setup timeout in milliseconds.
%% This timeout is set for every distributed action during
%% the connection setup.
-define(SETUPTIME, 2000). 

-include("net_address.hrl").

%% Interface functions

kernel_apply(M,F,A) ->         request({apply,M,F,A}).
allow(Nodes) ->                request({allow, Nodes}).
monitor_nodes(Flag) ->         request({monitor_nodes, Flag}).
longnames() ->                 request(longnames).
stop() ->                      erl_distribution:stop().

node_info(Node) ->             get_node_info(Node).
node_info(Node, Key) ->        get_node_info(Node, Key).
nodes_info() ->                get_nodes_info().
i() ->                         print_info().
i(Node) ->                     print_info(Node).

verbose(Level) when integer(Level) ->
    request({verbose, Level}).

get_cookie() when node() == nonode@nohost -> nocookie;
get_cookie() -> request(get_cookie).

set_cookie(Node,CI,CO) -> request({set_cookie,Node,CI,CO}).

get_cookie(Node) when atom(Node) ->
    request({get_cookie,Node}).


%% Called though BIF's

connect(Node) ->               request({connect, Node}).
disconnect(Node) ->            request({disconnect, Node}).

%% If the net_kernel isn't running we ignore all requests to the 
%% kernel, thus basically accepting them :-)
request(Req) ->
    case whereis(net_kernel) of
	P when pid(P) ->
	    gen_server:call(net_kernel,Req,infinity);
	Other -> ignored
    end.

%% This function is used to dynamically start the
%% distribution.

start(Args) ->
    erl_distribution:start(Args).

%% This is the main startup routine for net_kernel
%% The defaults are longnames and a ticktime of 15 secs to the tcp_drv.

start_link([Name]) ->
    start_link([Name, longnames]);

start_link([Name, LongOrShortNames]) ->
    start_link([Name, LongOrShortNames, 15000]);

start_link([Name, LongOrShortNames, Ticktime]) ->
    case gen_server:start_link({local, net_kernel}, net_kernel, 
			       {Name, LongOrShortNames, Ticktime}, []) of
	{ok, Pid} ->
	    {ok, Pid};
	{error, {already_started, Pid}} ->
	    {ok, Pid};
	Error ->
	    exit(nodistribution)
    end.

init({Name, LongOrShortNames, Ticktime}) ->
    process_flag(trap_exit,true),
    case init_node(Name, LongOrShortNames) of
	{ok, Node, Listeners} ->
	    process_flag(priority, max),
	    spawn_link(net_kernel, ticker, [self(), Ticktime]),
	    case init_cookies(Node) of
		false ->
		    {stop, {error,bad_cookie}};
		{true, Cookies} ->
		    Monitor = std_monitors(),
		    send_list(Monitor, {nodeup, Node}),
		    {ok, #state{name = Name,
				node = Node,
				type = LongOrShortNames,
				ticktime = Ticktime,
				connecttime = connecttime(),
				connections =
				    ets:new(sys_dist,[named_table,
						      protected,
						      {keypos, 2}]),
				cookies = Cookies,
				listen = Listeners,
				monitor = Monitor,
				allowed = [],
				verbose = 0
			       }}
	    end;
	Error ->
	    {stop, Error}
    end.


%% ------------------------------------------------------------
%% handle_call.
%% ------------------------------------------------------------

%%
%% Set up a connection to Node.
%% The response is delayed until the connection is up and
%% running.
%%
handle_call({connect, Node}, From, State) when Node == node() ->
    {reply, true, State};
handle_call({connect, Node}, From, State) ->
    verbose({connect, Node}, 1, State),
    case ets:lookup(sys_dist, Node) of
	[Conn] when Conn#connection.state == up ->
	    {reply, true, State};
	[Conn] when Conn#connection.state == pending ->
	    Waiting = Conn#connection.waiting,
	    ets:insert(sys_dist, Conn#connection{waiting = [From|Waiting]}),
	    {noreply, State};
	_ ->
	    case setup(Node,From, State) of
		{ok, SetupPid} ->
		    Owners = [{SetupPid, Node} | State#state.conn_owners],
		    Conn = [SetupPid | State#state.conn_pid],
		    {noreply, State#state{conn_owners = Owners,
					  conn_pid = Conn}};
		_  ->
		    {reply, false, State}
	    end
    end;

%%
%% Close the connection to Node.
%%
handle_call({disconnect, Node}, From, State) when Node == node() ->
    {reply, false, State};
handle_call({disconnect, Node}, From, State) ->
    verbose({disconnect, Node}, 1, State),
    {reply, do_disconnect(Node), State};

%% 
%% The spawn/4 BIF ends up here.
%% 
handle_call({spawn,M,F,A,Gleader}, {From,Tag}, State) when pid(From) ->
    Pid = (catch spawn(M,F,A)),
    group_leader(Gleader,Pid),
    {reply,Pid,State};

%% 
%% The spawn_link/4 BIF ends up here.
%% 
handle_call({spawn_link,M,F,A,Gleader}, {From,Tag}, State) when pid(From) ->
    catch spawn(net_kernel,do_spawn_link,[{From,Tag},M,F,A,Gleader]),
    {noreply,State};

%% 
%% Only allow certain nodes.
%% 
handle_call({allow, Nodes}, _From, State) ->
    case all_atoms(Nodes) of
	true ->
	    Allowed = State#state.allowed,
	    {reply,ok,State#state{allowed = Allowed ++ Nodes}};  
	false ->
	    {reply,error,State}
    end;

%% 
%% Toggle monitor of all nodes. Pid receives {nodeup, Node}
%% and {nodedown, Node} whenever a node appears/disappears.
%% 
handle_call({monitor_nodes, Flag}, {Pid, _}, State0) ->
    {Res, State} = monitor_nodes(Flag, Pid, State0),
    {reply,Res,State};

%% 
%% Not applicable any longer !?
%% 
handle_call({apply,Mod,Fun,Args}, {From,Tag}, State) when pid(From),
                                                         node(From) == node() ->
    gen_server:reply({From,Tag}, not_implemented),
%    Port = State#state.port,
%    catch apply(Mod,Fun,[Port|Args]),
    {noreply,State};

handle_call(longnames, _From, State) ->
    {reply, get(longnames), State};

handle_call(get_cookie, _From, State) ->
    %% return the general cookie (InCookie) for comatibility
    {reply, my_cookies(State), State};

handle_call({get_cookie,Node}, {Pid,_}, State) ->
    %% Check that Pid is a connection pid!!!
    case lists:member(Pid, State#state.conn_pid) of
	true ->
	    {reply, node_cookies(State, Node), State};
	false ->
	    {reply, {error, not_allowed}, State}
    end;

handle_call({set_cookie,Node,CI,CO},_From,State) ->
    %% check for valid node name
    case is_node_name(Node) of
	true when atom(CI), atom(CO) ->
	    ets:insert(State#state.cookies, {Node,CI,CO}),
	    {reply, true, State};
	false ->
	    {reply, error, State}
    end;

handle_call({verbose, Level}, _From, State) ->
    {reply, State#state.verbose, State#state{verbose = Level}}.
    

%% ------------------------------------------------------------
%% handle_cast.
%% ------------------------------------------------------------

handle_cast(_, State) ->
    {noreply,State}.

%% ------------------------------------------------------------
%% terminate.
%% ------------------------------------------------------------

terminate(no_network, State) ->
    lists:foreach(
      fun(Node) ->
	      ?nodedown(Node, State),
	      send_list(State#state.monitor, {nodedown,Node})
      end, get_nodes(up) ++ [node()]);
terminate(_Reason, State) ->
    lists:foreach(
      fun(#listen {listen = Listen,module = Mod}) ->
	      Mod:close(Listen)
      end, State#state.listen),
    lists:foreach(
      fun(Node) ->
	      ?nodedown(Node, State),
	      send_list(State#state.monitor, {nodedown,Node})
      end, get_nodes(up) ++ [node()]).


%% ------------------------------------------------------------
%% handle_info.
%% ------------------------------------------------------------

%%
%% accept a new connection.
%%
handle_info({accept,AcceptPid,Socket,Family,Proto}, State) ->
    MyNode = State#state.node,
    case get_proto_mod(Family,Proto,State#state.listen) of
	{ok, Mod} ->
	    Pid = Mod:accept_connection(AcceptPid,
					Socket,
					MyNode,
					State#state.allowed,
					State#state.connecttime),
	    AcceptPid ! {self(), controller, Pid},
	    {noreply, State#state { conn_pid = [Pid | State#state.conn_pid] }};
	_ ->
	    AcceptPid ! {self(), unsupported_protocol},
	    {noreply, State}
    end;

%%
%% A node has successfully been connected.
%%
handle_info({SetupPid, {nodeup,Node,Address,Type}}, State) ->
    case ets:lookup(sys_dist, Node) of
	[Conn] when Conn#connection.state == pending,
	            Conn#connection.owner == SetupPid ->
	    ets:insert(sys_dist, Conn#connection{state = up,
						 address = Address,
						 waiting = [],
						 type = Type}),
	    SetupPid ! {self(), inserted},
	    reply_waiting(Conn#connection.waiting, true),
	    case Type of
		normal ->
		    send_list(State#state.monitor, {nodeup, Node}),
		    {noreply, State};
		hidden ->
		    {noreply, State}
	    end;
	_ ->
	    SetupPid ! {self(), bad_request},
	    {noreply, State}
    end;

%%
%% Mark a node as pending (accept) if not busy.
%%
handle_info({AcceptPid, {accept_pending,Node,Address,Type}}, State) ->
    case ets:lookup(sys_dist, Node) of
	[Conn] when Conn#connection.state == pending ->
	    SetupPid = Conn#connection.owner,
	    AcceptPid ! {self(), {accept_pending, {pending, SetupPid}}},
	    {noreply, State};
	[Conn] when Conn#connection.state == up ->
	    AcceptPid ! {self(), {accept_pending, up}},
	    {noreply, State};
	_ ->
	    ets:insert(sys_dist, #connection{node = Node,
					     state = pending,
					     owner = AcceptPid,
					     address = Address,
					     type = Type}),
	    AcceptPid ! {self(), {accept_pending, ok}},
	    Owners = [{AcceptPid, Node} | State#state.conn_owners],
	    {noreply, State#state{conn_owners = Owners}}
    end;

%%
%% A simultaneous connect has been detected and we want to
%% change pending process.
%%
handle_info({AcceptPid, {remark_pending, Node}}, State) ->
    case ets:lookup(sys_dist, Node) of
	[Conn] when Conn#connection.state == pending ->
	    OldOwner = Conn#connection.owner,
	    Owners = lists:keyreplace(OldOwner,
				      1,
				      State#state.conn_owners,
				      {AcceptPid, Node}),
	    ets:insert(sys_dist, Conn#connection{owner = AcceptPid}),
	    AcceptPid ! {self(), {remark_pending, ok}},
	    {noreply, State#state{conn_owners = Owners}};
	_ ->
	    AcceptPid ! {self(), {remark_pending, bad_request}},
	    {noreply, State}
    end;

%%
%% Handle different types of process terminations.
%%
handle_info({'EXIT', From, Reason}, State) when pid(From) ->
    verbose({'EXIT', From, Reason}, 1, State),
    handle_exit(From, State);

%%
%% Handle badcookie and badname messages !
%%
handle_info({From,registered_send,To,Mess},State) ->
    send(From,To,Mess),
    {noreply,State};

%% badcookies SHOULD not be sent 
%% (if someone does erlang:set_cookie(node(),foo) this may be)
handle_info({From, badcookie, To ,Mess}, State) ->
    error_logger:error_msg("~n** Got OLD cookie from ~w~n",
			   [getnode(From)]),
    do_disconnect(getnode(From)),
    {noreply,State};

%%
%% Tick all connections.
%%
handle_info(tick, State) ->
    lists:foreach(fun({Pid,_Node}) -> Pid ! {self(), tick} end,
		  State#state.conn_owners),
    {noreply,State};

handle_info({From, {set_monitors, L}}, State) ->
    From ! {net_kernel, done},
    {noreply,State#state{monitor = L}};

handle_info(X, State) ->
    error_msg("Net kernel got ~w~n",[X]),
    {noreply,State}.

%% -----------------------------------------------------------
%% Handle exit signals.
%% We have 5 types of processes to handle.
%%
%%    1. The Listen process.
%%    2. The Accept process.
%%    3. Connection owning processes.
%%    4. Pending check nodeup processes.
%%    5. Processes monitoring nodeup/nodedown.
%%    (6. Garbage pid.)
%%
%% The process type function that handled the process throws 
%% the handle_info return value !
%% -----------------------------------------------------------

handle_exit(Pid, State) ->
    catch do_handle_exit(Pid, State).

do_handle_exit(Pid, State) ->
    State1 = remove_conn_pid(Pid, State),
    listen_exit(Pid, State1),
    accept_exit(Pid, State1),
    conn_own_exit(Pid, State1),
    monitor_exit(Pid, State1),
    {noreply, State1}.

remove_conn_pid(Pid, State) ->
    State#state { conn_pid = State#state.conn_pid -- [Pid] }.

listen_exit(Pid, State) ->
    case lists:keysearch(Pid, ?LISTEN_ID, State#state.listen) of
	{value, _} ->
	    error_msg("** Netkernel terminating ... **\n", []),
	    throw({stop,no_network,State});
	_ ->
	    false
    end.

accept_exit(Pid, State) ->
    Listen = State#state.listen,
    case lists:keysearch(Pid, ?ACCEPT_ID, Listen) of
	{value, ListenR} ->
	    ListenS = ListenR#listen.listen,
	    Mod = ListenR#listen.module,
	    AcceptPid = Mod:accept(ListenS),
	    L = lists:keyreplace(Pid, ?ACCEPT_ID, Listen,
				 ListenR#listen{accept = AcceptPid}),
	    throw({noreply, State#state{listen = L}});
	_ ->
	    false
    end.

conn_own_exit(Pid, State) ->
    Owners = State#state.conn_owners,
    case lists:keysearch(Pid, 1, Owners) of
	{value, {Pid, Node}} ->
	    throw({noreply, nodedown(Pid, Node, State)});
	_ ->
	    false
    end.

monitor_exit(Pid, State) ->
    Monitor = State#state.monitor,
    case delete_all(Pid, Monitor) of
	Monitor ->
	    false;
	NewMonitor ->
	    throw({noreply, State#state{monitor = NewMonitor}})
    end.

%% -----------------------------------------------------------
%% A node has gone down !!
%% nodedown(Owner, Node, State) -> State'
%% -----------------------------------------------------------

nodedown(Owner, Node, State) ->
    case get_conn(Node) of
	{ok, Conn} ->
	    nodedown(Conn, Owner, Node, Conn#connection.type, State);
	_ ->
	    State
    end.

get_conn(Node) ->
    case ets:lookup(sys_dist, Node) of
	[Conn] -> {ok, Conn};
	_      -> error
    end.

nodedown(Conn, Owner, Node, Type, OldState) ->
    Owners = lists:keydelete(Owner, 1, OldState#state.conn_owners),
    State = OldState#state{conn_owners = Owners},
    case Conn of
	Conn when Conn#connection.state == pending,
	            Conn#connection.owner == Owner ->
	    pending_nodedown(Conn, Node, Type, State);
	Conn when Conn#connection.state == up,
	            Conn#connection.owner == Owner ->
	    up_nodedown(Conn, Node, Type, State);
	_ ->
	    OldState
    end.

pending_nodedown(Conn, Node, Type, State) ->
    ets:delete(sys_dist, Node),
    reply_waiting(Conn#connection.waiting, false),
    case Type of
	normal ->
	    ?nodedown(Node, State),
	    send_list(State#state.monitor, {nodedown, Node});
	_      ->
	    ok
    end,
    State.

up_nodedown(Conn, Node, Type, State) ->
    ets:delete(sys_dist, Node),
    case Type of
	normal ->
	    ?nodedown(Node, State),
	    send_list(State#state.monitor, {nodedown, Node}),
	    State;
	_ ->
	    State
    end.

%% -----------------------------------------------------------
%% End handle_exit/2 !!
%% -----------------------------------------------------------

%% A process wants to toggle monitoring nodeup/nodedown from nodes.

monitor_nodes(true, Pid, State) ->
    %% Used to monitor all changes in the nodes list
    link(Pid),
    Monitor = State#state.monitor,
    {ok, State#state{monitor = [Pid|Monitor]}};
monitor_nodes(false, Pid, State) ->
    Monitor = State#state.monitor,
    State1 = State#state{monitor = delete_all(Pid,Monitor)},
    do_unlink(Pid, State1),
    {ok, State1};
monitor_nodes(_, _, State) ->
    {error, State}.

%% do unlink if we have no more references to Pid.
do_unlink(Pid, State) ->
    case lists:member(Pid, State#state.monitor) of
	true ->
	    false;
	_ ->
	    unlink(Pid)
    end.

do_disconnect(Node) ->
    case ets:lookup(sys_dist, Node) of
	[Conn] when record(Conn, connection) ->
	    Conn#connection.owner ! {self(), disconnect},
	    true;
	_ ->
	    false
    end.

%%
%%
%%
get_nodes(Which) ->
    get_nodes(ets:first(sys_dist), Which).

get_nodes('$end_of_table', _) ->
    [];
get_nodes(Key, Which) ->
    case ets:lookup(sys_dist, Key) of
	[Conn] when Conn#connection.state == up ->
	    [Conn#connection.node | get_nodes(ets:next(sys_dist, Key),
					      Which)];
	[Conn] when Which == all ->
	    [Conn#connection.node | get_nodes(ets:next(sys_dist, Key),
					      Which)];
	_ ->
	    get_nodes(ets:next(sys_dist, Key), Which)
    end.

stop_dist([], _) -> ok;
stop_dist([Node|Nodes], Monitor) ->
    send_list(Monitor, {nodedown, Node}),
    stop_dist(Nodes, Monitor).

ticker(Kernel, Tick) ->
    process_flag(priority, max),
    ticker1(Kernel, to_integer(Tick)).

to_integer(T) when integer(T) -> T;
to_integer(T) when atom(T) -> 
    list_to_integer(atom_to_list(T)).

ticker1(Kernel, Tick) ->
    receive
	after Tick -> 
		Kernel ! tick,
		ticker1(Kernel, Tick)
    end.

send(From,To,Mess) ->
    case whereis(To) of
	undefined ->
	    Mess;
	P when pid(P) ->
	    P ! Mess
    end.

safesend(Name,Mess) when atom(Name) ->
    case whereis(Name) of 
	undefined ->
	    Mess;
	P when pid(P) ->
	    P ! Mess
    end;
safesend(Pid, Mess) -> Pid ! Mess.

send_list([P|T], M) -> safesend(P, M), send_list(T, M);
send_list([], _) -> ok.

%% This code is really intricate. The link will go first and then comes
%% the pid, This means that the client need not do a network link.
%% If the link message would not arrive, the runtime system  shall
%% generate a nodedown message

do_spawn_link({From,Tag},M,F,A,Gleader) ->
    link(From),
    gen_server:reply({From,Tag},self()),  %% ahhh
    group_leader(Gleader,self()),
    apply(M,F,A).

%% -----------------------------------------------------------
%% Set up connection to a new node.
%% -----------------------------------------------------------

setup(Node,From,State) ->
    Allowed = State#state.allowed,
    case lists:member(Node, Allowed) of
	false when Allowed /= [] ->
	    error_msg("** Connection attempt with "
		      "disallowed node ~w ** ~n", [Node]),
	    {error, bad_node};
	_ ->
	    case select_mod(Node, State#state.listen) of
		{ok, L} ->
		    Mod = L#listen.module,
		    LAddr = L#listen.address,
		    MyNode = State#state.node,
		    Pid = Mod:setup(Node,
				    MyNode,
				    State#state.type,
				    State#state.connecttime),
		    Addr = LAddr#net_address {
					      address = undefined,
					      host = undefined },
		    ets:insert(sys_dist, #connection{node = Node,
						     state = pending,
						     owner = Pid,
						     waiting = [From],
						     address = Addr,
						     type = normal}),
		    {ok, Pid};
		Error ->
		    Error
	    end
    end.

%%
%% Find a module that is willing to handle connection setup to Node
%%
select_mod(Node, [L|Ls]) ->
    Mod = L#listen.module,
    case Mod:select(Node) of
	true -> {ok, L};
	false -> select_mod(Node, Ls)
    end;
select_mod(Node, []) ->
    {error, {unsupported_address_type, Node}}.


get_proto_mod(Family,Protocol,[L|Ls]) ->
    A = L#listen.address,
    if A#net_address.family == Family,
       A#net_address.protocol == Protocol ->
	    {ok, L#listen.module};
       true ->
	    get_proto_mod(Family,Protocol,Ls)
    end;
get_proto_mod(Family,Protocol,[]) ->    
    error.

%% -------- Initialisation functions ------------------------

init_node(Name, LongOrShortNames) ->
    {NameWithoutHost,Host} = lists:splitwith(fun($@)->false;(_)->true end,
				  atom_to_list(Name)),
    case create_name(Name, LongOrShortNames) of
	{ok,Node} ->
	    case start_protos(list_to_atom(NameWithoutHost),Node) of
		{ok, Ls} -> 
		    {ok, Node, Ls};
		Error -> Error
	    end;
	Error -> Error
    end.

%% Create the node name
create_name(Name, LongOrShortNames) ->
    put(longnames, case LongOrShortNames of 
		       shortnames -> false; 
		       longnames -> true 
		   end),
    {Head,Host1} = create_hostpart(Name,LongOrShortNames),
    case Host1 of
	{ok, HostPart} ->
	    {ok,list_to_atom(Head ++ HostPart)};
	{error,Type} ->
	    error_logger:info_msg(
	      lists:concat(["Can\'t set ",
			    Type,
			    " node name!\n"
			    "Please check your configuration\n"])),
	    {error,badarg}
    end;

create_name(Name, _) ->
    {error, badarg}.

create_hostpart(Name,LongOrShortNames) ->
    {Head,Host} = lists:splitwith(fun($@)->false;(_)->true end,
				  atom_to_list(Name)),
    Host1 = case {Host,LongOrShortNames} of
		{[$@,_|_],longnames} ->
		    {ok,Host};
		{[$@,_|_],shortnames} ->
		    case lists:member($.,Host) of
			true -> {error,short};
			_ -> {ok,Host}
		    end;
		{_,shortnames} ->
		    case inet_db:gethostname() of
			H when list(H), length(H)>0 ->
			    {ok,"@" ++ H};
			_ ->
			    {error,short}
		    end;
		{_,longnames} ->
		    case {inet_db:gethostname(),inet_db:res_option(domain)} of
			{H,D} when list(D),list(H),length(D)> 0, length(H)>0 ->
			    {ok,"@" ++ H ++ "." ++ D};
			_ ->
			    {error,long}
		    end
	    end,
    {Head,Host1}.
	
%%
%% Start all protocols
%%
start_protos(Name,Node) ->
    case init:get_argument(proto_dist) of
	{ok, [Protos]} ->
	    start_protos(Name,Protos, Node);
	_ ->
	    start_protos(Name,["inet_tcp"], Node)
    end.

start_protos(Name,Ps, Node) ->
    case start_protos(Name, Ps, Node, []) of
	[] -> {error, badarg};
	Ls -> {ok, Ls}
    end.

start_protos(Name, [Proto | Ps], Node, Ls) ->
    Mod = list_to_atom(Proto ++ "_dist"),
    case Mod:listen() of
	{ok, {Socket,Address}} ->
	    case catch Mod:reg(Name, Address) of
		{ok,Creation} ->
		    AcceptPid = Mod:accept(Socket),
		    erlang:setnode(Node, Creation),
		    L = #listen {
				 listen = Socket,
				 address = Address,
				 accept = AcceptPid,
				 module = Mod },
		    start_protos(Name,Ps, Node, [L|Ls]);
		{'EXIT', Reason} ->
		    error_logger:info_msg("Protocol: ~p: register error: ~p~n", 
					  [Proto, Reason]),
		    start_protos(Name,Ps, Node, Ls);
		{error, duplicate_name} ->
		    error_logger:info_msg("Protocol: ~p: the name " ++
					  atom_to_list(Node) ++
					  " seems to be in use by another Erlang node",
					  [Proto]),
		    start_protos(Name,Ps, Node, Ls);
		{error, Reason} ->
		    error_logger:info_msg("Protocol: ~p: register error: ~p~n", 
					  [Proto, Reason]),
		    start_protos(Name,Ps, Node, Ls)
	    end;
	{'EXIT', {undef,_}} ->
	    error_logger:info_msg("Protocol: ~p: not supported~n", [Proto]),
	    start_protos(Name,Ps, Node, Ls);
	{'EXIT', _} ->
	    error_logger:info_msg("Protocol: ~p: internal error~n", [Proto]),
	    start_protos(Name,Ps, Node, Ls);
	{error, Reason} ->
	    error_logger:info_msg("Protocol: ~p : listen error ~p~n", 
				  [Proto,Reason]),
	    start_protos(Name,Ps, Node, Ls)
    end;
start_protos(_,[], Node, Ls) ->
    Ls.

		    

init_cookies(Node) ->
    case init_cookie(Node) of
	{true, Cookie} ->
	    Cookies = ets:new(cookies, [private]),
	    ets:insert(Cookies, {Node,Cookie,Cookie}),
	    {true, Cookies};
	nocookie ->
	    Cookies = ets:new(cookies, [private]),	    
	    {true, Cookies};
	_ ->
	    false
    end.

init_cookie(Node) ->
    case init:get_argument(nocookie) of
	error ->
	    case init:get_argument(setcookie) of
		{ok, [[C0]]} ->
		    {true, list_to_atom(C0)};
		_ ->
		    %% Here is the default 
		    case read_cookie() of
			{ok, Cookie} ->
			    {true, list_to_atom(Cookie)};
			{error, Msg} ->
			    error_logger:error_msg(Msg, []),
			    false
		    end
	    end;
	Other ->
	    nocookie
    end.

%std_monitors() -> [global_name_server].
std_monitors() -> [global_group].

connecttime() ->
    case application:get_env(net_setuptime) of
	{ok, Time} when integer(Time), Time > 0, Time < 120 ->
	    Time * 1000;
	_ ->
	    ?SETUPTIME
    end.

%% -------- End initialisation functions --------------------

%% ------------------------------------------------------------
%% Node informaion.
%% ------------------------------------------------------------

get_node_info(Node) ->
    case ets:lookup(sys_dist, Node) of
	[Conn] ->
	    Owner = Conn#connection.owner,
	    State = Conn#connection.state,
	    case get_status(Owner, Node, State) of
		{ok, In, Out} ->
		    {ok, [{owner, Owner},
			  {state, State},
			  {address, Conn#connection.address},
			  {type, Conn#connection.type},
			  {in, In},
			  {out, Out}]};
		_ ->
		    {error, bad_node}
	    end;
	_ ->
	    {error, bad_node}
    end.

%%
%% We can't do monitor_node here incase the node is pending,
%% the monitor_node/2 call hangs until the connection is ready.
%% We will not ask about in/out information either for pending
%% connections as this also would block this call awhile.
%%
get_status(Owner, Node, up) ->
    monitor_node(Node, true),
    Owner ! {self(), get_status},
    receive
	{Owner, get_status, Res} ->
	    monitor_node(Node, false),
	    Res;
	{nodedown, Node} ->
	    error
    end;
get_status(_, _, _) ->
    {ok, 0, 0}.

get_node_info(Node, Key) ->
    case get_node_info(Node) of
	{ok, Info} ->
	    case lists:keysearch(Key, 1, Info) of
		{value, {Key, Value}} -> {ok, Value};
		_                     -> {error, invalid_key}
	    end;
	Error ->
	    Error
    end.

get_nodes_info() ->
    get_nodes_info(get_nodes(all), []).

get_nodes_info([Node|Nodes], InfoList) ->
    case get_node_info(Node) of
	{ok, Info} -> get_nodes_info(Nodes, [{Node, Info}|InfoList]);
	_          -> get_nodes_info(Nodes, InfoList)
    end;
get_nodes_info([], InfoList) ->
    {ok, InfoList}.

%% ------------------------------------------------------------
%% Misc. functions
%% ------------------------------------------------------------

reply_waiting(Waiting, Rep) ->
    reply_waiting1(lists:reverse(Waiting), Rep).

reply_waiting1([From|W], Rep) ->
    gen_server:reply(From, Rep),
    reply_waiting1(W, Rep);
reply_waiting1([], _) ->
    ok.

delete_all(From, [From |Tail]) -> delete_all(From, Tail);
delete_all(From, [H|Tail]) ->  [H|delete_all(From, Tail)];
delete_all(_, []) -> [].

all_atoms([]) -> true;
all_atoms([N|Tail]) when atom(N) ->
    all_atoms(Tail);
all_atoms(_) -> false.

my_cookies(State) ->
    case ets:lookup(State#state.cookies, State#state.node) of
	[{Node,IC,OC}] ->
	    if IC == OC -> IC;
	       true -> {IC,OC}
	    end;
	_ ->
	    error_msg("Cant read our cookie !!",[]),
	    nocookie
    end.

%% retrive the cookie pair for Node
node_cookies(State, Node) ->
    T = State#state.cookies,
    case ets:lookup(T,Node) of
	[{_,IC,OC}] ->
	    {IC, OC};
	_ ->
	    case ets:lookup(T,State#state.node) of
		[{_,IC,OC}] -> {IC,OC};
		_ -> 
		    % TBD, this case can never occur !
		    error_msg("Cant read cookie for node ~w !!",[Node]),
		    error
	    end
    end.

%% Generate a message digest from Challenge number and Cookie	
gen_digest(Challenge, Cookie) when integer(Challenge), atom(Cookie) ->
    C0 = md5:init(),
    C1 = md5:update(C0, atom_to_list(Cookie)),
    C2 = md5:update(C1, integer_to_list(Challenge)),
    md5:final(C2).

%% ---------------------------------------------------------------
%% Challenge code
%% gen_challenge() returns a "random" number
%% ---------------------------------------------------------------

gen_challenge() ->
    {A,B,C} = erlang:now(),
    {D,_}   = erlang:statistics(reductions),
    {E,_}   = erlang:statistics(runtime),
    {F,_}   = erlang:statistics(wall_clock),
    {G,H,_} = erlang:statistics(garbage_collection),
    %% A(8) B(16) C(16)
    %% D(16),E(8), F(16) G(8) H(16)
    ( ((A bsl 24) + (E bsl 16) + (G bsl 8) + F) bxor
      (B + (C bsl 16)) bxor 
      (D + (H bsl 16)) ) band 16#ffffffff.
    
%% ------------------------------------------------------------
%% Print status information.
%% ------------------------------------------------------------

print_info() ->
    nformat("Node", "State", "Type", "In", "Out", "Address"),
    {ok, NodesInfo} = nodes_info(),
    {In,Out} = lists:foldl(fun display_info/2, {0,0}, NodesInfo),
    nformat("Total", "", "",
	    integer_to_list(In), integer_to_list(Out), "").

display_info({Node, Info}, {I,O}) ->
    State = atom_to_list(fetch(state, Info)),
    In = fetch(in, Info),
    Out = fetch(out, Info),
    Type = atom_to_list(fetch(type, Info)),
    Address = fmt_address(fetch(address, Info)),
    nformat(atom_to_list(Node), State, Type,
	    integer_to_list(In), integer_to_list(Out), Address),
    {I+In,O+Out}.

fmt_address(undefined) -> 
    "-";
fmt_address(A) ->
    case A#net_address.family of
	inet ->
	    case A#net_address.address of
		{IP,Port} ->
		    inet_parse:ntoa(IP) ++ ":" ++ integer_to_list(Port);
		_ -> "-"
	    end;
	inet6 ->
	    case A#net_address.address of
		{IP,Port} ->
		    inet_parse:ntoa(IP) ++ "/" ++ integer_to_list(Port);
		_ -> "-"
	    end;
	_ ->
	    lists:flatten(io_lib:format("~p", [A#net_address.address]))
    end.


fetch(Key, Info) ->
    case lists:keysearch(Key, 1, Info) of
	{value, {_, Val}} -> Val;
	false -> 0
    end.

nformat(A1, A2, A3, A4, A5, A6) ->
    io:format("~-20s ~-7s ~-6s ~8s ~8s ~s~n", [A1,A2,A3,A4,A5,A6]).

print_info(Node) ->
    case node_info(Node) of
	{ok, Info} ->
	    State = fetch(state, Info),
	    In = fetch(in, Info),
	    Out = fetch(out, Info),
	    Type = fetch(type, Info),
	    Address = fmt_address(fetch(address, Info)),
	    io:format("Node     = ~p~n"
		      "State    = ~p~n"
		      "Type     = ~p~n"
		      "In       = ~p~n"
		      "Out      = ~p~n"
		      "Address  = ~s~n",
		      [Node, State, Type, In, Out, Address]);
	Error ->
	    Error
    end.

verbose(Term, Level, #state{verbose = Verbose}) when Verbose >= Level ->
    error_logger:info_report({net_kernel, Term});
verbose(_, _, _) ->
    ok.


%%
%% .erlang.cookie file stuff
%% OBSOLETES auth.erl 
%%
-include("../include/file.hrl").

read_cookie() ->
    case init:get_argument(home) of
	{ok, [[Home]]} ->
	    read_cookie(filename:join(Home, ".erlang.cookie"));
	_ ->
	    {error, "No home for cookie file"}
    end.

read_cookie(Name) ->
    case file:raw_read_file_info(Name) of
	{ok, #file_info {type=Type, mode=Mode, size=Size}} ->
	    case check_attributes(Name, Type, Mode, os:type()) of
		ok -> read_cookie(Name, Size);
		Error -> Error
	    end;
	{error, enoent} ->
	    case create_cookie(Name) of
		ok -> read_cookie(Name);
		Error -> Error
	    end;
	{error, Reason} ->
	    {error, make_error(Name, Reason)}
    end.

read_cookie(Name, Size) ->
    case file:open(Name, [raw, read]) of
	{ok, File} ->
	    case file:read(File, Size) of
		{ok, List} ->
		    file:close(File),
		    check_cookie(List, []);
		{error, Reason} ->
		    make_error(Name, Reason)
	    end;
	{error, Reason} ->
	    make_error(Name, Reason)
    end.
	
make_error(Name, Reason) ->
    {error, "Error when reading " ++ Name ++ ": " ++ atom_to_list(Reason)}.

%% Verifies that only the owner can access the cookie file.

check_attributes(Name, Type, _Mode, _Os) when Type /= regular ->
    {error, "Cookie file " ++ Name ++ " is of type " ++ Type};
check_attributes(Name, _Type, Mode, {unix, _}) when (Mode band 8#077) /= 0 ->
    {error, "Cookie file " ++ Name ++ " must be accessible by owner only"};
check_attributes(_Name, _Type, _Mode, _Os) ->
    ok.

%% Checks that the cookie has the correct format.

check_cookie([Letter|Rest], Result) when $  =< Letter, Letter =< $~ ->
    check_cookie(Rest, [Letter|Result]);
check_cookie([X|Rest], Result) ->
    check_cookie1([X|Rest], Result);
check_cookie([], Result) ->
    check_cookie1([], Result).

check_cookie1([$\n|Rest], Result) ->
    check_cookie1(Rest, Result);
check_cookie1([$\r|Rest], Result) ->
    check_cookie1(Rest, Result);
check_cookie1([$ |Rest], Result) ->
    check_cookie1(Rest, Result);
check_cookie1([_|Rest], Result) ->
    {error, "Bad characters in cookie"};
check_cookie1([], []) ->
    {error, "Too short cookie string"};
check_cookie1([], Result) ->
    {ok, lists:reverse(Result)}.

%% Creates a new, random cookie. 
   
create_cookie(Name) ->
    {_, S1, S2} = now(),
    Seed = S2*10000+S1,
    Cookie = random_cookie(20, Seed, []),
    case file:open(Name, [write, raw]) of
	{ok, File} ->
	    R1 = file:write(File, Cookie),
	    file:close(File),
	    R2 = file:raw_write_file_info(Name, make_info(Name)),
	    case {R1, R2} of
		{ok, ok} ->
		    ok;
		{{error, Reason}, _} ->
		    {error, "Failed to create cookie file"};
		{ok, {error, Reason}} ->
		    {error, "Failed to change mode: " ++ atom_to_list(Reason)}
	    end;
	{error, Reason} ->
	    {error, "Failed to create cookie file"}
    end.

random_cookie(0, _, Result) ->
    Result;
random_cookie(Count, X0, Result) ->
    X = next_random(X0),
    Letter = X*($Z-$A+1) div 16#1000000000 + $A,
    random_cookie(Count-1, X, [Letter|Result]).


%% Returns suitable information for a new cookie.
%%
%% Note: Since the generated cookie depends on the time the file was
%% created, and the time can be seen plainly in the file, we will
%% round down the file creation times to the nearest midnight to
%% give crackers some more work.

make_info(Name) ->
    Midnight =
	case file:raw_read_file_info(Name) of
	    {ok, #file_info{atime={Date, _}}} ->
		{Date, {0, 0, 0}};
	    _ ->
		{{1990, 1, 1}, {0, 0, 0}}
	    end,
    #file_info{mode=8#400, atime=Midnight, mtime=Midnight, ctime=Midnight}.


%% This RNG is from line 21 on page 102 in Knuth: The Art of Computer Programming,
%% Volume II, Seminumerical Algorithms.
%%
%% Returns an integer in the range 0..(2^35-1).

next_random(X) ->
    (X*17059465+1) band 16#fffffffff.

getnode(P) when pid(P) -> node(P);
getnode(P) -> P.

%% check that the name
is_node_name(Node) when atom(Node) ->
    case split_node(atom_to_list(Node), $@, []) of
	[_, Host] -> true;
	_ -> false
    end;
is_node_name(Node) ->
    false.

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)].
