scripts/inncheck.in

   1 #!@_PATH_PERL@ --
   2 ##  $Revision: 7748 $
   3 ##  Sanity-check the configuration of an INN system
   4 ##  by Brendan Kehoe <brendan@cygnus.com> and Rich $alz.
   5
   6 require "@LIBDIR@/innshellvars.pl" ;
   7
   8 $ST_MODE = 2;
   9 $ST_UID  = 4;
  10 $ST_GID  = 5;
  11
  12 $newsuser = '@NEWSUSER@';
  13 $newsgroup = '@NEWSGRP@';
  14
  15 ##  We use simple names, mapping them to the real filenames only when
  16 ##  we actually need a filename.
  17 %paths = (
  18     'active',           "$inn::pathdb/active",
  19     'archive',          "$inn::patharchive",
  20     'badnews',          "$inn::pathincoming/bad",
  21     'batchdir',         "$inn::pathoutgoing",
  22     'control.ctl',      "$inn::pathetc/control.ctl",
  23     'ctlprogs',         "$inn::pathcontrol",
  24     'expire.ctl',       "$inn::pathetc/expire.ctl",
  25     'history',          "$inn::pathdb/history",
  26     'incoming.conf',    "$inn::pathetc/incoming.conf",
  27     'inews',            "$inn::pathbin/inews",
  28     'inn.conf',         "$inn::pathetc/inn.conf",
  29     'innd',             "$inn::pathbin/innd",
  30     'innddir',          "$inn::pathrun",
  31     'inndstart',        "$inn::pathbin/inndstart",
  32     'moderators',       "$inn::pathetc/moderators",
  33     'most_logs',        "$inn::pathlog",
  34     'newsbin',          "$inn::pathbin",
  35     'newsboot',         "$inn::pathbin/rc.news",
  36     'newsfeeds',        "$inn::pathetc/newsfeeds",
  37     'overview.fmt',     "$inn::pathetc/overview.fmt",
  38     'newsetc',          "$inn::pathetc",
  39     'newslib',          "@LIBDIR@",
  40     'nnrpd',            "$inn::pathbin/nnrpd",
  41     'nntpsend.ctl',     "$inn::pathetc/nntpsend.ctl",
  42     'oldlogs',          "$inn::pathlog/OLD",
  43     'passwd.nntp',      "$inn::pathetc/passwd.nntp",
  44     'readers.conf',     "$inn::pathetc/readers.conf",
  45     'rnews',            "$inn::pathbin/rnews",
  46     'rnewsprogs',       "$inn::pathbin/rnews.libexec",
  47     'spooltemp',        "$inn::pathtmp",
  48     'spool',            "$inn::patharticles",
  49     'spoolnews',        "$inn::pathincoming"
  50 );
  51
  52 ##  The sub's that check the config files.
  53 %checklist = (
  54     'active',           'active',
  55     'control.ctl',      'control_ctl',
  56     'expire.ctl',       'expire_ctl',
  57     'incoming.conf',    'incoming_conf',
  58     'inn.conf',         'inn_conf',
  59     'moderators',       'moderators',
  60     'newsfeeds',        'newsfeeds',
  61     'overview.fmt',     'overview_fmt',
  62     'nntpsend.ctl',     'nntpsend_ctl',
  63     'passwd.nntp',      'passwd_nntp',
  64     'readers.conf',     'readers_conf'
  65 );
  66
  67 ##  The modes of the config files we can check.
  68 %modes = (
  69     'active',           @FILEMODE@,
  70     'control.ctl',      0644,
  71     'expire.ctl',       0644,
  72     'incoming.conf',    0640,
  73     'inn.conf',         0644,
  74     'moderators',       0644,
  75     'newsfeeds',        0644,
  76     'overview.fmt',     0644,
  77     'nntpsend.ctl',     0644,
  78     'passwd.nntp',      0640,
  79     'readers.conf',     0644
  80 );
  81
  82
  83 sub
  84 spacious
  85 {
  86     local ($i);
  87
  88     chop;
  89     study;
  90     if ( /^#/ || /^$/ ) {
  91         $i = 1;
  92     } elsif ( /^\s/ ) {
  93         print "$file:$line: starts with whitespace\n";
  94         $i = 1;
  95     } elsif ( /\s$/ ) {
  96         print "$file:$line: ends with whitespace\n";
  97         $i = 1;
  98     }
  99     $i;
 100 }
 101 \f
 102 ##
 103 ##  These are the functions that verify each individual file, called
 104 ##  from the main code.  Each function gets <IN> as the open file, $line
 105 ##  as the linecount, and $file as the name of the file.
 106 ##
 107
 108
 109 ##
 110 ##  active
 111 ##
 112 sub
 113 active
 114 {
 115     local ($group, $hi, $lo, $f, $alias, %groups, %aliases);
 116
 117     input: while ( <IN> ) {
 118         $line++;
 119         unless ( ($group, $hi, $lo, $f) = /^([^ ]+) (\d+) (\d+) (.+)\n$/ ) {
 120             print "$file:$line: malformed line.\n";
 121             next input;
 122         }
 123
 124         print "$file:$line: group `$group' already appeared\n"
 125             if $groups{$group}++;
 126         print "$file:$line: `$hi' <  '$lo'.\n"
 127             if $hi < $lo && $lo != $hi + 1;
 128
 129         next input if $f =~ /^[jmynx]$/;
 130         unless ( ($alias) = $f =~ /^=(.*)$/ ) {
 131             print "$file:$line: bad flag `$f'.\n";
 132             next input;
 133         }
 134         if ($alias eq "") {
 135             print "$file:$line: empty alias.\n";
 136             next input;
 137         }
 138         $aliases{$alias} = $line
 139             unless defined $groups{$alias};
 140     }
 141     foreach $key ( keys %aliases ) {
 142         print "$file:$aliases{$group} aliased to unknown group `$key'.\n"
 143             unless defined $groups{$key};
 144     }
 145     1;
 146 }
 147
 148
 149 ##
 150 ##  control.ctl
 151 ##
 152 %control'messages = (
 153     'all',              1,
 154     'checkgroups',      1,
 155     'ihave',            1,
 156     'newgroup',         1,
 157     'rmgroup',          1,
 158     'sendme',           1,
 159     'sendsys',          1,
 160     'senduuname',       1,
 161     'version',          1,
 162 );
 163 %control'actions = (
 164     'drop',             1,
 165     'log',              1,
 166     'mail',             1,
 167     'doit',             1,
 168     'doifarg',          1,
 169     'verify',           1
 170 );
 171
 172 sub
 173 control_ctl
 174 {
 175     local ($msg, $from, $ng, $act);
 176
 177     input: while ( <IN> ) {
 178         next input if &spacious($file, ++$line);
 179
 180         unless ( ($msg, $from, $ng, $act) =
 181                     /^([^:]+):([^:]+):([^:]+):(.+)$/ ) {
 182             print "$file:$line: malformed line.\n";
 183             next input;
 184         }
 185         if ( !defined $control'messages{$msg} ) {
 186             print "$file:$line: unknown control message `$msg'.\n";
 187             next input;
 188         }
 189         print "$file:$line: action for unknown control messages is `doit'.\n"
 190             if $msg eq "default" && $act eq "doit";
 191         print "$file:$line: empty from field.\n"
 192             if $from eq "";
 193         print "$file:$line: bad email address.\n"
 194             if $from ne "*" && $from !~ /[@!]/;
 195
 196         ##  Perhaps check for conflicting rules, or warn about the last-match
 197         ##  rule?  Maybe later...
 198         print "$file:$line: may not match groups properly.\n"
 199             if $ng ne "*" && $ng !~ /\./;
 200         if ( $act !~ /([^=]+)(=.+)?/ ) {
 201             print "$file:$line: malformed line.\n";
 202             next input;
 203         }
 204         $act =~ s/=.*//;
 205         $act = "verify" if ($act =~ /^verify-.+/) ;
 206         print "$file:$line: unknown action `$act'\n"
 207             if !defined $control'actions{$act};
 208     }
 209     1;
 210 }
 211
 212
 213 ##
 214 ##  expire.ctl
 215 ##
 216 sub
 217 expire_ctl
 218 {
 219     local ($rem, $v, $def, $class, $pat, $flag, $keep, $default, $purge, $groupbaseexpiry);
 220
 221     $groupbaseexpiry = $inn::groupbaseexpiry;
 222     $groupbaseexpiry =~ tr/A-Z/a-z/;
 223     input: while ( <IN> ) {
 224         next input if &spacious($file, ++$line);
 225
 226         if ( ($v) = m@/remember/:(.+)@ ) {
 227             print "$file:$line: more than one /remember/ line.\n"
 228                 if $rem++;
 229             if ( $v !~ /[\d\.]+/ ) {
 230                 print "$file:$line: illegal value `$v' for remember.\n";
 231                 next input;
 232             }
 233             print "$file:$line: are you sure about your /remember/ value?\n"
 234                 ##  These are arbitrary "sane" values.
 235                 if $v != 0 && ($v > 60.0 || $v < 5.0);
 236             next input;
 237         }
 238
 239         ##  Could check for conflicting lines, but that's hard.
 240         if ($groupbaseexpiry =~ /^true$/ || $groupbaseexpiry =~ /^yes$/ ||
 241             $groupbaseexpiry =~ /^on$/) {
 242             unless ( ($pat, $flag, $keep, $default, $purge) =
 243              /^([^:])+:([^:]+):([\d\.]+|never):([\d\.]+|never):([\d\.]+|never)$/ ) {
 244                 print "$file:$line: malformed line.\n";
 245                 next input;
 246             }
 247             print "$file:$line: duplicate default line\n"
 248                 if $pat eq "*" && $flag eq "a" && $def++;
 249             print "$file:$line: unknown modflag `$flag'\n"
 250                 if $flag !~ /[mMuUaAxX]/;
 251         } else {
 252             unless ( ($class, $keep, $default, $purge) =
 253              /^(\d+):([\d\.]+|never):([\d\.]+|never):([\d\.]+|never)$/ ) {
 254                 print "$file:$line: malformed line.\n";
 255                 next input;
 256             }
 257             print "$file:$line: invalid class\n"
 258                 if $class < 0;
 259         }
 260         print "$file:$line: purge `$purge' younger than default `$default'.\n"
 261             if $purge ne "never" && $default > $purge;
 262         print "$file:$line: default `$default' younger than keep `$keep'.\n"
 263             if $default ne "never" && $keep ne "never" && $keep > $default;
 264     }
 265     1;
 266 }
 267
 268
 269 ##
 270 ##  incoming.conf
 271 ##
 272 sub
 273 incoming_conf
 274 {
 275     1;
 276 }
 277
 278
 279 ##
 280 ##  inn.conf
 281 ##
 282 sub
 283 inn_conf
 284 {
 285     system ("$inn::pathbin/innconfval", '-C');
 286
 287 #    if ( $k eq "domain" ) {
 288 #        print "$file:$line: domain (`$v') isn't local domain\n"
 289 #            if $fqdn =~ /[^\.]+\(\..*\)/ && $v ne $1;
 290 #        print "$file:$line: domain should not have a leading period\n"
 291 #            if $v =~ /^\./;
 292 #    } elsif ( $k eq "fromhost" ) {
 293 #        print "$file:$line: fromhost isn't a valid FQDN\n"
 294 #            if $v !~ /[\w\-]+\.[\w\-]+/;
 295 #    } elsif ( $k eq "moderatormailer" ) {
 296 #        # FIXME: shouldn't warn about blank lines if the
 297 #        # moderators file exists
 298 #        print "$file:$line: moderatormailer has bad address\n"
 299 #            if $v !~ /[\w\-]+\.[\w\-]+/ && $v ne "%s";
 300 #    } elsif ( $k eq "organization" ) {
 301 #        print "$file:$line: org is blank\n"
 302 #            if $v eq "";
 303 #    } elsif ( $k eq "pathhost" ) {
 304 #        print "$file:$line: pathhost has a ! in it\n"
 305 #            if $v =~ /!/;
 306 #    } elsif ( $k eq "pathalias" ) {
 307 #        print "$file:$line: pathalias has a ! in it\n"
 308 #            if $v =~ /!/;
 309 #    } elsif ( $k eq "pathcluster" ) {
 310 #        print "$file:$line: pathcluster has a ! in it\n"
 311 #            if $v =~ /!/;
 312 #    } elsif ( $k eq "server" ) {
 313 #        print "$file:$line: server (`$v') isn't local hostname\n"
 314 #            if $pedantic && $fqdn !~ /^$v/;
 315 #    }
 316 #
 317 #    if ( $key eq "moderatormailer" ) {
 318 #        printf "$file:$line: missing $key and no moderators file.\n"
 319 #            if ! -f $paths{"moderators"};
 320 #    }
 321
 322     1;
 323 }
 324
 325
 326 ##
 327 ##  moderators
 328 ##
 329 sub
 330 moderators
 331 {
 332     local ($k, $v);
 333
 334     input: while ( <IN> ) {
 335         next input if &spacious($file, ++$line);
 336
 337         unless ( ($k, $v) = /^([^:]+):(.+)$/ ) {
 338             print "$file:$line: malformed line.\n";
 339             next input;
 340         }
 341
 342         if ( $k eq "" || $v eq "" ) {
 343             print "$file:$line: missing field\n";
 344             next input;
 345         }
 346         print "$file:$line: not an email address\n"
 347             if $pedantic && $v !~ /[@!]/;
 348         print "$file:$line: `$v' goes to local address\n"
 349             if $pedantic && $v eq "%s";
 350         print "$file:$line: more than one %s in address field\n"
 351             if $v =~ /%s.*%s/;
 352     }
 353     1;
 354 }
 355
 356
 357 ##
 358 ##  newsfeeds
 359 ##
 360 %newsfeeds'flags = (
 361     '<',        '^\d+$',
 362     '>',        '^\d+$',
 363     'A',        '^[cCdeoOp]+$',
 364     'B',        '^\d+(/\d+)?$',
 365     'C',        '^\d+$',
 366     'F',        '^.+$',
 367     'G',        '^\d+$',
 368     'H',        '^\d+$',
 369     'I',        '^\d+$',
 370     'N',        '^[mu]$',
 371     'O',        '^\S+$',
 372     'P',        '^\d+$',
 373     'Q',        '^@?\d+(-\d+)?/\d+(_\d+)?$',
 374     'S',        '^\d+$',
 375     'T',        '^[cflmpx]$',
 376     'W',        '^[befghmnpst*DGHNPOR]*$',
 377 );
 378
 379 sub
 380 newsfeeds
 381 {
 382     local ($next, $start, $me_empty, @muxes, %sites);
 383     local ($site, $pats, $dists, $flags, $param, $type, $k, $v, $defsub);
 384     local ($bang, $nobang, $prog, $dir);
 385
 386     input: while ( <IN> ) {
 387         $line++;
 388         next input if /^$/;
 389         chop;
 390         print "$file:$line: starts with whitespace\n"
 391             if /^\s+/;
 392
 393         ##  Read continuation lines.
 394         $start = $line;
 395         while ( /\\$/ ) {
 396             chop;
 397             chop($next = <IN>);
 398             $line++;
 399             $next =~ s/^\s*//;
 400             $_ .= $next;
 401         }
 402         next input if /^#/;
 403         print "$file:$line: ends with whitespace\n"
 404             if /\s+$/;
 405
 406         # Catch a variable setting.
 407         if ( /^\$([A-Za-z0-9]+)=/ ) {
 408             print "$file:$line: variable name too long\n"
 409                 if length ($1) > 31;
 410             next input;
 411         }
 412
 413         unless ( ($site, $pats, $flags, $param) =
 414                     /^([^:]+):([^:]*):([^:]*):(.*)$/ ) {
 415             print "$file:$line: malformed line.\n";
 416             next input;
 417         }
 418
 419         print "$file:$line: Newsfeed `$site' has whitespace in its name\n"
 420             if $site =~ /\s/;
 421         print "$file:$line: comma-space in site name\n"
 422             if $site =~ m@, @;
 423         print "$file:$line: comma-space in subscription list\n"
 424             if $pats =~ m@, @;
 425         print "$file:$line: comma-space in flags\n"
 426             if $flags =~ m@, @;
 427
 428         print "$file:$start: ME has exclusions\n"
 429             if $site =~ m@^ME/@;
 430         print "$file:$start: multiple slashes in exclusions for `$site'\n"
 431             if $site =~ m@/.*/@;
 432         $site =~ s@([^/]*)/.*@$1@;
 433         print "$site, "
 434             if $verbose;
 435
 436         if ( $site eq "ME" ) {
 437             $defsub = $pats;
 438             $defsub =~ s@(.*)/.*@$1@;
 439         } elsif  ( $defsub ne "" ) {
 440             $pats = "$defsub,$pats";
 441         }
 442         print "$file:$start: Multiple slashes in distribution for `$site'\n"
 443             if $pats =~ m@/.*/@;
 444
 445         if ( $site eq "ME" ) {
 446             print "$file:$start: ME flags should be empty\n"
 447                 if $flags ne "";
 448             print "$file:$start: ME param should be empty\n"
 449                 if $param ne "";
 450             $me_empty = 1
 451                 if $pats !~ "/.+";
 452         }
 453
 454         ##  If we don't have !junk,!control, give a helpful warning.
 455 #       if ( $site ne "ME" && $pats =~ /!\*,/ ) {
 456 #           print "$file:$start: consider adding !junk to $site\n"
 457 #               if $pats !~ /!junk/;
 458 #           print "$file:$start: consider adding !control to $site\n"
 459 #               if $pats !~ /!control/;
 460 #       }
 461
 462         ##  Check distributions.
 463         if ( ($dists) = $pats =~ m@.*/(.*)@ ) {
 464             $bang = $nobang = 0;
 465             dist: foreach $d ( split(/,/, $dists) ) {
 466                 if ( $d =~ /^!/ ) {
 467                     $bang++;
 468                 }
 469                 else {
 470                     $nobang++;
 471                 }
 472                 print "$file:$start: questionable distribution `$d'\n"
 473                     if $d !~ /^!?[a-z0-9-]+$/;
 474             }
 475             print "$file:$start: both ! and non-! distributions\n"
 476                 if $bang && $nobang;
 477         }
 478         $type = "f";
 479         flag: foreach $flag ( split(/,/, $flags) ) {
 480             ($k, $v) = $flag =~ /(.)(.*)/;
 481             if ( !defined $newsfeeds'flags{$k} ) {
 482                 print "$file:$start: unknown flag `$flag'\n";
 483                 next flag;
 484             }
 485             if ( $v !~ /$newsfeeds'flags{$k}/ ) {
 486                 print "$file:$start: bad value `$v' for flag `$k'\n";
 487                 next flag;
 488             }
 489             $type = $v
 490                 if $k eq "T";
 491         }
 492
 493         ##  Warn about multiple feeds.
 494         if ( !defined $sites{$site} ) {
 495             $sites{$site} = $type;
 496         } elsif ( $sites{$site} ne $type ) {
 497             print "$file:$start: feed $site multiple conflicting feeds\n";
 498         }
 499
 500         if ( $type =~ /[cpx]/ ) {
 501             $prog = $param;
 502             $prog =~ s/\s.*//;
 503             print "$file:$start: relative path for $site\n"
 504                 if $prog !~ m@^/@;
 505             print "$file:$start: `$prog' is not executable for $site\n"
 506                 if ! -x $prog;
 507         }
 508         if ( $type eq "f" && $param =~ m@/@ ) {
 509             $dir = $param;
 510             $dir =~ s@(.*)/.*@$1@;
 511             $dir = $paths{'batchdir'} . "/" . $dir
 512                 unless $dir =~ m@^/@;
 513             print "$file:$start: directory `$dir' does not exist for $site\n"
 514                 if ! -d $dir;
 515         }
 516
 517         ##  If multiplex target not known, add to multiplex list.
 518         push(@muxes, "$start: undefined multiplex `$param'")
 519             if $type eq "m" && !defined $sites{$param};
 520     }
 521
 522     ##  Go through and make sure all referenced multiplex exist.
 523     foreach (@muxes) {
 524         print "$file:$_\n"
 525             if /`(.*)'/ && !defined $sites{$1};
 526     }
 527     print "$file:0: warning you accept all incoming article distributions\n"
 528         if !defined $sites{"ME"} || $me_empty;
 529
 530     print "done.\n"
 531         if $verbose;
 532     1;
 533 }
 534
 535
 536 ##
 537 ##  overview.fmt
 538 ##
 539 #%overview_fmtheaders = (
 540 #    'Approved',                1,
 541 #    'Bytes',           1,
 542 #    'Control',         1,
 543 #    'Date',            1,
 544 #    'Distribution',    1,
 545 #    'Expires',         1,
 546 #    'From',            1,
 547 #    'Lines',           1,
 548 #    'Message-ID',      1,
 549 #    'Newsgroups',      1,
 550 #    'Path',            1,
 551 #    'References',      1,
 552 #    'Reply-To',                1,
 553 #    'Sender',          1,
 554 #    'Subject',         1,
 555 #    'Supersedes',      1,
 556 #);
 557
 558 sub
 559 overview_fmt
 560 {
 561     local ($header, $mode, $sawfull);
 562
 563     $sawfull = 0;
 564     input: while ( <IN> ) {
 565         next input if &spacious($file, ++$line);
 566
 567         unless ( ($header, $mode) = /^([^:]+):([^:]*)$/ ) {
 568             print "$file:$line: malformed line.\n";
 569             next input;
 570         }
 571
 572         #print "$file:$line: unknown header `$header'\n"
 573         #    if !defined $overview_fmtheaders{$header};
 574         if ( $mode eq "full" ) {
 575             $sawfull++;
 576         } elsif ( $mode eq "" ) {
 577             print "$file:$line: short header `$header' appears after full one\n"
 578                 if $sawfull;
 579         } else {
 580             print "$file:$line: unknown mode `$mode'\n";
 581         }
 582     }
 583     1;
 584 }
 585
 586
 587 ##
 588 ##  nntpsend.ctl
 589 ##
 590 sub
 591 nntpsend_ctl
 592 {
 593     local ($site, $fqdn, $flags, $f, $v);
 594
 595     input: while ( <IN> ) {
 596         next input if &spacious($file, ++$line);
 597
 598         ##  Ignore the size info for now.
 599         unless ( ($site, $fqdn, $flags) =
 600                     /^([\w\-\.]+):([^:]*):[^:]*:([^:]*)$/ ) {
 601             print "$file:$line: malformed line.\n";
 602             next input;
 603         }
 604         print "$file:$line: FQDN is empty for `$site'\n"
 605             if $fqdn eq "";
 606
 607         next input if $flags eq "";
 608         flag: foreach (split(/ /, $flags)) {
 609             unless ( ($f, $v) = /^-([adrvtTpSP])(.*)$/ ) {
 610                 print "$file:$line: unknown argument for `$site'\n";
 611                 next flag;
 612             }
 613             print "$file:$line: unknown argument to option `$f': $flags\n"
 614                 if ( $f eq "t" || $f eq "T" || $f eq "P") && $v !~ /\d+/;
 615         }
 616     }
 617     1;
 618 }
 619
 620
 621 ##
 622 ##  passwd.nntp
 623 ##
 624 sub
 625 passwd_nntp
 626 {
 627     local ($name, $pass);
 628
 629     input: while ( <IN> ) {
 630         next input if &spacious($file, ++$line);
 631
 632         unless ( ($name, $pass) = /[\w\-\.]+:(.*):(.*)(:authinfo)?$/ ) {
 633             next input;
 634             print "$file:$line: malformed line.\n";
 635         }
 636         print "$file:$line: username/password must both be blank or non-blank\n"
 637             if ( $name eq "" && $pass ne "" ) || ($name ne "" && $pass eq "");
 638     }
 639     1;
 640 }
 641
 642
 643 ##
 644 ##  readers.conf
 645 ##
 646 sub
 647 readers_conf
 648 {
 649     1;
 650 }
 651 \f
 652
 653 ##
 654 ##  Routines to check permissions
 655 ##
 656
 657 ##  Given a file F, check its mode to be M, and its ownership to be by the
 658 ##  user U in the group G.  U and G have defaults.
 659 sub
 660 checkperm
 661 {
 662     local ($f, $m, $u, $g) = ( @_, $newsuser, $newsgroup);
 663     local (@sb, $owner, $group, $mode);
 664
 665     die "Internal error, undefined name in perm from ", (caller(0))[2], "\n"
 666         if !defined $f;
 667     die "Internal error, undefined mode in perm from ", (caller(0))[2], "\n"
 668         if !defined $m;
 669
 670     if ( ! -e $f ) {
 671         print "$pfx$f:0: missing\n";
 672     }
 673     else {
 674         @sb = stat _;
 675         $owner = (getpwuid($sb[$ST_UID]))[0];
 676         $group = (getgrgid($sb[$ST_GID]))[0];
 677         $mode  = $sb[$ST_MODE] & ~0770000;
 678
 679         ##  Ignore setgid bit on directories.
 680         $mode &= ~0777000
 681             if -d _;
 682
 683         if ( $owner ne $u ) {
 684             print "$pfx$f:0: owned by $owner, should be $u\n";
 685             print "chown $u $f\n"
 686                 if $fix;
 687         }
 688         if ( $group ne $g ) {
 689             print "$pfx$f:0: in group $group, should be $g\n";
 690             print "chgrp $g $f\n"
 691                 if $fix;
 692         }
 693         if ( $mode ne $m ) {
 694             printf "$pfx$f:0: mode %o, should be %o\n", $mode, $m;
 695             printf "chmod %o $f\n", $m
 696                 if $fix;
 697         }
 698     }
 699 }
 700
 701 ##  Return 1 if the Intersection of the files in the DIR and FILES is empty.
 702 ##  Otherwise, report an error for each illegal file, and return 0.
 703 sub
 704 intersect
 705 {
 706     local ($dir, @files) = @_;
 707     local (@in, %dummy, $i);
 708
 709     if ( !opendir(DH, $dir) ) {
 710         print "$pfx$dir:0: can't open directory\n";
 711     }
 712     else {
 713         @in = grep($_ ne "." && $_ ne "..", readdir(DH));
 714         closedir(DH);
 715     }
 716
 717     $i = 1;
 718     if ( scalar(@in) ) {
 719         foreach ( @files ) {
 720             $dummy{$_}++;
 721         }
 722         foreach ( grep ($dummy{$_} == 0, @in) ) {
 723             print "$pfx$dir:0: ERROR: illegal file `$_' in directory\n";
 724             $i = 0;
 725         }
 726     }
 727     $i;
 728 }
 729
 730 @directories = (
 731     'archive', 'badnews', 'batchdir', 'ctlprogs', 'most_logs', 'newsbin',
 732     'newsetc', 'newslib', 'oldlogs', 'rnewsprogs', 'spooltemp', 'spool', 'spoolnews'
 733 );
 734 @rnews_programs = (
 735     'c7unbatch', 'decode', 'encode', 'gunbatch'
 736 );
 737 @newsbin_public = (
 738     'archive', 'batcher', 'buffchan', 'convdate', 'cvtbatch', 'expire',
 739     'filechan', 'getlist', 'grephistory', 'innconfval', 'innxmit',
 740     'makehistory', 'nntpget', 'overchan', 'prunehistory', 'shlock',
 741     'shrinkfile'
 742 );
 743 @newsbin_private = (
 744     'ctlinnd', 'expirerm', 'inncheck', 'innstat', 'innwatch',
 745     'news.daily', 'nntpsend', 'scanlogs', 'sendbatch',
 746     'tally.control', 'writelog',
 747     'send-ihave', 'send-nntp', 'send-uucp'
 748 );
 749 #@newslib_private_read = (
 750 #    'innlog.pl'
 751 #);
 752
 753 ## The modes for the various programs.
 754 %prog_modes = (
 755     'inews',             @INEWSMODE@,
 756     'innd',              0550,
 757     'newsboot',          0550,
 758     'nnrpd',             0555,
 759     'rnews',             @RNEWSMODE@,
 760 );
 761
 762 ##  Check the permissions of nearly every file in an INN installation.
 763 sub
 764 check_all_perms
 765 {
 766     local ($rnewsprogs) = $paths{'rnewsprogs'};
 767     local ($newsbin) = $paths{'newsbin'};
 768     local ($newslib) = $paths{'newslib'};
 769
 770     foreach ( @directories ) {
 771         &checkperm($paths{$_}, 0755);
 772     }
 773     &checkperm($paths{'innddir'}, 0750);
 774     foreach ( keys %prog_modes ) {
 775         &checkperm($paths{$_}, $prog_modes{$_});
 776     }
 777     &checkperm($paths{'inndstart'}, 04550, 'root', $newsgroup);
 778     foreach ( keys %paths ) {
 779         &checkperm($paths{$_}, $modes{$_})
 780             if defined $modes{$_};
 781     }
 782     &checkperm($paths{'history'}, 0644);
 783     # Commented out for now since it depends on the history type.
 784     #&checkperm($paths{'history'} . ".dir", 0644);
 785     #&checkperm($paths{'history'} . ".index", 0644);
 786     #&checkperm($paths{'history'} . ".hash", 0644);
 787     #foreach ( @newslib_private_read ) {
 788     #   &checkperm("$newslib/$_", 0440);
 789     #}
 790     foreach ( @newsbin_private ) {
 791         &checkperm("$newsbin/$_", 0550);
 792     }
 793     foreach ( @newsbin_public ) {
 794         &checkperm("$newsbin/$_", 0555);
 795     }
 796     foreach ( @rnews_programs ) {
 797         &checkperm("$rnewsprogs/$_", 0555);
 798     }
 799
 800     ##  Also make sure that @rnews_programs are the *only* programs in there;
 801     ##  anything else is probably someone trying to spoof rnews into being bad.
 802     &intersect($rnewsprogs, @rnews_programs);
 803
 804     1;
 805 }
 806
 807 \f
 808 ##
 809 ##  Parsing, main routine.
 810 ##
 811
 812 sub
 813 Usage
 814 {
 815     local ($i) = 0;
 816
 817     print "Usage error: @_.\n";
 818     print
 819 "Usage:
 820         $program [-v] [-noperm] [-pedantic] [-perms [-fix] ] [-a|file...]
 821 File to check may be followed by \"=path\" to use the specified path.  All
 822 files are checked if -a is used or if -perms is not used.  Files that may
 823 be checked are:\n";
 824     foreach ( sort(keys %checklist) ) {
 825         printf "     %-20s", $_;
 826         if ( ++$i == 3) {
 827             print "\n";
 828             $i = 0;
 829         }
 830     }
 831     print "\n"
 832         if $i;
 833     exit 0;
 834 }
 835
 836
 837 sub
 838 parse_flags
 839 {
 840     $all = 0;
 841     $fix = 0;
 842     $perms = 0;
 843     $noperms = 0;
 844     $verbose = 0;
 845     @todo = ();
 846
 847     arg: foreach ( @ARGV ) {
 848         if ( /-a/ ) {
 849             $all++;
 850             next arg;
 851         }
 852         if ( /^-v/ ) {
 853             $verbose++;
 854             next arg;
 855         }
 856         if ( /^-ped/ ) {
 857             $pedantic++;
 858             next arg;
 859         }
 860         if ( /^-f/ ) {
 861             $fix++;
 862             next arg;
 863         }
 864         if ( /^-per/ ) {
 865             $perms++;
 866             next arg;
 867         }
 868         if ( /^-noperm/ ) {
 869             $noperms++;
 870             next arg;
 871         }
 872         if ( /^-/ ) {
 873             &Usage("Unknown flag `$_'");
 874         }
 875         if ( ($k, $v) = /(.*)=(.*)/ ) {
 876             &Usage("Can't check `$k'")
 877                 if !defined $checklist{$k};
 878             push(@todo, $k);
 879             $paths{$k} = $v;
 880             next arg;
 881         }
 882         &Usage("Can't check `$_'")
 883             if !defined $checklist{$_};
 884         push(@todo, $_);
 885     }
 886
 887     &Usage("Can't use `-fix' without `-perm'")
 888         if $fix && !$perms;
 889     &Usage("Can't use `-noperm' with `-perm'")
 890         if $noperms && $perms;
 891     $pfx = $fix ? '# ' : '';
 892
 893     @todo = grep(defined $checklist{$_}, sort(keys %paths))
 894         if $all || (scalar(@todo) == 0 && ! $perms);
 895 }
 896
 897
 898 $program = $0;
 899 $program =~ s@.*/@@;
 900 $| = 1;
 901 &parse_flags();
 902 action: foreach $workfile ( @todo ) {
 903     $file = $paths{$workfile};
 904     if ( ! -f $file ) {
 905         print "$file:0: file missing\n";
 906         next action;
 907     }
 908     print "Looking at $file...\n"
 909         if $verbose;
 910     if ( !open(IN, $file) ) {
 911         print "$pfx$workfile:0: can't open $!\n";
 912         next action;
 913     }
 914     &checkperm($file, $modes{$workfile})
 915         if $noperms == 0 && !$perms && defined $modes{$workfile};
 916     $line = 0;
 917     eval "&$checklist{$workfile}" || warn "$@";
 918     close(IN);
 919 }
 920
 921 &check_all_perms()
 922     if $perms;
 923 exit(0);
 924
 925 if ( 0 ) {
 926     &active();
 927     &control_ctl();
 928     &incoming_conf();
 929     &expire_ctl();
 930     &inn_conf();
 931     &moderators();
 932     &nntpsend_ctl();
 933     &newsfeeds();
 934     &overview_fmt();
 935     &passwd_nntp();
 936     &readers_conf();
 937 }