# -*-perl-*-

# $Id: Initlinks.plm,v 1.3 2009/08/28 16:31:34 timc Exp $

# $Log: Initlinks.plm,v $
# Revision 1.3  2009/08/28 16:31:34  timc
# man page changed to be correct
# [CSL #376015] What::Initlinks man page error
#
# Revision 1.2  2003/12/15 16:28:35  thomas
# check-in for 0.1.1
#
# Revision 1.1.1.1  2003/12/02 14:47:35  thomas
# Initial version before export to 0.1.1
#

=head1 NAME

What::Node::Initlinks - manage rc file link forest

=head1 DESCRIPTION

This B<What> configuration package controls the creation of links for
various rc files in the system.

If a node for an init exists, any existing links will be removed.  New
links then be added based on the rest of the information in the node.

=head1 EXAMPLES

Activate the service B<foo> at run levels 2 though 5.  Create start
links B<S14foo> and kill links B<K72foo> in the appropriate
directories.

<node path="/Initlinks/inits/B<foo>" runlevels="2345" startindex="14" killindex="72" status="on"/>

Activate the service B<bar>, using the chkconfig data from the init file.

<node path="/Initlinks/inits/B<bar>" chkconfig="yes" status="on" />

Remove all links for the service B<qux>.

<node path="Initlinks/inits/B<qux>" status="off" />

=cut

package What::Node::Initlinks;

use strict;
use FileHandle;
use Data::Dumper;

use base qw(What::Node);

our %opts = ();

# Set the priority for this module in $::
$::module_priority{'Initlinks'} = 20;

###############################################################################
# Apply the current configuration

sub apply {
  my $class = shift;
  my $section = shift;
  my $what = shift;
  my $sname = shift;
  my $cname = shift;

  my ($directory_data, $linkroot, $rc_dir, $initprefix, $inits);

  my (%dirs, $init, $key, $attrs, $data, $runlevel, $index, $current, $fh);

  defined ($directory_data = $section->getattrs ($section)) or return 0;

  # The parent dir of the rc?.d directories
  defined ($linkroot = $directory_data->{rc_link_root}) or return 0;

  # Where the actual init scripts live (for creating links)
  defined ($rc_dir = $directory_data->{rc_dir}) or return 0;

  # Check for fake root
  if (defined $::opts{root}) {
    $linkroot = "$::opts{root}$linkroot";
    $rc_dir  = "$::opts{root}$rc_dir";
  }

  $initprefix = $class->calculate_init_prefix ($linkroot, $rc_dir);

  # Get a list of the inits to manage
  defined ($inits = $class->getchildren ($section, path => '/inits'))
    or return 0;

  # Get the current links once to avoid re-reading the dirs many times
  # The layout is $currentlinks->{initname}->{<SK><level>} => linkvalue
  my $currentlinks = {};
  my ($lrhandle, $rcdir, $dh, $de);
  defined ($lrhandle = new DirHandle $linkroot) or return 0;
  while (defined ($rcdir = $lrhandle->read)) {
    if (($rcdir =~ /^rc(.)\.d$/) && (-d "$linkroot/$rcdir")) {
      $runlevel = $1;
      if (defined ($dh = new DirHandle "$linkroot/$rcdir")) {
	$dirs{$runlevel} = 1;
	while (defined ($de = $dh->read)) {
	  if ($de =~ /([SK]\d\d)(.*)/ && -l "$linkroot/$rcdir/$de") {
	    $currentlinks->{$2}->{$runlevel}->{$1} =
	      readlink ("$linkroot/$rcdir/$de");
	  }
	}
      }
    }
  }

  # Now parse the config data
  foreach $init (sort keys %$inits) {
    $attrs = $inits->{$init}->getattrs ($section);
    $data = {};

    if (exists ($attrs->{status}) && $class->checkbool ($attrs->{status})) {
      # Figure out what should be there
      if (exists ($attrs->{chkconfig}) && $class->checkbool ($attrs->{chkconfig})) {
	# Read data from the init
	if (defined ($fh = new FileHandle "$rc_dir/$init", 'r')) {
	  while (<$fh>) {
	    if (/\#\s*chkconfig:\s*(\S+)\s+(\S+)\s+(\S+)/) {
	      ($data->{runlevels}, $data->{startindex}, $data->{killindex}) =
		($1, $2, $3);
	      last;
	    }
	  }
	  undef $fh;
	} else {
	  $class->err ("Failed to read $rc_dir/$init for chkconfig\n");
	}
      }

      foreach $key ('runlevels', 'startindex', 'killindex') {
	$attrs->{$key} and $data->{$key} = $attrs->{$key};
      }
      # Gratuitous error checking
      if (!defined $data->{runlevels}) {
	$class->debug (1, "Initlinks: Run levels missing for /Initlinks/$init\n");
	next;
      }
      if (!defined ($data->{startindex}) || !defined ($data->{killindex})) {
	$class->debug (1, "Initlinks: Indicies missing for /Initlinks/$init\n");
	next;
      }

      # Check each runlevel in turn
      foreach $runlevel (keys %dirs) {
	$current = $currentlinks->{$init}->{$runlevel};

	$index = ($data->{runlevels} =~ $runlevel) ?
	  "S$data->{startindex}" : "K$data->{killindex}";

	foreach $key (keys %$current) {
	  if ($index ne $key || "$initprefix/$init" ne $current->{$key} ) {
	    # Remove it
	    $class->debug (1, "rm %s\n", "$linkroot/rc${runlevel}.d/$key$init");
	    $class->getoption ('donothing') or
	      unlink "$linkroot/rc${runlevel}.d/$key$init";
	    delete $current->{$key};
	  }
	}
	if (!$current->{$index}) {
	  # Add it
	  $class->debug (1, "ln -s %s %s\n",
			 "$initprefix/$init", "$linkroot/rc${runlevel}.d/$index$init");
	  $class->getoption ('donothing')
	    or symlink "$initprefix/$init", "$linkroot/rc${runlevel}.d/$index$init";
	}
      }
    } else {
      # (!$attrs->{status}) -- Just remove anything that's there
      foreach $runlevel (keys %dirs) {
	$current = $currentlinks->{$init}->{$runlevel};
	foreach $key (keys %$current) {
	  $class->debug (1, "rm %s\n", "$linkroot/rc${runlevel}.d/$key$init");
	  $class->getoption ('donothing') or
	    unlink "$linkroot/rc${runlevel}.d/$key$init";
	  delete $current->{$key};
	}
      }
    }
  }
  return 1;
}


###############################################################################
# Figure out a relative link path from two absolute dirs

sub calculate_init_prefix {
  my ($class, $linkroot, $rc_dir) = @_;

  my @links = split ('/', $linkroot);
  my @inits = split ('/', $rc_dir);

  while (@links && @inits && $links[0] eq $inits[0]) {
    shift @links;
    shift @inits;
  }
  while (@links>1) {
    unshift @inits, '..';
    shift @links;
  }
  unshift @inits, '..';
  return $class->join_name (@inits);
}

###############################################################################
1;
