inncheck

早期freebsd实现

#!/usr/bin/perl --
##  $Revision: 1.10 $
##  Sanity-check the configuration of an INN system
##  by Brendan Kehoe <[e-mail]> and Rich $alz.

$ST_MODE = 2;
$ST_UID  = 4;
$ST_GID  = 5;

## =()<$newsuser = '@<NEWSUSER>@';>()=
$newsuser = 'news';
## =()<$newsgroup = '@<NEWSGROUP>@';>()=
$newsgroup = 'news';

##  We use simple names, mapping them to the real filenames only when
##  we actually need a filename.
%paths = (
## =()<    'active',		'@<_PATH_ACTIVE>@',>()=
    'active',		'/var/spool/news/data/active',
## =()<    'archive',		'@<_PATH_ARCHIVEDIR>@',>()=
    'archive',		'/var/spool/news/news.archive',
## =()<    'badnews',		'@<_PATH_BADNEWS>@',>()=
    'badnews',		'/var/spool/news/spool/in.coming/bad',
## =()<    'batchdir',		'@<_PATH_BATCHDIR>@',>()=
    'batchdir',		'/var/spool/news/out.going',
## =()<    'control.ctl',	'@<_PATH_CONTROLCTL>@',>()=
    'control.ctl',	'/var/spool/news/data/control.ctl',
## =()<    'ctlprogs',		'@<_PATH_CONTROLPROGS>@',>()=
    'ctlprogs',		'/var/spool/news/data/ctlbin',
## =()<    'expire.ctl',	'@<_PATH_EXPIRECTL>@',>()=
    'expire.ctl',	'/var/spool/news/data/expire.ctl',
## =()<    'hosts.nntp',	'@<_PATH_INNDHOSTS>@',>()=
    'hosts.nntp',	'/var/spool/news/data/hosts.nntp',
## =()<    'inews',		'@<_PATH_INEWS>@',>()=
    'inews',		'/usr/contrib/news/inews',
## =()<    'inn.conf',		'@<_PATH_CONFIG>@',>()=
    'inn.conf',		'/var/spool/news/data/inn.conf',
## =()<    'innd',		'@<_PATH_INND>@',>()=
    'innd',		'/usr/contrib/news/innd',
## =()<    'innddir',		'@<_PATH_INNDDIR>@',>()=
    'innddir',		'/var/spool/news/data/innd',
## =()<    'inndstart',	'@<_PATH_INNDSTART>@',>()=
    'inndstart',	'/usr/contrib/news/inndstart',
## =()<    'moderators',	'@<_PATH_MODERATORS>@',>()=
    'moderators',	'/var/spool/news/data/moderators',
## =()<    'most_logs',	'@<_PATH_MOST_LOGS>@',>()=
    'most_logs',	'/var/spool/news/data',
## =()<    'newsbin',		'@<_PATH_NEWSBIN>@',>()=
    'newsbin',		'/usr/contrib/news',
## =()<    'newsboot',		'@<_PATH_NEWSBOOT>@',>()=
    'newsboot',		'/usr/contrib/news/rc.news',
## =()<    'newsfeeds',	'@<_PATH_NEWSFEEDS>@',>()=
    'newsfeeds',	'/var/spool/news/data/newsfeeds',
## =()<    'overview.fmt',	'@<_PATH_SCHEMA>@',>()=
    'overview.fmt',	'/var/spool/news/data/overview.fmt',
## =()<    'newslib',		'@<_PATH_NEWSLIB>@',>()=
    'newslib',		'/var/spool/news/data',
## =()<    'nnrp.access',	'@<_PATH_NNRPACCESS>@',>()=
    'nnrp.access',	'/var/spool/news/data/nnrp.access',
## =()<    'nnrpd',		'@<_PATH_NNRPD>@',>()=
    'nnrpd',		'/usr/contrib/news/nnrpd',
## =()<    'nntpsend.ctl',	'@<_PATH_NEWSLIB>@/nntpsend.ctl',>()=
    'nntpsend.ctl',	'/var/spool/news/data/nntpsend.ctl',
## =()<    'oldlogs',		'@<_PATH_MOST_LOGS>@/OLD',>()=
    'oldlogs',		'/var/spool/news/data/OLD',
## =()<    'parsectl',		'@<_PATH_PARSECTL>@',>()=
    'parsectl',		'/var/spool/news/data/parsecontrol',
## =()<    'passwd.nntp',	'@<_PATH_NNTPPASS>@',>()=
    'passwd.nntp',	'/var/spool/news/data/passwd.nntp',
## =()<    'rnews',		'@<_PATH_RNEWS>@',>()=
    'rnews',		'/usr/contrib/news/rnews',
## =()<    'rnewsprogs',	'@<_PATH_RNEWSPROGS>@',>()=
    'rnewsprogs',	'/usr/contrib/rnews',
## =()<    'spooltemp',		'@<_PATH_SPOOLTEMP>@',>()=
    'spooltemp',		'/var/spool/news/spool/in.coming/tmp',
## =()<    'spool',		'@<_PATH_SPOOL>@',>()=
    'spool',		'/var/spool/news/spool',
## =()<    'spoolnews',	'@<_PATH_SPOOLNEWS>@'>()=
    'spoolnews',	'/var/spool/news/spool/in.coming'
);

