# -*- perl -*-

# Copyright (c) 2002 by Jeff Weisberg
# Author: Jeff Weisberg <argus @ tcp4me.com>
# Date: 2002-Apr-03 09:13 (EST)
# Function: config file reading
#
# $Id: Conf.pm,v 1.49 2005/11/25 17:11:36 jaw Exp $

# some bozo put a Config.pm in the standard perl dist
package Conf;
use strict;
use vars qw($doc %Config $has_errors);

%Config = ();		# misc top level global config data
$has_errors = 0;	# if we found errors, the web page will indicate such (global)
my $Top = undef;	# the Top pseudo-object
my @allfiles = ();	# all of the config files
my $timestamp = 0;	# time we last read the config files


$doc = {
    package => __PACKAGE__,
    file    => __FILE__,
    isa     => [ ],
    methods => {},
    conf    => {},
    fields  =>  {

	chmod_control => {
	    descr => 'control socket permissions (in octal)',
	    attrs => ['config', 'top'],
	    exmpl => '777',
	    versn => '3.1.3',
	},
	syslog => {
	    descr => 'syslog facility to use for syslogging if desired',
	    attrs => ['config', 'top'],
	    exmpl => 'daemon',
	    html  => 'troubleshooting',
	    callback => \&::xxx_openlog,
	},
	runatstartup => {
	    descr => 'command to run at startup',
	    attrs => ['config', 'top'],
	    versn => '3.2',
	},
	load_modules => {
	    descr => 'list of additional perl modules to load',
	    attrs => ['config', 'top'],
	    versn => '3.3',
	},
	lang => {
	    descr => 'override default language',
	    attrs => ['config', 'top'],
	    versn => '3.3',
	},
	test_port => {
	    descr => 'run a test server on the specified TCP port',
	    attrs => ['config', 'top'],
	    versn => '3.3',
	    exmpl => '3074',
	    html  => 'testport',
	    callback => sub { TestPort->Server::new_inet(shift) },
	},
	graphd_prog => {
	    descr => 'pathname of graphd program',
	    attrs => ['config', 'top'],
	    versn => '3.3',
	},
	picasso_prog => {
	    descr => 'pathname of picasso program',
	    attrs => ['config', 'top'],
	    versn => '3.3',
	},
	
################################################################
# experimental, undocumented features - for author's use only
################################################################
	_no_addtnl => {},	# suppress additional data on Top/about
	_save_less => {},	# delay commit of Stats files
	_ctl_debug => {},	# control channel debugging
	_hide_expr => {},	# supress experimental items from display config
	_hide_comm => {},	# supress community from display config
	_dont_ntfy => {},	# notifications are not sent
	_no_images => {},	# do not display graph images
	_test_mode => {},	# do not access datadir
    }
};


