NetNews Usenet Archive 1992 #30/NN_1992_30.iso/spool/comp/lang/perl/7558/fileop.pl

Text File | 1992-12-21 | 10.4 KB | 331 lines

;# NAME
;#    fileop.pl - perl function(s) create, remove, copy, and change mode of
;#          file system objects
;#
;# DESCRIPTION
;#    &Maybee_Delete_Path, &Create_Symlink, and &Create_Dir share 3 common
;#    arguments: $Override_If_Link, $Override_If_File, and $Override_If_Dir.
;#    They have the following meaning where Path is the object that will be
;#    created:
;#
;#       If Path is a link:
;#          + The operation will be forced if $Override_If_Link is TRUE
;#          + The operation will not be created otherwise
;#
;#       If Path is a file:
;#          + The operation will be forced if $Override_If_File is TRUE
;#          + The operation will not be created otherwise
;#
;#       If Path is a directory:
;#          + The operation will be forced if $Override_If_Dir is TRUE
;#          + The operation will not be created otherwise
;#
;#       If Path does not exist at all:
;#          + The directory will always be created
;#
;#    They all return the same thing, a ($Status, $Msg) pair where $status is:
;#
;#       -1     The action could not be performed because a condition for
;#        the action was not met. $Msg tells why not.
;#
;#       0     The action could not be performed because of an error. $Msg
;#        tells what happened.
;#
;#         1     The action was successfuly perfomed. $Msg tells what we did.
;#
;# AUTHOR
;#    Michael S. Muegel ([e-mail])
;#
;# RCS INFORMATION
;#    $Author: mmuegel $
;#    $Header: /usr/local/ustart/src/perl-stuff/libs/fwrdc/misc/RCS/fileop.pl,v 1.6 1992/11/02 02:58:21 mmuegel Exp $

require "fileinfo.pl";

;###############################################################################
;# Maybee_Delete_Path
;#
;# Deletes $Path depending on the Delete arguments. $Msg is a message
;# saying what deltion occured (null if none). $Type is set to "link",
;# "directory", "file", or "" depending on whether $Path was any of them.
;# Finally, $Status is:
;#
;#   -1 if a deletion was necess. but failed
;#    0 if a delete was not necess
;#    1 if a delete was necess and succeeded
;#
;# Arguments:
;#    $Path, $Delete_If_Link, $Delete_If_File, $Delete_If_Dir
;#
;# Returns:
;#    $Status, $Type, $Msg
;###############################################################################
sub Maybee_Delete_Path
{
   local ($Path, $Delete_If_Link, $Delete_If_File, $Delete_If_Dir) = @_;
   local ($Type, $Msg);

   # Check for existing link
   if (-l $Path)
   {
      $Type = "link";
      return (-1, $Type, "$Path is already a link") if (! $Delete_If_Link);
   }

   # Need to isolate these, really...
   else
   {
      # Check for existing file/directory
      if (-d $Path)
      {
         $Type = "directory";
         return (-1, $Type, "$Path is a directory") if (! $Delete_If_Dir);
      };
      if (-f _)
      {
         $Type = "file";
         return (-1, $Type, "$Path is a file") if (! $Delete_If_File);
      };
   };

   # Delete $Path if necess.
   if ($Type)
   {
      return (-1, $Type, "could not remove old $Type $Path")
         if (system ("/bin/rm -r $Path"));
      $Msg = "removed $Type $Path";
      return (0, $Type, $Msg);
   };

   return (1, $Type, $Msg);
};