##  The sub's that check the config files.
%checklist = (
    'active',		'active',
    'control.ctl',	'control_ctl',
    'expire.ctl',	'expire_ctl',
    'hosts.nntp',	'hosts_nntp',
    'inn.conf',		'inn_conf',
    'moderators',	'moderators',
    'newsfeeds',	'newsfeeds',
    'overview.fmt',	'overview_fmt',
    'nnrp.access',	'nnrp_access',
    'nntpsend.ctl',	'nntpsend_ctl',
    'passwd.nntp',	'passwd_nntp'
);

##  The modes of the config files we can check.
%modes = (
    'active',		0644,
    'control.ctl',	0440,
    'expire.ctl',	0440,
    'hosts.nntp',	0440,
    'inn.conf',		0444,
    'moderators',	0444,
    'newsfeeds',	0444,
    'overview.fmt',	0444,
    'nnrp.access',	0440,
    'nntpsend.ctl',	0440,
    'passwd.nntp',	0440
);


sub
spacious
{
    local ($i);

    chop;
    study;
    if ( /^#/ || /^$/ ) {
	$i = 1;
    } elsif ( /^\s/ ) {
	print "$file:$line: starts with whitespace\n";
	$i = 1;
    } elsif ( /\s$/ ) {
	print "$file:$line: ends with whitespace\n";
	$i = 1;
    }
    $i;
}

##
##  These are the functions that verify each individual file, called
##  from the main code.  Each function gets <IN> as the open file, $line
##  as the linecount, and $file as the name of the file.
##


##
##  active
##
sub
active
{
    local ($group, $hi, $lo, $f, $alias, %groups, %aliases);

    input: while ( <IN> ) {
	next input if &spacious($file, ++$line);
	unless ( ($group, $hi, $lo, $f) = /^([^ ]+) (\d+) (\d+) (.+)$/ ) {
	    print "$file:$line: malformed line.\n";
	    next input;
	}

	print "$file:$line: group `$group' already appeared\n"
	    if $groups{$group}++;
	print "$file:$line: `$hi' <  '$lo'.\n"
	    if $hi < $lo && $lo != $hi + 1;

	next input if $f =~ /^[jmynx]$/;
	unless ( ($alias) = $f =~ /^=(.*)$/ ) {
	    print "$file:$line: bad flag `$f'.\n";
	    next input;
	}
	$aliases{$alias} = $line
	    unless defined $groups{$alias};
    }
    foreach $key ( keys %aliases ) {
	print "$file:$aliases{$group} aliased to unknown group `$key'.\n"
	    unless defined $groups{$key};
    }
    1;
}


##
##  control.ctl
##
%control'messages = (
    'all',		1,
    'checkgroups',	1,
    'ihave',		1,
    'newgroup',		1,
    'rmgroup',		1,
    'sendme',		1,
    'sendsys',		1,
    'senduuname',	1,
    'version',		1,
);
%control'actions = (
    'drop',		1,
    'log',		1,
    'mail',		1,
    'doit',		1,
    'doifarg',		1
);

