1%%
2%% %CopyrightBegin%
3%%
4%% Copyright Ericsson AB 2003-2016. All Rights Reserved.
5%%
6%% Licensed under the Apache License, Version 2.0 (the "License");
7%% you may not use this file except in compliance with the License.
8%% You may obtain a copy of the License at
9%%
10%%     http://www.apache.org/licenses/LICENSE-2.0
11%%
12%% Unless required by applicable law or agreed to in writing, software
13%% distributed under the License is distributed on an "AS IS" BASIS,
14%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
15%% See the License for the specific language governing permissions and
16%% limitations under the License.
17%%
18%% %CopyrightEnd%
19%%
20-module(snmp_app).
21
22-behaviour(application).
23
24-include("snmp_debug.hrl").
25
26
27%%%-----------------------------------------------------------------
28%%%  This module implements the SNMP application.
29%%%-----------------------------------------------------------------
30-export([start/2, stop/0, stop/1, config_change/3]).
31-export([start_agent/0,   start_agent/1,   start_agent/2]).
32-export([start_manager/0, start_manager/1, start_manager/2]).
33
34start(Type, []) ->
35    ?d("start -> entry with"
36      "~n   Type. ~p", [Type]),
37    %% This is the new snmp application config format
38    %% First start the (new) central supervisor,
39    {ok, Pid} = snmp_app_sup:start_link(),
40    Entities = entities(),
41    ok = start_entities(Type, Entities),
42    {ok, Pid}.
43
44entities() ->
45    entities([agent, manager], []).
46
47entities([], []) ->
48    ?d("entities -> entry when no entities", []),
49
50    %% Could be old style snmp (agent) application config format
51    %% but could also be a skeleton start, which means that neither
52    %% agent nor manager config has been specified
53
54    case get_env() of
55	[] ->
56	    %% Skeleton start
57	    ?d("entities -> skeleton start", []),
58	    [];
59	OldConf when is_list(OldConf) ->
60	    ?d("entities -> old style config: ~n~p", [OldConf]),
61	    %% Old style snmp (agent) application config format
62	    Conf = snmpa_app:convert_config(OldConf),
63	    ?d("entities -> converted config: ~n~p", [Conf]),
64	    [{agent, Conf}]
65    end;
66entities([], Acc) ->
67    ?d("entities -> done", []),
68    lists:reverse(Acc);
69entities([Ent|Ents], Acc) ->
70    ?d("entities -> entry with"
71       "~n   Ent: ~p", [Ent]),
72    case application:get_env(snmp, Ent) of
73	{ok, Conf} ->
74	    entities(Ents, [{Ent, Conf}|Acc]);
75	_ ->
76	    entities(Ents, Acc)
77    end.
78
79start_entities(_Type, []) ->
80    ok;
81start_entities(Type, [{agent, Opts}|Entities]) ->
82    case start_agent(Type, Opts) of
83	ok ->
84	    start_entities(Type, Entities);
85	Error ->
86	    Error
87    end;
88start_entities(Type, [{manager, Opts}|Entities]) ->
89    case start_manager(Type, Opts) of
90	ok ->
91	    start_entities(Type, Entities);
92	Error ->
93	    Error
94    end;
95start_entities(Type, [BadEntity|Entities]) ->
96    error_msg("Bad snmp configuration: ~n: ~p", [BadEntity]),
97    start_entities(Type, Entities).
98
99
100start_agent() ->
101    start_agent(normal).
102
103start_agent(Type) when is_atom(Type) ->
104    case application:get_env(snmp, agent) of
105	{ok, Opts} ->
106	    start_agent(Type, Opts);
107	_ ->
108	    {error, missing_config}
109    end;
110start_agent(Opts) when is_list(Opts) ->
111    start_agent(normal, Opts);
112start_agent(BadArg) ->
113    {error, {bad_arg, BadArg}}.
114
115start_agent(Type, Opts) ->
116    ?d("start_agent -> entry", []),
117    case snmp_app_sup:start_agent(Type, Opts) of
118	{ok, _} ->
119	    ok;
120	Error ->
121	    Error
122    end.
123
124start_manager() ->
125    start_manager(normal).
126
127start_manager(Type) when is_atom(Type) ->
128    case application:get_env(snmp, manager) of
129	{ok, Opts} ->
130	    start_manager(Type, Opts);
131	_ ->
132	    {error, missing_config}
133    end;
134start_manager(Opts) when is_list(Opts) ->
135    start_manager(normal, Opts);
136start_manager(BadArg) ->
137    {error, {bad_arg, BadArg}}.
138
139start_manager(Type, Opts) ->
140    ?d("start manager -> entry", []),
141    case snmp_app_sup:start_manager(Type, Opts) of
142	{ok, _} ->
143	    ok;
144	Error ->
145	    Error
146    end.
147
148
149stop(_) ->
150    ok.
151
152stop() ->
153    snmp_app_sup:stop().
154
155
156get_env() ->
157    Env        = application:get_all_env(snmp),
158    DeleteElem = [included_applications],
159    F = fun({Key, _}) -> lists:member(Key, DeleteElem) end,
160    lists:dropwhile(F, Env).
161
162
163%%-----------------------------------------------------------------
164%% The presence of this function means that we will accept changes
165%% in the configuration parameters.  However, we won't react upon
166%% those changes until the app is restarted.  So we just return
167%% ok.
168%%-----------------------------------------------------------------
169config_change(_Changed, _New, _Removed) ->
170    ok.
171
172%% ---------------------------------------------------------------------
173
174error_msg(F, A) ->
175    error_logger:error_msg("~w: " ++ F ++ "~n", [?MODULE|A]).
176
177