;###############################################################################
;# Create_Symlink
;#
;# Creates a symbolic link from $Link_From -> $Link_To. Note that the link will
;# NOT be no matter what the Ovveride's are set to if it would result in a
;# recursive link. May delete an old  $Link_To depending on the Override
;# arguments.
;#
;# Arguments:
;#    $Link_To, $Link_From, $Override_If_Link, $Override_If_File,
;#    $Override_If_Dir
;#
;# Returns:
;#    $Status, $Msg
;###############################################################################
sub Create_Symlink
{
   local ($Link_To, $Link_From, $Override_If_Link, $Override_If_File,
          $Override_If_Dir) = @_;
   local ($Remove, $Type, $Msg, $Link_From_Real, $Link_To_Real,
          $Link_From_Basename, $Link_From_Dir, $Real_Path, $Status);

   # Determine whether $Link_From and $Link_To point to the same object!
   ($Link_From_Basename = $Link_From) =~ s/.*\///;
   $Link_From_Dir = &Dir_Name ($Link_From);
   return (0, $Real_Path) if (! (($Status, $Real_Path) = &Real_Path ($Link_From_Dir))[0]);
   chop ($Real_Path) if ($Real_Path =~ /^(\/){1,2}$/);
   $Link_From_Real = "$Real_Path/$Link_From_Basename";
   $Link_To_Real = "$Link_From_Dir/$Link_To" if ($Link_To !~ /^\//);
   return (0, $Link_To_Real) if (! (($Status, $Link_To_Real) = &Real_Path ($Link_To_Real))[0]);
   return (0, "$Link_From -> $Link_To would be a recursive link")
      if ($Link_From_Real eq $Link_To_Real);

   # Possibly delete $Link_To
   return (-1, $Msg)
      if ((($Status, $Type, $Msg) = &Maybee_Delete_Path ($Link_From, $Override_If_Link, $Override_If_File,
                                                         $Override_If_Dir))[0] == -1);

   # Create the link!
   $Msg .= ", " if ($Msg);
   return (0, "${Msg}error creating link $Link_From -> $Link_To")
      if (! symlink ($Link_To, $Link_From));
   return (1, "${Msg}created link $Link_From -> $Link_To");
};


;###############################################################################
;# Create_Dir
;#
;# Creates a directory $Path. May delete an old $Path depending on the
;# Override arguments. Uses $Mode as the mode of the directory. $Mode had better
;# be in octal!!
;#
;# Arguments:
;#    $Path, $Mode, $Override_If_Link, $Override_If_File, $Override_If_Dir
;#
;# Returns:
;#    $Status, $Msg
;###############################################################################
sub Create_Dir
{
   local ($Path, $Mode, $Override_If_Link, $Override_If_File,
          $Override_If_Dir) = @_;
   local ($Status, $Msg);

   # Possibly delete $Link_To
   return (-1, $Msg)
      if ((($Status, $Type, $Msg) = &Maybee_Delete_Path ($Path, $Override_If_Link, $Override_If_File,
                                                         $Override_If_Dir))[0] == -1);

   # Convert a mode in form 0[0-9]{1,3} to cotal because it must be ASCII
   $Mode = oct ($Mode) if ($Mode =~ /^0/);

   # Create the directory
   $Msg .= ", " if ($Msg);
   return (0, "${Msg}error directory $Path")
      if (! mkdir ($Path, $Mode));
   return (1, "${Msg}created directory $Path");
};

;###############################################################################
;# Change_File_Info
;#
;# This function can change the owner, group, and modes of a file or directory.
;# It will only perform these operations if the function arguments are
;# not -1. As an example, the following will change the mode and group
;# of a file and leave the owner unchanged:
;#
;#    ($Status, $Msg) = &Change_FIle_Info ($File, 0555, -1, "staff", 1)
;#
;# By default this function requires numerical user and group IDs. However, if
;# $Lookup_IDs is 1 then the $Owner and $Group will be interpreted as
;# actual login names or group names.
;#
;# Returns with a $Status of 1 if everything went AOK; otherwise, $Status is
;# 0 and $Msg contains an error message.
;#
;# Arguments:
;#    $Path, $Mode, $Owner, $Group, $Lookup_IDs
;#
;# Returns:
;#    $Status, $Msg
;###############################################################################
sub Change_File_Info
{
   local ($Path, $Mode, $Owner, $Group, $Lookup_IDs) = @_;
   local ($Uid, $Gid);

   # Change owner and/or mode
   if (($Owner != -1) || ($Group != -1))
   {
      # Get the default owner and group of the file
      (($Uid, $Gid) = (stat ($Path))[4,5]) || return (0, "error stating $Path");

      # Override the default owner?
      if ($Owner != -1)
      {
         if ($Lookup_IDs)
         {
            $Uid = (getpwnam ($Owner))[2];
           return (0, "no such user: $Owner") if ($Uid eq "");
         }
     else
         {
            $Uid = $Owner;
         };
      };

      # Override the default group?
      if ($Group != -1)
      {
         if ($Lookup_IDs)
         {
           $Gid = (getgrnam ($Group))[2];
        return (0, "no such group: $Group") if ($Gid eq "");
         }
         else
         {
            $Gid = $Group;
         };
      };

      # Change owner/group
      chown ($Uid, $Gid, $Path) || return (0, "error changing owner/group of $Path");
   };

   # Change mode
   if ($Mode != -1)
   {
      $Mode = oct ($Mode) if ($Mode =~ /^0/);
      chmod ($Mode, $Path) || return (0, "error changing mode of $Path");
   };

   return (1);
};


;###############################################################################
;# Copy_File
;#
;# Copies $Source to $Dest. If $Mode, $Owner, or $Group are -1 their default
;# values are used. Their default will be computed via the umask, ACLs,
;# etc or, if $Preserve is 1, the mode, owner, and group of the original file
;# is maintained. When $Preserve $Mode, $Owner, or $Group are ignored as you
;# would expect.
;#
;# By default this function requires numerical user and group IDs. However, if
;# $Lookup_IDs is 1 then the $Owner and $Group will be interpreted as
;# actual login names or group names.
;#
;# If $Force is 1 any pre-existing destination file will be overriden even
;# if the file is read only.
;#
;# Returns with a $Status of 1 if everything went AOK; otherwise, $Status is
;# 0 and $Msg contains an error message.
;#
;# Arguments:
;#    $Source, $Dest, $Preserve, $Mode, $Owner, $Group, $Lookup_IDs,
;#    $Force
;#
;# Returns:
;#    $Status, $Msg
;###############################################################################
sub Copy_File
{
   local ($Source, $Dest, $Preserve, $Mode, $Owner, $Group, $Lookup_IDs,
      $Force) = @_;
   local ($Output);

   # If the dest file exists and is not writable ...
   # mode.
   if ((-f $Dest) && (! -w $Dest))
   {
      # If not force mode copy will fail
      return (0, "$Dest is not writable") if (! $Force);

      # Force mode, try to change the mode. We can only change its mode if
      # we own it
      if ((stat (_))[4] == $>)
      {
         system ("chmod u+w $Dest") && return (0, "error making $Dest writable to owner");
      }
      else
      {
         return (0, "$Dest is not writable and you do not own it");
      };
   };

   # Copy
   $Output = `/bin/sh -c 'cp $Source $Dest' 2>&1`;
   $Output =~ s/\n$//;
   return (0, $Output) if ($Output);

   # If we want to change the mode of the destination to match the source
   # then we need to stat() it
   if ($Preserve)
   {
      (($Mode, $Owner, $Group) = (stat ($Source))[2,4,5]) || return (0, "error stating $Source");
      $Lookup_IDs = 0;
   };

   # Change the uid, gid, or mode of the destination
   return &Change_File_Info ($Dest, $Mode, $Owner, $Group, $Lookup_IDs);
};


1;