sub
control_ctl
{
    local ($msg, $from, $ng, $act);

    input: while ( <IN> ) {
	next input if &spacious($file, ++$line);

	unless ( ($msg, $from, $ng, $act) =
		    /^([^:]+):([^:]+):([^:]+):(.+)$/ ) {
	    print "$file:$line: malformed line.\n";
	    next input;
	}
	if ( !defined $control'messages{$msg} ) {
	    print "$file:$line: unknown control message `$msg'.\n";
	    next input;
	}
	print "$file:$line: action for unknown control messages is `doit'.\n"
	    if $msg eq "default" && $act eq "doit";
	print "$file:$line: empty from field.\n"
	    if $from eq "";
	print "$file:$line: bad email address.\n"
	    if $from ne "*" && $from !~ /[@!]/;

	##  Perhaps check for conflicting rules, or warn about the last-match
	##  rule?  Maybe later...
	print "$file:$line: may not match groups properly.\n"
	    if $ng ne "*" && $ng !~ /\./;
	if ( $act !~ /([^=]+)(=.+)?/ ) {
	    print "$file:$line: malformed line.\n";
	    next input;
	}
	$act =~ s/=.*//;
	print "$file:$line: unknown action `$act'\n"
	    if !defined $control'actions{$act};
    }
    1;
}


##
##  expire.ctl
##
sub
expire_ctl
{
    local ($rem, $v, $def, $flag, $keep, $default, $purge);

    input: while ( <IN> ) {
	next input if &spacious($file, ++$line);

	if ( ($v) = m@/remember/:(.+)@ ) {
	    print "$file:$line: more than one /remember/ line.\n"
		if $rem++;
	    if ( $v !~ /[\d\.]+/ ) {
		print "$file:$line: illegal value `$v' for remember.\n";
		next input;
	    }
	    print "$file:$line: are you sure about your /remember/ value?\n"
		##  These are arbitrary "sane" values.
		if $v != 0 && ($v > 60.0 || $v < 5.0);
	    next input;
	}

	##  Could check for conflicting lines, but that's hard.
	unless ( ($pat, $flag, $keep, $default, $purge) =
         /^([^:])+:([^:]+):([\d\.]+|never):([\d\.]+|never):([\d\.]+|never)$/ ) {
	    print "$file:$line: malformed line.\n";
	    next input;
	}
	print "$file:$line: duplicate default line\n"
	    if $pat eq "*" && $flag eq "a" && $def++;
	print "$file:$line: unknown modflag `$flag'\n"
	    if $flag !~ /[mMuUaA]/;
	print "$file:$line: purge `$purge' younger than default `$default'.\n"
	    if $purge ne "never" && $default > $purge;
	print "$file:$line: default `$default' younger than keep `$keep'.\n"
	    if $default ne "never" && $keep ne "never" && $keep > $default;
    }
    1;
}


##
##  hosts.nntp
##
sub
hosts_nntp
{
    local ($host, $pass);

    input: while ( <IN> ) {
	next input if &spacious($file, ++$line);

	unless ( ($host, $pass) = /^([^:])+:(.*)$/ ) {
	    print "$file:$line: malformed line.\n";
	    next input;
	}

	print "$file:$line bad format for host `$host'.\n"
	    unless $host =~ /^[\w\.\-]+/ || $host =~ /^(\d+\.){2}\d+/;
    }
    1;
}


##
##  inn.conf
##
%inn_conf'fields = (
    'domain',		0,
    'fromhost',		0,
    'moderatormailer',	0,
    'organization',	0,
    'pathhost',		0,
    'server',		0,
    'mime-version',	0,
    'mime-contenttype',	0,
    'mime-encoding',	0
);
%inn_conf'optionals = (
    'mime-version',	0,
    'mime-contenttype',	0,
    'mime-encoding',	0
);

sub
inn_conf
{
    local ($k, $v, $hostname, $fqdn);

    chop($hostname = `hostname`);
    $fqdn = (gethostbyname($hostname))[0];
    foreach $key ( keys %inn_conf'fields ) {
	$inn_conf'fields{$key} = 0;
    }

    input: while ( <IN> ) {
	next input if &spacious($file, ++$line);

	unless ( ($k, $v) = /^(.*):\s*(.*)$/ ) {
	    print "$file:$line: malformed line.\n";
	    next input;
	}
	if ( !defined $inn_conf'fields{$k} ) {
	    print "$file:$line: Invalid field `$k'\n";
	    next input;
	}
	if ( ++$inn_conf'fields{$k} > 1 ) {
	    print "$file:$line: Duplicate field `$k'\n";
	    next input;
	}
	if ( $k eq "domain" ) {
	    print "$file:$line: domain (`$v') isn't local domain\n"
		if $fqdn =~ /[^\.]+\(\..*\)/ && $v ne $1;
	    print "$file:$line: domain should not have a leading period\n"
		if $v =~ /^\./;
	} elsif ( $k eq "fromhost" ) {
	    print "$file:$line: fromhost isn't a valid FQDN\n"
		if $v !~ /[\w\-]+\.[\w\-]+/;
	} elsif ( $k eq "moderatormailer" ) {
	    print "$file:$line: modmailer has bad address\n"
		if $v !~ /[\w\-]+\.[\w\-]+/ && $v ne "%s";
	} elsif ( $k eq "organization" ) {
	    print "$file:$line: org is blank\n"
		if $v eq "";
	} elsif ( $k eq "pathhost" ) {
	    print "$file:$line: pathhost has a ! in it\n"
		if $v =~ /!/;
	} elsif ( $k eq "server" ) {
	    print "$file:$line: server (`$v') isn't local hostname\n"
		if $pedantic && $fqdn !~ /^$v/;
	}
	else {
	    print "$file:$line: semi-known field\n";
	}
    }

    key: foreach $key ( keys %inn_conf'fields ) {
	next key if defined $inn_conf'fields{$key};
	next key if defined $inn_conf'optionals{$key};
	if ( $key eq "moderatormailer" ) {
	    printf "$file:$line: missing $key and no moderators file.\n"
		if ! -f $paths{"moderators"};
	} elsif ( $pedantic ) {
	    printf "$file:$line: missing $key\n";
	}
    }
    1;
}


