#!/usr/bin/perl

# $Id: dmupdatedb,v 1.4 2000/04/12 23:07:59 alban Exp $

# dmupdatedb
#
#   Creates a dmlocatedb file for each dmf filesystem on the local host.
#   These databases are then used by dmlocate.  dmupdatedb and dmlocate
#   are similar in function to GNU's updatedb and locate except that
#   dmupdatedb and dmlocate expect regular expressions, not file
#   globbing patterns.

#   Note:  Each dmlocate database name incorporates the path
#          of the mount point of the filesystem for which it contains
#          data.  The slashes (path component separators) were
#          necessarily replaced so that a legal filename could be
#          constructed.  The string "::" was substituted for each '/'.
#          This is intended to be a one-way operation.  Replacing "::"
#          in the database names will not result in the original mount
#          point if any path component in the original mount point
#          path contained "::".  But this is O.K. because I don't
#          intend the reverse operation to be needed.  You've been
#          warned. :-)

require Cwd;

use strict;

my (
     $pgm,
     $dmconfig,
     @dmconfig_options_to_get_dmf_filesystems,
     $egrep,
     $grep,
     $gendmlocdb,
     $mount,
     @mount_p,
     $nice,
     $uname,
     $dmlocatedb_dir,
     $slash_substitute,
     $nice_value,
     $arg,
     $interactive,
     @dmf_mount_points,
     $mntpt,
     $pid,
     $mount_point_w_substitutions_for_slashes,
     $dbname,
     @cmd,
) = ();

( $pgm = $0 ) =~ s=^.*/==s;

# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
#                     begin commands definition section
# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -

$dmconfig = "/usr/lib/dm/dmconfig";
@dmconfig_options_to_get_dmf_filesystems = qw( FILE_SYSTEMS );
$egrep = "/bin/egrep";
$grep = "/bin/grep";
$gendmlocdb = "/usr/local/bin/gendmlocdb";
$mount = "/etc/mount";
@mount_p = ( $mount, "-p" );
$nice = "/bin/nice";
$uname = "/bin/uname";

# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
#                      end commands definition section
# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -

$dmlocatedb_dir = "/dmf/etc/dmlocatedb";

# This will be used to replace slashes in the mount point in the name
# of the dmlocate database for each mount point
$slash_substitute = "::";

# for interactive use
$nice_value = "-20";

# process command line arguments
while ( defined ( $arg = shift )) {
  if ( $arg =~ /^-h$|^-\?$|^--help$/ ) {
    usage();
    exit 0;
  } # if
  elsif ( $arg =~ /^-i$|^--interactive$/ ) {
    $interactive = 1;
  } # if
  else {
    die "$pgm: $arg: unknown option\n";
  } # if
} # while

generate_dmf_mount_points( \@dmf_mount_points );

# For each dmf filesystem, spawn a job to create its database: for
# each child process:  convert $mntpt to a path devoid of symbolic
# links (a null op if $mntpt doesn't contain any symlinks) by passing
# the realpath() function a pointer to the mount_point string.  If we
# encounter a problem during the conversion, die.  Compose a name for
# the mount point's database by concatenating "dmlocatedb" and the
# string resulting from substituting $slash_substitute for each '/' in
# the mount point.  Compose the gendmlocdb command that will actually
# produce the database.  If we are invoced with the interactive option,
# prepend "nice" and a nice value to the command.  exec the command.

for $mntpt ( @dmf_mount_points ) {
  if (( $pid = fork ) == 0 ) {
    if ( ! realpath( \$mntpt ) ) {
      die "$pgm: errors occurred when attempting to identify and resolve\n"
          . "symbolic links in the path $mntpt\n";
    } # if
    ( $mount_point_w_substitutions_for_slashes
        = $mntpt ) =~ s=/+=$slash_substitute=g;
    $dbname = "${dmlocatedb_dir}/dmlocatedb"
              . "$mount_point_w_substitutions_for_slashes";

    @cmd = ( $gendmlocdb, $mntpt, $dbname );
    if ( $interactive ) {
      @cmd = ( $nice, $nice_value, @cmd );
    } # if
    exec @cmd;
    # print "@cmd\n"; last;
  } # if
} # for

# if we got the interactive option, wait for all children to finish
# before exiting; this allows a command line user to interrupt

if ( $interactive ) {
  for $mntpt ( @dmf_mount_points ) {
    wait;
  } # for
} # if

