1%%
2%% %CopyrightBegin%
3%%
4%% Copyright Ericsson AB 2004-2018. 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
21-module(ct_snmp).
22
23-include("snmp_types.hrl").
24-include("inet.hrl").
25-include("ct.hrl").
26
27%%% API
28-export([start/2, start/3, stop/1, get_values/3, get_next_values/3, set_values/4,
29	 set_info/1, register_users/2, register_agents/2, register_usm_users/2,
30	 unregister_users/1, unregister_users/2, unregister_agents/1,
31	 unregister_agents/2, unregister_usm_users/1, unregister_usm_users/2,
32	 load_mibs/1, unload_mibs/1]).
33
34%% Manager values
35-define(CT_SNMP_LOG_FILE, "ct_snmp_set.log").
36-define(MGR_PORT, 5000).
37-define(MAX_MSG_SIZE, 484).
38-define(ENGINE_ID, "mgrEngine").
39
40%% Agent values
41-define(AGENT_ENGINE_ID, "agentEngine").
42-define(TRAP_UDP, 5000).
43-define(AGENT_UDP, 4000).
44-define(CONF_FILE_VER, [v2]).
45-define(AGENT_MAX_MSG_SIZE, 484).
46-define(AGENT_NOTIFY_TYPE, trap).
47-define(AGENT_SEC_TYPE, none).
48-define(AGENT_PASSWD, "").
49%%%=========================================================================
50%%%  API
51%%%=========================================================================
52
53start(Config, MgrAgentConfName) ->
54    start(Config, MgrAgentConfName, undefined).
55
56start(Config, MgrAgentConfName, SnmpAppConfName) ->
57    StartManager= ct:get_config({MgrAgentConfName, start_manager}, true),
58    StartAgent = ct:get_config({MgrAgentConfName, start_agent}, false),
59
60    SysName = ct:get_config({MgrAgentConfName, agent_sysname}, "ct_test"),
61    {ok, HostName} = inet:gethostname(),
62    {ok, Addr} = inet:getaddr(HostName, inet),
63    IP = tuple_to_list(Addr),
64    AgentManagerIP = ct:get_config({MgrAgentConfName, agent_manager_ip}, IP),
65
66    prepare_snmp_env(),
67    setup_agent(StartAgent, MgrAgentConfName, SnmpAppConfName,
68		Config, SysName, AgentManagerIP, IP),
69    setup_manager(StartManager, MgrAgentConfName, SnmpAppConfName,
70		  Config, AgentManagerIP),
71    ok = start_application(snmp),
72
73    manager_register(StartManager, MgrAgentConfName).
74
75start_application(App) ->
76    case application:start(App) of
77        {error, {already_started, App}} ->
78            ok;
79        Else ->
80            Else
81    end.
82
83stop(Config) ->
84    PrivDir = ?config(priv_dir, Config),
85    ok = application:stop(snmp),
86    ok = application:stop(mnesia),
87    MgrDir =  filename:join(PrivDir,"mgr"),
88    ConfDir = filename:join(PrivDir, "conf"),
89    DbDir = filename:join(PrivDir,"db"),
90    catch del_dir(MgrDir),
91    catch del_dir(ConfDir),
92    catch del_dir(DbDir).
93
94
95get_values(Agent, Oids, MgrAgentConfName) ->
96    [Uid | _] = agent_conf(Agent, MgrAgentConfName),
97    {ok, SnmpReply, _} = snmpm:sync_get2(Uid, target_name(Agent), Oids),
98    SnmpReply.
99
100get_next_values(Agent, Oids, MgrAgentConfName) ->
101    [Uid | _] = agent_conf(Agent, MgrAgentConfName),
102    {ok, SnmpReply, _} = snmpm:sync_get_next2(Uid, target_name(Agent), Oids),
103    SnmpReply.
104
105set_values(Agent, VarsAndVals, MgrAgentConfName, Config) ->
106    PrivDir = ?config(priv_dir, Config),
107    [Uid | _] = agent_conf(Agent, MgrAgentConfName),
108    Oids = lists:map(fun({Oid, _, _}) -> Oid end, VarsAndVals),
109    TargetName = target_name(Agent),
110    {ok, SnmpGetReply, _} = snmpm:sync_get2(Uid, TargetName, Oids),
111    {ok, SnmpSetReply, _} = snmpm:sync_set2(Uid, TargetName, VarsAndVals),
112    case SnmpSetReply of
113	{noError, 0, _} when PrivDir /= false ->
114	    log(PrivDir, Agent, SnmpGetReply, VarsAndVals);
115	_ ->
116	    set_failed_or_user_did_not_want_to_log
117    end,
118    SnmpSetReply.
119
120set_info(Config) ->
121    PrivDir = ?config(priv_dir, Config),
122    SetLogFile = filename:join(PrivDir, ?CT_SNMP_LOG_FILE),
123    case file:consult(SetLogFile) of
124	{ok, SetInfo} ->
125	    ok = delete_file(SetLogFile),
126	    lists:reverse(SetInfo);
127	_ ->
128	    []
129    end.
130
131register_users(MgrAgentConfName, Users) ->
132    case setup_users(Users) of
133	ok ->
134	    SnmpVals = ct:get_config(MgrAgentConfName),
135	    OldUsers = ct:get_config({MgrAgentConfName,users},[]),
136	    NewSnmpVals = lists:keystore(users, 1, SnmpVals,
137					 {users, Users ++ OldUsers}),
138	    ct_config:update_config(MgrAgentConfName, NewSnmpVals),
139	    ok;
140	Error ->
141	    Error
142    end.
143
144register_agents(MgrAgentConfName, ManagedAgents) ->
145    case setup_managed_agents(MgrAgentConfName,ManagedAgents) of
146	ok ->
147	    SnmpVals = ct:get_config(MgrAgentConfName),
148	    OldAgents = ct:get_config({MgrAgentConfName,managed_agents},[]),
149	    NewSnmpVals = lists:keystore(managed_agents, 1, SnmpVals,
150					 {managed_agents,
151					  ManagedAgents ++ OldAgents}),
152	    ct_config:update_config(MgrAgentConfName, NewSnmpVals),
153	    ok;
154	Error ->
155	    Error
156    end.
157
158register_usm_users(MgrAgentConfName, UsmUsers) ->
159    EngineID = ct:get_config({MgrAgentConfName, engine_id}, ?ENGINE_ID),
160    case setup_usm_users(UsmUsers, EngineID) of
161	ok ->
162	    SnmpVals = ct:get_config(MgrAgentConfName),
163	    OldUsmUsers = ct:get_config({MgrAgentConfName,usm_users},[]),
164	    NewSnmpVals = lists:keystore(usm_users, 1, SnmpVals,
165					 {usm_users, UsmUsers ++ OldUsmUsers}),
166	    ct_config:update_config(MgrAgentConfName, NewSnmpVals),
167	    ok;
168	Error ->
169	    Error
170    end.
171
172unregister_users(MgrAgentConfName) ->
173    Users = [Id || {Id,_} <- ct:get_config({MgrAgentConfName, users},[])],
174    unregister_users(MgrAgentConfName,Users).
175
176unregister_users(MgrAgentConfName,Users) ->
177    takedown_users(Users),
178    SnmpVals = ct:get_config(MgrAgentConfName),
179    AllUsers = ct:get_config({MgrAgentConfName, users},[]),
180    RemainingUsers = lists:filter(fun({Id,_}) ->
181					  not lists:member(Id,Users)
182				  end,
183				  AllUsers),
184    NewSnmpVals = lists:keyreplace(users, 1, SnmpVals, {users,RemainingUsers}),
185    ct_config:update_config(MgrAgentConfName, NewSnmpVals),
186    ok.
187
188unregister_agents(MgrAgentConfName) ->
189    ManagedAgents =  [AgentName ||
190			 {AgentName, _} <-
191			     ct:get_config({MgrAgentConfName,managed_agents},[])],
192    unregister_agents(MgrAgentConfName,ManagedAgents).
193
194unregister_agents(MgrAgentConfName,ManagedAgents) ->
195    takedown_managed_agents(MgrAgentConfName, ManagedAgents),
196    SnmpVals = ct:get_config(MgrAgentConfName),
197    AllAgents = ct:get_config({MgrAgentConfName,managed_agents},[]),
198    RemainingAgents = lists:filter(fun({Name,_}) ->
199					  not lists:member(Name,ManagedAgents)
200				   end,
201				   AllAgents),
202    NewSnmpVals = lists:keyreplace(managed_agents, 1, SnmpVals,
203				   {managed_agents,RemainingAgents}),
204    ct_config:update_config(MgrAgentConfName, NewSnmpVals),
205    ok.
206
207unregister_usm_users(MgrAgentConfName) ->
208    UsmUsers = [Id || {Id,_} <- ct:get_config({MgrAgentConfName, usm_users},[])],
209    unregister_usm_users(MgrAgentConfName,UsmUsers).
210
211unregister_usm_users(MgrAgentConfName,UsmUsers) ->
212    EngineID = ct:get_config({MgrAgentConfName, engine_id}, ?ENGINE_ID),
213    takedown_usm_users(UsmUsers,EngineID),
214    SnmpVals = ct:get_config(MgrAgentConfName),
215    AllUsmUsers = ct:get_config({MgrAgentConfName, usm_users},[]),
216    RemainingUsmUsers = lists:filter(fun({Id,_}) ->
217					     not lists:member(Id,UsmUsers)
218				     end,
219				     AllUsmUsers),
220    NewSnmpVals = lists:keyreplace(usm_users, 1, SnmpVals,
221				   {usm_users,RemainingUsmUsers}),
222    ct_config:update_config(MgrAgentConfName, NewSnmpVals),
223    ok.
224
225load_mibs(Mibs) ->
226    snmpa:load_mibs(snmp_master_agent, Mibs).
227
228unload_mibs(Mibs) ->
229    snmpa:unload_mibs(snmp_master_agent, Mibs).
230
231%%%========================================================================
232%%% Internal functions
233%%%========================================================================
234prepare_snmp_env() ->
235    %% To make sure application:set_env is not overwritten by any
236    %% app-file settings.
237    _ = application:load(snmp),
238
239    %% Fix for older versions of snmp where there are some
240    %% inappropriate default values for alway starting an
241    %% agent.
242    application:unset_env(snmp, agent).
243%%%---------------------------------------------------------------------------
244setup_manager(false, _, _, _, _) ->
245    ok;
246setup_manager(true, MgrConfName, SnmpConfName, Config, IP) ->
247    PrivDir = ?config(priv_dir, Config),
248    MaxMsgSize = ct:get_config({MgrConfName,max_msg_size}, ?MAX_MSG_SIZE),
249    Port = ct:get_config({MgrConfName,mgr_port}, ?MGR_PORT),
250    EngineID = ct:get_config({MgrConfName,engine_id}, ?ENGINE_ID),
251    MgrDir =  filename:join(PrivDir,"mgr"),
252    %%% Users, Agents and Usms are in test suites register after the
253    %%% snmp application is started.
254    Users = [],
255    Agents = [],
256    Usms = [],
257    ok = make_dir(MgrDir),
258
259    snmp_config:write_manager_snmp_files(MgrDir, IP, Port, MaxMsgSize,
260					 EngineID, Users, Agents, Usms),
261    SnmpEnv = merge_snmp_conf([{config, [{dir, MgrDir},{db_dir, MgrDir},
262					 {verbosity, trace}]},
263			       {server, [{verbosity, trace}]},
264			       {net_if, [{verbosity, trace}]},
265			       {versions, [v1, v2, v3]}],
266			      ct:get_config({SnmpConfName,manager})),
267    application:set_env(snmp, manager, SnmpEnv).
268%%%---------------------------------------------------------------------------
269setup_agent(false,_, _, _, _, _, _) ->
270    ok;
271setup_agent(true, AgentConfName, SnmpConfName,
272	    Config, SysName, ManagerIP, AgentIP) ->
273    ok = start_application(mnesia),
274    PrivDir = ?config(priv_dir, Config),
275    Vsns = ct:get_config({AgentConfName, agent_vsns}, ?CONF_FILE_VER),
276    TrapUdp = ct:get_config({AgentConfName, agent_trap_udp}, ?TRAP_UDP),
277    AgentUdp = ct:get_config({AgentConfName, agent_udp}, ?AGENT_UDP),
278    NotifType = ct:get_config({AgentConfName, agent_notify_type},
279			      ?AGENT_NOTIFY_TYPE),
280    SecType = ct:get_config({AgentConfName, agent_sec_type}, ?AGENT_SEC_TYPE),
281    Passwd  = ct:get_config({AgentConfName, agent_passwd}, ?AGENT_PASSWD),
282    AgentEngineID = ct:get_config({AgentConfName, agent_engine_id},
283				  ?AGENT_ENGINE_ID),
284    AgentMaxMsgSize = ct:get_config({AgentConfName, agent_max_msg_size},
285				    ?MAX_MSG_SIZE),
286
287    ConfDir = filename:join(PrivDir, "conf"),
288    DbDir = filename:join(PrivDir,"db"),
289    ok = make_dir(ConfDir),
290    ok = make_dir(DbDir),
291    snmp_config:write_agent_snmp_files(ConfDir, Vsns, ManagerIP, TrapUdp,
292				       AgentIP, AgentUdp, SysName,
293				       NotifType, SecType, Passwd,
294				       AgentEngineID, AgentMaxMsgSize),
295
296    override_default_configuration(Config, AgentConfName),
297
298    SnmpEnv = merge_snmp_conf([{db_dir, DbDir},
299			       {config, [{dir, ConfDir},
300					 {verbosity, trace}]},
301			       {agent_type, master},
302			       {agent_verbosity, trace},
303			       {net_if, [{verbosity, trace}]},
304			       {versions, Vsns}],
305			      ct:get_config({SnmpConfName,agent})),
306    application:set_env(snmp, agent, SnmpEnv).
307%%%---------------------------------------------------------------------------
308merge_snmp_conf(Defaults, undefined) ->
309    Defaults;
310merge_snmp_conf([Def={Key,DefList=[P|_]}|DefParams], UserParams) when is_tuple(P) ->
311    case lists:keysearch(Key, 1, UserParams) of
312	false ->
313	    [Def | merge_snmp_conf(DefParams, UserParams)];
314	{value,{Key,UserList}} ->
315	    DefList1 = [{SubKey,Val} || {SubKey,Val} <- DefList,
316					lists:keysearch(SubKey, 1, UserList) == false],
317	    [{Key,DefList1++UserList} | merge_snmp_conf(DefParams,
318							lists:keydelete(Key, 1, UserParams))]
319    end;
320merge_snmp_conf([Def={Key,_}|DefParams], UserParams) ->
321    case lists:keysearch(Key, 1, UserParams) of
322	false ->
323	    [Def | merge_snmp_conf(DefParams, UserParams)];
324	{value,_} ->
325	    merge_snmp_conf(DefParams, UserParams)
326    end;
327merge_snmp_conf([], UserParams) ->
328    UserParams.
329
330
331%%%---------------------------------------------------------------------------
332manager_register(false, _) ->
333    ok;
334manager_register(true, MgrAgentConfName) ->
335    Agents = ct:get_config({MgrAgentConfName, managed_agents}, []),
336    Users = ct:get_config({MgrAgentConfName, users}, []),
337    UsmUsers = ct:get_config({MgrAgentConfName, usm_users}, []),
338    EngineID = ct:get_config({MgrAgentConfName, engine_id}, ?ENGINE_ID),
339
340    setup_usm_users(UsmUsers, EngineID),
341    setup_users(Users),
342    setup_managed_agents(MgrAgentConfName,Agents).
343
344%%%---------------------------------------------------------------------------
345setup_users(Users) ->
346    while_ok(fun({Id, [Module, Data]}) ->
347		     snmpm:register_user(Id, Module, Data)
348	     end, Users).
349%%%---------------------------------------------------------------------------
350setup_managed_agents(AgentConfName,Agents) ->
351    Fun =
352	fun({AgentName, [Uid, AgentIp, AgentUdpPort, AgentConf0]}) ->
353		NewAgentIp = case AgentIp of
354				 IpTuple when is_tuple(IpTuple) ->
355				     IpTuple;
356				 HostName when is_list(HostName) ->
357				     {ok,Hostent} = inet:gethostbyname(HostName),
358				     [IpTuple|_] = Hostent#hostent.h_addr_list,
359				     IpTuple
360			     end,
361		AgentConf =
362		    case lists:keymember(engine_id,1,AgentConf0) of
363			true ->
364			    AgentConf0;
365			false ->
366			    DefaultEngineID =
367				ct:get_config({AgentConfName,agent_engine_id},
368					      ?AGENT_ENGINE_ID),
369			    [{engine_id,DefaultEngineID}|AgentConf0]
370		    end,
371		snmpm:register_agent(Uid, target_name(AgentName),
372				     [{address,NewAgentIp},{port,AgentUdpPort} |
373				      AgentConf])
374	end,
375    while_ok(Fun,Agents).
376%%%---------------------------------------------------------------------------
377setup_usm_users(UsmUsers, EngineID)->
378    while_ok(fun({UsmUser, Conf}) ->
379		     snmpm:register_usm_user(EngineID, UsmUser, Conf)
380	     end, UsmUsers).
381%%%---------------------------------------------------------------------------
382takedown_users(Users) ->
383     lists:foreach(fun(Id) ->
384			  snmpm:unregister_user(Id)
385		   end, Users).
386%%%---------------------------------------------------------------------------
387takedown_managed_agents(MgrAgentConfName,ManagedAgents) ->
388    lists:foreach(fun(AgentName) ->
389			  [Uid | _] = agent_conf(AgentName, MgrAgentConfName),
390			  snmpm:unregister_agent(Uid, target_name(AgentName))
391		  end, ManagedAgents).
392%%%---------------------------------------------------------------------------
393takedown_usm_users(UsmUsers, EngineID) ->
394     lists:foreach(fun(Id) ->
395			  snmpm:unregister_usm_user(EngineID, Id)
396		   end, UsmUsers).
397%%%---------------------------------------------------------------------------
398log(PrivDir, Agent, {_, _, Varbinds}, NewVarsAndVals) ->
399
400    Fun = fun(#varbind{oid = Oid, variabletype = Type, value = Value}) ->
401		  {Oid, Type, Value}
402	  end,
403    OldVarsAndVals = lists:map(Fun, Varbinds),
404
405    File = filename:join(PrivDir, ?CT_SNMP_LOG_FILE),
406    {ok, Fd} = file:open(File, [write, append]),
407    io:format(Fd, "~p.~n", [{Agent, OldVarsAndVals, NewVarsAndVals}]),
408    ok = file:close(Fd),
409    ok.
410%%%---------------------------------------------------------------------------
411del_dir(Dir) ->
412    {ok, Files} = file:list_dir(Dir),
413    FullPathFiles = lists:map(fun(File) -> filename:join(Dir, File) end,
414			      Files),
415    lists:foreach(fun file:delete/1, FullPathFiles),
416    ok = delete_dir(Dir),
417    ok.
418%%%---------------------------------------------------------------------------
419agent_conf(Agent, MgrAgentConfName) ->
420    Agents = ct:get_config({MgrAgentConfName, managed_agents}),
421    case lists:keysearch(Agent, 1, Agents) of
422	{value, {Agent, AgentConf}} ->
423	    AgentConf;
424	_ ->
425	    exit({error, {unknown_agent, Agent, Agents}})
426    end.
427%%%---------------------------------------------------------------------------
428override_default_configuration(Config, MgrAgentConfName) ->
429    override_contexts(Config,
430		      ct:get_config({MgrAgentConfName, agent_contexts}, undefined)),
431    override_community(Config,
432		       ct:get_config({MgrAgentConfName, agent_community}, undefined)),
433    override_sysinfo(Config,
434		     ct:get_config({MgrAgentConfName, agent_sysinfo}, undefined)),
435    override_vacm(Config,
436		  ct:get_config({MgrAgentConfName, agent_vacm}, undefined)),
437    override_usm(Config,
438		 ct:get_config({MgrAgentConfName, agent_usm}, undefined)),
439    override_notify(Config,
440		    ct:get_config({MgrAgentConfName, agent_notify_def}, undefined)),
441    override_target_address(Config,
442			    ct:get_config({MgrAgentConfName,
443					   agent_target_address_def},
444					  undefined)),
445    override_target_params(Config,
446			   ct:get_config({MgrAgentConfName, agent_target_param_def},
447					 undefined)).
448
449%%%---------------------------------------------------------------------------
450override_contexts(_, undefined) ->
451    ok;
452
453override_contexts(Config, {data_dir_file, File}) ->
454    Dir = ?config(data_dir, Config),
455    FullPathFile = filename:join(Dir, File),
456    {ok, ContextInfo} = file:consult(FullPathFile),
457    override_contexts(Config, ContextInfo);
458
459override_contexts(Config, Contexts) ->
460    Dir = filename:join(?config(priv_dir, Config),"conf"),
461    File = filename:join(Dir,"context.conf"),
462    ok = delete_file(File),
463    ok = snmp_config:write_agent_context_config(Dir, "", Contexts).
464
465%%%---------------------------------------------------------------------------
466override_sysinfo(_, undefined) ->
467    ok;
468
469override_sysinfo(Config, {data_dir_file, File}) ->
470    Dir = ?config(data_dir, Config),
471    FullPathFile = filename:join(Dir, File),
472    {ok, SysInfo} = file:consult(FullPathFile),
473    override_sysinfo(Config, SysInfo);
474
475override_sysinfo(Config, SysInfo) ->
476    Dir = filename:join(?config(priv_dir, Config),"conf"),
477    File = filename:join(Dir,"standard.conf"),
478    ok = delete_file(File),
479    ok = snmp_config:write_agent_standard_config(Dir, "", SysInfo).
480
481%%%---------------------------------------------------------------------------
482override_target_address(_, undefined) ->
483    ok;
484override_target_address(Config, {data_dir_file, File}) ->
485    Dir = ?config(data_dir, Config),
486    FullPathFile = filename:join(Dir, File),
487    {ok, TargetAddressConf} = file:consult(FullPathFile),
488    override_target_address(Config, TargetAddressConf);
489
490override_target_address(Config, TargetAddressConf) ->
491    Dir = filename:join(?config(priv_dir, Config),"conf"),
492    File = filename:join(Dir,"target_addr.conf"),
493    ok = delete_file(File),
494    ok = snmp_config:write_agent_target_addr_config(Dir, "", TargetAddressConf).
495
496
497%%%---------------------------------------------------------------------------
498override_target_params(_, undefined) ->
499    ok;
500override_target_params(Config, {data_dir_file, File}) ->
501    Dir = ?config(data_dir, Config),
502    FullPathFile = filename:join(Dir, File),
503    {ok, TargetParamsConf} = file:consult(FullPathFile),
504    override_target_params(Config, TargetParamsConf);
505
506override_target_params(Config, TargetParamsConf) ->
507    Dir = filename:join(?config(priv_dir, Config),"conf"),
508    File = filename:join(Dir,"target_params.conf"),
509    ok = delete_file(File),
510    ok = snmp_config:write_agent_target_params_config(Dir, "", TargetParamsConf).
511
512%%%---------------------------------------------------------------------------
513override_notify(_, undefined) ->
514    ok;
515override_notify(Config, {data_dir_file, File}) ->
516    Dir = ?config(data_dir, Config),
517    FullPathFile = filename:join(Dir, File),
518    {ok, NotifyConf} = file:consult(FullPathFile),
519    override_notify(Config, NotifyConf);
520
521override_notify(Config, NotifyConf) ->
522    Dir = filename:join(?config(priv_dir, Config),"conf"),
523    File = filename:join(Dir,"notify.conf"),
524    ok = delete_file(File),
525    ok = snmp_config:write_agent_notify_config(Dir, "", NotifyConf).
526
527%%%---------------------------------------------------------------------------
528override_usm(_, undefined) ->
529    ok;
530override_usm(Config, {data_dir_file, File}) ->
531    Dir = ?config(data_dir, Config),
532    FullPathFile = filename:join(Dir, File),
533    {ok, UsmConf} = file:consult(FullPathFile),
534    override_usm(Config, UsmConf);
535
536override_usm(Config, UsmConf) ->
537    Dir = filename:join(?config(priv_dir, Config),"conf"),
538    File = filename:join(Dir,"usm.conf"),
539    ok = delete_file(File),
540    ok = snmp_config:write_agent_usm_config(Dir, "", UsmConf).
541
542%%%--------------------------------------------------------------------------
543override_community(_, undefined) ->
544    ok;
545override_community(Config, {data_dir_file, File}) ->
546    Dir = ?config(data_dir, Config),
547    FullPathFile = filename:join(Dir, File),
548    {ok, CommunityConf} = file:consult(FullPathFile),
549    override_community(Config, CommunityConf);
550
551override_community(Config, CommunityConf) ->
552    Dir = filename:join(?config(priv_dir, Config),"conf"),
553    File = filename:join(Dir,"community.conf"),
554    ok = delete_file(File),
555    ok = snmp_config:write_agent_community_config(Dir, "", CommunityConf).
556
557%%%---------------------------------------------------------------------------
558
559override_vacm(_, undefined) ->
560    ok;
561override_vacm(Config, {data_dir_file, File}) ->
562    Dir = ?config(data_dir, Config),
563    FullPathFile = filename:join(Dir, File),
564    {ok, VacmConf} = file:consult(FullPathFile),
565    override_vacm(Config, VacmConf);
566
567override_vacm(Config, VacmConf) ->
568    Dir = filename:join(?config(priv_dir, Config),"conf"),
569    File = filename:join(Dir,"vacm.conf"),
570    ok = delete_file(File),
571    ok = snmp_config:write_agent_vacm_config(Dir, "", VacmConf).
572
573%%%---------------------------------------------------------------------------
574
575target_name(Agent) ->
576    atom_to_list(Agent).
577
578while_ok(Fun,[H|T]) ->
579    case Fun(H) of
580	ok -> while_ok(Fun,T);
581	Error -> Error
582    end;
583while_ok(_Fun,[]) ->
584    ok.
585
586delete_file(FileName) ->
587    case file:delete(FileName) of
588        {error, enoent} -> ok;
589        Else -> Else
590    end.
591
592make_dir(Dir) ->
593    case file:make_dir(Dir) of
594        {error, eexist} -> ok;
595        Else -> Else
596    end.
597
598delete_dir(Dir) ->
599    case file:del_dir(Dir) of
600        {error, enoent} -> ok;
601        Else -> Else
602    end.
603