ACC SHELL

#!/usr/bin/perl

use strict;
use Getopt::Long;
use File::Temp 'tempfile';

my $initdir = '/etc/init.d';
my $inetddir = '/etc/inetd.d';
my $xinetddir = '/etc/xinetd.d';

my %to_d = (
  '0' => 'rc0.d', '1' => 'rc1.d', '2' => 'rc2.d', '3' => 'rc3.d',
  '4' => 'rc4.d', '5' => 'rc5.d', 'S' => 'rcS.d', 'B' => 'boot.d'
);

# which files to skip in $initdir
my %skips_rc = map {$_ => 1} qw {rc rx skeleton powerfail boot halt reboot single boot.local halt.local};

# which services are known
my %known_rc = ();
my %known_inetd = ();
my %known_xinetd = ();
my %known_all = ();

#
# get the contents of a directory
#
sub ls {
  my $dir = shift;

  local *D;
  return () unless opendir(D, $dir);
  my @ret = grep {$_ ne '.' && $_ ne '..'} readdir(D);
  closedir D;
  return @ret;
}

#
# unify an array
#
sub unify {
  my %h = map {$_ => 1} @_;
  return grep {delete $h{$_}} @_;
}


##################################################################
#                         runlevel part
##################################################################

# which services are currently on? this is a cache to speed things up
# initialized by initlinks_rc(), used in getreal_rc()
my %links = ();
my %links_unknown = ();

#
#
# calculate the default runlevels of a service by reading the
# insserv header. regexes taken from insserv.c
#
my %getdef_rc_cache = ();

sub getdef_rc {
  my $s = shift;

  return $getdef_rc_cache{$s} if exists $getdef_rc_cache{$s};
  my $file = "$initdir/$s";
  local *F;
  if (!open(F, "<$file")) {
    print STDERR "$file: $!\n";
    $getdef_rc_cache{$s} = undef;
    return undef;
  }
  while (<F>) {
    chomp;
    if (/^#[[:blank:]]*default[-_]?start:[[:blank:]]*([[:print:][:blank:]]*)/i) {
      my $ret = $1;
      close F;
      $ret =~ s/[[:blank:]]+//g;
      my @ret = split('', $ret);
      $ret = '';
      for (sort @ret) {
	$_ = uc($_);
	$ret .= $_ if /[0123456SB]/;
      }
      $getdef_rc_cache{$s} = $ret;
      return $ret;
    }
  }
  $getdef_rc_cache{$s} = '35';
  return '35';
}

#
# calculate the required services by reading the insserv header.
# regexes taken from insserv.c
#
sub getdeps_rc {
  my $s = shift;

  my $file = "$initdir/$s";
  local *F;
  open(F, "<$file") || return undef;
  while (<F>) {
    chomp;
    if (/^#[[:blank:]]*required[-_]?start:[[:blank:]]*([[:print:][:blank:]]*)/i) {
      my $ret = $1;
      close F;
      $ret =~ s/\s+$//;
      return $ret;
    }
  }
  return '';
}

#
# calculate the active runlevels of a service. Uses global %links
# hash.
#
sub getreal_rc {
  my $s = shift;

  my $start = '';
  my $l;
  initlinks_rc() if $links_unknown{$s};
  for $l (sort keys %links) {
    $start .= $l if $links{$l}->{$s};
  }
  return $start;
}

