~ubuntu-branches/debian/squeeze/erlang/squeeze

« back to all changes in this revision

Viewing changes to lib/snmp/src/misc/snmp_config.erl

  • Committer: Bazaar Package Importer
  • Author(s): Sergei Golovan
  • Date: 2010-03-09 17:34:57 UTC
  • mfrom: (10.1.2 sid)
  • Revision ID: james.westby@ubuntu.com-20100309173457-4yd6hlcb2osfhx31
Tags: 1:13.b.4-dfsg-3
Manpages in section 1 are needed even if only arch-dependent packages are
built. So, re-enabled them.

Show diffs side-by-side

added added

removed removed

Lines of Context:
1
1
%% 
2
2
%% %CopyrightBegin%
3
 
%% 
4
 
%% Copyright Ericsson AB 1996-2009. All Rights Reserved.
5
 
%% 
 
3
%%
 
4
%% Copyright Ericsson AB 1996-2010. All Rights Reserved.
 
5
%%
6
6
%% The contents of this file are subject to the Erlang Public License,
7
7
%% Version 1.1, (the "License"); you may not use this file except in
8
8
%% compliance with the License. You should have received a copy of the
9
9
%% Erlang Public License along with this software. If not, it can be
10
10
%% retrieved online at http://www.erlang.org/.
11
 
%% 
 
11
%%
12
12
%% Software distributed under the License is distributed on an "AS IS"
13
13
%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See
14
14
%% the License for the specific language governing rights and limitations
15
15
%% under the License.
16
 
%% 
 
16
%%
17
17
%% %CopyrightEnd%
18
18
%% 
19
19
 
327
327
                            ATLRepair = ask("23f. Audit trail log repair "
328
328
                                            "(true/false/truncate/snmp_repair)?", "true",
329
329
                                            fun verify_atl_repair/1),
 
330
                            ATLSeqNo = ask("23g. Audit trail log "
 
331
                                           "sequence-numbering (true/false)?", 
 
332
                                           "false",
 
333
                                           fun verify_atl_seqno/1),
330
334
                            [{audit_trail_log, [{type,   ATLType},
331
335
                                                {dir,    ATLDir},
332
336
                                                {size,   ATLSize},
333
 
                                                {repair, ATLRepair}]}];
 
337
                                                {repair, ATLRepair},
 
338
                                                {seqno, ATLSeqNo}]}];
334
339
                        no ->
335
340
                            []
336
341
                    end,
400
405
                NetIf = [{module,    NetIfMod},
401
406
                         {verbosity, NetIfVerb},
402
407
                         {options,   NetIfOpts}],
 
408
                TermDiscoEnable = ask("26a. Allow terminating discovery "
 
409
                                      "(true/false)?", "true",
 
410
                                      fun verify_bool/1),
 
411
                TermDiscoConf = 
 
412
                    case TermDiscoEnable of
 
413
                        true ->
 
414
                            TermDiscoStage2 = 
 
415
                                ask("26b. Second stage behaviour "
 
416
                                    "(discovery/plain)?", "discovery",
 
417
                                    fun verify_term_disco_behaviour/1),
 
418
                            TermDiscoTrigger = 
 
419
                                ask("26c. Trigger username "
 
420
                                    "(default/a string)?", "default",
 
421
                                    fun verify_term_disco_trigger_username/1),
 
422
                            [{enable, TermDiscoEnable},
 
423
                             {stage2, TermDiscoStage2},
 
424
                             {trigger_username, TermDiscoTrigger}];
 
425
                        false ->
 
426
                            [{enable, TermDiscoEnable},
 
427
                             {stage2, discovery},
 
428
                             {trigger_username, ""}]
 
429
                    end,
 
430
                OrigDiscoEnable = ask("27a. Allow originating discovery "
 
431
                                      "(true/false)?", "true",
 
432
                                      fun verify_bool/1),
 
433
                OrigDiscoConf = 
 
434
                    [{enable, OrigDiscoEnable}], 
 
435
                DiscoveryConfig = 
 
436
                    [{terminating, TermDiscoConf},
 
437
                     {originating, OrigDiscoConf}], 
403
438
                [{agent_type,      master},
404
439
                 {agent_verbosity, MasterAgentVerb},
 
440
                 {discovery,       DiscoveryConfig}, 
405
441
                 {config,          [{dir,        ConfigDir}, 
406
442
                                    {force_load, ForceLoad},
407
443
                                    {verbosity,  ConfigVerb}]},
644
680
                 "(y/n)?",
645
681
                 "n", fun verify_yes_or_no/1) of
