Filename | /usr/local/lib/perl5/site_perl/mach/5.24/Razor2/Client/Config.pm |
Statements | Executed 13 statements in 6.74ms |
Calls | P | F | Exclusive Time |
Inclusive Time |
Subroutine |
---|---|---|---|---|---|
1 | 1 | 1 | 4.02ms | 4.45ms | BEGIN@15 | Razor2::Client::Config::
1 | 1 | 1 | 51µs | 64µs | BEGIN@12 | Razor2::Client::Config::
1 | 1 | 1 | 29µs | 103µs | BEGIN@14 | Razor2::Client::Config::
1 | 1 | 1 | 27µs | 152µs | BEGIN@13 | Razor2::Client::Config::
1 | 1 | 1 | 16µs | 16µs | BEGIN@18 | Razor2::Client::Config::
1 | 1 | 1 | 13µs | 13µs | BEGIN@16 | Razor2::Client::Config::
0 | 0 | 0 | 0s | 0s | compute_identity | Razor2::Client::Config::
0 | 0 | 0 | 0s | 0s | compute_razorconf | Razor2::Client::Config::
0 | 0 | 0 | 0s | 0s | create_home | Razor2::Client::Config::
0 | 0 | 0 | 0s | 0s | default_agent_conf | Razor2::Client::Config::
0 | 0 | 0 | 0s | 0s | default_server_conf | Razor2::Client::Config::
0 | 0 | 0 | 0s | 0s | find_home | Razor2::Client::Config::
0 | 0 | 0 | 0s | 0s | find_user | Razor2::Client::Config::
0 | 0 | 0 | 0s | 0s | get_ident | Razor2::Client::Config::
0 | 0 | 0 | 0s | 0s | ident_fn | Razor2::Client::Config::
0 | 0 | 0 | 0s | 0s | my_readlink | Razor2::Client::Config::
0 | 0 | 0 | 0s | 0s | new | Razor2::Client::Config::
0 | 0 | 0 | 0s | 0s | parse_value | Razor2::Client::Config::
0 | 0 | 0 | 0s | 0s | read_conf | Razor2::Client::Config::
0 | 0 | 0 | 0s | 0s | read_file | Razor2::Client::Config::
0 | 0 | 0 | 0s | 0s | register_identity | Razor2::Client::Config::
0 | 0 | 0 | 0s | 0s | save_ident | Razor2::Client::Config::
0 | 0 | 0 | 0s | 0s | write_conf | Razor2::Client::Config::
0 | 0 | 0 | 0s | 0s | write_file | Razor2::Client::Config::
Line | State ments |
Time on line |
Calls | Time in subs |
Code |
---|---|---|---|---|---|
1 | #!/usr/local/bin/perl -s | ||||
2 | ## | ||||
3 | ## Razor2::Client:Config | ||||
4 | ## | ||||
5 | ## Copyright (c) 2002, Vipul Ved Prakash. All rights reserved. | ||||
6 | ## This code is free software; you can redistribute it and/or modify | ||||
7 | ## it under the same terms as Perl itself. | ||||
8 | ## | ||||
9 | ## $Id: Config.pm,v 1.66 2007/05/10 20:32:10 rsoderberg Exp $ | ||||
10 | |||||
11 | package Razor2::Client::Config; | ||||
12 | 2 | 72µs | 2 | 78µs | # spent 64µs (51+14) within Razor2::Client::Config::BEGIN@12 which was called:
# once (51µs+14µs) by base::import at line 12 # spent 64µs making 1 call to Razor2::Client::Config::BEGIN@12
# spent 14µs making 1 call to strict::import |
13 | 2 | 68µs | 2 | 278µs | # spent 152µs (27+126) within Razor2::Client::Config::BEGIN@13 which was called:
# once (27µs+126µs) by base::import at line 13 # spent 152µs making 1 call to Razor2::Client::Config::BEGIN@13
# spent 126µs making 1 call to Exporter::import |
14 | 2 | 61µs | 2 | 177µs | # spent 103µs (29+74) within Razor2::Client::Config::BEGIN@14 which was called:
# once (29µs+74µs) by base::import at line 14 # spent 103µs making 1 call to Razor2::Client::Config::BEGIN@14
# spent 74µs making 1 call to vars::import |
15 | 2 | 385µs | 2 | 4.58ms | # spent 4.45ms (4.02+432µs) within Razor2::Client::Config::BEGIN@15 which was called:
# once (4.02ms+432µs) by base::import at line 15 # spent 4.45ms making 1 call to Razor2::Client::Config::BEGIN@15
# spent 128µs making 1 call to Exporter::import |
16 | 2 | 54µs | 1 | 13µs | # spent 13µs within Razor2::Client::Config::BEGIN@16 which was called:
# once (13µs+0s) by base::import at line 16 # spent 13µs making 1 call to Razor2::Client::Config::BEGIN@16 |
17 | |||||
18 | 2 | 6.09ms | 1 | 16µs | # spent 16µs within Razor2::Client::Config::BEGIN@18 which was called:
# once (16µs+0s) by base::import at line 18 # spent 16µs making 1 call to Razor2::Client::Config::BEGIN@18 |
19 | |||||
20 | #use base qw(Razor2::Logger); | ||||
21 | |||||
22 | sub new { | ||||
23 | my ($class) = @_; | ||||
24 | return bless {}, $class; | ||||
25 | } | ||||
26 | |||||
27 | # | ||||
28 | # figures out razorhome and razorconf file | ||||
29 | # | ||||
30 | sub read_conf { | ||||
31 | my ($self,$params) = @_; | ||||
32 | |||||
33 | my $default_conf_fn = "$self->{global_razorhome}/razor-agent.conf"; | ||||
34 | my $conf; | ||||
35 | my $defaults = $self->default_agent_conf(); | ||||
36 | my $use_engines = $defaults->{use_engines}; | ||||
37 | |||||
38 | if ($self->{razorconf}) { | ||||
39 | # | ||||
40 | # cmd-line config file specified | ||||
41 | # | ||||
42 | $conf = $self->read_file($self->{razorconf},$defaults) | ||||
43 | unless ($self->{opt}->{create} && $self->{opt}->{config}); | ||||
44 | if ($self->{opt}->{razorhome}) { | ||||
45 | $self->{computed_razorhome} = $self->{razorhome} = $self->{opt}->{razorhome}; | ||||
46 | } else { | ||||
47 | $self->find_home($self->{opt}->{razorhome} || $conf->{razorhome}); | ||||
48 | } | ||||
49 | } else { | ||||
50 | |||||
51 | $self->compute_razorconf(); | ||||
52 | |||||
53 | if ($self->{razorconf}) { | ||||
54 | $conf = $self->read_file($self->{razorconf},$defaults); | ||||
55 | } else { | ||||
56 | $self->log(6, "No razor-agent.conf found, using defaults. "); | ||||
57 | $conf = $defaults; | ||||
58 | } | ||||
59 | } | ||||
60 | |||||
61 | foreach (keys %{$defaults}) { | ||||
62 | next if exists $conf->{$_}; | ||||
63 | $conf->{$_} = $defaults->{$_}; | ||||
64 | } | ||||
65 | |||||
66 | # Override use_engines from defaults. To store use_engines | ||||
67 | # in the config file is a design flaw, since the client | ||||
68 | # supported engines are defined by the razor-agents source, | ||||
69 | # and could potentially be incorrect in the config file | ||||
70 | # after an upgrade. | ||||
71 | |||||
72 | $conf->{use_engines} = $use_engines; | ||||
73 | |||||
74 | foreach (keys %{$self->{opt}}) { | ||||
75 | next if ($_ eq '' || $_ eq 'use_engines' || $_ eq 'razorzone'); | ||||
76 | $conf->{$_} = $self->{opt}->{$_}; | ||||
77 | } | ||||
78 | |||||
79 | if ($params) { | ||||
80 | foreach (keys %$params) { | ||||
81 | next if ($_ eq '' || $_ eq 'use_engines' || $_ eq 'razorzone'); | ||||
82 | $conf->{$_} = $params->{$_}; | ||||
83 | } | ||||
84 | } | ||||
85 | |||||
86 | $self->{conf} = $conf; | ||||
87 | |||||
88 | # | ||||
89 | # post config processing | ||||
90 | # insert things that should not be in conf here | ||||
91 | # | ||||
92 | |||||
93 | # turn off run-time warnings unless debug flag passed | ||||
94 | # http://www.perldoc.com/perl5.6.1/pod/perllexwarn.html | ||||
95 | $^W = 0 unless $conf->{debug}; | ||||
96 | |||||
97 | # add full path to all config values that need them | ||||
98 | # | ||||
99 | if ($self->{razorhome}) { | ||||
100 | foreach (qw( logfile pidfile listfile_catalogue listfile_nomination | ||||
101 | listfile_discovery whitelist identity)) { | ||||
102 | next unless $conf->{$_}; | ||||
103 | next if $conf->{$_} =~ /^\//; | ||||
104 | next if ($_ eq 'logfile' && ($conf->{$_} eq 'syslog' || $conf->{$_} eq 'sys-syslog')); | ||||
105 | $conf->{$_} = "$self->{razorhome}/$conf->{$_}"; | ||||
106 | } | ||||
107 | } | ||||
108 | return $self->{conf}; | ||||
109 | } | ||||
110 | |||||
111 | # | ||||
112 | # Figure out which conf to use - user's own, or system conf. | ||||
113 | # | ||||
114 | # If no user conf or no system conf, razorconf will be blank | ||||
115 | # but computed_razorconf will be set. | ||||
116 | # | ||||
117 | # However, if razorhome is still unknown, computed_razorconf can be blank | ||||
118 | # | ||||
119 | sub compute_razorconf { | ||||
120 | my $self = shift; | ||||
121 | |||||
122 | my $default_conf_fn = "$self->{global_razorhome}/razor-agent.conf"; | ||||
123 | |||||
124 | $self->{razorconf} = ""; | ||||
125 | $self->find_home(); | ||||
126 | if ($self->{razorhome}) { | ||||
127 | my $mycf = "$self->{razorhome}/razor-agent.conf"; | ||||
128 | $self->{computed_razorconf} = $mycf; | ||||
129 | if (-r $mycf) { | ||||
130 | $self->{razorconf} = $mycf; | ||||
131 | } elsif (-e $mycf) { | ||||
132 | $self->log(5, "Found but can't read $mycf, skipping."); | ||||
133 | } else { | ||||
134 | $self->log(5, "No $mycf found, skipping."); | ||||
135 | } | ||||
136 | } | ||||
137 | if (!$self->{razorconf} && -e $default_conf_fn) { | ||||
138 | if (-r $default_conf_fn) { | ||||
139 | $self->{razorconf} = $default_conf_fn; | ||||
140 | } else { | ||||
141 | $self->log(5, "Found but can't read $default_conf_fn, skipping."); | ||||
142 | $self->{computed_razorconf} ||= $default_conf_fn; | ||||
143 | } | ||||
144 | } | ||||
145 | } | ||||
146 | |||||
147 | sub write_conf { | ||||
148 | my ($self,$hash) = @_; | ||||
149 | |||||
150 | unless ($self->{razorconf}) { | ||||
151 | $self->log(5,"Cannot write_conf without razorconf set"); | ||||
152 | return $self->error("Cannot write_conf without razorconf set"); | ||||
153 | } | ||||
154 | my $now = localtime(); | ||||
155 | my $srcmsg; | ||||
156 | unless ($hash) { | ||||
157 | $hash = $self->default_agent_conf(); | ||||
158 | if (-r $self->{razorconf}) { | ||||
159 | $hash = $self->read_file( $self->{razorconf}, $hash); | ||||
160 | $srcmsg = "Non-default values taken from $self->{razorconf}"; | ||||
161 | } else { | ||||
162 | $srcmsg = "Created with all default values"; | ||||
163 | } | ||||
164 | } | ||||
165 | |||||
166 | my $clientheader = <<EOFCLIENT; | ||||
167 | # | ||||
168 | # Razor2 config file | ||||
169 | # | ||||
170 | # Autogenerated by $self->{name_version} | ||||
171 | # $now | ||||
172 | # $srcmsg | ||||
173 | # | ||||
174 | # see razor-agent.conf(5) man page | ||||
175 | # | ||||
176 | EOFCLIENT | ||||
177 | return $self->write_file($self->{razorconf}, $hash, 0, $clientheader); | ||||
178 | } | ||||
179 | |||||
180 | |||||
181 | sub find_user { | ||||
182 | my $self = shift; | ||||
183 | |||||
184 | return 1 if $self->{user}; | ||||
185 | |||||
186 | $self->{user} = getpwuid($>) || do { | ||||
187 | $self->log(1, "Can't figure out who the effective user is: $!"); | ||||
188 | return undef; | ||||
189 | }; | ||||
190 | return 1; | ||||
191 | } | ||||
192 | |||||
193 | # compute razorhome. like so: | ||||
194 | # | ||||
195 | # -home=/tmp/razor/ used if readable, else | ||||
196 | # 'razorhome' from config file used if readable, else | ||||
197 | # <home>/.razor/ used if readable, else | ||||
198 | # <home>/.razor/ is created. if that fails, no razorhome. | ||||
199 | # -conf=/foo/razor/razor.conf if all else fails pick it up from the config file path, | ||||
200 | # if one is available | ||||
201 | |||||
202 | sub find_home { | ||||
203 | my ($self,$rhome) = @_; | ||||
204 | |||||
205 | my $dotrazor = '.razor'; | ||||
206 | $dotrazor = '_razor' if $^O eq 'VMS'; | ||||
207 | |||||
208 | if (defined $self->{razorhome}) { | ||||
209 | $self->{razorhome_computed} = $self->{razorhome}; | ||||
210 | return 1; | ||||
211 | } | ||||
212 | |||||
213 | if (defined $self->{opt}->{razorhome}) { | ||||
214 | $self->{razorhome_computed} = $self->{razorhome}; | ||||
215 | return 1; | ||||
216 | } | ||||
217 | |||||
218 | # if razorhome is read from config file, its passed as rhome | ||||
219 | unless ($rhome) { | ||||
220 | |||||
221 | if (defined $ENV{HOME}) { | ||||
222 | $rhome = File::Spec->catdir("$ENV{HOME}", "$dotrazor"); | ||||
223 | } else { | ||||
224 | return unless $self->find_user(); | ||||
225 | $rhome = File::Spec->catdir((getpwnam($self->{user}))[7], "$dotrazor") || "/home/$self->{user}/$dotrazor"; | ||||
226 | } | ||||
227 | $rhome = VMS::Filespec::unixify($rhome) if $^O eq 'VMS'; | ||||
228 | $self->log(8,"Computed razorhome from env: $rhome"); | ||||
229 | } | ||||
230 | $self->{razorhome_computed} = $rhome; | ||||
231 | |||||
232 | if (-d $rhome) { | ||||
233 | if (-w $rhome) { | ||||
234 | $self->log(6,"Found razorhome: $rhome"); | ||||
235 | } else { | ||||
236 | $self->log(6,"Found razorhome: $rhome, however, can't write to it."); | ||||
237 | } | ||||
238 | $self->{razorhome} = $rhome; | ||||
239 | return 1; | ||||
240 | |||||
241 | } | ||||
242 | |||||
243 | if ($self->{razorconf}) { | ||||
244 | my $path = $$self{razorconf}; | ||||
245 | if ($path =~ m:/:) { | ||||
246 | if ($path =~ m:(.*)/:) { | ||||
247 | $self->{razorhome} = $1; | ||||
248 | return 1; | ||||
249 | } | ||||
250 | } | ||||
251 | } | ||||
252 | |||||
253 | $self->log(5,"No razorhome found, using all defaults"); | ||||
254 | $self->{razorhome} = ""; | ||||
255 | return 1; | ||||
256 | } | ||||
257 | |||||
258 | sub create_home { | ||||
259 | my ($self,$rhome) = @_; | ||||
260 | |||||
261 | if (-d $rhome) { | ||||
262 | $self->{razorhome} = $rhome; | ||||
263 | return 1; | ||||
264 | } | ||||
265 | if (mkdir $rhome, 0755) { | ||||
266 | $self->log(6,"Created razorhome: $rhome"); | ||||
267 | $self->{razorhome} = $rhome; | ||||
268 | return 1; | ||||
269 | } | ||||
270 | return $self->error("Could not mkdir $rhome: $!"); | ||||
271 | } | ||||
272 | |||||
273 | sub compute_identity { | ||||
274 | my ($self) = @_; | ||||
275 | $self->find_home() or return; | ||||
276 | |||||
277 | return 1 if $self->{identity}; | ||||
278 | |||||
279 | my $id; | ||||
280 | |||||
281 | if ($id = $self->{opt}->{identity}) { | ||||
282 | $self->{identity} = $self->my_readlink($id); | ||||
283 | # warn we can't read it unless we are registering new identity | ||||
284 | $self->log(6,"Can't read identity: $self->{identity}") | ||||
285 | unless ($self->{opt}->{register}) || (-r $self->{identity}); | ||||
286 | return 1; | ||||
287 | |||||
288 | # if not specified via cmd-line, just compute it, don't read it. | ||||
289 | |||||
290 | } elsif ($id = $self->{conf}->{identity}) { | ||||
291 | $self->{identity} = $self->my_readlink($id); | ||||
292 | return 1; | ||||
293 | |||||
294 | } else { | ||||
295 | $id = $self->{razorhome} ? "$self->{razorhome}/identity" : ""; | ||||
296 | $self->{identity} = $self->my_readlink($id); | ||||
297 | return 1; | ||||
298 | } | ||||
299 | } | ||||
300 | |||||
301 | |||||
302 | sub get_ident { | ||||
303 | my ($self) = @_; | ||||
304 | $self->find_home() or return; | ||||
305 | |||||
306 | my $idfn = $self->{identity}; | ||||
307 | return $self->error("Cannot read the identity file: $idfn") unless -r $idfn; | ||||
308 | |||||
309 | $idfn = $self->my_readlink($idfn); | ||||
310 | |||||
311 | my $mode = ((stat($idfn))[2]) & 07777; # mask off file type | ||||
312 | if ($mode & 0007) { | ||||
313 | $self->log(2,"Please chmod $idfn so it is not world readable."); | ||||
314 | } | ||||
315 | return $self->read_file( $idfn ); | ||||
316 | } | ||||
317 | |||||
318 | # returns { user => $user, pass => $pass } if success | ||||
319 | # returns 2 if error | ||||
320 | sub register_identity { | ||||
321 | my($self, $user, $pass) = @_; | ||||
322 | my $ident = $self->register({ | ||||
323 | user => $user, | ||||
324 | pass => $pass, | ||||
325 | }); | ||||
326 | $self->disconnect() or return 2; | ||||
327 | return $ident || 2; | ||||
328 | } | ||||
329 | |||||
330 | sub ident_fn { | ||||
331 | my ($self,$ident) = @_; | ||||
332 | $self->find_home() or return; | ||||
333 | |||||
334 | my $orig; | ||||
335 | my $syml; | ||||
336 | my $obase = "identity-$ident->{user}"; | ||||
337 | |||||
338 | $obase = $1 if $obase =~ /^(\S+)$/; # untaint obase | ||||
339 | |||||
340 | # if it's a user specified identity file, don't symlink | ||||
341 | unless ($orig = $self->{opt}->{identity}) { | ||||
342 | $orig = "$self->{razorhome}/$obase"; | ||||
343 | $syml = "$self->{razorhome}/identity"; | ||||
344 | |||||
345 | $orig = $1 if $orig =~ /^(\S+)$/; # untaint orig | ||||
346 | $syml = $1 if $syml =~ /^(\S+)$/; # untaint syml | ||||
347 | } | ||||
348 | |||||
349 | |||||
350 | return ($orig, $obase, $syml); | ||||
351 | } | ||||
352 | |||||
353 | sub save_ident { | ||||
354 | my ($self,$ident) = @_; | ||||
355 | |||||
356 | my ($orig, $obase, $syml) = $self->ident_fn($ident); | ||||
357 | |||||
358 | unless (length $orig) { | ||||
359 | return $self->error("couldn't figure out identity filename"); | ||||
360 | } | ||||
361 | |||||
362 | rename($orig,"$orig.bak") if -s $orig; | ||||
363 | my $umask = umask 0077; # disable group and all from read/write/execute | ||||
364 | $self->write_file($orig,$ident) or return; | ||||
365 | umask $umask; | ||||
366 | |||||
367 | # don't create a symlink if user specified identity file from cmd-line | ||||
368 | return $orig unless $syml; | ||||
369 | |||||
370 | unless ($self->{opt}->{symlink}) { | ||||
371 | return $orig if -e $syml; # already has another identity | ||||
372 | } | ||||
373 | |||||
374 | unlink $syml; | ||||
375 | if (eval { symlink("",""); 1 } ) { | ||||
376 | $obase = $1 if $obase =~ /^(\S+)$/; # untaint obase | ||||
377 | $syml = $1 if $syml =~ /^(\S+)$/; # untaint syml | ||||
378 | |||||
379 | symlink $obase, $syml or | ||||
380 | return $self->error("Created $orig, but could not symlink to it $syml: $!"); | ||||
381 | } else { | ||||
382 | $self->log(5, "symlinks don't work on this machine"); | ||||
383 | copy($orig,$syml); | ||||
384 | } | ||||
385 | return $orig; | ||||
386 | } | ||||
387 | |||||
388 | sub my_readlink { | ||||
389 | my ($self,$fn) = @_; | ||||
390 | |||||
391 | while (1) { | ||||
392 | return $fn unless -l $fn; | ||||
393 | |||||
394 | if ($fn =~ /^(.*)\/([^\/]+)$/) { | ||||
395 | my $dir = $1; | ||||
396 | $fn = readlink $fn; | ||||
397 | $fn = $1 if $fn =~ /^(\S+)$/; # untaint readlink | ||||
398 | $fn = "$dir/$fn" unless $fn =~ /^\//; | ||||
399 | } else { | ||||
400 | $fn = readlink $fn; | ||||
401 | $fn = $1 if $fn =~ /^(\S+)$/; # untaint readlink | ||||
402 | } | ||||
403 | } | ||||
404 | } | ||||
405 | |||||
406 | sub parse_value { | ||||
407 | my ($self, $value) = @_; | ||||
408 | |||||
409 | $value =~ s/^\s+//; | ||||
410 | $value =~ s/\s+$//; | ||||
411 | if ($value =~ m:,:) { | ||||
412 | my @values = split /,\s*/, $value; | ||||
413 | return [@values]; | ||||
414 | } else { | ||||
415 | return $value; | ||||
416 | } | ||||
417 | } | ||||
418 | |||||
419 | # given filename, returns hash ref of key = val from file | ||||
420 | # if $nothash, than no key && val, just return array ref containing all lines. | ||||
421 | # | ||||
422 | sub read_file { | ||||
423 | my ($self,$fn,$h,$nothash) = @_; | ||||
424 | |||||
425 | unless (defined $fn && length $fn) { | ||||
426 | $self->log(5,"Filename not provided to read_file"); | ||||
427 | return; | ||||
428 | } | ||||
429 | |||||
430 | my $conf = ref($h) eq 'HASH' ? $h : {}; | ||||
431 | |||||
432 | if( $^O eq 'VMS' && $fn !~ /\[/ ) { | ||||
433 | my ($dir,$file,$ext) = ($fn =~ /(^.*\/)(.*)(\..*)$/); | ||||
434 | $dir =~ s/\./_/g; | ||||
435 | $file =~ s/\./_/g; | ||||
436 | $fn = $dir . $file . $ext; | ||||
437 | } | ||||
438 | |||||
439 | $fn = $1 if $fn =~ /^(\S+)$/; # untaint $fn | ||||
440 | |||||
441 | unless (defined($fn) && (($fn =~ /^\//) || -e $fn)) { | ||||
442 | $self->log(7,"Can't read file $fn, looking relative to $self->{razorhome}"); | ||||
443 | $fn = "$self->{razorhome}/$fn"; | ||||
444 | $fn = $1 if $fn =~ /^(\S+)$/; # untaint $fn | ||||
445 | } | ||||
446 | |||||
447 | my $total = 0; | ||||
448 | my @lines; | ||||
449 | unless (open CONF, "<$fn") { | ||||
450 | $self->log(5,"Can't read file $fn: $!"); | ||||
451 | return; | ||||
452 | } | ||||
453 | |||||
454 | # set $/ to the default in case someone has overwritten $/ elsewhere | ||||
455 | local $/ = "\n"; | ||||
456 | |||||
457 | for (<CONF>) { | ||||
458 | chomp; | ||||
459 | next if /^\s*#/; | ||||
460 | if ($nothash) { | ||||
461 | next unless s/^\s*(.+?)\s*$/$1/; # untaint | ||||
462 | $conf->{$_} = 7; | ||||
463 | push @lines, $_; | ||||
464 | } else { | ||||
465 | next unless /=/; | ||||
466 | my ($attribute, $value) = /^\s*(.+?)\s*=\s*(.+?)\s*$/; # untaint | ||||
467 | next unless (defined $attribute && defined $value); | ||||
468 | $conf->{$attribute} = $self->parse_value($value); | ||||
469 | } | ||||
470 | $total++; | ||||
471 | } | ||||
472 | close CONF; | ||||
473 | $self->log(5, "read_file: $total items read from $fn"); | ||||
474 | |||||
475 | return $nothash ? \@lines : $conf; | ||||
476 | } | ||||
477 | |||||
478 | # given hash ref, writes to file key = val | ||||
479 | # NOTE: key should not contain '='; | ||||
480 | # | ||||
481 | # given array ref, writes to file each item | ||||
482 | # | ||||
483 | # given scalar ref, writes to file | ||||
484 | # | ||||
485 | sub write_file { | ||||
486 | my ($self,$fn,$hash,$append,$header,$lock) = @_; | ||||
487 | |||||
488 | $fn = "$self->{razorhome}/$fn" unless ($fn =~ /^\//); | ||||
489 | $fn = ">$fn" if $append; | ||||
490 | |||||
491 | if( $^O eq 'VMS' && $fn !~ /\[/ ) { | ||||
492 | my ($dir,$file,$ext) = ($fn =~ /(^.*\/)(.*)(\..*)$/); | ||||
493 | $dir =~ s/\./_/g; | ||||
494 | $file =~ s/\./_/g; | ||||
495 | $fn = $dir . $file . $ext; | ||||
496 | } | ||||
497 | |||||
498 | $fn = $1 if $fn =~ /^(\S+)$/; # untaint $fn | ||||
499 | |||||
500 | # check for lock file | ||||
501 | my $lockfile = "$fn.lock"; | ||||
502 | $lockfile = "${fn}_lock;1" if $^O eq 'VMS'; | ||||
503 | if ($lock) { | ||||
504 | if (-r "$lockfile") { | ||||
505 | return $self->error("File is locked, try again later: $lockfile"); | ||||
506 | } else { | ||||
507 | unless (open LOCK, ">$fn.lock") { | ||||
508 | return $self->error("Can't create lock file $fn.lock: $!"); | ||||
509 | } | ||||
510 | close LOCK; | ||||
511 | } | ||||
512 | } | ||||
513 | unless (open CONF, ">$fn") { | ||||
514 | return $self->error("Can't write file $fn: $!"); | ||||
515 | } | ||||
516 | print CONF "$header\n" if $header; | ||||
517 | my $total = 0; | ||||
518 | if (ref($hash) eq 'HASH') { | ||||
519 | foreach (sort keys %$hash) { | ||||
520 | return $self->error("Key cannot contain '=': $_") if /=/; | ||||
521 | printf CONF "%-22s = ", $_; | ||||
522 | if (ref($hash->{$_}) eq "ARRAY") { | ||||
523 | print CONF join(',', @{$hash->{$_}}) ."\n"; | ||||
524 | } else { | ||||
525 | print CONF $hash->{$_} ."\n"; | ||||
526 | } | ||||
527 | $total++; | ||||
528 | } | ||||
529 | |||||
530 | } elsif (ref($hash) eq 'ARRAY') { | ||||
531 | foreach (@$hash) { | ||||
532 | next unless /\S/; | ||||
533 | if (ref($_) eq "ARRAY") { | ||||
534 | print CONF join(', ', @$_) ."\n"; | ||||
535 | } else { | ||||
536 | print CONF $_ ."\n"; | ||||
537 | } | ||||
538 | $total++; | ||||
539 | } | ||||
540 | } elsif (ref($hash) eq 'SCALAR') { | ||||
541 | printf CONF $$hash; | ||||
542 | $total++; | ||||
543 | } | ||||
544 | close CONF; | ||||
545 | if ($lock) { | ||||
546 | 1 while unlink "$lockfile"; | ||||
547 | } | ||||
548 | $self->log(5, "wrote $total ". ref($hash) ." items to file: $fn"); | ||||
549 | |||||
550 | #return $total; | ||||
551 | return 1; | ||||
552 | } | ||||
553 | |||||
- - | |||||
556 | sub default_server_conf { | ||||
557 | my $self = shift; | ||||
558 | my $defaults = { | ||||
559 | srl => -1, | ||||
560 | ep4 => '7542-10', | ||||
561 | bql => 4, | ||||
562 | ac => 0, | ||||
563 | bqs => 128, | ||||
564 | se => 'C8', # engines 4, 8 | ||||
565 | dre => 4, | ||||
566 | zone => 'razor2.cloudmark.com', | ||||
567 | logic_method => 4, | ||||
568 | }; | ||||
569 | |||||
570 | # split strings with , into array | ||||
571 | foreach (keys %$defaults) { | ||||
572 | $defaults->{$_} = $self->parse_value($defaults->{$_}); | ||||
573 | } | ||||
574 | return $defaults; | ||||
575 | } | ||||
576 | |||||
577 | |||||
578 | sub default_agent_conf { | ||||
579 | my $self = shift; | ||||
580 | # | ||||
581 | # These get overwritten by whatever's in config file, | ||||
582 | # which in turn gets overwritten by cmd-line options. | ||||
583 | # | ||||
584 | my $defaults = { | ||||
585 | debuglevel => "3", | ||||
586 | logfile => "razor-agent.log", | ||||
587 | listfile_catalogue => "servers.catalogue.lst", | ||||
588 | listfile_nomination => "servers.nomination.lst", | ||||
589 | listfile_discovery => "servers.discovery.lst", | ||||
590 | min_cf => "ac", | ||||
591 | turn_off_discovery => "0", | ||||
592 | ignorelist => "0", | ||||
593 | razordiscovery => "discovery.razor.cloudmark.com", | ||||
594 | rediscovery_wait => "172800", | ||||
595 | report_headers => "1", | ||||
596 | whitelist => "razor-whitelist", | ||||
597 | use_engines => "4, 8", | ||||
598 | identity => "identity", | ||||
599 | logic_method => 4, | ||||
600 | }; | ||||
601 | |||||
602 | # 'razorhome' can exist in .conf, but we compute it instead of listing it here | ||||
603 | # 'rlimit' ? | ||||
604 | |||||
605 | # split strings with , into array | ||||
606 | foreach (keys %$defaults) { | ||||
607 | $defaults->{$_} = $self->parse_value($defaults->{$_}); | ||||
608 | } | ||||
609 | return $defaults; | ||||
610 | } | ||||
611 | |||||
612 | |||||
613 | 1 | 10µs | 1; | ||
614 |