#
# initializes global %links hash by scanning the link directories
# for each runlevel.
#
sub initlinks_rc {
  my $l;
  for $l (keys %to_d) {
    my @links = grep {s/^S\d\d//} ls("$initdir/$to_d{$l}");
    $links{$l} = { map {$_ => 1} @links };
  }
  %links_unknown = ();
}

my $force;
my $allservices;

#
# run insserv
#
sub insserv {
  my @i = ("/sbin/insserv");
  push @i, "-f" if $force;
  my $r = system(@i, @_);
  if ($r == -1) {
    printf STDERR "/sbin/insserv: $!\n";
    return undef;
  } elsif ($r) {
    printf STDERR "/sbin/insserv failed, exit code %d\n", $? >> 8;
    return undef;
  }
  return 1;
}


##################################################################
#                         xinetd part
##################################################################

#
# get the state of a xinetd service
#
sub getreal_xinetd {
  my $s = shift;

  my $file = "$xinetddir/$s";
  local *F;
  open(F, "<$file") || return undef;
  my $dis = 1;
  while (<F>) {
    if (/^\s*service\s*\S/) {
      if (!$dis) {
	close F;
	return 'X';
      }
      $dis = 0;
    }
    if (/^\s*disable\s*=\s*yes/) {
      $dis = 1;
      next;
    }
  }
  close F;
  return $dis ? '' : 'X';
}

#
# change the state of a xinetd service
#
sub set_xinetd {
  my $s = shift;
  my $state = shift;

  if (!$known_xinetd{$s}) {
    print STDERR "$s: not a xinetd service\n";
    return;
  }
  local *F;
  local *N;
  my $file = "$xinetddir/$s";
  if (!open(F, "<$file")) {
    print STDERR "$file: $!\n";
    return;
  }
  if (!open(N, ">$file.chkconfig~")) {
    print STDERR "$file.chkconfig~: $!\n";
    return;
  }
  while (<F>) {
    if (/^\s*service\s*\S/) {
      if (!/{/) {	#}
        print N $_;
	$_ = <F>;
      }
      print N $_;
      print N "\tdisable     = yes\n" unless $state;
      next;
    }
    print N $_ unless /^\s*disable\s*=\s*yes/;
  }
  close F;
  if (!close N) {
    print STDERR "$file.chkconfig~: $!\n";
    unlink("$file.chkconfig~");
    return;
  }
  if (!rename("$file.chkconfig~", "$file")) {
    print STDERR "rename $file.chkconfig~ $file: $!\n";
    unlink("$file.chkconfig~");
    return;
  }
  return 1;
}


##################################################################
#                         inetd part
##################################################################

#
# get the state of a inetd service
#
sub getreal_inetd {
  my $s = shift;

  my $file = "$inetddir/$s";
  local *F;
  open(F, "<$file") || return undef;
  while (<F>) {
    chomp;
    next if /^\s*#/;
    next if /^\s*$/;
    close F;
    return 'T';
  }
  close F;
  return '';
}

#
# does the line look like a inetd service?
#
sub looks_ok_inetd {
  return 1 if $_[0] =~ /^![\|<]/;
  my @x = split(' ', $_[0]);
  my %oktype = map {$_ => 1} qw{stream dgram raw rdm seqpacket};
  return 0 unless $oktype{$x[1]};
  return 0 unless $x[3] =~ /^(no)?wait/;
  return 1;
}

#
# change the state of a inetd service
#
sub set_inetd {
  my $s = shift;
  my $state = shift;

  if (!$known_inetd{$s}) {
    print STDERR "$s: not an inetd service\n";
    return;
  }
  local *F;
  local *N;
  my $file = "$inetddir/$s";
  if (!open(F, "<$file")) {
    print STDERR "$file: $!\n";
    return;
  }
  if (!open(N, ">$file.chkconfig~")) {
    print STDERR "$file.chkconfig~: $!\n";
    return;
  }
  while (<F>) {
    chomp;
    if (/^#\s*(.*)/) {
      my $l = $1;
      if (looks_ok_inetd($l)) {
        print N $state ? "$l\n" : "## $l\n";
        next;
      }
    }
    if (!$state && looks_ok_inetd($_)) {
      print N "# $_\n";
      next;
    }
    print N "$_\n";
  }
  if (!close N) {
    print STDERR "$file.chkconfig~: $!\n";
    unlink("$file.chkconfig~");
    return;
  }
  if (!rename("$file.chkconfig~", "$file")) {
    print STDERR "rename $file.chkconfig~ $file: $!\n";
    unlink("$file.chkconfig~");
    return;
  }
  return 1;
}


##################################################################
#                     common functions
##################################################################

#
# calculate current status
#
sub getcurrent {
  my $s = shift;

  if (!$known_all{$s}) {
    print STDERR "$s: unknown service\n";
    return undef;
  }
  my $start = '';
  $start .= getreal_rc($s) if $known_rc{$s};
  $start .= getreal_inetd($s) if $known_inetd{$s};
  $start .= getreal_xinetd($s) if $known_xinetd{$s};
  return $start;
}


#
# return all services we know about by scanning $initdir for init
# scripts.
#
sub findknown {
  for (ls($initdir)) {
    next unless -f "$initdir/$_";
    next if /^README/ || /^core/;
    next if /~$/ || /^[\d\$\.#_\-\\\*]/ || /\.(rpm|ba|old|new|save|swp|core)/;
    $known_rc{$_} = 1;
    $known_all{$_} = 1;
  }
  for (ls($xinetddir)) {
    next unless -f "$xinetddir/$_";
    next if /~$/ || /\./;
    $known_xinetd{$_} = 1;
    $known_all{$_} = 1;
  }
  return unless -d $inetddir;
  return unless -f "/etc/inetd.conf";
  local *F;
  my $gotinetd = 0;
  if (!open(F, "</etc/inetd.conf")) {
    print STDERR "/etc/inetd.conf: $!\n";
    return;
  }
  while (<F>) {
    chomp;
    if (/^!\|\s*\/usr\/lib\/inetd\/includedir\s+\Q$inetddir\E\s*$/) {
      $gotinetd = 1;
      last;
    }
  }
  close F;
  return unless $gotinetd;
  for (ls($inetddir)) {
    next unless -f "$inetddir/$_";
    next if /~$/ || /\./;
    $known_inetd{$_} = 1;
    $known_all{$_} = 1;
  }
}

#
# normalize runlevel
#
my $level;	# overwrite on with $level

sub normalize {
  my $s = shift;
  my $rl = shift;

  $rl = lc($rl);
  return '' if $rl eq 'off' || $rl eq '';
  my $def = '35';
  $def = 'inetd' if $known_inetd{$s};
  $def = 'xinetd' if $known_xinetd{$s};
  $def = getdef_rc($s) if $known_rc{$s};
  return undef unless defined $def;
  $rl = ",$rl,";
  $rl =~ s/,on,/,$level,/g if defined $level;
  $rl =~ s/,on,/,$def,/g;
  $rl =~ s/,xinetd,/,X,/g;
  $rl =~ s/,inetd,/,T,/g;
  $rl =~ s/s/S/g;
  $rl =~ s/b/B/g;
  $rl =~ s/,//g;
  $rl = join('', sort unify(split('', $rl)));
  if ($rl =~ /([^0123456SBTX])/) {
    print STDERR "illegal runlevel specified for $s: $1\n";
    return undef;
  }
  return $rl;
}

#
# convert runlevels into a nice human readable form
#
sub readable {
  my $s = shift;
  my $rl = shift;

  return 'off' if $rl eq '';
  my $def = '';
  $def = getdef_rc($s) if $known_rc{$s};
  return undef unless defined $def;
  $rl = ",$rl,";
  $rl =~ s/T/,inetd,/g;
  $rl =~ s/X/,xinetd,/g;
  $rl =~ s/,\Q$def\E,/,on,/ if $def ne '';
  $rl =~ s/,,+/,/g;
  $rl =~ s/^,//;
  $rl =~ s/,$//;
  return $rl;
}


##################################################################
#                     main program
##################################################################

my $mode = '';
my $printdeps;


sub addmode {
  die("Please specify only one mode.\n") if $mode;
  $mode = substr($_[0], 0, 1);
}

sub usage {
  print <<EOF;
usage:
        chkconfig -A|--allservices              (together with -l: show all services)
        chkconfig -t|--terse [names]            (shows the links)
        chkconfig -e|--edit  [names]            (configure services)
        chkconfig -s|--set   [name state]...    (configure services)
        chkconfig -l|--list [--deps] [names]    (shows the links)
        chkconfig -c|--check name [state]       (check state)
        chkconfig -a|--add   [names]            (runs insserv)
        chkconfig -d|--del   [names]            (runs insserv -r)
        chkconfig -h|--help                     (print usage)
        chkconfig -f|--force ...                (call insserv with -f)

        chkconfig [name]           same as chkconfig -t
        chkconfig name state...    same as chkconfig -s name state
EOF
}

Getopt::Long::Configure('no_ignore_case');

if (!GetOptions('list|l'   => \&addmode,
                'terse|t'  => \&addmode,
                'add|a'    => \&addmode,
                'del|d'    => \&addmode,
                'edit|e'   => \&addmode,
                'help|h'   => \&addmode,
                'set|s'    => \&addmode,
                'check|c'  => \&addmode,
                'level=s'  => \$level,
                'force|f'  => \$force,
                'allservices|A'  => \$allservices,
                'deps'     => \$printdeps
   )) {
  usage();
  exit 1;
}
if ($mode eq 'h') {
  usage();
  exit 0;
}
my (@services, $s);
my (@remove, $s);
my (@enable, $s);

findknown();

if (@ARGV) {
  @services = @ARGV;
  $mode = @services == 1 ? 't' : 's' if $mode eq '';
} else {
  die("Please specify a service\n") if $mode eq 'c' || $mode eq 'a' || $mode eq 'd';
  @services = sort grep {!$skips_rc{$_}} keys %known_all if $mode ne 's';
}
$mode = 't' if $mode eq '';

initlinks_rc() if $mode eq 'e' || $mode eq 't' || $mode eq 's' || $mode eq 'c' || $mode eq 'l';

if (!@ARGV && !$allservices) {
  my $l;
  my %ison;
  for $l (0, 1, 2, 3, 4, 5, 6) {
    $ison{$_} = 1 for keys %{$links{$l}};
  }
  @services = grep {!/^boot\./ || $ison{$_}} @services;
}

my %current = ();

if ($mode eq 'c') {
  die("Please specify only one service to check\n") if @services > 2;
  $s = $services[0];
  my $want;
  if (@services == 1) {
    $want = `/sbin/runlevel`;
    chomp($want);
    die("Can't determine current runlevel\n") unless $want =~ s/^. (.)$/$1/;
  } else {
    $want = $services[1];
  }
  $want = normalize($s, $want);
  exit 1 unless defined $want;
  exit 0 if $want eq '';
  my $l;
  for $l (split('', $want)) {
    if ($l eq 'T') {
      exit 1 unless getreal_inetd($s) ne '';
      next;
    }
    if ($l eq 'X') {
      exit 1 unless getreal_xinetd($s) ne '';
      next;
    }
    exit 1 unless $links{$l}->{$s};
  }
  exit 0;
}

if ($mode eq 'e' || $mode eq 't') {
  my ($fh, $tmpname);
  my $maxlen = 0;
  $maxlen >= length($_) or $maxlen = length($_) for @services;
  if ($mode eq 'e') {
    ($fh, $tmpname) = tempfile("chkconfig.XXXXX", DIR => '/tmp', UNLINK => 1);
    die("Could not create temporary file\n") unless $tmpname ne '';
  } else {
    $fh = *STDOUT;
  }
  for $s (@services) {
    $current{$s} = getcurrent($s);
    next unless defined $current{$s};
    my $r = readable($s, $current{$s});
    next unless defined $r;
    printf $fh "%-*s  %s\n", $maxlen, $s, $r;
  }
  exit 0 unless $mode eq 'e';
  close $fh;
  system("\${VISUAL:-vi} $tmpname");
  open(STDIN, "<$tmpname") or die("Could not open temporary file\n");
  $mode = 's';
  @services = ();
}

if ($mode eq 's') {
  my $status = 0;
  my $usestdin = !@services;
  my $ln = 0;
  do {
    if ($usestdin) {
      while (<STDIN>) {
	$ln++;
	chomp;
	next if /^\s*#/;
	next if /^\s*$/;
	my @line = split(' ', $_);
	if (@line != 2) {
	  print STDERR "parse error line $ln: $_\n";
	  $status = 1;
	  next;
	}
	@services = @line;
	last;
      }
      exit 1 unless @services;
    }
    if (@services & 1) {
      printf("Usage: chkconfig -s service on|off|runlevels\n");
      exit 1;
    }
    @remove = ();
    @enable = ();
    while (@services) {
      $s = shift @services;
      my $want = shift @services;
      $want = normalize($s, $want);
      $status = 1, next unless defined $want;
      $current{$s} = getcurrent($s) unless defined $current{$s};
      $status = 1, next unless defined $current{$s};
      my $current = $current{$s};
      next if $want eq $current;
      delete $current{$s};
      if (($want =~ /T/) && ($current !~ /T/)) {
        $status = 1 unless set_inetd($s, 1);
      } elsif (($want !~ /T/) && ($current =~ /T/)) {
        $status = 1 unless set_inetd($s, 0);
      }
      if (($want =~ /X/) && ($current !~ /X/)) {
        $status = 1 unless set_xinetd($s, 1);
      } elsif (($want !~ /X/) && ($current =~ /X/)) {
        $status = 1 unless set_xinetd($s, 0);
      }
      $want =~ s/[TX]//g;
      $current =~ s/[TX]//g;
      next if $want eq $current;

      if (!$known_rc{$s}) {
        print STDERR "$s: not a runlevel service\n";
	$status = 1;
        next;
      }
      if ($want eq '') {
        push @remove, $s;
      } elsif ($want eq getdef_rc($s)) {
        push @enable, $s;
      } else {
        push @remove, $s;
        push @enable, "$s,start=".join(',', split('', $want));
      }
      $links_unknown{$s} = 1;	# check again for this service
    }
    if (scalar(@remove)) {
      $status = 1 unless insserv('-r', '-d', '-p', "$initdir", @remove);
    }
    if (scalar(@enable)) {
      $status = 1 unless insserv('-p', "$initdir", @enable);
    }
  } while ($usestdin);
  exit $status;
}

#
# compatibility section
#
my $status = 0;
if ($mode eq 'a' || $mode eq 'd') {
  for $s (splice @services) {
    if (!$known_all{$s}) {
      print STDERR "$s: unknown service\n";
      $status = 1;
      next;
    }
    if (!$known_rc{$s}) {
      print STDERR "$s: not a runlevel service\n";
      $status = 1;
      next;
    }
    push @services, $s;
  }
  if (!$status) {
    if ($mode eq 'a') {
      insserv('-p', "$initdir", @services) or $status = 1;
    } else {
      insserv('-p', "$initdir", '-r', @services) or $status = 1;
    }
  }
  $mode = 'l';
  initlinks_rc();
}
if ($mode eq 'l') {
  my $usecolor = -t STDOUT;
  for $s (@services) {
    if (!$known_rc{$s}) {
      print STDERR "$s: unknown service\n" unless $known_all{$s};
      next;
    }
    printf "%-24s", $s;
    my $l;
    for $l (0, 1, 2, 3, 4, 5, 6, 'B', 'S') {
      next if ($l eq 'B' || $l eq 'S') && !$links{$l}->{$s};
      if ($usecolor) {
	print $links{$l}->{$s} ? "  \e[0;1;32m$l:on\e[m " : "  $l:off";
      } else {
	print $links{$l}->{$s} ? "  $l:on " : "  $l:off";
      }
    }
    print getdeps_rc($s) if $printdeps;
    print "\n";
  }
  my @inetd_services = grep {$known_inetd{$_}} @services;
  if (@inetd_services) {
    print "inetd based services:\n";
    for $s (@inetd_services) {
      printf "        %-19s ", "$s:";
      if (getreal_inetd($s) ne '') {
	print $usecolor ? "\e[0;1;32mon\e[m\n" : "on\n";
      } else {
	print "off\n";
      }
    }
  }
  my @xinetd_services = grep {$known_xinetd{$_}} @services;
  if (@xinetd_services) {
    print "xinetd based services:\n";
    for $s (@xinetd_services) {
      printf "        %-19s ", "$s:";
      if (getreal_xinetd($s) ne '') {
	print $usecolor ? "\e[0;1;32mon\e[m\n" : "on\n";
      } else {
	print "off\n";
      }
    }
  }
  exit($status);
}