2
votes

Say I have a gen_server callback module, g, a snippet of the code looks like this:

start_link(Args) ->
    gen_server:start_link(?MODULE, [Args], []).

process_packet(Ref, Packet) ->
    gen_server:call(Ref, MsgPacket={process_packet, Packet}).

init(Args) ->
    gen_server:cast(self(), MsgInit={init, Args}), %% delayed initialization
    {ok, state_not_initialized}.

handle_call({process_packet, Packet}, #g_state{}=S) ->
    {reply, Packet, S}.

handle_cast({init, Args}, _) ->
    State = #g_state{} = do_init(Args),
    {noreply, State}.

and another gen_server, t, whose job is to listen to a socket, and if a specific packet is received, start a g to do something about the packet, so, some code in t would looks like this:

handle_info({tcp, _Socket, Packet}, #t_state{}) ->
    case g:start_link(WhatEver) of
        {ok, Pid} ->
            g:process_packet(Pid, Packet);
        _ ->
            not_interested
    end.

Let g's pid be PidG and t's pid be PidT.

My question is, is it possible that MsgPacket (sent by PidT to PidG), arrives PidG before MsgInit (sent by PidG to itself)? if this happens, PidG whill crash, because state_not_initialized doesn't match with #g_state{} in g's handle_call.

My guess is that this is entirely possible, but I failed to come up with a method to produce this scenario. Ideally, you could slow down the speed of the message transportation of the message MsgInit, but I doubt Erlang allows me to do this kind of thing. Any idea how to make MsgPacket arrives before MsgInit?

The fix is relatively easy, (assume my guess is right), you just receive some ack sent by PidG's do_init in PidT right after g has been started, before doing the gen call.

UPDATE

Assume that my guess is right, to make the question more concrete, how to make one of the processes started by kickoff_many/1 crash? (modified based on zxq9's example)

-module(spawn_spammer).
-export([kickoff_many/1]).

kickoff() ->
    {ok, Catcher} = spawn_catcher:start(),
    {echo, _} = spawn_catcher:process_packet(Catcher, {packet_from, self()}).

kickoff_many(N) ->
    lists:foreach(fun(_) -> spawn(fun kickoff/0) end, lists:seq(1, N)).


-module(spawn_catcher).
-behavior(gen_server).

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

start() ->
    gen_server:start(?MODULE, [], []).

process_packet(Ref, Packet) ->
    gen_server:call(Ref, {process_packet, Packet}).

init(_) ->
    gen_server:cast(self(), get_ready),
    {ok, not_ready}.

handle_cast(get_ready, not_ready) ->
    {noreply, ready}.

handle_call({process_packet, P}, _From, ready) ->
    {stop, normal, {echo, P}, ready};

handle_call({process_packet, _P}, _From, not_ready) ->
    {stop, normal, call_while_not_ready, not_ready}.

handle_info(_, ready) ->
    {stop, normal, unexpected, ready}.

terminate(_, _) -> ok.

code_change(_, State, _) -> {ok, State}.
2

2 Answers

0
votes

Yes, it is possible. You can know the sequence of messages relative to process A and B, but you cannot know the message sequences relative to any other two processes and A and B (meaning, you can't know what order various streams of messages will be interleaved), and this also means you don't know the relative ordering of messages from A to B, and B to B.

How to avoid this? The most straight forward way would be to have your process T spawn process G if I does not yet exist. Or always spawn a G to handle the processing job. Or handle the processing itself. Or make the socket listener not a gen_server, but rather a pure Erlang OTP process (look up proc_lib -- I find this much smoother for socket listeners) and your weird conflicts between the gen_server world and the necessity of initializing certain aspects of socket handler processes can be made to go away.

To sum up:

  • The ordering problem you think exists really does exist. In practice it will almost never happen -- until the most inopportune time in production, of course.
  • Socket handlers should do nothing other than handling sockets.
  • "Handling sockets" means translating between Erlang messages and network messages (if its TCP they are not packets it is a stream -- be careful), and dispatching to inner gen_* processes.
  • Your initialization problem can be dealt with, but it is better to eliminate the need entirely. There is nearly always a way to do this -- when there isn't, there is proc_lib.

UPDATE

Here is what can happen if you don't flush the mailbox with a select receive searching for your magical first message.

Here we have a spamming process that will send a bajillion messages to the soon-to-be spawned gen_server:

-module(spawn_spammer).
-export([kickoff/0]).

kickoff() ->
    Spammer = start(),
    Catcher = spawn_catcher:start(),
    {Spammer, Catcher}.

start() ->
    ok = io:format("~tp ~tp: Starting up.~n", [self(), ?MODULE]),
    spawn(fun() -> loop() end).

loop() ->
    try
        spawn_catcher ! {self(), test_spam}
    catch
        _:_ -> io:format("~tp ~tp: Missed.~n", [self(), ?MODULE])
    end,
    receive
        cut_it_out ->
            ok;
        Unexpected ->
            io:format("~tp ~tp: Unexpected message ~tp~n", [self(), ?MODULE, Unexpected]),
            loop()
        after 0 ->
            loop()
    end.

Here we have that gen_server, trying to conduct a (supposedly) safe delayed initialization with itself:

-module(spawn_catcher).
-behavior(gen_server).
-export([start/0, init/1, handle_call/3, handle_cast/2, handle_info/2, terminate/2, code_change/3]).

start() ->
    ok = io:format("~tp ~tp: Starting up.~n", [self(), ?MODULE]),
    gen_server:start({local, ?MODULE}, ?MODULE, [], []).

init(_) ->
    ok = io:format("~tp ~tp: Blank initialization.~n", [self(), ?MODULE]),
    gen_server:cast(self(), get_ready),
    {ok, not_ready}.

handle_call(Message, From, State) ->
    ok = io:format("~tp ~tp: Unexpected call: ~tp from ~tp~n", [self(), ?MODULE, Message, From]),
    {noreply, State}.

handle_cast(get_ready, not_ready) ->
    ok = io:format("~tp ~tp: Getting ready~n", [self(), ?MODULE]),
    {noreply, ready};
handle_cast(Message, State) ->
    ok = io:format("~tp ~tp: Unexpected call: ~tp~n", [self(), ?MODULE, Message]),
    {noreply, State}.

handle_info(Message, not_ready) ->
    ok = io:format("~tp ~tp: DANGEROUS MESSAGE: ~tp~n", [self(), ?MODULE, Message]),
    {noreply, not_ready};
handle_info({Spammer, test_spam}, ready) ->
    ok = io:format("~tp ~tp: Got first proper message. Sending reply.~n", [self(), ?MODULE]),
    Spammer ! cut_it_out,
    {stop, normal, ready};
handle_info(Message, ready) ->
    ok = io:format("~tp ~tp: Unexpected message: ~tp~n", [self(), ?MODULE, Message]),
    {noreply, ready}.

terminate(_, _) -> ok.

code_change(_, State, _) -> {ok, State}.

And here is how that plays out in the shell:

1> spawn_spammer:kickoff().
<0.33.0> spawn_spammer: Starting up.
<0.33.0> spawn_catcher: Starting up.
<0.99.0> spawn_spammer: Missed.
<0.99.0> spawn_spammer: Missed.
<0.100.0> spawn_catcher: Blank initialization.
<0.100.0> spawn_catcher: DANGEROUS MESSAGE: {<0.99.0>,test_spam}
<0.100.0> spawn_catcher: DANGEROUS MESSAGE: {<0.99.0>,test_spam}
<0.100.0> spawn_catcher: DANGEROUS MESSAGE: {<0.99.0>,test_spam}
{<0.99.0>,{ok,<0.100.0>}}
<0.100.0> spawn_catcher: DANGEROUS MESSAGE: {<0.99.0>,test_spam}
<0.100.0> spawn_catcher: DANGEROUS MESSAGE: {<0.99.0>,test_spam}
<0.100.0> spawn_catcher: DANGEROUS MESSAGE: {<0.99.0>,test_spam}
<0.100.0> spawn_catcher: DANGEROUS MESSAGE: {<0.99.0>,test_spam}
<0.100.0> spawn_catcher: DANGEROUS MESSAGE: {<0.99.0>,test_spam}
<0.100.0> spawn_catcher: DANGEROUS MESSAGE: {<0.99.0>,test_spam}
<0.100.0> spawn_catcher: DANGEROUS MESSAGE: {<0.99.0>,test_spam}
<0.100.0> spawn_catcher: DANGEROUS MESSAGE: {<0.99.0>,test_spam}
<0.100.0> spawn_catcher: DANGEROUS MESSAGE: {<0.99.0>,test_spam}
<0.100.0> spawn_catcher: DANGEROUS MESSAGE: {<0.99.0>,test_spam}
<0.100.0> spawn_catcher: DANGEROUS MESSAGE: {<0.99.0>,test_spam}
<0.100.0> spawn_catcher: DANGEROUS MESSAGE: {<0.99.0>,test_spam}
<0.100.0> spawn_catcher: DANGEROUS MESSAGE: {<0.99.0>,test_spam}
<0.100.0> spawn_catcher: DANGEROUS MESSAGE: {<0.99.0>,test_spam}
<0.100.0> spawn_catcher: DANGEROUS MESSAGE: {<0.99.0>,test_spam}
<0.100.0> spawn_catcher: DANGEROUS MESSAGE: {<0.99.0>,test_spam}
<0.100.0> spawn_catcher: DANGEROUS MESSAGE: {<0.99.0>,test_spam}
<0.100.0> spawn_catcher: DANGEROUS MESSAGE: {<0.99.0>,test_spam}
<0.100.0> spawn_catcher: DANGEROUS MESSAGE: {<0.99.0>,test_spam}
<0.100.0> spawn_catcher: DANGEROUS MESSAGE: {<0.99.0>,test_spam}
<0.100.0> spawn_catcher: DANGEROUS MESSAGE: {<0.99.0>,test_spam}
<0.100.0> spawn_catcher: DANGEROUS MESSAGE: {<0.99.0>,test_spam}
<0.100.0> spawn_catcher: DANGEROUS MESSAGE: {<0.99.0>,test_spam}
<0.100.0> spawn_catcher: DANGEROUS MESSAGE: {<0.99.0>,test_spam}
<0.100.0> spawn_catcher: DANGEROUS MESSAGE: {<0.99.0>,test_spam}
<0.100.0> spawn_catcher: DANGEROUS MESSAGE: {<0.99.0>,test_spam}
<0.100.0> spawn_catcher: DANGEROUS MESSAGE: {<0.99.0>,test_spam}
<0.100.0> spawn_catcher: DANGEROUS MESSAGE: {<0.99.0>,test_spam}
<0.100.0> spawn_catcher: Getting ready
<0.100.0> spawn_catcher: Got first proper message. Sending reply.

THIS IS EXTREMELY UNLIKELY but it can happen.

0
votes

Short answer. No, this is not possible.

This technique is sometimes called delayed initialization and is used quite often.

Long answer. No, this is not possible if you are using gen_server and not using selective receive.

From gen_server docs:

The gen_server process calls Module:init/1 to initialize. To ensure a synchronized start-up procedure, start_link/3,4 does not return until Module:init/1 has returned.

Thing that you should consider here is following.

Who knows PidG at the moment when g:init/1 is running? Only PidG process itself. Process who started PidG will return from gen_server:start/x only after PidG will return from g:init/1.

Having established that, we know that {init, Args} is the first message in PidG's message queue. And since we are using gen_server, which (generally) processes messages one-by-one, you can be sure that PidG will also process message {init, Args} as first one.

There is no interaction between PidG and PidT at that point of time.

EDIT: Removing mention about returning {ok, State, 0} and receiving 'timeout', since it will fail because it creates race condition (see gen_server.erl). There is only one safe way: self() ! message under condition that you don't do such things as sending your pid anywhere in Module:init/x.