646
682
            yes ->
647
 
                ATLDir = ask("19b. Where to store the "
 
683
                ATLType = ask("19b. Audit trail log type "
 
684
                              "(write/read_write)?",
 
685
                              "read_write", fun verify_atl_type/1),
 
686
                ATLDir = ask("19c. Where to store the "
648
687
                             "audit trail log?",
649
688
                             DefDir, fun verify_dir/1),
650
 
                ATLMaxFiles = ask("19c. Max number of files?", 
 
689
                ATLMaxFiles = ask("19d. Max number of files?", 
651
690
                                  "10", 
652
691
                                  fun verify_pos_integer/1),
653
 
                ATLMaxBytes = ask("19d. Max size (in bytes) "
 
692
                ATLMaxBytes = ask("19e. Max size (in bytes) "
654
693
                                  "of each file?", 
655
694
                                  "10240", 
656
695
                                  fun verify_pos_integer/1),
657
696
                ATLSize = {ATLMaxBytes, ATLMaxFiles},
658
 
                ATLRepair = ask("19e. Audit trail log repair "
 
697
                ATLRepair = ask("19f. Audit trail log repair "
659
698
                                "(true/false/truncate/snmp_repair)?", "true",
660
699
                                fun verify_atl_repair/1),
661
 
                [{audit_trail_log, [{dir,    ATLDir},
 
700
                ATLSeqNo = ask("19g. Audit trail log sequence-numbering "
 
701
                               "(true/false)?", "false",
 
702
                               fun verify_atl_seqno/1),
 
703
                [{audit_trail_log, [{type,   ATLType},
 
704
                                    {dir,    ATLDir},
662
705
                                    {size,   ATLSize},
663
 
                                    {repair, ATLRepair}]}];
 
706
                                    {repair, ATLRepair},
 
707
                                    {seqno,  ATLSeqNo}]}];
664
708
            no ->
665
709
                []
666
710
        end,
1180
1224
verify_atl_repair(R) ->
1181
1225
    {error, "invalid audit trail log repair: " ++ R}.
1182
1226
 
 
1227
verify_atl_seqno("true") ->
 
1228
    {ok, true};
 
1229
verify_atl_seqno("false") ->
 
1230
    {ok, false};
 
1231
verify_atl_seqno(SN) ->
 
1232
    {error, "invalid audit trail log seqno: " ++ SN}.
 
1233
 
1183
1234
 
1184
1235
verify_pos_integer(I0) ->
1185
1236
    case (catch list_to_integer(I0)) of
1237
1288
    end.
1238
1289
    
1239
1290
 
 
1291
verify_term_disco_behaviour("discovery") ->
 
1292
    {ok, discovery};
 
1293
verify_term_disco_behaviour("plain") ->
 
1294
    {ok, plain};
 
1295
verify_term_disco_behaviour(B) ->
 
1296
    {error, "invalid terminating discovery behaviour: " ++ B}.
 
1297
 
 
1298
verify_term_disco_trigger_username("default") ->
 
1299
    {ok, ""};
 
1300
verify_term_disco_trigger_username(Trigger) ->
 
1301
    {ok, Trigger}.
 
1302
 
1240
1303
 
1241
1304
verify_user_id(UserId) when is_list(UserId) ->
1242
1305
    case (catch list_to_atom(UserId)) of
1743
1806
"%% {\"standard inform\", \"std_inform\", inform}.\n"
1744
1807
"%%\n\n",
1745
1808
    Hdr = header() ++ Comment, 
1746
 
    Conf = [{"stadard_trap", "std_trap", NotifyType}],
 
1809
    Conf = [{"standard trap", "std_trap", NotifyType}],
1747
1810
    write_agent_notify_config(Dir, Hdr, Conf).
1748
1811
 
1749
1812
write_agent_notify_config(Dir, Hdr, Conf) ->
2096
2159
    ok = io:format(Fid, "     {audit_trail_log, [", []),
2097
2160
    write_sys_config_file_agent_atl_opts(Fid, Opts),
2098
2161
    ok = io:format(Fid, "}", []);
 
2162
write_sys_config_file_agent_opt(Fid, {discovery, Opts}) ->
 
2163
    ok = io:format(Fid, "     {discovery, [", []),
 
2164
    write_sys_config_file_agent_disco_opts(Fid, Opts),
 
2165
    ok = io:format(Fid, "}", []);
2099
2166
write_sys_config_file_agent_opt(Fid, {net_if, Opts}) ->
2100
2167
    ok = io:format(Fid, "     {net_if, ~w}", [Opts]);
2101
2168
write_sys_config_file_agent_opt(Fid, {mib_server, Opts}) ->
2139
2206
write_sys_config_file_agent_atl_opt(Fid, {size, Size}) ->
2140
2207
    ok = io:format(Fid, "{size, ~w}", [Size]);
2141
2208
write_sys_config_file_agent_atl_opt(Fid, {repair, Rep}) ->
2142
 
    ok = io:format(Fid, "{repair, ~w}", [Rep]).
 
2209
    ok = io:format(Fid, "{repair, ~w}", [Rep]);
 
2210
write_sys_config_file_agent_atl_opt(Fid, {seqno, SeqNo}) ->
 
2211
    ok = io:format(Fid, "{seqno, ~w}", [SeqNo]).
 
2212
 
 
2213
 
 
2214
%% These options are allways there
 
2215
write_sys_config_file_agent_disco_opts(Fid, [Opt]) ->
 
2216
    write_sys_config_file_agent_disco_opt(Fid, Opt),
 
2217
    ok = io:format(Fid, "]", []),
 
2218
    ok;
 
2219
write_sys_config_file_agent_disco_opts(Fid, [Opt|Opts]) ->
 
2220
    write_sys_config_file_agent_disco_opt(Fid, Opt),
 
2221
    ok = io:format(Fid, ", ", []),
 
2222
    write_sys_config_file_agent_disco_opts(Fid, Opts).
 
2223
    
 
2224
write_sys_config_file_agent_disco_opt(Fid, {terminating, Opts}) ->
 
2225
    ok = io:format(Fid, "{terminating, [", []),
 
2226
    write_sys_config_file_agent_term_disco_opts(Fid, Opts),
 
2227
    ok = io:format(Fid, "}", []);
 
2228
write_sys_config_file_agent_disco_opt(Fid, {originating, Opts}) ->
 
2229
    ok = io:format(Fid, "{originating, [", []),
 
2230
    write_sys_config_file_agent_orig_disco_opts(Fid, Opts),
 
2231
    ok = io:format(Fid, "}", []).
 
2232
 
 
2233
write_sys_config_file_agent_term_disco_opts(Fid, [Opt]) ->
 
2234
    write_sys_config_file_agent_term_disco_opt(Fid, Opt),
 
2235
    ok = io:format(Fid, "]", []),
 
2236
    ok;
 
2237
write_sys_config_file_agent_term_disco_opts(Fid, [Opt|Opts]) ->
 
2238
    write_sys_config_file_agent_term_disco_opt(Fid, Opt),
 
2239
    ok = io:format(Fid, ", ", []),
 
2240
    write_sys_config_file_agent_term_disco_opts(Fid, Opts).
 
2241
    
 
2242
write_sys_config_file_agent_term_disco_opt(Fid, {enable, Enable}) ->
 
2243
    ok = io:format(Fid, "{enable, ~w}", [Enable]);
 
2244
write_sys_config_file_agent_term_disco_opt(Fid, {stage2, Stage2}) ->
 
2245
    ok = io:format(Fid, "{stage2, ~w}", [Stage2]);
 
2246
write_sys_config_file_agent_term_disco_opt(Fid, {trigger_username, Trigger}) ->
 
2247
    ok = io:format(Fid, "{trigger_username, \"~s\"}", [Trigger]).
 
2248
 
 
2249
write_sys_config_file_agent_orig_disco_opts(Fid, [Opt]) ->
 
2250
    write_sys_config_file_agent_orig_disco_opt(Fid, Opt),
 
2251
    ok = io:format(Fid, "]", []),
 
2252
    ok;
 
2253
write_sys_config_file_agent_orig_disco_opts(Fid, [Opt|Opts]) ->
 
2254
    write_sys_config_file_agent_orig_disco_opt(Fid, Opt),
 
2255
    ok = io:format(Fid, ", ", []),
 
2256
    write_sys_config_file_agent_orig_disco_opts(Fid, Opts).
 
2257
    
 
2258
write_sys_config_file_agent_orig_disco_opt(Fid, {enable, Enable}) ->
 
2259
    ok = io:format(Fid, "{enable, ~w}", [Enable]).
 
2260
 
2143
2261
 
2144
2262
 
2145
2263
write_sys_config_file_manager_opts(Fid, [Opt]) ->