← Index
NYTProf Performance Profile   « line view »
For /usr/local/bin/sa-learn
  Run on Tue Nov 7 05:38:10 2017
Reported on Tue Nov 7 06:16:04 2017

Filename/usr/local/lib/perl5/site_perl/mach/5.24/Razor2/Client/Config.pm
StatementsExecuted 13 statements in 7.25ms
Subroutines
Calls P F Exclusive
Time		 Inclusive
Time		 Subroutine
1114.15ms4.67msRazor2::Client::Config::::BEGIN@15Razor2::Client::Config::BEGIN@15
11146µs59µsRazor2::Client::Config::::BEGIN@12Razor2::Client::Config::BEGIN@12
11128µs113µsRazor2::Client::Config::::BEGIN@14Razor2::Client::Config::BEGIN@14
11125µs146µsRazor2::Client::Config::::BEGIN@13Razor2::Client::Config::BEGIN@13
11124µs24µsRazor2::Client::Config::::BEGIN@16Razor2::Client::Config::BEGIN@16
11118µs18µsRazor2::Client::Config::::BEGIN@18Razor2::Client::Config::BEGIN@18
0000s0sRazor2::Client::Config::::compute_identityRazor2::Client::Config::compute_identity
0000s0sRazor2::Client::Config::::compute_razorconfRazor2::Client::Config::compute_razorconf
0000s0sRazor2::Client::Config::::create_homeRazor2::Client::Config::create_home
0000s0sRazor2::Client::Config::::default_agent_confRazor2::Client::Config::default_agent_conf
0000s0sRazor2::Client::Config::::default_server_confRazor2::Client::Config::default_server_conf
0000s0sRazor2::Client::Config::::find_homeRazor2::Client::Config::find_home
0000s0sRazor2::Client::Config::::find_userRazor2::Client::Config::find_user
0000s0sRazor2::Client::Config::::get_identRazor2::Client::Config::get_ident
0000s0sRazor2::Client::Config::::ident_fnRazor2::Client::Config::ident_fn
0000s0sRazor2::Client::Config::::my_readlinkRazor2::Client::Config::my_readlink
0000s0sRazor2::Client::Config::::newRazor2::Client::Config::new
0000s0sRazor2::Client::Config::::parse_valueRazor2::Client::Config::parse_value
0000s0sRazor2::Client::Config::::read_confRazor2::Client::Config::read_conf
0000s0sRazor2::Client::Config::::read_fileRazor2::Client::Config::read_file
0000s0sRazor2::Client::Config::::register_identityRazor2::Client::Config::register_identity
0000s0sRazor2::Client::Config::::save_identRazor2::Client::Config::save_ident
0000s0sRazor2::Client::Config::::write_confRazor2::Client::Config::write_conf
0000s0sRazor2::Client::Config::::write_fileRazor2::Client::Config::write_file
Call graph for these subroutines as a Graphviz dot language file.
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
11package Razor2::Client::Config;
12264µs272µs
# spent 59µs (46+13) within Razor2::Client::Config::BEGIN@12 which was called: # once (46µs+13µs) by base::import at line 12
use strict;
# spent 59µs making 1 call to Razor2::Client::Config::BEGIN@12 # spent 13µs making 1 call to strict::import
13271µs2267µs
# spent 146µs (25+121) within Razor2::Client::Config::BEGIN@13 which was called: # once (25µs+121µs) by base::import at line 13
use Data::Dumper;
# spent 146µs making 1 call to Razor2::Client::Config::BEGIN@13 # spent 121µs making 1 call to Exporter::import
14268µs2198µs
# spent 113µs (28+85) within Razor2::Client::Config::BEGIN@14 which was called: # once (28µs+85µs) by base::import at line 14
use vars qw( $VERSION );
# spent 113µs making 1 call to Razor2::Client::Config::BEGIN@14 # spent 85µs making 1 call to vars::import
152392µs24.84ms
# spent 4.67ms (4.15+515µs) within Razor2::Client::Config::BEGIN@15 which was called: # once (4.15ms+515µs) by base::import at line 15
use File::Copy;
# spent 4.67ms making 1 call to Razor2::Client::Config::BEGIN@15 # spent 172µs making 1 call to Exporter::import
16278µs124µs
# spent 24µs within Razor2::Client::Config::BEGIN@16 which was called: # once (24µs+0s) by base::import at line 16
use File::Spec;
# spent 24µs making 1 call to Razor2::Client::Config::BEGIN@16
17
1826.57ms118µs
# spent 18µs within Razor2::Client::Config::BEGIN@18 which was called: # once (18µs+0s) by base::import at line 18
use Razor2::Logger;
# spent 18µs making 1 call to Razor2::Client::Config::BEGIN@18
19
20#use base qw(Razor2::Logger);
21
22sub new {
23 my ($class) = @_;
24 return bless {}, $class;
25}
26
27#
28# figures out razorhome and razorconf file
29#
30sub 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#
119sub 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
147sub 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#
176EOFCLIENT
177 return $self->write_file($self->{razorconf}, $hash, 0, $clientheader);
178}
179
180
181sub 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
202sub 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
258sub 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
273sub 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
302sub 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
320sub 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
330sub 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
353sub 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
388sub 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
406sub 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#
422sub 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#
485sub 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
- -
556sub 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
578sub 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
61318µs1;
614
Report produced by the NYTProf 6.04 Perl profiler, developed by Tim Bunce based on work by Adam Kaplan and Salvador Fandiño García.