# read the config file(s)
sub readconfig {
    my $file = shift;
    my $me = {};
    my( @files );

    bless $me;
    $timestamp = $^T;
    $Service::n_services = 0;		      # this really doesn't belong here, but...
    # one file or directory of files?
    if( -d $file && -r _ && -x _ ){
	$me->{basedir} = $file;		      # includes will be relative to config dir
	opendir D, $file;
	@files = 
	  grep { !/^[\.\#]/ }		      # skip .file and #file
	  grep { !/(\.bkp|~)$/ } readdir D;   # and file.bkp and file~
	closedir D;
    }else{
	@files = ($file);
    }

    $me->{files} = [sort @files];
    $me->{openfiles} = [];
    
    $Top = $me->configure();
    
    $Top->{definedinfile} = $file;
    $Top->{definedonline} = 1;
    $Top->{definedattime} = $^T;
}

sub configure {
    my $me = shift;
    my( $top, $o, $nomoredata, $nomorespec, @kids );

    $Config{_test_mode} = 1 if $::opt_t || $::datadir eq '__' . 'DATADIR' . '__';
    $top = Group->new();
    $top->{type} = 'Group';
    $top->{name} = 'Top';
    $top->{i_am_top} = 1;	# used only to pretty print the config


    while( defined( $_ = $me->nextline() ) ){
	# print STDERR "  gotline: $_\n" if $::opt_d;
	eval {
	    if( /^(Group|Host)\s/i ){
		$nomoredata = 1;
		$nomorespec = 1;
		$me->ungetline($_);
		$o = Group::readconfig($me, $top);
		push @kids, $o if $o;
	    }
	    elsif( /^Alias\s/i ){
		$nomoredata = 1;
		$nomorespec = 1;
		$me->ungetline($_);
		$o = Alias::readconfig($me, $top);
		push @kids, $o if $o;
	    }
	    elsif( /^Method\s/i ){
		$nomoredata = 1;
		$me->ungetline($_);
	        NotMe::readconfig($me);
	    }
	    elsif( /^cron\s/i ){
		$me->ungetline($_);
	        my $c = UserCron::readconfig($me, $top);
		push @{ $top->{cronjobs} }, $c if $c;
	    }
	    elsif( /^Resolv/i ){
		$me->error( "Resolv block must appear before any Groups or Services" )
		    if $nomorespec;
		$nomoredata = 1;
		$me->ungetline( "Service $_" ); # magic!
		$o = Service::readconfig($me, undef);
	    }
	    elsif( /^DARP\s/i && $::HAVE_DARP ){
		# $me->error( "DARP block must appear before any Groups or Services" )
		#     if $nomorespec;
		# $nomoredata = 1;
		# XXX - enforce order after testing
		$me->ungetline($_);
	        DARP::readconfig($me);
	    }
	    
	    elsif( /:/ ){
		my ($k, $v) = split /:\s*/, $_, 2;
		if( $nomoredata ){
		    $me->warning( "additional data not permitted here (ignored)" );
		    next;
		}
		
		if( defined $Config{$k} && $k !~ /^_/ ){
		    $me->warning( "redefinition of parameter '$k'" );
		    $Config{$k} = $v;
		}else{
		    $Config{$k} = $v;
		    my $c = $doc->{fields}{$k}{callback};
		    $c->($v) if $c;
		}
	    }
	    else{
		eval{ $me->error( "Huh? This does not look like a vaild config entry: '$_'" ); };
		$me->eat_block() if /\{\s*$/;
		$top->{conferrs} ++;
		die $me;
	    }
	};
	if( $@ ){
	    # QQQ
	    die $@ if $@ != $me;
	}
    }

    push @{$top->{children}}, @kids;
    $top->config($me);
    
    return if $::opt_t;
    $top->clearcache();        # reclaim memory used by hasattr cache
    eval {
	$top->resolve_alii($me);
    };
    eval {
	$top->resolve_depends($me);
    };
    $top->jiggle_lightly();	# update object statuses
    $top->{sort} = 0;     	# top is not sorted
    $top->{overridable} = 0;
    $top->sort_children();

    $top;
}

sub eat_block {
    my $me = shift;

    while( defined( $_ = $me->nextline() ) ){
	print STDERR "  ignoring: $_\n" if $::opt_d;
	last if /^\s*\}/;
	$me->eat_block() if /\{\s*$/;
    }
}

sub error {
    my $me = shift;
    my $msg = shift;
    my( $m );

    $has_errors ++;
    $m = "ERROR: ";
    if( $me->{file} ){
	$m .= "in file '$me->{file}' on line $me->{line} - ";
    }
    $m .= $msg;
    ::loggit( $m, 1 );

    die $me;
    undef;
}

sub warning {
    my $me = shift;
    my $msg = shift;
    my( $m );

    $has_errors ++ if $Conf::Config{_test_mode};
    
    $m = "WARNING: ";
    if( $me->{file} ){
	$m .= "in file '$me->{file}' on line $me->{line} - ";
    }
    $m .= $msg;
    ::loggit( $m, 1 );
    undef;
}

sub openfile {
    my $me = shift;
    my $f  = shift;
    my( $ff, $fh );
    
    $me->{fd} = $fh = BaseIO::anon_fh();
    $me->{file} = undef;
    $me->{line} = undef;
    
    print STDERR "reading config file: $f\n" if $::opt_d;
    eval {
	if( $me->{basedir} && $f !~ m,^/, ){
	    $ff = "$me->{basedir}/$f";
	}else{
	    $ff = $f;
	}
	open( $fh, $ff ) ||
	    $me->error( "'$ff' is stubborn and refuses to open: $!" );
    };
    return undef if $@;

    # handle #!
    my $l = <$fh>;
    chop $l;
    if( $l =~ /^\#!\s*(.*)/ ){
	my $prog = $1;
	close $fh;

	print STDERR "reading config program: $prog $ff\n" if $::opt_d;
	eval {
	    open( $fh, "$prog $ff |" ) ||
		$me->error( "'$prog $ff' is stubborn and refuses to run: $!" );
	};
	return undef if $@;
	$me->{line} = 0;
    }else{
	$me->ungetline($l);
	$me->{line} = 1;
    }
    
    push @allfiles, $ff;
    $me->{file} = $f;
    
    1;
}

sub includefile {
    my $me = shift;
    my $file = shift;

    push @{$me->{openfiles}}, [$me->{fd}, $me->{file}, $me->{line}];
    $me->openfile( $file ) || $me->nextfile();
}

sub nextfile {
    my $me = shift;
    my( $f, $fh );
    $fh = $me->{fd};

    close $fh if $fh;

    if( @{$me->{openfiles}} ){
	($me->{fd}, $me->{file}, $me->{line}) = @{ pop @{$me->{openfiles}} };
	return 1;
    }
    
    while(1){
	$f = shift @{$me->{files}};
	return undef unless $f;
	print STDERR "next file: $f\n" if $::opt_d;
	next unless $me->openfile( $f );
	return 1;
    }
}

sub nextline {
    my $me = shift;
    my( $fh, $a );

    $a = '';
    while(1){

	while( 1 ){
	    $fh = $me->{fd};
	    if( defined($_ = $me->{prevline}) ){
		delete $me->{prevline};
	    }elsif( $fh ){
		$_ = <$fh>;
		$me->{line} ++;
	    }else{
		$_ = undef;
	    }
	    last unless defined $_;

	    chomp;
	    # need to be able to include a literal # in the config
	    # by saying \# and below convert \# -> #
	    s/\s*(?<!\\)\#.*$//;
	    s/^\s+//;
	    s/\s+$//;
	    next if /^\s*$/;
	    s/\\&//g;
	    s/\\n/\n/g;
	    s/\\r/\r/g;
	    s/\\x([0-9a-fA-F]{2})/chr(hex($1))/eg;
	    s/\\\#/\#/g;
	    # no, I don't want to s/\\(.)/$1/
	    # it will mess up regexes
	    
	    # handle include files
	    if( /^include \"(.*)\"/i ){
		$me->includefile( $1 );
		$fh = $me->{fd};
		next;
	    }
	    
	    $a .= $_;
	    if( $a =~ /\\$/ ){
		chop $a;
		next;
	    }
	    return $a;
	}
	$me->nextfile() || return undef;
    }
}

sub ungetline {
    my $me = shift;
    my $line = shift;

    $me->{prevline} = $line;
}

sub check_config_files {
    foreach my $f (@allfiles){
	my $t = (stat($f))[9];
	if( $t > $timestamp ){
	    # the file changed--restart
	    ::loggit( "config file '$f' changed - restarting", 1 );
	    kill 'HUP', $$;
	    last;
	}
    }
}

sub deconfigure {
    %Config = ();
    $Top = undef;
}

################################################################
# for testing - config from filehandle

sub testconfig {
    my $fd = shift;
    
    my $cf = bless {};
    $cf->{openfiles} = [ [ $fd, 'data', 1 ] ];

    $cf->configure();
}

################################################################
Doc::register( $doc );

# check for changes in config files every 5 minutes
Cron->new(
	  freq => 300,
	  text => 'check config files',
	  func => \&check_config_files,
	  );

1;

