1# Copyright (c) 2016-2017, OARC, Inc. 2# Copyright (c) 2007, The Measurement Factory, Inc. 3# Copyright (c) 2007, Internet Systems Consortium, Inc. 4# All rights reserved. 5# 6# Redistribution and use in source and binary forms, with or without 7# modification, are permitted provided that the following conditions 8# are met: 9# 10# 1. Redistributions of source code must retain the above copyright 11# notice, this list of conditions and the following disclaimer. 12# 13# 2. Redistributions in binary form must reproduce the above copyright 14# notice, this list of conditions and the following disclaimer in 15# the documentation and/or other materials provided with the 16# distribution. 17# 18# 3. Neither the name of the copyright holder nor the names of its 19# contributors may be used to endorse or promote products derived 20# from this software without specific prior written permission. 21# 22# THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS 23# "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT 24# LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS 25# FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE 26# COPYRIGHT HOLDER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, 27# INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, 28# BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; 29# LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER 30# CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT 31# LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN 32# ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE 33# POSSIBILITY OF SUCH DAMAGE. 34 35package DSC::grapher::config; 36 37BEGIN { 38 use Exporter (); 39 use vars qw($VERSION @ISA @EXPORT @EXPORT_OK %EXPORT_TAGS); 40 $VERSION = '2.04'; 41 @ISA = qw(Exporter); 42 @EXPORT = qw( 43 &read_config 44 ); 45 %EXPORT_TAGS = ( ); 46 @EXPORT_OK = qw(); 47} 48use vars @EXPORT; 49use vars @EXPORT_OK; 50 51use IO::File; # for debugging 52 53END { } 54 55use strict; 56use warnings; 57 58my %CONFIG; 59 60sub read_config { 61 my $f = shift; 62 open(F, $f) || die "$f: $!\n"; 63 while (<F>) { 64 my @x = split; 65 next unless @x; 66 my $directive = shift @x; 67 if ($directive eq 'server') { 68 my $servername = shift @x; 69 push (@{$CONFIG{serverlist}}, $servername); 70 foreach my $t (@x) { 71 my $fn = $t; # fake name 72 my @rn = ($t); # real name 73 if ($fn =~ /^([^=]+)=(.*)$/) { 74 $fn = $1; 75 @rn = split(/,/, $2); 76 } 77 push (@{$CONFIG{servers}{$servername}}, $fn); 78 $CONFIG{nodemap}{$servername}{$fn} = \@rn; 79 } 80 } elsif ($directive =~ /windows$/) { 81 $CONFIG{$directive} = \@x; 82 } elsif ($directive eq 'embargo') { 83 $CONFIG{$directive} = $x[0]; 84 } elsif ($directive eq 'anonymize_ip') { 85 $CONFIG{$directive} = 1; 86 } elsif ($directive eq 'no_http_header') { 87 $CONFIG{$directive} = 1; 88 } elsif ($directive eq 'hide_nodes') { 89 $CONFIG{$directive} = 1; 90 } elsif ($directive eq 'timezone') { 91 $ENV{TZ} = $x[0]; 92 } elsif ($directive eq 'domain_list') { 93 my $listname = shift @x; 94 die "Didn't find list-name after domain_list" unless defined($listname); 95 push(@{$CONFIG{domain_list}{$listname}}, @x); 96 } elsif ($directive eq 'valid_domains') { 97 my $server = shift @x; 98 die "Didn't find server-name after valid_domains" unless defined($server); 99 my $listname = shift @x; 100 die "domain list-name $listname does not exist" 101 unless defined($CONFIG{domain_list}{$listname}); 102 $CONFIG{valid_domains}{$server} = $listname; 103 } elsif ($directive eq 'debug_file') { 104 my $fn = shift @x; 105 $CONFIG{debug_fh} = new IO::File("> $fn"); 106 } elsif ($directive eq 'debug_level') { 107 $CONFIG{debug_level} = shift @x; 108 } 109 } 110 close(F); 111 \%CONFIG; 112} 113 114sub get_valid_domains { 115 my $server = shift; 116 #print STDERR "get_valid_domains: server is $server\n"; 117 my $listname = $CONFIG{valid_domains}{$server}; 118 #print STDERR "get_valid_domains: listname is $listname\n"; 119 return (undef) unless defined ($listname); 120 return (undef) unless defined ($CONFIG{domain_list}{$listname}); 121 #print STDERR "get_valid_domains: $server valid domain list is $listname\n"; 122 @{$CONFIG{domain_list}{$listname}}; 123} 124 1251; 126