diff options
Diffstat (limited to 'lib/sasl/src')
| -rw-r--r-- | lib/sasl/src/erlsrv.erl | 31 | ||||
| -rw-r--r-- | lib/sasl/src/release_handler.erl | 241 | ||||
| -rw-r--r-- | lib/sasl/src/release_handler_1.erl | 289 | ||||
| -rw-r--r-- | lib/sasl/src/systools_lib.erl | 40 | ||||
| -rw-r--r-- | lib/sasl/src/systools_make.erl | 180 | ||||
| -rw-r--r-- | lib/sasl/src/systools_relup.erl | 68 |
6 files changed, 551 insertions, 298 deletions
diff --git a/lib/sasl/src/erlsrv.erl b/lib/sasl/src/erlsrv.erl index f9804c41dc..086dc7c651 100644 --- a/lib/sasl/src/erlsrv.erl +++ b/lib/sasl/src/erlsrv.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1998-2009. All Rights Reserved. +%% Copyright Ericsson AB 1998-2011. All Rights Reserved. %% %% 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 @@ -75,14 +75,21 @@ write_all_data(Port,[H|T]) -> write_all_data(Port,T). read_all_data(Port) -> + lists:reverse(read_all_data(Port,[],[])). +read_all_data(Port,Line,Lines) -> receive + {Port, {data, {noeol,Data}}} -> + read_all_data(Port,Line++Data,Lines); {Port, {data, {eol,Data}}} -> - [ Data | read_all_data(Port)]; - _ -> + read_all_data(Port,[],[Line++Data|Lines]); + {Port,_Other} -> Port ! {self(), close}, receive {Port, closed} -> - [] + case Line of + [] -> Lines; + _ -> [Line|Lines] + end end end. @@ -208,7 +215,7 @@ store_service(EmulatorVersion,Service) -> false -> {error, no_servicename}; {value, {_,Name}} -> - {Action,Service1} = case get_service(Name) of + {Action,Service1} = case get_service(EmulatorVersion,Name) of {error, no_such_service} -> {"add",Service}; _ -> @@ -377,8 +384,14 @@ pick_argument(_,[],Acc) -> {Acc, ""}; pick_argument(normal,[$ |T],Acc) -> {Acc,T}; +pick_argument(normal,[$\\|T],Acc) -> + pick_argument(normal_escaped,T,[$\\|Acc]); pick_argument(normal,[$"|T],Acc) -> pick_argument(quoted,T,[$"|Acc]); +pick_argument(normal_escaped,[$"|T],Acc) -> + pick_argument(bquoted,T,[$"|Acc]); +pick_argument(normal_escaped,[A|T],Acc) -> + pick_argument(normal,T,[A|Acc]); pick_argument(quoted_escaped,[H|T],Acc) -> pick_argument(quoted,T,[H|Acc]); pick_argument(quoted,[$"|T],Acc) -> @@ -387,6 +400,14 @@ pick_argument(quoted,[$\\|T],Acc) -> pick_argument(quoted_escaped,T,[$\\|Acc]); pick_argument(quoted,[H|T],Acc) -> pick_argument(quoted,T,[H|Acc]); +pick_argument(bquoted_escaped,[$"|T],Acc) -> + pick_argument(normal,T,[$"|Acc]); +pick_argument(bquoted_escaped,[H|T],Acc) -> + pick_argument(bquoted,T,[H|Acc]); +pick_argument(bquoted,[$\\|T],Acc) -> + pick_argument(bquoted_escaped,T,[$\\|Acc]); +pick_argument(bquoted,[H|T],Acc) -> + pick_argument(bquoted,T,[H|Acc]); pick_argument(normal,[H|T],Acc) -> pick_argument(normal,T,[H|Acc]). diff --git a/lib/sasl/src/release_handler.erl b/lib/sasl/src/release_handler.erl index b60aa847df..bc08f94dff 100644 --- a/lib/sasl/src/release_handler.erl +++ b/lib/sasl/src/release_handler.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1996-2010. All Rights Reserved. +%% Copyright Ericsson AB 1996-2011. All Rights Reserved. %% %% 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 @@ -25,8 +25,8 @@ -export([start_link/0, create_RELEASES/1, create_RELEASES/2, create_RELEASES/4, unpack_release/1, - check_install_release/1, install_release/1, install_release/2, - remove_release/1, + check_install_release/1, check_install_release/2, + install_release/1, install_release/2, remove_release/1, which_releases/0, make_permanent/1, reboot_old_release/1, set_unpacked/2, set_removed/1, install_file/2]). -export([upgrade_app/2, downgrade_app/2, downgrade_app/3, @@ -149,15 +149,35 @@ unpack_release(ReleaseName) -> %%----------------------------------------------------------------- %% Purpose: Checks the relup script for the specified version. %% The release must be unpacked. +%% Options = [purge] - all old code that can be soft purged +%% will be purged if all checks succeeds. This can be usefull +%% in order to reduce time needed in the following call to +%% install_release. %% Returns: {ok, FromVsn, Descr} | {error, Reason} -%% Reason = {already_installed, Vsn} | +%% Reason = {illegal_option, IllegalOpt} | +%% {already_installed, Vsn} | %% {bad_relup_file, RelFile} | %% {no_such_release, Vsn} | %% {no_such_from_vsn, Vsn} | %% exit_reason() %%----------------------------------------------------------------- check_install_release(Vsn) -> - call({check_install_release, Vsn}). + check_install_release(Vsn, []). + +check_install_release(Vsn, Opts) -> + case check_check_install_options(Opts, false) of + {ok,Purge} -> + call({check_install_release, Vsn, Purge}); + Error -> + Error + end. + +check_check_install_options([purge|Opts], _) -> + check_check_install_options(Opts, true); +check_check_install_options([Illegal|_],_Purge) -> + {error,{illegal_option,Illegal}}; +check_check_install_options([],Purge) -> + {ok,Purge}. %%----------------------------------------------------------------- @@ -291,7 +311,8 @@ check_script(Script, LibDirs) -> release_handler_1:check_script(Script, LibDirs). %%----------------------------------------------------------------- -%% eval_script(Script, Apps, LibDirs, Opts) -> {ok, UnPurged} | +%% eval_script(Script, Apps, LibDirs, NewLibs, Opts) -> +%% {ok, UnPurged} | %% restart_new_emulator | %% {error, Error} %% {'EXIT', Reason} @@ -299,9 +320,13 @@ check_script(Script, LibDirs) -> %% net_kernel:monitor_nodes(true) before calling this function. %% No! No other process than the release_handler can ever call this %% function, if sync_nodes is used. -%%----------------------------------------------------------------- -eval_script(Script, Apps, LibDirs, Opts) -> - catch release_handler_1:eval_script(Script, Apps, LibDirs, Opts). +%% +%% LibDirs is a list of all applications, while NewLibs is a list of +%% applications that have changed version between the current and the +%% new release. +%% ----------------------------------------------------------------- +eval_script(Script, Apps, LibDirs, NewLibs, Opts) -> + catch release_handler_1:eval_script(Script, Apps, LibDirs, NewLibs, Opts). %%----------------------------------------------------------------- %% Func: create_RELEASES(Root, RelFile, LibDirs) -> ok | {error, Reason} @@ -405,6 +430,7 @@ eval_appup_script(App, ToVsn, ToDir, Script) -> Res = release_handler_1:eval_script(Script, [], % [AppSpec] [{App, ToVsn, ToDir}], + [{App, ToVsn, ToDir}], []), % [Opt] case Res of {ok, _Unpurged} -> @@ -535,11 +561,12 @@ handle_call({unpack_release, ReleaseName}, _From, S) handle_call({unpack_release, _ReleaseName}, _From, S) -> {reply, {error, client_node}, S}; -handle_call({check_install_release, Vsn}, _From, S) -> +handle_call({check_install_release, Vsn, Purge}, _From, S) -> case catch do_check_install_release(S#state.rel_dir, Vsn, S#state.releases, - S#state.masters) of + S#state.masters, + Purge) of {ok, CurrentVsn, Descr} -> {reply, {ok, CurrentVsn, Descr}, S}; {error, Reason} -> @@ -849,7 +876,7 @@ check_path_response(Path, {ok, _Info}) -> check_path_response(Path, {error, _Reason}) -> throw({error, {no_such_directory, Path}}). -do_check_install_release(RelDir, Vsn, Releases, Masters) -> +do_check_install_release(RelDir, Vsn, Releases, Masters, Purge) -> case lists:keysearch(Vsn, #release.vsn, Releases) of {value, #release{status = current}} -> {error, {already_installed, Vsn}}; @@ -874,7 +901,20 @@ do_check_install_release(RelDir, Vsn, Releases, Masters) -> case get_rh_script(LatestRelease, Release, RelDir, Masters) of {ok, {CurrentVsn, Descr, Script}} -> case catch check_script(Script, Libs) of - ok -> + {ok,SoftPurgeMods} when Purge=:=true -> + %% Get modules with brutal_purge + %% instructions, but that can be + %% soft purged + {ok,BrutalPurgeMods} = + release_handler_1:check_old_processes( + Script,brutal_purge), + lists:foreach( + fun(Mod) -> + catch erlang:purge_module(Mod) + end, + SoftPurgeMods ++ BrutalPurgeMods), + {ok, CurrentVsn, Descr}; + {ok,_} -> {ok, CurrentVsn, Descr}; Else -> Else @@ -890,6 +930,7 @@ do_check_install_release(RelDir, Vsn, Releases, Masters) -> end. do_install_release(#state{start_prg = StartPrg, + root = RootDir, rel_dir = RelDir, releases = Releases, masters = Masters, static_emulator = Static}, @@ -905,7 +946,9 @@ do_install_release(#state{start_prg = StartPrg, EnvBefore = application_controller:prep_config_change(), Apps = change_appl_data(RelDir, Release, Masters), LibDirs = Release#release.libs, - case eval_script(Script, Apps, LibDirs, Opts) of + NewLibs = get_new_libs(LatestRelease#release.libs, + Release#release.libs), + case eval_script(Script, Apps, LibDirs, NewLibs, Opts) of {ok, []} -> application_controller:config_change(EnvBefore), mon_nodes(false), @@ -926,8 +969,8 @@ do_install_release(#state{start_prg = StartPrg, NReleases = set_status(Vsn, current, Releases), NReleases2 = set_status(Vsn,tmp_current,NReleases), write_releases(RelDir, NReleases2, Masters), - prepare_restart_new_emulator(StartPrg, RelDir, - Release, + prepare_restart_new_emulator(StartPrg, RootDir, + RelDir, Release, PermanentRelease, Masters), {restart_new_emulator, CurrentVsn, Descr}; @@ -997,7 +1040,7 @@ do_make_services_permanent(PermanentVsn,Vsn, PermanentEVsn, EVsn) -> throw(Error4) end end. - + do_make_permanent(#state{releases = Releases, rel_dir = RelDir, unpurged = Unpurged, masters = Masters, @@ -1409,8 +1452,8 @@ prepare_restart_nt(#release{erts_vsn = EVsn, vsn = Vsn}, FutureServiceName = hd(string:tokens(atom_to_list(node()),"@")) ++ "_" ++ Vsn, CurrentService = case erlsrv:get_service(PermEVsn,CurrentServiceName) of - {error, Reason} -> - throw({error, Reason}); + {error, _} = Error1 -> + throw(Error1); CS -> CS end, @@ -1425,37 +1468,33 @@ prepare_restart_nt(#release{erts_vsn = EVsn, vsn = Vsn}, CurrentServiceName), case erlsrv:store_service(EVsn, FutureService) of - {error, Rison} -> - throw({error,Rison}); - _ -> + {error, _} = Error2 -> + throw(Error2); + _X -> erlsrv:disable_service(EVsn, FutureServiceName), ErlSrv = filename:nativename(erlsrv:erlsrv(EVsn)), - case heart:set_cmd(ErlSrv ++ " enable " ++ FutureServiceName ++ - " & " ++ ErlSrv ++ " start " ++ - FutureServiceName ++ - " & " ++ ErlSrv ++ " disable " ++ - FutureServiceName) of + StartDisabled = ErlSrv ++ " start_disabled " ++ FutureServiceName, + case heart:set_cmd(StartDisabled) of ok -> ok; - Error -> - throw({error, {'heart:set_cmd() error', Error}}) + Error3 -> + throw({error, {'heart:set_cmd() error', Error3}}) end end. - %%----------------------------------------------------------------- %% Set things up for restarting the new emulator. The actual %% restart is performed by calling init:reboot() higher up. %%----------------------------------------------------------------- -prepare_restart_new_emulator(StartPrg, RelDir, - Release, PRelease, - Masters) -> +prepare_restart_new_emulator(StartPrg, RootDir, RelDir, + Release, PRelease, Masters) -> #release{erts_vsn = EVsn, vsn = Vsn} = Release, Data = EVsn ++ " " ++ Vsn, DataFile = write_new_start_erl(Data, RelDir, Masters), %% Tell heart to use DataFile instead of start_erl.data case os:type() of {win32,nt} -> + write_ini_file(RootDir,EVsn,Masters), prepare_restart_nt(Release,PRelease,DataFile); {unix,_} -> StartP = check_start_prg(StartPrg, Masters), @@ -1832,50 +1871,10 @@ write_start(File, Data, false) -> end; write_start(File, Data, Masters) -> all_masters(Masters), - write_start_m(File, Data, Masters). + safe_write_file_m(File, Data, Masters). %%----------------------------------------------------------------- -%% Write the "start_erl.data" file at all master nodes. -%% 1. Save "start_erl.backup" at all nodes. -%% 2. Write the "start_erl.change" file at all nodes. -%% 3. Move "start_erl.change" to "start_erl.data". -%% 4. Remove "start_erl.backup" at all nodes. -%% -%% If one of the steps above fails, all steps is recovered from -%% (as long as possible), except for 4 which is allowed to fail. -%%----------------------------------------------------------------- -write_start_m(File, Data, Masters) -> - Dir = filename:dirname(File), - Backup = filename:join(Dir, "start_erl.backup"), - Change = filename:join(Dir, "start_erl.change"), - case at_all_masters(Masters, ?MODULE, do_copy_files, - [File, [Backup]]) of - ok -> - case at_all_masters(Masters, ?MODULE, do_write_file, - [Change, Data]) of - ok -> - case at_all_masters(Masters, file, rename, - [Change, File]) of - ok -> - remove_files(all, [Backup, Change], Masters), - ok; - {error, {Master, R}} -> - takewhile(Master, Masters, file, rename, - [Backup, File]), - remove_files(all, [Backup, Change], Masters), - throw({error, {Master, R, move_start_erl}}) - end; - {error, {Master, R}} -> - remove_files(all, [Backup, Change], Masters), - throw({error, {Master, R, write_start_erl}}) - end; - {error, {Master, R}} -> - remove_files(Master, [Backup], Masters), - throw({error, {Master, R, backup_start_erl}}) - end. - -%%----------------------------------------------------------------- %% Copy the "start.boot" and "sys.config" from SrcDir to DestDir at all %% master nodes. %% 1. Save DestDir/"start.backup" and DestDir/"sys.backup" at all nodes. @@ -1917,3 +1916,97 @@ set_static_files(SrcDir, DestDir, Masters) -> remove_files(Master, [BackupBoot, BackupConf], Masters), throw({error, {Master, R, backup_start_config}}) end. + +%%----------------------------------------------------------------- +%% Write erl.ini +%% Writes the erl.ini file used by erl.exe when (re)starting the erlang node. +%% At first installation, this is done by Install.exe, which means that if +%% the format of this file for some reason is changed, then Install.c must +%% also be updated (and probably some other c-files which read erl.ini) +%%----------------------------------------------------------------- +write_ini_file(RootDir,EVsn,Masters) -> + BinDir = filename:join([RootDir,"erts-"++EVsn,"bin"]), + Str0 = io_lib:format("[erlang]~n" + "Bindir=~s~n" + "Progname=erl~n" + "Rootdir=~s~n", + [filename:nativename(BinDir), + filename:nativename(RootDir)]), + Str = re:replace(Str0,"\\\\","\\\\\\\\",[{return,list},global]), + IniFile = filename:join(BinDir,"erl.ini"), + do_write_ini_file(IniFile,Str,Masters). + +do_write_ini_file(File,Data,false) -> + case do_write_file(File, Data) of + ok -> ok; + Error -> throw(Error) + end; +do_write_ini_file(File,Data,Masters) -> + all_masters(Masters), + safe_write_file_m(File, Data, Masters). + + +%%----------------------------------------------------------------- +%% Write the given file at all master nodes. +%% 1. Save <File>.backup at all nodes. +%% 2. Write <File>.change at all nodes. +%% 3. Move <File>.change to <File> +%% 4. Remove <File>.backup at all nodes. +%% +%% If one of the steps above fails, all steps are recovered from +%% (as long as possible), except for 4 which is allowed to fail. +%%----------------------------------------------------------------- +safe_write_file_m(File, Data, Masters) -> + Backup = File ++ ".backup", + Change = File ++ ".change", + case at_all_masters(Masters, ?MODULE, do_copy_files, + [File, [Backup]]) of + ok -> + case at_all_masters(Masters, ?MODULE, do_write_file, + [Change, Data]) of + ok -> + case at_all_masters(Masters, file, rename, + [Change, File]) of + ok -> + remove_files(all, [Backup, Change], Masters), + ok; + {error, {Master, R}} -> + takewhile(Master, Masters, file, rename, + [Backup, File]), + remove_files(all, [Backup, Change], Masters), + throw({error, {Master, R, rename, + filename:basename(Change), + filename:basename(File)}}) + end; + {error, {Master, R}} -> + remove_files(all, [Backup, Change], Masters), + throw({error, {Master, R, write, filename:basename(Change)}}) + end; + {error, {Master, R}} -> + remove_files(Master, [Backup], Masters), + throw({error, {Master, R, backup, + filename:basename(File), + filename:basename(Backup)}}) + end. + +%%----------------------------------------------------------------- +%% Figure out which applications that have changed version between the +%% two releases. The paths for these applications must always be +%% updated, even if the relup script does not load any modules. See +%% OTP-9402. +%% +%% A different situation is when the same application version is used +%% in old and new release, but the path has changed. This is not +%% handled here - instead it must be explicitely indicated by the +%% 'update_paths' option to release_handler:install_release/2 if the +%% code path shall be updated then. +%% ----------------------------------------------------------------- +get_new_libs([{App,Vsn,_LibDir}|CurrentLibs], NewLibs) -> + case lists:keyfind(App,1,NewLibs) of + {App,NewVsn,_} = LibInfo when NewVsn =/= Vsn -> + [LibInfo | get_new_libs(CurrentLibs,NewLibs)]; + _ -> + get_new_libs(CurrentLibs,NewLibs) + end; +get_new_libs([],_) -> + []. diff --git a/lib/sasl/src/release_handler_1.erl b/lib/sasl/src/release_handler_1.erl index 8d050fb7b0..8d0baf3ab1 100644 --- a/lib/sasl/src/release_handler_1.erl +++ b/lib/sasl/src/release_handler_1.erl @@ -19,8 +19,9 @@ -module(release_handler_1). %% External exports --export([eval_script/3, eval_script/4, check_script/2]). --export([get_current_vsn/1]). %% exported because used in a test case +-export([eval_script/1, eval_script/5, + check_script/2, check_old_processes/2]). +-export([get_current_vsn/1, get_supervised_procs/0]). %% exported because used in a test case -record(eval_state, {bins = [], stopped = [], suspended = [], apps = [], libdirs, unpurged = [], vsns = [], newlibs = [], @@ -33,11 +34,11 @@ %% libdirs = [{Lib, LibVsn, LibDir}] - Maps Lib to Vsn and Directory %% unpurged = [{Mod, soft_purge | brutal_purge}] %% vsns = [{Mod, OldVsn, NewVsn}] - remember the old vsn of a mod -%% before it is removed/a new vsn is loaded; the new vsn +%% before a new vsn is loaded; the new vsn %% is kept in case of a downgrade, where the code_change %% function receives the vsn of the module to downgrade %% *to*. -%% newlibs = [{Lib, Dir}] - list of all new libs; used to change +%% newlibs = [{Lib, LibVsn, LibDir}] - list of all new libs; used to change %% the code path %% opts = [{Tag, Value}] - list of options %%----------------------------------------------------------------- @@ -47,34 +48,39 @@ %%% This is a low-level release handler. %%%----------------------------------------------------------------- check_script(Script, LibDirs) -> - case catch check_old_processes(Script) of - ok -> + case catch check_old_processes(Script,soft_purge) of + {ok, PurgeMods} -> {Before, _After} = split_instructions(Script), case catch lists:foldl(fun(Instruction, EvalState1) -> eval(Instruction, EvalState1) end, #eval_state{libdirs = LibDirs}, Before) of - EvalState2 when is_record(EvalState2, eval_state) -> ok; - {error, Error} -> {error, Error}; - Other -> {error, Other} + EvalState2 when is_record(EvalState2, eval_state) -> + {ok,PurgeMods}; + {error, Error} -> + {error, Error}; + Other -> + {error, Other} end; {error, Mod} -> {error, {old_processes, Mod}} end. -eval_script(Script, Apps, LibDirs) -> - eval_script(Script, Apps, LibDirs, []). +%% eval_script/1 - For testing only - no apps added, just testing instructions +eval_script(Script) -> + eval_script(Script, [], [], [], []). -eval_script(Script, Apps, LibDirs, Opts) -> - case catch check_old_processes(Script) of - ok -> +eval_script(Script, Apps, LibDirs, NewLibs, Opts) -> + case catch check_old_processes(Script,soft_purge) of + {ok,_} -> {Before, After} = split_instructions(Script), case catch lists:foldl(fun(Instruction, EvalState1) -> eval(Instruction, EvalState1) end, #eval_state{apps = Apps, libdirs = LibDirs, + newlibs = NewLibs, opts = Opts}, Before) of EvalState2 when is_record(EvalState2, eval_state) -> @@ -110,32 +116,63 @@ split_instructions([], Before) -> {[], lists:reverse(Before)}. %%----------------------------------------------------------------- -%% Func: check_old_processes/1 +%% Func: check_old_processes/2 %% Args: Script = [instruction()] +%% PrePurgeMethod = soft_purge | brutal_purge %% Purpose: Check if there is any process that runs an old version -%% of a module that should be soft_purged, (i.e. not purged -%% at all if there is any such process). Returns {error, Mod} -%% if so, ok otherwise. -%% Returns: ok | {error, Mod} +%% of a module that should be purged according to PrePurgeMethod. +%% Returns a list of modules that can be soft_purged. +%% +%% If PrePurgeMethod == soft_purge, the function will succeed +%% only if there is no process running old code of any of the +%% modules. Else it will throw {error,Mod}, where Mod is the +%% first module found that can not be soft_purged. +%% +%% If PrePurgeMethod == brutal_purge, the function will +%% always succeed and return a list of all modules that are +%% specified in the script with PrePurgeMethod brutal_purge, +%% but that can be soft_purged. +%% +%% Returns: {ok,PurgeMods} | {error, Mod} +%% PurgeMods = [Mod] %% Mod = atom() %%----------------------------------------------------------------- -check_old_processes(Script) -> - lists:foreach(fun({load, {Mod, soft_purge, _PostPurgeMethod}}) -> - check_old_code(Mod); - ({remove, {Mod, soft_purge, _PostPurgeMethod}}) -> - check_old_code(Mod); - (_) -> ok - end, - Script). +check_old_processes(Script,PrePurgeMethod) -> + Procs = erlang:processes(), + {ok,lists:flatmap( + fun({load, {Mod, PPM, _PostPurgeMethod}}) when PPM==PrePurgeMethod -> + check_old_code(Mod,Procs,PrePurgeMethod); + ({remove, {Mod, PPM, _PostPurgeMethod}}) when PPM==PrePurgeMethod -> + check_old_code(Mod,Procs,PrePurgeMethod); + (_) -> [] + end, + Script)}. + +check_old_code(Mod,Procs,PrePurgeMethod) -> + case erlang:check_old_code(Mod) of + true when PrePurgeMethod==soft_purge -> + do_check_old_code(Mod,Procs); + true when PrePurgeMethod==brutal_purge -> + case catch do_check_old_code(Mod,Procs) of + {error,Mod} -> []; + R -> R + end; + false -> + [] + end. + + +do_check_old_code(Mod,Procs) -> + lists:foreach( + fun(Pid) -> + case erlang:check_process_code(Pid, Mod) of + false -> ok; + true -> throw({error, Mod}) + end + end, + Procs), + [Mod]. -check_old_code(Mod) -> - lists:foreach(fun(Pid) -> - case erlang:check_process_code(Pid, Mod) of - false -> ok; - true -> throw({error, Mod}) - end - end, - erlang:processes()). %%----------------------------------------------------------------- %% An unpurged module is a module for which there exist an old @@ -214,16 +251,15 @@ check_old_code(Mod) -> %%----------------------------------------------------------------- eval({load_object_code, {Lib, LibVsn, Modules}}, EvalState) -> case lists:keysearch(Lib, 1, EvalState#eval_state.libdirs) of - {value, {Lib, LibVsn, LibDir}} -> - Ebin = filename:join(LibDir, "ebin"), + {value, {Lib, LibVsn, LibDir} = LibInfo} -> Ext = code:objfile_extension(), {NewBins, NewVsns} = lists:foldl(fun(Mod, {Bins, Vsns}) -> File = lists:concat([Mod, Ext]), - FName = filename:join(Ebin, File), + FName = filename:join([LibDir, "ebin", File]), case erl_prim_loader:get_file(FName) of {ok, Bin, FName2} -> - NVsns = add_new_vsn(Mod, Bin, Vsns), + NVsns = add_vsns(Mod, Bin, Vsns), {[{Mod, Bin, FName2} | Bins],NVsns}; error -> throw({error, {no_such_file,FName}}) @@ -232,7 +268,7 @@ eval({load_object_code, {Lib, LibVsn, Modules}}, EvalState) -> {EvalState#eval_state.bins, EvalState#eval_state.vsns}, Modules), - NewLibs = [{Lib, Ebin} | EvalState#eval_state.newlibs], + NewLibs = lists:keystore(Lib,1,EvalState#eval_state.newlibs,LibInfo), EvalState#eval_state{bins = NewBins, newlibs = NewLibs, vsns = NewVsns}; @@ -242,15 +278,14 @@ eval({load_object_code, {Lib, LibVsn, Modules}}, EvalState) -> eval(point_of_no_return, EvalState) -> Libs = case get_opt(update_paths, EvalState, false) of false -> - EvalState#eval_state.newlibs; % [{Lib, Path}] + EvalState#eval_state.newlibs; true -> - lists:map(fun({Lib, _LibVsn, LibDir}) -> - Ebin= filename:join(LibDir,"ebin"), - {Lib, Ebin} - end, - EvalState#eval_state.libdirs) + EvalState#eval_state.libdirs end, - lists:foreach(fun({Lib, Path}) -> code:replace_path(Lib, Path) end, + lists:foreach(fun({Lib, _LibVsn, LibDir}) -> + Ebin = filename:join(LibDir,"ebin"), + code:replace_path(Lib, Ebin) + end, Libs), EvalState; eval({load, {Mod, _PrePurgeMethod, PostPurgeMethod}}, EvalState) -> @@ -258,32 +293,21 @@ eval({load, {Mod, _PrePurgeMethod, PostPurgeMethod}}, EvalState) -> {value, {_Mod, Bin, File}} = lists:keysearch(Mod, 1, Bins), % load_binary kills all procs running old code % if soft_purge, we know that there are no such procs now - Vsns = EvalState#eval_state.vsns, - NewVsns = add_old_vsn(Mod, Vsns), code:load_binary(Mod, File, Bin), % Now, the prev current is old. There might be procs % running it. Find them. Unpurged = do_soft_purge(Mod,PostPurgeMethod,EvalState#eval_state.unpurged), EvalState#eval_state{bins = lists:keydelete(Mod, 1, Bins), - unpurged = Unpurged, - vsns = NewVsns}; + unpurged = Unpurged}; eval({remove, {Mod, _PrePurgeMethod, PostPurgeMethod}}, EvalState) -> - % purge kills all procs running old code - % if soft_purge, we know that there are no such procs now - Vsns = EvalState#eval_state.vsns, - NewVsns = add_old_vsn(Mod, Vsns), + %% purge kills all procs running old code + %% if soft_purge, we know that there are no such procs now code:purge(Mod), code:delete(Mod), - % Now, the prev current is old. There might be procs - % running it. Find them. - Unpurged = - case code:soft_purge(Mod) of - true -> EvalState#eval_state.unpurged; - false -> [{Mod, PostPurgeMethod} | EvalState#eval_state.unpurged] - end, -%% Bins = EvalState#eval_state.bins, -%% EvalState#eval_state{bins = lists:keydelete(Mod, 1, Bins), - EvalState#eval_state{unpurged = Unpurged, vsns = NewVsns}; + %% Now, the prev current is old. There might be procs + %% running it. Find them. + Unpurged = do_soft_purge(Mod,PostPurgeMethod,EvalState#eval_state.unpurged), + EvalState#eval_state{unpurged = Unpurged}; eval({purge, Modules}, EvalState) -> % Now, if there are any processes still executing old code, OR % if some new processes started after suspend but before load, @@ -469,6 +493,19 @@ start(Procs) -> %% supervisor module, we should load the new version, and then %% delete the old. Then we should perform the start changes %% manually, by adding/deleting children. +%% +%% Recent changes to this code cause the upgrade error out and +%% log the case where a suspended supervisor has which_children +%% called against it. This retains the behavior of causing a VM +%% restart to the *old* version of a release but has the +%% advantage of logging the pid and supervisor that had the +%% issue. +%% +%% A second case where this can occur is if a child spec is +%% incorrect and get_modules is called against a process that +%% can't respond to the gen:call. Again an error is logged, +%% an error returned and a VM restart is issued. +%% %% Returns: [{SuperPid, ChildName, ChildPid, Mods}] %%----------------------------------------------------------------- %% OTP-3452. For each application the first item contains the pid @@ -478,49 +515,81 @@ start(Procs) -> get_supervised_procs() -> lists:foldl( fun(Application, Procs) -> - case application_controller:get_master(Application) of - Pid when is_pid(Pid) -> - {Root, _AppMod} = application_master:get_child(Pid), - case get_supervisor_module(Root) of - {ok, SupMod} -> - get_procs(supervisor:which_children(Root), - Root) ++ - [{undefined, undefined, Root, [SupMod]} | - Procs]; - {error, _} -> - error_logger:error_msg("release_handler: " - "cannot find top " - "supervisor for " - "application ~w~n", - [Application]), - get_procs(supervisor:which_children(Root), - Root) ++ Procs - end; - _ -> Procs - end + get_master_procs(Application, + Procs, + application_controller:get_master(Application)) end, [], - lists:map(fun({Application, _Name, _Vsn}) -> - Application - end, - application:which_applications())). + get_application_names()). + +get_supervised_procs(_, Root, Procs, {ok, SupMod}) -> + get_procs(maybe_supervisor_which_children(get_proc_state(Root), SupMod, Root), Root) ++ + [{undefined, undefined, Root, [SupMod]} | Procs]; +get_supervised_procs(Application, Root, Procs, {error, _}) -> + error_logger:error_msg("release_handler: cannot find top supervisor for " + "application ~w~n", [Application]), + get_procs(maybe_supervisor_which_children(get_proc_state(Root), Application, Root), Root) ++ Procs. + +get_application_names() -> + lists:map(fun({Application, _Name, _Vsn}) -> + Application + end, + application:which_applications()). + +get_master_procs(Application, Procs, Pid) when is_pid(Pid) -> + {Root, _AppMod} = application_master:get_child(Pid), + get_supervised_procs(Application, Root, Procs, get_supervisor_module(Root)); +get_master_procs(_, Procs, _) -> + Procs. get_procs([{Name, Pid, worker, dynamic} | T], Sup) when is_pid(Pid) -> - Mods = get_dynamic_mods(Pid), + Mods = maybe_get_dynamic_mods(Name, Pid), [{Sup, Name, Pid, Mods} | get_procs(T, Sup)]; get_procs([{Name, Pid, worker, Mods} | T], Sup) when is_pid(Pid), is_list(Mods) -> [{Sup, Name, Pid, Mods} | get_procs(T, Sup)]; get_procs([{Name, Pid, supervisor, Mods} | T], Sup) when is_pid(Pid) -> - [{Sup, Name, Pid, Mods} | get_procs(T, Sup)] ++ - get_procs(supervisor:which_children(Pid), Pid); + [{Sup, Name, Pid, Mods} | get_procs(T, Sup)] ++ + get_procs(maybe_supervisor_which_children(get_proc_state(Pid), Name, Pid), Pid); get_procs([_H | T], Sup) -> get_procs(T, Sup); get_procs(_, _Sup) -> []. -get_dynamic_mods(Pid) -> - {ok,Res} = gen:call(Pid, self(), get_modules), - Res. +get_proc_state(Proc) -> + {status, _, {module, _}, [_, State, _, _, _]} = sys:get_status(Proc), + State. + +maybe_supervisor_which_children(suspended, Name, Pid) -> + error_logger:error_msg("release_handler: a which_children call" + " to ~p (~p) was avoided. This supervisor" + " is suspended and should likely be upgraded" + " differently. Exiting ...~n", [Name, Pid]), + error(suspended_supervisor); + +maybe_supervisor_which_children(State, Name, Pid) -> + case catch supervisor:which_children(Pid) of + Res when is_list(Res) -> + Res; + Other -> + error_logger:error_msg("release_handler: ~p~nerror during" + " a which_children call to ~p (~p)." + " [State: ~p] Exiting ... ~n", + [Other, Name, Pid, State]), + error(which_children_failed) + end. + +maybe_get_dynamic_mods(Name, Pid) -> + case catch gen:call(Pid, self(), get_modules) of + {ok, Res} -> + Res; + Other -> + error_logger:error_msg("release_handler: ~p~nerror during a" + " get_modules call to ~p (~p)," + " there may be an error in it's" + " childspec. Exiting ...~n", + [Other, Name, Pid]), + error(get_modules_failed) + end. %% XXXX %% Note: The following is a terrible hack done in order to resolve the @@ -606,26 +675,20 @@ sync_nodes(Id, Nodes) -> end, NNodes). -add_old_vsn(Mod, Vsns) -> +add_vsns(Mod, NewBin, Vsns) -> + OldVsn = get_current_vsn(Mod), + NewVsn = get_vsn(NewBin), case lists:keysearch(Mod, 1, Vsns) of - {value, {Mod, undefined, NewVsn}} -> - OldVsn = get_current_vsn(Mod), - lists:keyreplace(Mod, 1, Vsns, {Mod, OldVsn, NewVsn}); - {value, {Mod, _OldVsn, _NewVsn}} -> - Vsns; + {value, {Mod, OldVsn0, NewVsn0}} -> + lists:keyreplace(Mod, 1, Vsns, {Mod, + replace_undefined(OldVsn0,OldVsn), + replace_undefined(NewVsn0,NewVsn)}); false -> - OldVsn = get_current_vsn(Mod), - [{Mod, OldVsn, undefined} | Vsns] + [{Mod, OldVsn, NewVsn} | Vsns] end. -add_new_vsn(Mod, Bin, Vsns) -> - NewVsn = get_vsn(Bin), - case lists:keysearch(Mod, 1, Vsns) of - {value, {Mod, OldVsn, undefined}} -> - lists:keyreplace(Mod, 1, Vsns, {Mod, OldVsn, NewVsn}); - false -> - [{Mod, undefined, NewVsn} | Vsns] - end. +replace_undefined(undefined,Vsn) -> Vsn; +replace_undefined(Vsn,_) -> Vsn. %%----------------------------------------------------------------- %% Func: get_current_vsn/1 @@ -645,7 +708,9 @@ get_current_vsn(Mod) -> {ok, Bin, _File2} -> get_vsn(Bin); error -> - throw({error, {no_such_file, File}}) + %% This is the case when a new module is added, there will + %% be no current version of it at the time of this call. + undefined end. %%----------------------------------------------------------------- diff --git a/lib/sasl/src/systools_lib.erl b/lib/sasl/src/systools_lib.erl index b652c109fe..1b6ea125d9 100644 --- a/lib/sasl/src/systools_lib.erl +++ b/lib/sasl/src/systools_lib.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1996-2009. All Rights Reserved. +%% Copyright Ericsson AB 1996-2011. All Rights Reserved. %% %% 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 @@ -24,7 +24,7 @@ %% -export([file_term2binary/2, read_term/1, read_term_from_stream/2, - get_dirs/1, get_path/1]). + get_dirs/1, get_path/1, werror/2]). -include_lib("kernel/include/file.hrl"). @@ -176,21 +176,26 @@ add_dirs(RegName, Dirs, Root) -> regexp_match(RegName, D0, Root) -> case file:list_dir(D0) of {ok, Files} when length(Files) > 0 -> - FR = fun(F) -> - case regexp:match(F, RegName) of - {match,1,N} when N == length(F) -> - DirF = join(D0, F, Root), - case dir_p(DirF) of - true -> - {true, DirF}; + case re:compile(RegName) of + {ok, MP} -> + FR = fun(F) -> + case re:run(F, MP) of + {match,[{0,N}]} when N == length(F) -> + DirF = join(D0, F, Root), + case dir_p(DirF) of + true -> + {true, DirF}; + _ -> + false + end; _ -> false - end; - _ -> - false - end - end, - {true,lists:zf(FR, Files)}; + end + end, + {true,lists:zf(FR, Files)}; + _ -> + false + end; _ -> false end. @@ -214,6 +219,7 @@ flat([H|T], Ack) -> flat(T, [H|Ack]); flat([], Ack) -> lists:reverse(Ack). - - + +werror(Options, Warnings) -> + lists:member(warnings_as_errors, Options) andalso Warnings =/= []. diff --git a/lib/sasl/src/systools_make.erl b/lib/sasl/src/systools_make.erl index 7489ee58d2..7f400f5cce 100644 --- a/lib/sasl/src/systools_make.erl +++ b/lib/sasl/src/systools_make.erl @@ -44,10 +44,12 @@ %%----------------------------------------------------------------- %% Create a boot script from a release file. -%% Options is a list of {path, Path} | silent | local where path sets -%% the search path, silent supresses error message printing on console, -%% local generates a script with references to the directories there -%% the applications are found. +%% Options is a list of {path, Path} | silent | local +%% | warnings_as_errors +%% where path sets the search path, silent supresses error message +%% printing on console, local generates a script with references +%% to the directories there the applications are found, +%% and warnings_as_errors treats warnings as errors. %% %% New options: {path,Path} can contain wildcards %% src_tests @@ -85,11 +87,16 @@ make_script(RelName, Output, Flags) when is_list(RelName), ModTestP = {member(src_tests, Flags),xref_p(Flags)}, case get_release(RelName, Path, ModTestP, machine(Flags)) of {ok, Release, Appls, Warnings} -> - case generate_script(Output,Release,Appls,Flags) of - ok -> + case systools_lib:werror(Flags, Warnings) of + true -> return(ok,Warnings,Flags); - Error -> - return(Error,Warnings,Flags) + false -> + case generate_script(Output,Release,Appls,Flags) of + ok -> + return(ok,Warnings,Flags); + Error -> + return(Error,Warnings,Flags) + end end; Error -> return(Error,[],Flags) @@ -130,10 +137,21 @@ get_outdir(Flags) -> return(ok,Warnings,Flags) -> case member(silent,Flags) of true -> - {ok,?MODULE,Warnings}; + case systools_lib:werror(Flags, Warnings) of + true -> + error; + false -> + {ok,?MODULE,Warnings} + end; _ -> - io:format("~s",[format_warning(Warnings)]), - ok + case member(warnings_as_errors,Flags) of + true -> + io:format("~s",[format_warning(Warnings, true)]), + error; + false -> + io:format("~s",[format_warning(Warnings)]), + ok + end end; return({error,Mod,Error},_,Flags) -> case member(silent,Flags) of @@ -1612,9 +1630,9 @@ var_dir(_Dir, _, _, []) -> false. appDir(AppDir) -> - case reverse(filename:split(AppDir)) of - ["ebin"|Dir] -> filename:join(reverse(Dir)); - _ -> AppDir + case filename:basename(AppDir) of + "ebin" -> filename:dirname(AppDir); + _ -> AppDir end. add_modules(Modules, Tar, AppDir, ToDir, Ext) -> @@ -1833,78 +1851,89 @@ get_flag(_,_) -> false. %% Check Options for make_script check_args_script(Args) -> cas(Args, - {undef, undef, undef, undef, undef, undef, undef, undef, []}). + {undef, undef, undef, undef, undef, undef, undef, undef, + undef, []}). -cas([], {_Path,_Sil,_Loc,_Test,_Var,_Mach,_Xref,_XrefApps, X}) -> +cas([], {_Path,_Sil,_Loc,_Test,_Var,_Mach,_Xref,_XrefApps,_Werror, X}) -> X; %%% path --------------------------------------------------------------- -cas([{path, P} | Args], {Path, Sil, Loc, Test, Var, Mach, - Xref, XrefApps, X}) when is_list(P) -> +cas([{path, P} | Args], {Path, Sil, Loc, Test, Var, Mach, Xref, + XrefApps, Werror, X}) when is_list(P) -> case check_path(P) of ok -> - cas(Args, {P, Sil, Loc, Test, Var, Mach, Xref, XrefApps,X}); + cas(Args, {P, Sil, Loc, Test, Var, Mach, Xref, XrefApps, + Werror, X}); error -> cas(Args, {Path, Sil, Loc, Test, Var, Mach, Xref, XrefApps, - X++[{path,P}]}) + Werror, X++[{path,P}]}) end; %%% silent ------------------------------------------------------------- -cas([silent | Args], {Path, _Sil, Loc, Test, Var, Mach, - Xref, XrefApps, X}) -> - cas(Args, {Path, silent, Loc, Test, Var, Mach, Xref, XrefApps, X}); +cas([silent | Args], {Path, _Sil, Loc, Test, Var, Mach, Xref, + XrefApps, Werror, X}) -> + cas(Args, {Path, silent, Loc, Test, Var, Mach, Xref, XrefApps, + Werror, X}); %%% local -------------------------------------------------------------- -cas([local | Args], {Path, Sil, _Loc, Test, Var, Mach, - Xref, XrefApps, X}) -> - cas(Args, {Path, Sil, local, Test, Var, Mach, Xref, XrefApps, X}); +cas([local | Args], {Path, Sil, _Loc, Test, Var, Mach, Xref, + XrefApps, Werror, X}) -> + cas(Args, {Path, Sil, local, Test, Var, Mach, Xref, XrefApps, + Werror, X}); %%% src_tests ------------------------------------------------------- -cas([src_tests | Args], {Path, Sil, Loc, _Test, Var, Mach, - Xref, XrefApps, X}) -> +cas([src_tests | Args], {Path, Sil, Loc, _Test, Var, Mach, Xref, + XrefApps, Werror, X}) -> cas(Args, - {Path, Sil, Loc, src_tests, Var, Mach, Xref, XrefApps,X}); + {Path, Sil, Loc, src_tests, Var, Mach, Xref, Werror, XrefApps,X}); %%% variables ---------------------------------------------------------- -cas([{variables, V} | Args], {Path, Sil, Loc, Test, Var, Mach, - Xref, XrefApps, X}) when is_list(V) -> +cas([{variables, V} | Args], {Path, Sil, Loc, Test, Var, Mach, Xref, + XrefApps, Werror, X}) when is_list(V) -> case check_vars(V) of ok -> cas(Args, - {Path, Sil, Loc, Test, V, Mach, Xref, XrefApps, X}); + {Path, Sil, Loc, Test, V, Mach, Xref, XrefApps, Werror, X}); error -> cas(Args, {Path, Sil, Loc, Test, Var, Mach, Xref, XrefApps, - X++[{variables, V}]}) + Werror, X++[{variables, V}]}) end; %%% machine ------------------------------------------------------------ -cas([{machine, M} | Args], {Path, Sil, Loc, Test, Var, Mach, - Xref, XrefApps, X}) when is_atom(M) -> - cas(Args, {Path, Sil, Loc, Test, Var, Mach, Xref, XrefApps, X}); +cas([{machine, M} | Args], {Path, Sil, Loc, Test, Var, Mach, Xref, + XrefApps, Werror, X}) when is_atom(M) -> + cas(Args, {Path, Sil, Loc, Test, Var, Mach, Xref, XrefApps, Werror, X}); %%% exref -------------------------------------------------------------- -cas([exref | Args], {Path, Sil, Loc, Test, Var, Mach, - _Xref, XrefApps, X}) -> - cas(Args, {Path, Sil, Loc, Test, Var, Mach, exref, XrefApps, X}); +cas([exref | Args], {Path, Sil, Loc, Test, Var, Mach, _Xref, + XrefApps, Werror, X}) -> + cas(Args, {Path, Sil, Loc, Test, Var, Mach, exref, XrefApps, Werror, X}); %%% exref Apps --------------------------------------------------------- -cas([{exref, Apps} | Args], {Path, Sil, Loc, Test, Var, Mach, - Xref, XrefApps, X}) when is_list(Apps) -> +cas([{exref, Apps} | Args], {Path, Sil, Loc, Test, Var, Mach, Xref, + XrefApps, Werror, X}) when is_list(Apps) -> case check_apps(Apps) of ok -> cas(Args, {Path, Sil, Loc, Test, Var, Mach, - Xref, Apps, X}); + Xref, Apps, Werror, X}); error -> cas(Args, {Path, Sil, Loc, Test, Var, Mach, - Xref, XrefApps, X++[{exref, Apps}]}) + Xref, XrefApps, Werror, X++[{exref, Apps}]}) end; %%% outdir Dir --------------------------------------------------------- -cas([{outdir, Dir} | Args], {Path, Sil, Loc, Test, Var, Mach, - Xref, XrefApps, X}) when is_list(Dir) -> - cas(Args, {Path, Sil, Loc, Test, Var, Mach, Xref, XrefApps, X}); +cas([{outdir, Dir} | Args], {Path, Sil, Loc, Test, Var, Mach, Xref, + XrefApps, Werror, X}) when is_list(Dir) -> + cas(Args, {Path, Sil, Loc, Test, Var, Mach, Xref, XrefApps, Werror, X}); %%% otp_build (secret, not documented) --------------------------------- -cas([otp_build | Args], {Path, Sil, Loc, Test, Var, Mach, - Xref, XrefApps, X}) -> - cas(Args, {Path, Sil, Loc, Test, Var, Mach, Xref, XrefApps, X}); +cas([otp_build | Args], {Path, Sil, Loc, Test, Var, Mach, Xref, + XrefApps, Werror, X}) -> + cas(Args, {Path, Sil, Loc, Test, Var, Mach, Xref, XrefApps, Werror, X}); %%% no_module_tests (kept for backwards compatibility, but ignored) ---- -cas([no_module_tests | Args], {Path, Sil, Loc, Test, Var, Mach, - Xref, XrefApps, X}) -> - cas(Args, {Path, Sil, Loc, Test, Var, Mach, Xref, XrefApps,X}); +cas([no_module_tests | Args], {Path, Sil, Loc, Test, Var, Mach, Xref, + XrefApps, Werror, X}) -> + cas(Args, {Path, Sil, Loc, Test, Var, Mach, Xref, XrefApps, Werror, X}); +%%% warnings_as_errors (kept for backwards compatibility, but ignored) ---- +cas([warnings_as_errors | Args], {Path, Sil, Loc, Test, Var, Mach, Xref, + XrefApps, _Werror, X}) -> + cas(Args, {Path, Sil, Loc, Test, Var, Mach, Xref, XrefApps, + warnings_as_errors, X}); %%% ERROR -------------------------------------------------------------- -cas([Y | Args], {Path, Sil, Loc, Test, Var, Mach, Xref, XrefApps, X}) -> - cas(Args, {Path, Sil, Loc, Test, Var, Mach, Xref, XrefApps,X++[Y]}). +cas([Y | Args], {Path, Sil, Loc, Test, Var, Mach, Xref, XrefApps, + Werror, X}) -> + cas(Args, {Path, Sil, Loc, Test, Var, Mach, Xref, XrefApps, Werror, + X++[Y]}). @@ -2030,7 +2059,6 @@ check_apps([H|T]) when is_atom(H) -> check_apps(_) -> error. - %% Format error format_error(badly_formatted_release) -> @@ -2144,21 +2172,31 @@ form_tar_err({add, File, Error}) -> %% Format warning format_warning(Warnings) -> - map(fun({warning,W}) -> form_warn(W) end, Warnings). - -form_warn({source_not_found,{Mod,_,App,_,_}}) -> - io_lib:format("*WARNING* ~p: Source code not found: ~p.erl~n", - [App,Mod]); -form_warn({{parse_error, File},{_,_,App,_,_}}) -> - io_lib:format("*WARNING* ~p: Parse error: ~p~n", - [App,File]); -form_warn({obj_out_of_date,{Mod,_,App,_,_}}) -> - io_lib:format("*WARNING* ~p: Object code (~p) out of date~n",[App,Mod]); -form_warn({exref_undef, Undef}) -> - F = fun({M,F,A}) -> - io_lib:format("*WARNING* Undefined function ~p:~p/~p~n", - [M,F,A]) + format_warning(Warnings, false). + +format_warning(Warnings, Werror) -> + Prefix = case Werror of + true -> + ""; + false -> + "*WARNING* " + end, + map(fun({warning,W}) -> form_warn(Prefix, W) end, Warnings). + +form_warn(Prefix, {source_not_found,{Mod,_,App,_,_}}) -> + io_lib:format("~s~p: Source code not found: ~p.erl~n", + [Prefix,App,Mod]); +form_warn(Prefix, {{parse_error, File},{_,_,App,_,_}}) -> + io_lib:format("~s~p: Parse error: ~p~n", + [Prefix,App,File]); +form_warn(Prefix, {obj_out_of_date,{Mod,_,App,_,_}}) -> + io_lib:format("~s~p: Object code (~p) out of date~n", + [Prefix,App,Mod]); +form_warn(Prefix, {exref_undef, Undef}) -> + F = fun({M,F,A}) -> + io_lib:format("~sUndefined function ~p:~p/~p~n", + [Prefix,M,F,A]) end, map(F, Undef); -form_warn(What) -> - io_lib:format("*WARNING* ~p~n", [What]). +form_warn(Prefix, What) -> + io_lib:format("~s ~p~n", [Prefix,What]). diff --git a/lib/sasl/src/systools_relup.erl b/lib/sasl/src/systools_relup.erl index ec5486226c..6d9e922900 100644 --- a/lib/sasl/src/systools_relup.erl +++ b/lib/sasl/src/systools_relup.erl @@ -122,7 +122,7 @@ %% rel_filename() = description() = string() %% Opts = [opt()] %% opt() = {path, [path()]} | silent | noexec | restart_emulator -%% | {outdir, string()} +%% | {outdir, string()} | warnings_as_errors %% path() = [string()] %% Ret = ok | error | {ok, Relup, Module, Warnings} | {error, Module, Error} %% @@ -139,8 +139,9 @@ %% %% The option `path' sets search path, `silent' suppresses printing of %% error messages to the console, `noexec' inhibits the creation of -%% the output "relup" file, and restart_emulator ensures that the new -%% emulator is restarted (as the final step). +%% the output "relup" file, restart_emulator ensures that the new +%% emulator is restarted (as the final step), and `warnings_as_errors' +%% treats warnings as errors. %% ---------------------------------------------------------------- mk_relup(TopRelFile, BaseUpRelDcs, BaseDnRelDcs) -> mk_relup(TopRelFile, BaseUpRelDcs, BaseDnRelDcs, []). @@ -153,14 +154,29 @@ mk_relup(TopRelFile, BaseUpRelDcs, BaseDnRelDcs, Opts) -> {false, false} -> case R of {ok, _Res, _Mod, Ws} -> - print_warnings(Ws), - ok; + print_warnings(Ws, Opts), + case systools_lib:werror(Opts, Ws) of + true -> + error; + false -> + ok + end; Other -> print_error(Other), error end; - _ -> - R + _ -> + case R of + {ok, _Res, _Mod, Ws} -> + case systools_lib:werror(Opts, Ws) of + true -> + error; + false -> + R + end; + R -> + R + end end; BadArg -> erlang:error({badarg, BadArg}) @@ -195,7 +211,12 @@ do_mk_relup(TopRelFile, BaseUpRelDcs, BaseDnRelDcs, Path, Opts) -> {Dn, Ws2} = foreach_baserel_dn(TopRel, TopApps, BaseDnRelDcs, Path, Opts, Ws1), Relup = {TopRel#release.vsn, Up, Dn}, - write_relup_file(Relup, Opts), + case systools_lib:werror(Opts, Ws2) of + true -> + ok; + false -> + write_relup_file(Relup, Opts) + end, {ok, Relup, ?MODULE, Ws2}; Other -> throw(Other) @@ -527,20 +548,29 @@ format_error(Error) -> io:format("~p~n", [Error]). -print_warnings(Ws) when is_list(Ws) -> - lists:foreach(fun(W) -> print_warning(W) end, Ws); -print_warnings(W) -> - print_warning(W). +print_warnings(Ws, Opts) when is_list(Ws) -> + lists:foreach(fun(W) -> print_warning(W, Opts) end, Ws); +print_warnings(W, Opts) -> + print_warning(W, Opts). -print_warning(W) -> - S = format_warning(W), +print_warning(W, Opts) -> + Prefix = case lists:member(warnings_as_errors, Opts) of + true -> + ""; + false -> + "*WARNING* " + end, + S = format_warning(Prefix, W), io:format("~s", [S]). -format_warning({erts_vsn_changed, {Rel1, Rel2}}) -> - io_lib:format("*WARNING* The ERTS version changed between ~p and ~p~n", - [Rel1, Rel2]); -format_warning(What) -> - io_lib:format("*WARNING* ~p~n",[What]). +format_warning(W) -> + format_warning("*WARNING* ", W). + +format_warning(Prefix, {erts_vsn_changed, {Rel1, Rel2}}) -> + io_lib:format("~sThe ERTS version changed between ~p and ~p~n", + [Prefix, Rel1, Rel2]); +format_warning(Prefix, What) -> + io_lib:format("~s~p~n",[Prefix, What]). get_reason({error, {open, _, _}}) -> open; |