##
##  moderators
##
sub
moderators
{
    local ($k, $v);

    input: while ( <IN> ) {
	next input if &spacious($file, ++$line);

	unless ( ($k, $v) = /^([\w\.\-\*]*):(.*)$/ ) {
	    print "$file:$line: malformed line.\n";
	    next input;
	}

	if ( $k eq "" || $v eq "" ) {
	    print "$file:$line: missing field\n";
	    next input;
	}
	print "$file:$line: not an email address\n"
	    if $pedantic && $v !~ /[@!]/;
	print "$file:$line: `$v' goes to local address\n"
	    if $pedantic && $v eq "%s";
	print "$file:$line: more than one %s in address field\n"
	    if $v =~ /%s.*%s/;
    }
    1;
}


##
##  newsfeeds
##
%newsfeeds'flags = (
    '<',	'^\d+$',
    'A',	'^[dp]+$',
    'B',	'^\d+(/\d+)?$',
    'F',	'^.+$',
    'G',	'^\d+$',
    'H',	'^\d+$',
    'I',	'^\d+$',
    'N',	'^[mu]$',
    'S',	'^\d+$',
    'T',	'^[cflmpx]$',
    'W',	'^[*nfgbmstDNHOR]*$',
);

sub
newsfeeds
{
    local ($next, $start, $me_empty, @muxes, %sites);
    local ($site, $pats, $dists, $flags, $param, $type, $k, $v, $defsub);
    local ($bang, $nobang, $prog);

    input: while ( <IN> ) {
	$line++;
	next input if /^$/;
	chop;
	print "$file:$line: starts with whitespace\n"
	    if /^\s+/;

	##  Read continuation lines.
	$start = $line;
	while ( /\\$/ ) {
	    chop;
	    chop($next = <IN>);
	    $line++;
	    $next =~ s/^\s*//;
	    $_ .= $next;
	}
	next input if /^#/;
	print "$file:$line: ends with whitespace\n"
	    if /\s+$/;

	unless ( ($site, $pats, $flags, $param) =
		    /^([^:]+):([^:]*):([^:]*):(.*)$/ ) {
	    print "$file:$line: malformed line.\n";
	    next input;
	}

	print "$file:$line: Newsfeed `$site' has whitespace in its name\n"
	    if $site =~ /\s/;

	print "$file:$start: ME has exclusions\n"
	    if $site =~ m@^ME/@;
	print "$file:$start: multiple slashes in exclusions for `$site'\n"
	    if $site =~ m@/.*/@;
	$site =~ s@([^/]*)/.*@$1@;
	print "$site, "
	    if $verbose;

	if ( $site eq "ME" ) {
	    $defsub = $pats;
	    $defsub =~ s@(.*)/.*@$1@;
	} elsif  ( $defsub ne "" ) {
	    $pats = "$defsub,$pats";
	}
	print "$file:$start: Multiple slashes in distribution for `$site'\n"
	    if $pats =~ m@/.*/@;

	if ( $site eq "ME" ) {
	    print "$file:$start: ME flags should be empty\n"
		if $flags ne "";
	    print "$file:$start: ME param should be empty\n"
		if $param ne "";
	    $me_empty = 1
		if $pats !~ "/.+";
	}

	##  If we don't have !junk,!control, give a helpful warning.
#	if ( $site ne "ME" && $pats =~ /!\*,/ ) {