#-----------------------------------------------------------------------
sub usage {
  print STDERR <<"EndOfUsage";
usage: $pgm [ options ]

options:
  -h,--help           List usage

  -i,--interactive    Indicate interactive behavior or $pgm is
                      desired.  Each process spawned to create a
                      dmlocate database is niced.  $pgm will wait for
                      all child processes to finish before exiting.

                      The default behavior is non-interactive.
EndOfUsage
} # usage

#-----------------------------------------------------------------------
# Invocation: status = realpath( \$path )
#
# Takes a reference to a string and assumes it is a unix path.  Attempts
# to determine an equivalent path which:
#
#   . Is absolute (i.e., starts with '/')
#   . Contains no symbolic links
#   . Contains no '.' or '..' components
#   . Collapses all groups of two or more adjacent slashes to single
#     slashes
#
# If such a path can be determined, this function modifies the
# referenced string and returns 1.  If such a path cannot be determined
# the referenced string remains unchanged and 0 is returned.

sub realpath {

  my ( 
       $component,
       @components,
       $func,
       $given_ref,
       $i,
       $link_contents,
       $not_done,
       $null_component,
       $old_directory,
       $path,
     ) = ();

  $func = "realpath()";

  # save current directory so we can return there before returning from
  # this function
  $old_directory = Cwd::cwd();

  # if no arguments were given, return false
  $given_ref = shift;
  if ( ! defined $given_ref ) {
    return 0;
  } # if

  # if a null path is given, return true and set the referenced path
  # to the empty string
  if ( $$given_ref =~ /^\s*$/ ) {
    $$given_ref = "";
    return 1;
  } # if

  # make a local copy of the given referenced path
  $path = $$given_ref;

  # if referenced string doesn't begin with a slash, set local copy
  # equal to the concatenation of the current working directory, a
  # slash, and the given path
  if ( $$given_ref !~ /^\// ) {
    $path = $old_directory . "/" . $$given_ref;
  } # if

  # The following white loop is used to decide whether to repeat a
  # process, which is contained in the inner while loop.  The process
  # is as follows:

  # Build a list of components from current value of path.  Then set
  # path = "/".  Now we are ready to build a new path by "walking"
  # through the component list, examining one component at a time.
  # If the component is not a symlink, append it to the "new" path.
  # If it is a symlink, then:  if the target begins with '/', completely
  # replace path with the target of the link; else replace the component
  # with the target and append to the new path.  If a symlink is found,
  # then the outer while loop (the process of examining a component
  # list) must occur again with a new component list made up of
  # components from our current new path and any components that in the
  # current loop we haven't examined yet.

  $not_done = 1;
  while ( $not_done ) {
    $not_done = 0;

    # Capture all path components in @components; $null_component is
    # used to "throw away" the first component, "", that split will
    # return 
    ( $null_component, @components ) = split /\/+/, $path;

    # Initialize the "new" path
    $path = "/";

    while ( $component = shift @components ) {
      if ( -l "$path/$component" ) {
        $link_contents = readlink "$path/$component";
        if ( $link_contents =~ /^\// ) {
          $path = join( '/', ( $link_contents, @components ));
        } # if
        else {
          $path .= ( '/' . readlink "$path/$component" );
          $path = join( '/', ( $path, @components ));
        } # if

        # if we got a link, set not_done so as to repeat the component
        # walkthrough with the new path and any components yet
        # unexamined
        $not_done = 1;
        # stop this iteration of component walkthrough to
        # immediately start the process again
        last;
      } # if
      elsif ( -e "$path/$component" ) {
        $path .= ( '/' . $component );
      } # if
      else {
        # else original given path could not be resolved for some reason
        return 0;
      } # if
    } # while
  } # while

  # Once again, capture in @components, the components of the path.  At
  # this point though, none of the components should be a symbolic
  # link.  That is, all symbolic links should have been resolved.
  ( $null_component, @components ) = split /\/+/, $path;
  $path = "/";

  # Now we get rid of any "." or ".." components by using the
  # symlink-free component list.  Initialize $path to "/" and cd to
  # /.  Then for each component, cd to $path/$component if it's a
  # directory.  If the cd was successful, the entire path will now be
  # given by `pwd`.  This will resolve all "." and ".." components.
  # If $path/$component is not a directory, but exists, and if we are
  # evaluating the last component in the list, then the current value
  # of $path may be used to modify $$given_ref, the original referenced
  # string, and we return "true".  Else, we leave $$given_ref unmodified
  # and return "false".

  chdir "/" or return 0;
  for $i ( 0..$#components ) {
    $path .= ( "/" . $components[ $i ] );
    if ( -l $path ) {
      die "$func: LOGIC ERROR; \$path is \"$path\";"
          . " \$components\[ \$i \] is \"$components[ $i ]\"";
    } # if
    elsif ( -d $path ) {
      if ( chdir( $path )) {
        $path = Cwd::cwd();
      } # if
      else {
        chdir $old_directory
          or warn "$func: could not return to"
                  . " original directory $old_directory\n";
        return 0;
      } # if
    } # if
    elsif ( ! (( -e $path ) && ( $i = $#components ))) {
      chdir $old_directory
        or warn "$func: could not return to"
                . " original directory $old_directory\n";
      return 0;
    } # if
  } # for

  $$given_ref = $path;
  chdir $old_directory
    or warn "$func: could not return to"
            . " original directory $old_directory\n";
  return 1;

} # realpath

#-----------------------------------------------------------------------
# generate an array of dmf filesystems on the local host
# invocation: generate_dmf_mount_points( \@mount_points )
sub generate_dmf_mount_points {

  my (
       $dmco_line,
       @dmconfig_cmd,
       @dmconfig_output,
       $filesystem,
       $func,
       $line,
       $mount_points_array_ref,
       $mountpoint,
       $options,
       @other_stuff_we_dont_care_about,
       $type,
     ) = ();

  $func = "generate_dmf_mount_points()";

  $mount_points_array_ref = shift;
  die "$pgm: $func: \$mount_points_array_ref: undefined\n"
    if ! defined $mount_points_array_ref;

  if ( irix() ) {
    @dmconfig_cmd
      = ( $dmconfig, @dmconfig_options_to_get_dmf_filesystems );
    chomp( @dmconfig_output = `@dmconfig_cmd` );
    if ( @dmconfig_output != 1 ) {
      warn "$pgm: $func: \@dmconfig_output not a single line:\n";
      for $dmco_line ( @dmconfig_output ) {
        print "$pgm:   $dmco_line\n";
      } # for
      die;
    } # if
    @{ $mount_points_array_ref }
      = split /\s+/, $dmconfig_output[ 0 ];
  } # if
  elsif ( unicos() ) {
    generate_unicos_dmf_mntpts( $mount_points_array_ref );
  } # if
  else {
    open MOUNT_P, "@mount_p" . '|'
      or die "$pgm: @mount_p: can't open cmd: $!\n";

    while ( chomp ( $line = <MOUNT_P> )) {
      ( $filesystem, $mountpoint, $type, $options,
        @other_stuff_we_dont_care_about ) = split /\s+/, $line;
      if ( $options =~ /^dmi,|,dmi,|,dmi$/ ) {
        push @{ $mount_points_array_ref }, $mountpoint;
      } # if
    } # while

    close MOUNT_P
      or warn "$pgm: @mount_p: can't close cmd: $!\n";
  } # if

} # generate_dmf_mount_points

#-----------------------------------------------------------------------
sub unicos {
  return ( `$uname` =~ /unicos/i );
} # unicos

#-----------------------------------------------------------------------
sub irix {
  return ( `$uname` =~ /irix/i );
} # irix

#-----------------------------------------------------------------------
sub generate_unicos_dmf_mntpts {
  my (
       @cmd,
       @filesys_opts,
       $fs_keyword,
       $func,
       $mntpts_ref,
       @results,
       $server,
       @serverlist_opts,
       @servers,
       $serveropt,
     ) = ();

  $func = "generate_unicos_dmf_mntpts()";

  if ( ! defined( $mntpts_ref = shift )) {
    die "$pgm: $func: \$mntpts_ref undefined";
  } # if

  @serverlist_opts = qw( -c SERVER_NAMES );
  $fs_keyword = "FILE_SYSTEMS";
  $serveropt = "-S";

  @cmd = ( $dmconfig, @serverlist_opts );
  
  @results = `@cmd`;
  if ( $? != 0 ) {
    die "$pgm: $func: @cmd: non-zero status getting server names: $?\n";
  } # if

  for ( @results ) {
    chomp;
    push @servers, split;
  } # for

  if ( ! @servers ) {
    die "$pgm: $func: logic error: server list is empty!\n";
  } # if

  for $server ( @servers ) {
    @filesys_opts = ( $serveropt, $server, $fs_keyword );
    @cmd = ( $dmconfig, @filesys_opts );
    @results = `@cmd`;
    if ( $? != 0 ) {
      die "$pgm: $func: @cmd: non-zero status getting server names: $?\n";
    } # if
    for ( @results ) {
      chomp;
      push @{ $mntpts_ref }, split;
    } # for
  } # for

} # generate_unicos_dmf_mntpts