/src/gen_server2.erl
Erlang | 1152 lines | 740 code | 97 blank | 315 comment | 6 complexity | bb5c194abdcf7231bb16e2f556a36462 MD5 | raw file
1%% This file is a copy of gen_server.erl from the R13B-1 Erlang/OTP 2%% distribution, with the following modifications: 3%% 4%% 1) the module name is gen_server2 5%% 6%% 2) more efficient handling of selective receives in callbacks 7%% gen_server2 processes drain their message queue into an internal 8%% buffer before invoking any callback module functions. Messages are 9%% dequeued from the buffer for processing. Thus the effective message 10%% queue of a gen_server2 process is the concatenation of the internal 11%% buffer and the real message queue. 12%% As a result of the draining, any selective receive invoked inside a 13%% callback is less likely to have to scan a large message queue. 14%% 15%% 3) gen_server2:cast is guaranteed to be order-preserving 16%% The original code could reorder messages when communicating with a 17%% process on a remote node that was not currently connected. 18%% 19%% 4) The callback module can optionally implement prioritise_call/3, 20%% prioritise_cast/2 and prioritise_info/2. These functions take 21%% Message, From and State or just Message and State and return a 22%% single integer representing the priority attached to the message. 23%% Messages with higher priorities are processed before requests with 24%% lower priorities. The default priority is 0. 25%% 26%% 5) The callback module can optionally implement 27%% handle_pre_hibernate/1 and handle_post_hibernate/1. These will be 28%% called immediately prior to and post hibernation, respectively. If 29%% handle_pre_hibernate returns {hibernate, NewState} then the process 30%% will hibernate. If the module does not implement 31%% handle_pre_hibernate/1 then the default action is to hibernate. 32%% 33%% 6) init can return a 4th arg, {backoff, InitialTimeout, 34%% MinimumTimeout, DesiredHibernatePeriod} (all in 35%% milliseconds). Then, on all callbacks which can return a timeout 36%% (including init), timeout can be 'hibernate'. When this is the 37%% case, the current timeout value will be used (initially, the 38%% InitialTimeout supplied from init). After this timeout has 39%% occurred, hibernation will occur as normal. Upon awaking, a new 40%% current timeout value will be calculated. 41%% 42%% The purpose is that the gen_server2 takes care of adjusting the 43%% current timeout value such that the process will increase the 44%% timeout value repeatedly if it is unable to sleep for the 45%% DesiredHibernatePeriod. If it is able to sleep for the 46%% DesiredHibernatePeriod it will decrease the current timeout down to 47%% the MinimumTimeout, so that the process is put to sleep sooner (and 48%% hopefully stays asleep for longer). In short, should a process 49%% using this receive a burst of messages, it should not hibernate 50%% between those messages, but as the messages become less frequent, 51%% the process will not only hibernate, it will do so sooner after 52%% each message. 53%% 54%% When using this backoff mechanism, normal timeout values (i.e. not 55%% 'hibernate') can still be used, and if they are used then the 56%% handle_info(timeout, State) will be called as normal. In this case, 57%% returning 'hibernate' from handle_info(timeout, State) will not 58%% hibernate the process immediately, as it would if backoff wasn't 59%% being used. Instead it'll wait for the current timeout as described 60%% above. 61 62%% All modifications are (C) 2009-2010 LShift Ltd. 63 64%% ``The contents of this file are subject to the Erlang Public License, 65%% Version 1.1, (the "License"); you may not use this file except in 66%% compliance with the License. You should have received a copy of the 67%% Erlang Public License along with this software. If not, it can be 68%% retrieved via the world wide web at http://www.erlang.org/. 69%% 70%% Software distributed under the License is distributed on an "AS IS" 71%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See 72%% the License for the specific language governing rights and limitations 73%% under the License. 74%% 75%% The Initial Developer of the Original Code is Ericsson Utvecklings AB. 76%% Portions created by Ericsson are Copyright 1999, Ericsson Utvecklings 77%% AB. All Rights Reserved.'' 78%% 79%% $Id$ 80%% 81-module(gen_server2). 82 83%%% --------------------------------------------------- 84%%% 85%%% The idea behind THIS server is that the user module 86%%% provides (different) functions to handle different 87%%% kind of inputs. 88%%% If the Parent process terminates the Module:terminate/2 89%%% function is called. 90%%% 91%%% The user module should export: 92%%% 93%%% init(Args) 94%%% ==> {ok, State} 95%%% {ok, State, Timeout} 96%%% {ok, State, Timeout, Backoff} 97%%% ignore 98%%% {stop, Reason} 99%%% 100%%% handle_call(Msg, {From, Tag}, State) 101%%% 102%%% ==> {reply, Reply, State} 103%%% {reply, Reply, State, Timeout} 104%%% {noreply, State} 105%%% {noreply, State, Timeout} 106%%% {stop, Reason, Reply, State} 107%%% Reason = normal | shutdown | Term terminate(State) is called 108%%% 109%%% handle_cast(Msg, State) 110%%% 111%%% ==> {noreply, State} 112%%% {noreply, State, Timeout} 113%%% {stop, Reason, State} 114%%% Reason = normal | shutdown | Term terminate(State) is called 115%%% 116%%% handle_info(Info, State) Info is e.g. {'EXIT', P, R}, {nodedown, N}, ... 117%%% 118%%% ==> {noreply, State} 119%%% {noreply, State, Timeout} 120%%% {stop, Reason, State} 121%%% Reason = normal | shutdown | Term, terminate(State) is called 122%%% 123%%% terminate(Reason, State) Let the user module clean up 124%%% always called when server terminates 125%%% 126%%% ==> ok 127%%% 128%%% handle_pre_hibernate(State) 129%%% 130%%% ==> {hibernate, State} 131%%% {stop, Reason, State} 132%%% Reason = normal | shutdown | Term, terminate(State) is called 133%%% 134%%% handle_post_hibernate(State) 135%%% 136%%% ==> {noreply, State} 137%%% {stop, Reason, State} 138%%% Reason = normal | shutdown | Term, terminate(State) is called 139%%% 140%%% The work flow (of the server) can be described as follows: 141%%% 142%%% User module Generic 143%%% ----------- ------- 144%%% start -----> start 145%%% init <----- . 146%%% 147%%% loop 148%%% handle_call <----- . 149%%% -----> reply 150%%% 151%%% handle_cast <----- . 152%%% 153%%% handle_info <----- . 154%%% 155%%% terminate <----- . 156%%% 157%%% -----> reply 158%%% 159%%% 160%%% --------------------------------------------------- 161 162%% API 163-export([start/3, start/4, 164 start_link/3, start_link/4, 165 call/2, call/3, 166 cast/2, reply/2, 167 abcast/2, abcast/3, 168 multi_call/2, multi_call/3, multi_call/4, 169 enter_loop/3, enter_loop/4, enter_loop/5, enter_loop/6, wake_hib/1]). 170 171-export([behaviour_info/1]). 172 173%% System exports 174-export([system_continue/3, 175 system_terminate/4, 176 system_code_change/4, 177 format_status/2]). 178 179%% Internal exports 180-export([init_it/6]). 181 182-import(error_logger, [format/2]). 183 184%% State record 185-record(gs2_state, {parent, name, state, mod, time, 186 timeout_state, queue, debug, prioritise_call, 187 prioritise_cast, prioritise_info}). 188 189%%%========================================================================= 190%%% Specs. These exist only to shut up dialyzer's warnings 191%%%========================================================================= 192 193-ifdef(use_specs). 194 195-type(gs2_state() :: #gs2_state{}). 196 197-spec(handle_common_termination/3 :: 198 (any(), atom(), gs2_state()) -> no_return()). 199-spec(hibernate/1 :: (gs2_state()) -> no_return()). 200-spec(pre_hibernate/1 :: (gs2_state()) -> no_return()). 201-spec(system_terminate/4 :: (_, _, _, gs2_state()) -> no_return()). 202 203-endif. 204 205%%%========================================================================= 206%%% API 207%%%========================================================================= 208 209behaviour_info(callbacks) -> 210 [{init,1},{handle_call,3},{handle_cast,2},{handle_info,2}, 211 {terminate,2},{code_change,3}]; 212behaviour_info(_Other) -> 213 undefined. 214 215%%% ----------------------------------------------------------------- 216%%% Starts a generic server. 217%%% start(Mod, Args, Options) 218%%% start(Name, Mod, Args, Options) 219%%% start_link(Mod, Args, Options) 220%%% start_link(Name, Mod, Args, Options) where: 221%%% Name ::= {local, atom()} | {global, atom()} 222%%% Mod ::= atom(), callback module implementing the 'real' server 223%%% Args ::= term(), init arguments (to Mod:init/1) 224%%% Options ::= [{timeout, Timeout} | {debug, [Flag]}] 225%%% Flag ::= trace | log | {logfile, File} | statistics | debug 226%%% (debug == log && statistics) 227%%% Returns: {ok, Pid} | 228%%% {error, {already_started, Pid}} | 229%%% {error, Reason} 230%%% ----------------------------------------------------------------- 231start(Mod, Args, Options) -> 232 gen:start(?MODULE, nolink, Mod, Args, Options). 233 234start(Name, Mod, Args, Options) -> 235 gen:start(?MODULE, nolink, Name, Mod, Args, Options). 236 237start_link(Mod, Args, Options) -> 238 gen:start(?MODULE, link, Mod, Args, Options). 239 240start_link(Name, Mod, Args, Options) -> 241 gen:start(?MODULE, link, Name, Mod, Args, Options). 242 243 244%% ----------------------------------------------------------------- 245%% Make a call to a generic server. 246%% If the server is located at another node, that node will 247%% be monitored. 248%% If the client is trapping exits and is linked server termination 249%% is handled here (? Shall we do that here (or rely on timeouts) ?). 250%% ----------------------------------------------------------------- 251call(Name, Request) -> 252 case catch gen:call(Name, '$gen_call', Request) of 253 {ok,Res} -> 254 Res; 255 {'EXIT',Reason} -> 256 exit({Reason, {?MODULE, call, [Name, Request]}}) 257 end. 258 259call(Name, Request, Timeout) -> 260 case catch gen:call(Name, '$gen_call', Request, Timeout) of 261 {ok,Res} -> 262 Res; 263 {'EXIT',Reason} -> 264 exit({Reason, {?MODULE, call, [Name, Request, Timeout]}}) 265 end. 266 267%% ----------------------------------------------------------------- 268%% Make a cast to a generic server. 269%% ----------------------------------------------------------------- 270cast({global,Name}, Request) -> 271 catch global:send(Name, cast_msg(Request)), 272 ok; 273cast({Name,Node}=Dest, Request) when is_atom(Name), is_atom(Node) -> 274 do_cast(Dest, Request); 275cast(Dest, Request) when is_atom(Dest) -> 276 do_cast(Dest, Request); 277cast(Dest, Request) when is_pid(Dest) -> 278 do_cast(Dest, Request). 279 280do_cast(Dest, Request) -> 281 do_send(Dest, cast_msg(Request)), 282 ok. 283 284cast_msg(Request) -> {'$gen_cast',Request}. 285 286%% ----------------------------------------------------------------- 287%% Send a reply to the client. 288%% ----------------------------------------------------------------- 289reply({To, Tag}, Reply) -> 290 catch To ! {Tag, Reply}. 291 292%% ----------------------------------------------------------------- 293%% Asyncronous broadcast, returns nothing, it's just send'n pray 294%% ----------------------------------------------------------------- 295abcast(Name, Request) when is_atom(Name) -> 296 do_abcast([node() | nodes()], Name, cast_msg(Request)). 297 298abcast(Nodes, Name, Request) when is_list(Nodes), is_atom(Name) -> 299 do_abcast(Nodes, Name, cast_msg(Request)). 300 301do_abcast([Node|Nodes], Name, Msg) when is_atom(Node) -> 302 do_send({Name,Node},Msg), 303 do_abcast(Nodes, Name, Msg); 304do_abcast([], _,_) -> abcast. 305 306%%% ----------------------------------------------------------------- 307%%% Make a call to servers at several nodes. 308%%% Returns: {[Replies],[BadNodes]} 309%%% A Timeout can be given 310%%% 311%%% A middleman process is used in case late answers arrives after 312%%% the timeout. If they would be allowed to glog the callers message 313%%% queue, it would probably become confused. Late answers will 314%%% now arrive to the terminated middleman and so be discarded. 315%%% ----------------------------------------------------------------- 316multi_call(Name, Req) 317 when is_atom(Name) -> 318 do_multi_call([node() | nodes()], Name, Req, infinity). 319 320multi_call(Nodes, Name, Req) 321 when is_list(Nodes), is_atom(Name) -> 322 do_multi_call(Nodes, Name, Req, infinity). 323 324multi_call(Nodes, Name, Req, infinity) -> 325 do_multi_call(Nodes, Name, Req, infinity); 326multi_call(Nodes, Name, Req, Timeout) 327 when is_list(Nodes), is_atom(Name), is_integer(Timeout), Timeout >= 0 -> 328 do_multi_call(Nodes, Name, Req, Timeout). 329 330 331%%----------------------------------------------------------------- 332%% enter_loop(Mod, Options, State, <ServerName>, <TimeOut>, <Backoff>) ->_ 333%% 334%% Description: Makes an existing process into a gen_server. 335%% The calling process will enter the gen_server receive 336%% loop and become a gen_server process. 337%% The process *must* have been started using one of the 338%% start functions in proc_lib, see proc_lib(3). 339%% The user is responsible for any initialization of the 340%% process, including registering a name for it. 341%%----------------------------------------------------------------- 342enter_loop(Mod, Options, State) -> 343 enter_loop(Mod, Options, State, self(), infinity, undefined). 344 345enter_loop(Mod, Options, State, Backoff = {backoff, _, _ , _}) -> 346 enter_loop(Mod, Options, State, self(), infinity, Backoff); 347 348enter_loop(Mod, Options, State, ServerName = {_, _}) -> 349 enter_loop(Mod, Options, State, ServerName, infinity, undefined); 350 351enter_loop(Mod, Options, State, Timeout) -> 352 enter_loop(Mod, Options, State, self(), Timeout, undefined). 353 354enter_loop(Mod, Options, State, ServerName, Backoff = {backoff, _, _, _}) -> 355 enter_loop(Mod, Options, State, ServerName, infinity, Backoff); 356 357enter_loop(Mod, Options, State, ServerName, Timeout) -> 358 enter_loop(Mod, Options, State, ServerName, Timeout, undefined). 359 360enter_loop(Mod, Options, State, ServerName, Timeout, Backoff) -> 361 Name = get_proc_name(ServerName), 362 Parent = get_parent(), 363 Debug = debug_options(Name, Options), 364 Queue = priority_queue:new(), 365 Backoff1 = extend_backoff(Backoff), 366 loop(find_prioritisers( 367 #gs2_state { parent = Parent, name = Name, state = State, 368 mod = Mod, time = Timeout, timeout_state = Backoff1, 369 queue = Queue, debug = Debug })). 370 371%%%======================================================================== 372%%% Gen-callback functions 373%%%======================================================================== 374 375%%% --------------------------------------------------- 376%%% Initiate the new process. 377%%% Register the name using the Rfunc function 378%%% Calls the Mod:init/Args function. 379%%% Finally an acknowledge is sent to Parent and the main 380%%% loop is entered. 381%%% --------------------------------------------------- 382init_it(Starter, self, Name, Mod, Args, Options) -> 383 init_it(Starter, self(), Name, Mod, Args, Options); 384init_it(Starter, Parent, Name0, Mod, Args, Options) -> 385 Name = name(Name0), 386 Debug = debug_options(Name, Options), 387 Queue = priority_queue:new(), 388 GS2State = find_prioritisers( 389 #gs2_state { parent = Parent, 390 name = Name, 391 mod = Mod, 392 queue = Queue, 393 debug = Debug }), 394 case catch Mod:init(Args) of 395 {ok, State} -> 396 proc_lib:init_ack(Starter, {ok, self()}), 397 loop(GS2State #gs2_state { state = State, 398 time = infinity, 399 timeout_state = undefined }); 400 {ok, State, Timeout} -> 401 proc_lib:init_ack(Starter, {ok, self()}), 402 loop(GS2State #gs2_state { state = State, 403 time = Timeout, 404 timeout_state = undefined }); 405 {ok, State, Timeout, Backoff = {backoff, _, _, _}} -> 406 Backoff1 = extend_backoff(Backoff), 407 proc_lib:init_ack(Starter, {ok, self()}), 408 loop(GS2State #gs2_state { state = State, 409 time = Timeout, 410 timeout_state = Backoff1 }); 411 {stop, Reason} -> 412 %% For consistency, we must make sure that the 413 %% registered name (if any) is unregistered before 414 %% the parent process is notified about the failure. 415 %% (Otherwise, the parent process could get 416 %% an 'already_started' error if it immediately 417 %% tried starting the process again.) 418 unregister_name(Name0), 419 proc_lib:init_ack(Starter, {error, Reason}), 420 exit(Reason); 421 ignore -> 422 unregister_name(Name0), 423 proc_lib:init_ack(Starter, ignore), 424 exit(normal); 425 {'EXIT', Reason} -> 426 unregister_name(Name0), 427 proc_lib:init_ack(Starter, {error, Reason}), 428 exit(Reason); 429 Else -> 430 Error = {bad_return_value, Else}, 431 proc_lib:init_ack(Starter, {error, Error}), 432 exit(Error) 433 end. 434 435name({local,Name}) -> Name; 436name({global,Name}) -> Name; 437%% name(Pid) when is_pid(Pid) -> Pid; 438%% when R12 goes away, drop the line beneath and uncomment the line above 439name(Name) -> Name. 440 441unregister_name({local,Name}) -> 442 _ = (catch unregister(Name)); 443unregister_name({global,Name}) -> 444 _ = global:unregister_name(Name); 445unregister_name(Pid) when is_pid(Pid) -> 446 Pid; 447% Under R12 let's just ignore it, as we have a single term as Name. 448% On R13 it will never get here, as we get tuple with 'local/global' atom. 449unregister_name(_Name) -> ok. 450 451extend_backoff(undefined) -> 452 undefined; 453extend_backoff({backoff, InitialTimeout, MinimumTimeout, DesiredHibPeriod}) -> 454 {backoff, InitialTimeout, MinimumTimeout, DesiredHibPeriod, now()}. 455 456%%%======================================================================== 457%%% Internal functions 458%%%======================================================================== 459%%% --------------------------------------------------- 460%%% The MAIN loop. 461%%% --------------------------------------------------- 462loop(GS2State = #gs2_state { time = hibernate, 463 timeout_state = undefined }) -> 464 pre_hibernate(GS2State); 465loop(GS2State) -> 466 process_next_msg(drain(GS2State)). 467 468drain(GS2State) -> 469 receive 470 Input -> drain(in(Input, GS2State)) 471 after 0 -> GS2State 472 end. 473 474process_next_msg(GS2State = #gs2_state { time = Time, 475 timeout_state = TimeoutState, 476 queue = Queue }) -> 477 case priority_queue:out(Queue) of 478 {{value, Msg}, Queue1} -> 479 process_msg(Msg, GS2State #gs2_state { queue = Queue1 }); 480 {empty, Queue1} -> 481 {Time1, HibOnTimeout} 482 = case {Time, TimeoutState} of 483 {hibernate, {backoff, Current, _Min, _Desired, _RSt}} -> 484 {Current, true}; 485 {hibernate, _} -> 486 %% wake_hib/7 will set Time to hibernate. If 487 %% we were woken and didn't receive a msg 488 %% then we will get here and need a sensible 489 %% value for Time1, otherwise we crash. 490 %% R13B1 always waits infinitely when waking 491 %% from hibernation, so that's what we do 492 %% here too. 493 {infinity, false}; 494 _ -> {Time, false} 495 end, 496 receive 497 Input -> 498 %% Time could be 'hibernate' here, so *don't* call loop 499 process_next_msg( 500 drain(in(Input, GS2State #gs2_state { queue = Queue1 }))) 501 after Time1 -> 502 case HibOnTimeout of 503 true -> 504 pre_hibernate( 505 GS2State #gs2_state { queue = Queue1 }); 506 false -> 507 process_msg(timeout, 508 GS2State #gs2_state { queue = Queue1 }) 509 end 510 end 511 end. 512 513wake_hib(GS2State = #gs2_state { timeout_state = TS }) -> 514 TimeoutState1 = case TS of 515 undefined -> 516 undefined; 517 {SleptAt, TimeoutState} -> 518 adjust_timeout_state(SleptAt, now(), TimeoutState) 519 end, 520 post_hibernate( 521 drain(GS2State #gs2_state { timeout_state = TimeoutState1 })). 522 523hibernate(GS2State = #gs2_state { timeout_state = TimeoutState }) -> 524 TS = case TimeoutState of 525 undefined -> undefined; 526 {backoff, _, _, _, _} -> {now(), TimeoutState} 527 end, 528 proc_lib:hibernate(?MODULE, wake_hib, 529 [GS2State #gs2_state { timeout_state = TS }]). 530 531pre_hibernate(GS2State = #gs2_state { state = State, 532 mod = Mod }) -> 533 case erlang:function_exported(Mod, handle_pre_hibernate, 1) of 534 true -> 535 case catch Mod:handle_pre_hibernate(State) of 536 {hibernate, NState} -> 537 hibernate(GS2State #gs2_state { state = NState } ); 538 Reply -> 539 handle_common_termination(Reply, pre_hibernate, GS2State) 540 end; 541 false -> 542 hibernate(GS2State) 543 end. 544 545post_hibernate(GS2State = #gs2_state { state = State, 546 mod = Mod }) -> 547 case erlang:function_exported(Mod, handle_post_hibernate, 1) of 548 true -> 549 case catch Mod:handle_post_hibernate(State) of 550 {noreply, NState} -> 551 process_next_msg(GS2State #gs2_state { state = NState, 552 time = infinity }); 553 {noreply, NState, Time} -> 554 process_next_msg(GS2State #gs2_state { state = NState, 555 time = Time }); 556 Reply -> 557 handle_common_termination(Reply, post_hibernate, GS2State) 558 end; 559 false -> 560 %% use hibernate here, not infinity. This matches 561 %% R13B. The key is that we should be able to get through 562 %% to process_msg calling sys:handle_system_msg with Time 563 %% still set to hibernate, iff that msg is the very msg 564 %% that woke us up (or the first msg we receive after 565 %% waking up). 566 process_next_msg(GS2State #gs2_state { time = hibernate }) 567 end. 568 569adjust_timeout_state(SleptAt, AwokeAt, {backoff, CurrentTO, MinimumTO, 570 DesiredHibPeriod, RandomState}) -> 571 NapLengthMicros = timer:now_diff(AwokeAt, SleptAt), 572 CurrentMicros = CurrentTO * 1000, 573 MinimumMicros = MinimumTO * 1000, 574 DesiredHibMicros = DesiredHibPeriod * 1000, 575 GapBetweenMessagesMicros = NapLengthMicros + CurrentMicros, 576 Base = 577 %% If enough time has passed between the last two messages then we 578 %% should consider sleeping sooner. Otherwise stay awake longer. 579 case GapBetweenMessagesMicros > (MinimumMicros + DesiredHibMicros) of 580 true -> lists:max([MinimumTO, CurrentTO div 2]); 581 false -> CurrentTO 582 end, 583 {Extra, RandomState1} = random:uniform_s(Base, RandomState), 584 CurrentTO1 = Base + Extra, 585 {backoff, CurrentTO1, MinimumTO, DesiredHibPeriod, RandomState1}. 586 587in({'$gen_cast', Msg}, GS2State = #gs2_state { prioritise_cast = PC, 588 queue = Queue }) -> 589 GS2State #gs2_state { queue = priority_queue:in( 590 {'$gen_cast', Msg}, 591 PC(Msg, GS2State), Queue) }; 592in({'$gen_call', From, Msg}, GS2State = #gs2_state { prioritise_call = PC, 593 queue = Queue }) -> 594 GS2State #gs2_state { queue = priority_queue:in( 595 {'$gen_call', From, Msg}, 596 PC(Msg, From, GS2State), Queue) }; 597in(Input, GS2State = #gs2_state { prioritise_info = PI, queue = Queue }) -> 598 GS2State #gs2_state { queue = priority_queue:in( 599 Input, PI(Input, GS2State), Queue) }. 600 601process_msg(Msg, 602 GS2State = #gs2_state { parent = Parent, 603 name = Name, 604 debug = Debug }) -> 605 case Msg of 606 {system, From, Req} -> 607 sys:handle_system_msg( 608 Req, From, Parent, ?MODULE, Debug, 609 GS2State); 610 %% gen_server puts Hib on the end as the 7th arg, but that 611 %% version of the function seems not to be documented so 612 %% leaving out for now. 613 {'EXIT', Parent, Reason} -> 614 terminate(Reason, Msg, GS2State); 615 _Msg when Debug =:= [] -> 616 handle_msg(Msg, GS2State); 617 _Msg -> 618 Debug1 = sys:handle_debug(Debug, fun print_event/3, 619 Name, {in, Msg}), 620 handle_msg(Msg, GS2State #gs2_state { debug = Debug1 }) 621 end. 622 623%%% --------------------------------------------------- 624%%% Send/recive functions 625%%% --------------------------------------------------- 626do_send(Dest, Msg) -> 627 catch erlang:send(Dest, Msg). 628 629do_multi_call(Nodes, Name, Req, infinity) -> 630 Tag = make_ref(), 631 Monitors = send_nodes(Nodes, Name, Tag, Req), 632 rec_nodes(Tag, Monitors, Name, undefined); 633do_multi_call(Nodes, Name, Req, Timeout) -> 634 Tag = make_ref(), 635 Caller = self(), 636 Receiver = 637 spawn( 638 fun () -> 639 %% Middleman process. Should be unsensitive to regular 640 %% exit signals. The sychronization is needed in case 641 %% the receiver would exit before the caller started 642 %% the monitor. 643 process_flag(trap_exit, true), 644 Mref = erlang:monitor(process, Caller), 645 receive 646 {Caller,Tag} -> 647 Monitors = send_nodes(Nodes, Name, Tag, Req), 648 TimerId = erlang:start_timer(Timeout, self(), ok), 649 Result = rec_nodes(Tag, Monitors, Name, TimerId), 650 exit({self(),Tag,Result}); 651 {'DOWN',Mref,_,_,_} -> 652 %% Caller died before sending us the go-ahead. 653 %% Give up silently. 654 exit(normal) 655 end 656 end), 657 Mref = erlang:monitor(process, Receiver), 658 Receiver ! {self(),Tag}, 659 receive 660 {'DOWN',Mref,_,_,{Receiver,Tag,Result}} -> 661 Result; 662 {'DOWN',Mref,_,_,Reason} -> 663 %% The middleman code failed. Or someone did 664 %% exit(_, kill) on the middleman process => Reason==killed 665 exit(Reason) 666 end. 667 668send_nodes(Nodes, Name, Tag, Req) -> 669 send_nodes(Nodes, Name, Tag, Req, []). 670 671send_nodes([Node|Tail], Name, Tag, Req, Monitors) 672 when is_atom(Node) -> 673 Monitor = start_monitor(Node, Name), 674 %% Handle non-existing names in rec_nodes. 675 catch {Name, Node} ! {'$gen_call', {self(), {Tag, Node}}, Req}, 676 send_nodes(Tail, Name, Tag, Req, [Monitor | Monitors]); 677send_nodes([_Node|Tail], Name, Tag, Req, Monitors) -> 678 %% Skip non-atom Node 679 send_nodes(Tail, Name, Tag, Req, Monitors); 680send_nodes([], _Name, _Tag, _Req, Monitors) -> 681 Monitors. 682 683%% Against old nodes: 684%% If no reply has been delivered within 2 secs. (per node) check that 685%% the server really exists and wait for ever for the answer. 686%% 687%% Against contemporary nodes: 688%% Wait for reply, server 'DOWN', or timeout from TimerId. 689 690rec_nodes(Tag, Nodes, Name, TimerId) -> 691 rec_nodes(Tag, Nodes, Name, [], [], 2000, TimerId). 692 693rec_nodes(Tag, [{N,R}|Tail], Name, Badnodes, Replies, Time, TimerId ) -> 694 receive 695 {'DOWN', R, _, _, _} -> 696 rec_nodes(Tag, Tail, Name, [N|Badnodes], Replies, Time, TimerId); 697 {{Tag, N}, Reply} -> %% Tag is bound !!! 698 unmonitor(R), 699 rec_nodes(Tag, Tail, Name, Badnodes, 700 [{N,Reply}|Replies], Time, TimerId); 701 {timeout, TimerId, _} -> 702 unmonitor(R), 703 %% Collect all replies that already have arrived 704 rec_nodes_rest(Tag, Tail, Name, [N|Badnodes], Replies) 705 end; 706rec_nodes(Tag, [N|Tail], Name, Badnodes, Replies, Time, TimerId) -> 707 %% R6 node 708 receive 709 {nodedown, N} -> 710 monitor_node(N, false), 711 rec_nodes(Tag, Tail, Name, [N|Badnodes], Replies, 2000, TimerId); 712 {{Tag, N}, Reply} -> %% Tag is bound !!! 713 receive {nodedown, N} -> ok after 0 -> ok end, 714 monitor_node(N, false), 715 rec_nodes(Tag, Tail, Name, Badnodes, 716 [{N,Reply}|Replies], 2000, TimerId); 717 {timeout, TimerId, _} -> 718 receive {nodedown, N} -> ok after 0 -> ok end, 719 monitor_node(N, false), 720 %% Collect all replies that already have arrived 721 rec_nodes_rest(Tag, Tail, Name, [N | Badnodes], Replies) 722 after Time -> 723 case rpc:call(N, erlang, whereis, [Name]) of 724 Pid when is_pid(Pid) -> % It exists try again. 725 rec_nodes(Tag, [N|Tail], Name, Badnodes, 726 Replies, infinity, TimerId); 727 _ -> % badnode 728 receive {nodedown, N} -> ok after 0 -> ok end, 729 monitor_node(N, false), 730 rec_nodes(Tag, Tail, Name, [N|Badnodes], 731 Replies, 2000, TimerId) 732 end 733 end; 734rec_nodes(_, [], _, Badnodes, Replies, _, TimerId) -> 735 case catch erlang:cancel_timer(TimerId) of 736 false -> % It has already sent it's message 737 receive 738 {timeout, TimerId, _} -> ok 739 after 0 -> 740 ok 741 end; 742 _ -> % Timer was cancelled, or TimerId was 'undefined' 743 ok 744 end, 745 {Replies, Badnodes}. 746 747%% Collect all replies that already have arrived 748rec_nodes_rest(Tag, [{N,R}|Tail], Name, Badnodes, Replies) -> 749 receive 750 {'DOWN', R, _, _, _} -> 751 rec_nodes_rest(Tag, Tail, Name, [N|Badnodes], Replies); 752 {{Tag, N}, Reply} -> %% Tag is bound !!! 753 unmonitor(R), 754 rec_nodes_rest(Tag, Tail, Name, Badnodes, [{N,Reply}|Replies]) 755 after 0 -> 756 unmonitor(R), 757 rec_nodes_rest(Tag, Tail, Name, [N|Badnodes], Replies) 758 end; 759rec_nodes_rest(Tag, [N|Tail], Name, Badnodes, Replies) -> 760 %% R6 node 761 receive 762 {nodedown, N} -> 763 monitor_node(N, false), 764 rec_nodes_rest(Tag, Tail, Name, [N|Badnodes], Replies); 765 {{Tag, N}, Reply} -> %% Tag is bound !!! 766 receive {nodedown, N} -> ok after 0 -> ok end, 767 monitor_node(N, false), 768 rec_nodes_rest(Tag, Tail, Name, Badnodes, [{N,Reply}|Replies]) 769 after 0 -> 770 receive {nodedown, N} -> ok after 0 -> ok end, 771 monitor_node(N, false), 772 rec_nodes_rest(Tag, Tail, Name, [N|Badnodes], Replies) 773 end; 774rec_nodes_rest(_Tag, [], _Name, Badnodes, Replies) -> 775 {Replies, Badnodes}. 776 777 778%%% --------------------------------------------------- 779%%% Monitor functions 780%%% --------------------------------------------------- 781 782start_monitor(Node, Name) when is_atom(Node), is_atom(Name) -> 783 if node() =:= nonode@nohost, Node =/= nonode@nohost -> 784 Ref = make_ref(), 785 self() ! {'DOWN', Ref, process, {Name, Node}, noconnection}, 786 {Node, Ref}; 787 true -> 788 case catch erlang:monitor(process, {Name, Node}) of 789 {'EXIT', _} -> 790 %% Remote node is R6 791 monitor_node(Node, true), 792 Node; 793 Ref when is_reference(Ref) -> 794 {Node, Ref} 795 end 796 end. 797 798%% Cancels a monitor started with Ref=erlang:monitor(_, _). 799unmonitor(Ref) when is_reference(Ref) -> 800 erlang:demonitor(Ref), 801 receive 802 {'DOWN', Ref, _, _, _} -> 803 true 804 after 0 -> 805 true 806 end. 807 808%%% --------------------------------------------------- 809%%% Message handling functions 810%%% --------------------------------------------------- 811 812dispatch({'$gen_cast', Msg}, Mod, State) -> 813 Mod:handle_cast(Msg, State); 814dispatch(Info, Mod, State) -> 815 Mod:handle_info(Info, State). 816 817common_reply(_Name, From, Reply, _NState, [] = _Debug) -> 818 reply(From, Reply), 819 []; 820common_reply(Name, From, Reply, NState, Debug) -> 821 reply(Name, From, Reply, NState, Debug). 822 823common_debug([] = _Debug, _Func, _Info, _Event) -> 824 []; 825common_debug(Debug, Func, Info, Event) -> 826 sys:handle_debug(Debug, Func, Info, Event). 827 828handle_msg({'$gen_call', From, Msg}, GS2State = #gs2_state { mod = Mod, 829 state = State, 830 name = Name, 831 debug = Debug }) -> 832 case catch Mod:handle_call(Msg, From, State) of 833 {reply, Reply, NState} -> 834 Debug1 = common_reply(Name, From, Reply, NState, Debug), 835 loop(GS2State #gs2_state { state = NState, 836 time = infinity, 837 debug = Debug1 }); 838 {reply, Reply, NState, Time1} -> 839 Debug1 = common_reply(Name, From, Reply, NState, Debug), 840 loop(GS2State #gs2_state { state = NState, 841 time = Time1, 842 debug = Debug1}); 843 {noreply, NState} -> 844 Debug1 = common_debug(Debug, fun print_event/3, Name, 845 {noreply, NState}), 846 loop(GS2State #gs2_state {state = NState, 847 time = infinity, 848 debug = Debug1}); 849 {noreply, NState, Time1} -> 850 Debug1 = common_debug(Debug, fun print_event/3, Name, 851 {noreply, NState}), 852 loop(GS2State #gs2_state {state = NState, 853 time = Time1, 854 debug = Debug1}); 855 {stop, Reason, Reply, NState} -> 856 {'EXIT', R} = 857 (catch terminate(Reason, Msg, 858 GS2State #gs2_state { state = NState })), 859 reply(Name, From, Reply, NState, Debug), 860 exit(R); 861 Other -> 862 handle_common_reply(Other, Msg, GS2State) 863 end; 864handle_msg(Msg, GS2State = #gs2_state { mod = Mod, state = State }) -> 865 Reply = (catch dispatch(Msg, Mod, State)), 866 handle_common_reply(Reply, Msg, GS2State). 867 868handle_common_reply(Reply, Msg, GS2State = #gs2_state { name = Name, 869 debug = Debug}) -> 870 case Reply of 871 {noreply, NState} -> 872 Debug1 = common_debug(Debug, fun print_event/3, Name, 873 {noreply, NState}), 874 loop(GS2State #gs2_state { state = NState, 875 time = infinity, 876 debug = Debug1 }); 877 {noreply, NState, Time1} -> 878 Debug1 = common_debug(Debug, fun print_event/3, Name, 879 {noreply, NState}), 880 loop(GS2State #gs2_state { state = NState, 881 time = Time1, 882 debug = Debug1 }); 883 _ -> 884 handle_common_termination(Reply, Msg, GS2State) 885 end. 886 887handle_common_termination(Reply, Msg, GS2State) -> 888 case Reply of 889 {stop, Reason, NState} -> 890 terminate(Reason, Msg, GS2State #gs2_state { state = NState }); 891 {'EXIT', What} -> 892 terminate(What, Msg, GS2State); 893 _ -> 894 terminate({bad_return_value, Reply}, Msg, GS2State) 895 end. 896 897reply(Name, {To, Tag}, Reply, State, Debug) -> 898 reply({To, Tag}, Reply), 899 sys:handle_debug( 900 Debug, fun print_event/3, Name, {out, Reply, To, State}). 901 902 903%%----------------------------------------------------------------- 904%% Callback functions for system messages handling. 905%%----------------------------------------------------------------- 906system_continue(Parent, Debug, GS2State) -> 907 loop(GS2State #gs2_state { parent = Parent, debug = Debug }). 908 909system_terminate(Reason, _Parent, Debug, GS2State) -> 910 terminate(Reason, [], GS2State #gs2_state { debug = Debug }). 911 912system_code_change(GS2State = #gs2_state { mod = Mod, 913 state = State }, 914 _Module, OldVsn, Extra) -> 915 case catch Mod:code_change(OldVsn, State, Extra) of 916 {ok, NewState} -> 917 NewGS2State = find_prioritisers( 918 GS2State #gs2_state { state = NewState }), 919 {ok, [NewGS2State]}; 920 Else -> 921 Else 922 end. 923 924%%----------------------------------------------------------------- 925%% Format debug messages. Print them as the call-back module sees 926%% them, not as the real erlang messages. Use trace for that. 927%%----------------------------------------------------------------- 928print_event(Dev, {in, Msg}, Name) -> 929 case Msg of 930 {'$gen_call', {From, _Tag}, Call} -> 931 io:format(Dev, "*DBG* ~p got call ~p from ~w~n", 932 [Name, Call, From]); 933 {'$gen_cast', Cast} -> 934 io:format(Dev, "*DBG* ~p got cast ~p~n", 935 [Name, Cast]); 936 _ -> 937 io:format(Dev, "*DBG* ~p got ~p~n", [Name, Msg]) 938 end; 939print_event(Dev, {out, Msg, To, State}, Name) -> 940 io:format(Dev, "*DBG* ~p sent ~p to ~w, new state ~w~n", 941 [Name, Msg, To, State]); 942print_event(Dev, {noreply, State}, Name) -> 943 io:format(Dev, "*DBG* ~p new state ~w~n", [Name, State]); 944print_event(Dev, Event, Name) -> 945 io:format(Dev, "*DBG* ~p dbg ~p~n", [Name, Event]). 946 947 948%%% --------------------------------------------------- 949%%% Terminate the server. 950%%% --------------------------------------------------- 951 952terminate(Reason, Msg, #gs2_state { name = Name, 953 mod = Mod, 954 state = State, 955 debug = Debug }) -> 956 case catch Mod:terminate(Reason, State) of 957 {'EXIT', R} -> 958 error_info(R, Reason, Name, Msg, State, Debug), 959 exit(R); 960 _ -> 961 case Reason of 962 normal -> 963 exit(normal); 964 shutdown -> 965 exit(shutdown); 966 {shutdown,_}=Shutdown -> 967 exit(Shutdown); 968 _ -> 969 error_info(Reason, undefined, Name, Msg, State, Debug), 970 exit(Reason) 971 end 972 end. 973 974error_info(_Reason, _RootCause, application_controller, _Msg, _State, _Debug) -> 975 %% OTP-5811 Don't send an error report if it's the system process 976 %% application_controller which is terminating - let init take care 977 %% of it instead 978 ok; 979error_info(Reason, RootCause, Name, Msg, State, Debug) -> 980 Reason1 = error_reason(Reason), 981 Fmt = 982 "** Generic server ~p terminating~n" 983 "** Last message in was ~p~n" 984 "** When Server state == ~p~n" 985 "** Reason for termination == ~n** ~p~n", 986 case RootCause of 987 undefined -> format(Fmt, [Name, Msg, State, Reason1]); 988 _ -> format(Fmt ++ "** In 'terminate' callback " 989 "with reason ==~n** ~p~n", 990 [Name, Msg, State, Reason1, 991 error_reason(RootCause)]) 992 end, 993 sys:print_log(Debug), 994 ok. 995 996error_reason({undef,[{M,F,A}|MFAs]} = Reason) -> 997 case code:is_loaded(M) of 998 false -> {'module could not be loaded',[{M,F,A}|MFAs]}; 999 _ -> case erlang:function_exported(M, F, length(A)) of 1000 true -> Reason; 1001 false -> {'function not exported',[{M,F,A}|MFAs]} 1002 end 1003 end; 1004error_reason(Reason) -> 1005 Reason. 1006 1007%%% --------------------------------------------------- 1008%%% Misc. functions. 1009%%% --------------------------------------------------- 1010 1011opt(Op, [{Op, Value}|_]) -> 1012 {ok, Value}; 1013opt(Op, [_|Options]) -> 1014 opt(Op, Options); 1015opt(_, []) -> 1016 false. 1017 1018debug_options(Name, Opts) -> 1019 case opt(debug, Opts) of 1020 {ok, Options} -> dbg_options(Name, Options); 1021 _ -> dbg_options(Name, []) 1022 end. 1023 1024dbg_options(Name, []) -> 1025 Opts = 1026 case init:get_argument(generic_debug) of 1027 error -> 1028 []; 1029 _ -> 1030 [log, statistics] 1031 end, 1032 dbg_opts(Name, Opts); 1033dbg_options(Name, Opts) -> 1034 dbg_opts(Name, Opts). 1035 1036dbg_opts(Name, Opts) -> 1037 case catch sys:debug_options(Opts) of 1038 {'EXIT',_} -> 1039 format("~p: ignoring erroneous debug options - ~p~n", 1040 [Name, Opts]), 1041 []; 1042 Dbg -> 1043 Dbg 1044 end. 1045 1046get_proc_name(Pid) when is_pid(Pid) -> 1047 Pid; 1048get_proc_name({local, Name}) -> 1049 case process_info(self(), registered_name) of 1050 {registered_name, Name} -> 1051 Name; 1052 {registered_name, _Name} -> 1053 exit(process_not_registered); 1054 [] -> 1055 exit(process_not_registered) 1056 end; 1057get_proc_name({global, Name}) -> 1058 case global:safe_whereis_name(Name) of 1059 undefined -> 1060 exit(process_not_registered_globally); 1061 Pid when Pid =:= self() -> 1062 Name; 1063 _Pid -> 1064 exit(process_not_registered_globally) 1065 end. 1066 1067get_parent() -> 1068 case get('$ancestors') of 1069 [Parent | _] when is_pid(Parent)-> 1070 Parent; 1071 [Parent | _] when is_atom(Parent)-> 1072 name_to_pid(Parent); 1073 _ -> 1074 exit(process_was_not_started_by_proc_lib) 1075 end. 1076 1077name_to_pid(Name) -> 1078 case whereis(Name) of 1079 undefined -> 1080 case global:safe_whereis_name(Name) of 1081 undefined -> 1082 exit(could_not_find_registerd_name); 1083 Pid -> 1084 Pid 1085 end; 1086 Pid -> 1087 Pid 1088 end. 1089 1090find_prioritisers(GS2State = #gs2_state { mod = Mod }) -> 1091 PrioriCall = function_exported_or_default( 1092 Mod, 'prioritise_call', 3, 1093 fun (_Msg, _From, _State) -> 0 end), 1094 PrioriCast = function_exported_or_default(Mod, 'prioritise_cast', 2, 1095 fun (_Msg, _State) -> 0 end), 1096 PrioriInfo = function_exported_or_default(Mod, 'prioritise_info', 2, 1097 fun (_Msg, _State) -> 0 end), 1098 GS2State #gs2_state { prioritise_call = PrioriCall, 1099 prioritise_cast = PrioriCast, 1100 prioritise_info = PrioriInfo }. 1101 1102function_exported_or_default(Mod, Fun, Arity, Default) -> 1103 case erlang:function_exported(Mod, Fun, Arity) of 1104 true -> case Arity of 1105 2 -> fun (Msg, GS2State = #gs2_state { state = State }) -> 1106 case catch Mod:Fun(Msg, State) of 1107 Res when is_integer(Res) -> 1108 Res; 1109 Err -> 1110 handle_common_termination(Err, Msg, GS2State) 1111 end 1112 end; 1113 3 -> fun (Msg, From, GS2State = #gs2_state { state = State }) -> 1114 case catch Mod:Fun(Msg, From, State) of 1115 Res when is_integer(Res) -> 1116 Res; 1117 Err -> 1118 handle_common_termination(Err, Msg, GS2State) 1119 end 1120 end 1121 end; 1122 false -> Default 1123 end. 1124 1125%%----------------------------------------------------------------- 1126%% Status information 1127%%----------------------------------------------------------------- 1128format_status(Opt, StatusData) -> 1129 [PDict, SysState, Parent, Debug, 1130 #gs2_state{name = Name, state = State, mod = Mod, queue = Queue}] = 1131 StatusData, 1132 NameTag = if is_pid(Name) -> 1133 pid_to_list(Name); 1134 is_atom(Name) -> 1135 Name 1136 end, 1137 Header = lists:concat(["Status for generic server ", NameTag]), 1138 Log = sys:get_debug(log, Debug, []), 1139 Specfic = 1140 case erlang:function_exported(Mod, format_status, 2) of 1141 true -> case catch Mod:format_status(Opt, [PDict, State]) of 1142 {'EXIT', _} -> [{data, [{"State", State}]}]; 1143 Else -> Else 1144 end; 1145 _ -> [{data, [{"State", State}]}] 1146 end, 1147 [{header, Header}, 1148 {data, [{"Status", SysState}, 1149 {"Parent", Parent}, 1150 {"Logged events", Log}, 1151 {"Queued messages", priority_queue:to_list(Queue)}]} | 1152 Specfic].