#!/usr/local/bin/perl -w
#
# Author Wolfgang Friebel Wolfgang.Friebel@desy.de
#
# Change History:
#     23.07.2001 error messages to stderr, retcodes, -d flag
#     18.07.2001 complete rewrite, -t flag, -s with enhanced output
#     02.05.2000 previous stable version

use strict;
use vars qw($rc $opt_d $opt_f $opt_h $opt_s $opt_t $level %tg %mem %maps %excl);

(my $program = $0) =~ s,.*/,,;
$rc = 0;
my $domain = '';
if ( open F, "/etc/resolv.conf" ) {
  while (<F>) {
    last if ($domain) = /^domain\s+([^\s]+)/;
    last if ($domain) = /^search\s+([^\s]+)/;
  }
  close F;
}
if ( ! $domain ) {
  print "!!! Unable to determine our domain, assuming 'ifh.de'\n",
	"!!! This is a bug which should be reported back to wolfgang.friebel\@desy.de\n"
	if -t STDOUT;
  $domain = 'ifh.de';
}
use Getopt::Long;
GetOptions('d=s', 'f=s', 'h+', 's+' , 't+') || ( $rc=1 );
if ( $opt_h or $rc ) {
print << "EOF";
usage: $program [-h] [-t] [-d domain] [-f file] [-s] [netgroup]
       $program -d domain ...	use domain instead of default domain
       $program -f file ...	exclude entries found in file from listing
				if pseudo files "[-]ping" and "[-]alive" used
				then hosts not pinging/not alive are in/excluded
       $program -h		displays this help information
       $program netgroup		lists entries in netgroup
       $program -s		lists the whole netgroups structure
       $program -s netgroup	lists the structure of netgroup 
       $program -t		lists top netgroups
return codes: 	1		program called with wrong option[s]
		2		domain or netgroup given in arglist not existing
		3		subordinate netgroup not existing
EOF
print "       $program               lists entries in netgroup admin\n"
      if $domain eq 'ifh.de';
  exit $rc;
}
# respect exclude file if given
%excl = ();
if ( defined $opt_f ) {
  my $file = '/net/share/admin/hostinfo';
  $file = $opt_f if $opt_f  !~ /^-?ping$|^-?alive$/;
  if ( open F, $file ) {
    my $content = '';
    if ( $opt_f =~ /^-?ping$|^-?alive$/ ) {
      $content = <F>; #skip first line
      $content = <F>;
      $content .= <F> if $opt_f =~ /alive/;
    } else {
      local $/ = undef;
      $content = <F>;
    }
    close F;
    %excl = map { $_ => 1 } grep { !/^\d+$/ } split '\s', $content;
  } else {
    print "$program: $file unreadable: $!\n";
  }
} else {
  $opt_f = ''; # get rid of warnings
}

$opt_d = $opt_d ? "-d $opt_d" : '';
open (HOSTS, "ypcat -k $opt_d netgroup|");
while (<HOSTS>){
  next if /^\s*$/;
  next if /^#/;
  my $key; my $map = [];
  ($key,@$map) = split;
  $maps{$key} = $map;
}
close HOSTS;
@ARGV = ( 'admin' ) if ! @ARGV and $domain eq 'ifh.de' and ! $opt_s;# Zeuthen
$opt_t = 1 unless @ARGV;
@ARGV = keys %maps if $opt_t;

foreach (sort numerically @ARGV) {
    $level = 0;
    if ( exists $maps{$_} ) {
      print "$_\n" if $opt_s;
      &resolve_subclass($_) if $_;
    } else {
      print STDERR "Netgroup $_ not existing\n";
      $rc = 2;
    }
}

$\ = $, = "\n";
if ( $opt_t ) {
  print "Top netgroups:" if -t STDOUT;
  my %sg = reverse %tg;
  print grep (!exists $tg{$_}, sort numerically keys %sg);
} elsif ( ! $opt_s ) {
  delete @mem{'ilos-f', 'elrond-f'}
	if $ARGV[0] eq 'admin' and $domain eq 'ifh.de';		# DESY Zeuthen
  print "List of members for netgroup $ARGV[0]:" if -t STDOUT;
  for ( sort numerically keys %mem ) {
    print if $opt_f =~ /^-/ and $excl{$_};
    next if $excl{$_}; #exclude hosts as given in file;
    print if $opt_f !~ /^-/;
  }
}
exit $rc;

sub resolve_subclass {
  $level++;
  my ($key) = $_[0];
  my $map = $maps{$key};
  $rc = 3, print STDERR "Error in netgroup structure: $key not existing\n"
	unless $maps{$key};
  foreach (@$map) {
    if (/\(\W*([-\w]+)\W/) { $mem{$1} = $key }
    else {
      $tg{$_} = $key;
      if ( $domain ne 'ifh.de' or ! /-\d+$/ ) {			# DESY Zeuthen
        print '  'x$level, $_, "\n" if $opt_s;
      }
      &resolve_subclass($_);
      $level--;
    }
  }
}

sub numerically {
  if ($a =~ /\d+$/) {
   my $al = $`; my $an = "$&";
   if ($b =~ /\d+$/) {
     my $bl = $`; my $bn = "$&";
     my $cmp = $al cmp $bl;
     return $cmp if $cmp;
     return $an <=> $bn;
   }
  }
  return $a cmp $b;
}
