#!/usr/bin/perl

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

# avoid recursion if systemd calls us back for sysv units.
if ($ENV{CHKCONFIG_RECURSIVE_CALL}) {
  exit 0;
}
$ENV{CHKCONFIG_RECURSIVE_CALL} = 1;

my $initdir = '/etc/init.d';
my $inetddir = '/etc/inetd.d';
my $xinetddir = '/etc/xinetd.d';
my @systemd_paths = ('/usr/lib/systemd/system', '/lib/systemd/system', '/run/systemd/system', '/etc/systemd/system');
my $systemd_binary_path = '/bin/systemd';

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;
my $nosystemctl = 0;

#
# 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;
}

#
# check if systemd is active
#
sub is_systemd_active {
    use File::stat;
    lstat("/run/systemd/system") or return 0;
    -e $systemd_binary_path or return 0;
    return 1;
}

sub is_overriden_by_systemd {
    my $service = shift;
    my $root = shift;

    if (!$nosystemctl) {
        for my $path (@systemd_paths) {
	    return $path if -e "$root/$path/$service.service";
        }
    }
    return undef;
}

sub systemd_get_enabled {
    my $service = shift;
    my $root = shift;
    my $unit = "$service.service";
    my $ret;
    my $root_option;
    $root_option = "--root $root" if $root ne "/" ;
    #print STDERR "Note: Forwarding request to 'systemctl is-enabled $unit'.\n";
    $ret = system ("systemctl -q $root_option is-enabled $unit");
    return $ret==0?'on':'off';
}

sub forward_to_systemd {
    my $service = shift;
    my $verb = shift;
    my $root = shift;

    return unless is_overriden_by_systemd ($service,$root);

    my $unit = "$service.service";
    my $ret;
    my $root_option;
    #print STDERR "Note: Forwarding request to 'systemctl $verb $unit'.\n";
    $root_option = "--root $root" unless $root eq "/" ;
    $ret = system ("systemctl $root_option $verb $unit");
    return $ret == 0;
}



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

my $mode = '';
my $printdeps;
my $root = '/';

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 -L|--liston [--deps] [names]  (as -l, enabled in at least 1 level)
        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
        chkconfig --root=<root> ...  use <root> as the root file system
EOF
}

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

if (!GetOptions('list|l'   => \&addmode,
		'L|liston' => \&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,
                'root=s'   => \$root,
                'no-systemctl' => \$nosystemctl,
   )) {
  usage();
  exit 1;
}
if ($mode eq 'h') {
  usage();
  exit 0;
}
my (@services, $s);
my (@remove, $s);
my (@enable, $s);

$initdir = "$root/etc/init.d";
$inetddir = "$root/etc/inetd.d";
$xinetddir = "$root/etc/xinetd.d";

findknown();

if (@ARGV) {
  @services = @ARGV;
  $mode = @services == 1 ? ($level ? 'c': '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' || $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 && $level) {
    $want = $level;
  } elsif (@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;
    }
    if (is_overriden_by_systemd($s, $root)) {
       my $r = systemd_get_enabled($s, $root);
       exit 1 if $r eq "off";
    } else {
       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;
    if (is_overriden_by_systemd($s, $root)) {
	$r = systemd_get_enabled($s, $root);
    }
    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;
      if (is_overriden_by_systemd ($s,$root)) {
	if ($want ne "") {
	    $status = 1 unless forward_to_systemd($s, 'enable', $root);
        } else {
	    $status = 1 unless forward_to_systemd($s, 'disable', $root);
	}
	next;
      }
      $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 (!is_overriden_by_systemd($s, $root)) {
      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) {
    for $s (splice @services) {
      if (is_overriden_by_systemd($s,$root)) {
	if ($mode eq 'a') {
	  forward_to_systemd($s, 'enable', $root);
	} else {
	  forward_to_systemd($s, 'disable', $root);
	}
      } else {
	push @services, $s;
      }
    }
    if (scalar(@services)) {
      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' || $mode eq 'L') {
  my $usecolor = -t STDOUT;
  if (is_systemd_active() && @services) {
      print STDERR <<EOF;

Note: This output shows SysV services only and does not include native
systemd services. SysV configuration data might be overridden by native
systemd configuration.

If you want to list systemd services use 'systemctl list-unit-files'.
To see services enabled on particular target use
'systemctl list-dependencies [target]'.

EOF
  }
  for $s (@services) {
    if (!$known_rc{$s}) {
      if (!$known_all{$s}) {
	print STDERR "$s: unknown service\n";
	$status = 1;
	next;
      }
    }
    my $line = "";
    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) {
	$line .= ( $links{$l}->{$s} ? "  \e[0;1;32m$l:on\e[m " : "  $l:off" );
      } else {
	$line .= ( $links{$l}->{$s} ? "  $l:on " : "  $l:off" );
      }
    }
    if (($mode eq 'l') || ($line =~ /:on/)) {
      printf "%-24s%s", $s, $line;
      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) {
      my $enabled = getreal_inetd($s) ne '';
      next if !$enabled && $mode eq 'L';
      printf "        %-19s ", "$s:";
      if ($enabled) {
	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) {
      my $enabled = getreal_xinetd($s) ne '';
      next if !$enabled && $mode eq 'L';
      printf "        %-19s ", "$s:";
      if ($enabled) {
	print $usecolor ? "\e[0;1;32mon\e[m\n" : "on\n";
      } else {
	print "off\n";
      }
    }
  }
  exit($status);
}
