NetNews Usenet Archive 1993 #1/NN_1993_1.iso/spool/comp/unix/aux/4587/mksystem.perl

Text File | 1993-01-10 | 8.6 KB | 419 lines

#!/usr/local/bin/perl
#
# mksystem
#
# Set up a local System folder, with local extensions.
#

# Initialize parameters and parse the command line

$CHOWN = 0;
$force = 0;
$user = "";
while ( $#ARGV >= 0 )
{
    if ( $ARGV[0] eq '-f' )
    {
        # Force copying of System File
        $force = 1;
        shift(@ARGV);
    }
    elsif ( $ARGV[0] eq '-u' )
    {
        # Build system folder on behalf of another user
        $CHOWN = 1;
        $user = $ARGV[1];
        if ( $user eq "" )
        {
            &usage;
        }
        shift(@ARGV);
        shift(@ARGV);
    }
    elsif ( substr($ARGV[0],0,2) eq '-u' )
    {
        # Build system folder on behalf of another user
        $CHOWN = 1;
        $user = substr($ARGV[0],2);
        shift(@ARGV);
        shift(@ARGV);
    }
    else
    {
        # Display usage message
        &usage;
    }
}

# Locate the files to be contained in the local System Folder.  XX-PRODUCTS-XX
# is substituted with the directory containing local extensions as it is
# set up in the Makefile.

$systemdir = '/mac/lib/SystemFiles';
$systemfolder = '/mac/sys/System Folder';
$products = 'XX-PRODUCTS-XX';

# Read our umask for use later

$umask = umask;
umask($umask);

# Get the home directory of the user who will own the new local System Folder.
# If the owner is not the same as the invoker, then we need the owner's
# uid and default gid for chown.

if ( $CHOWN )
{
    ($p_name,$p_passwd,$p_uid,$p_gid,$p_quota,$p_comment,$p_gcos,$HOME) =
        getpwnam($user);
}
else
{
    ($p_name,$p_passwd,$p_uid,$p_gid,$p_quota,$p_comment,$p_gcos,$HOME) =
        getpwuid($<);
    $p_uid = $<;
    $p_gid = $(;
}

if ( $HOME eq '' )
{
    print STDERR "User <$user> not listed in /etc/passwd!\n";
    exit 1;
}

# Compute the name of the local System Folder based on how mksystem was
# invoked; it has two names:  mksystem and mksystem24.

if ( substr($0,-2,2) eq "24" )
{
    $mydir = "$HOME/System Folder24";
}
else
{
    $mydir = "$HOME/System Folder";
}

# Look for Apple's system files.

if ( ! -d $systemdir )
{
    print STDERR "$0:  Cannot find global system folder $systemdir.\n";
    exit 1;
}

# Check permissions on the new local System Folder, creating it if necessary.

if ( -f $mydir )
{
    print STDERR "$0: Cannot create '$mydir'.\n";
    print STDERR "A regular file by that name currently exists.\n";
    exit 1;
}
elsif ( -d $mydir )
{
    if ( ! -w $mydir )
    {
        print STDERR "$0: cannot update $mydir.  Permission denied.\n";
        exit 1;
    }
    print "System Folder '$mydir' already exists - updating.\n";
    if ( $force == 0 )
    {
        print "\n";
        print STDERR "CAUTION: Existing private (writable) files will ";
        print STDERR "not be updated.\n";
        print STDERR "         Use the force option (-f) to update ";
        print STDERR "these files!\n";
    }
}
else
{
    print "Creating System Folder '$mydir'\n";
    $newdir = 1;
    if ( mkdir($mydir,( 0777 & ~ $umask )) eq 0 )
    {
        print STDERR "Cannot create $mydir:\n$!\n";
        exit 1;
    }
}

# Always want local stuff in favor of Apple stuff.  Therefore, if
# forced, want to do the local stuff last.  Otherwise do the local
# stuff first.

if ( $force )
{
    &appleStuff;
    &localStuff;
}
else
{
    &localStuff;
    &appleStuff;
}

# This subroutine copies $old to $new, using the command specified in $how.
# $how contains a Unix command with "$old" representing the source file and
# "$new" representing the destination file.  For example:  "/bin/cp $old $new".
# File names are treated in an 8-bit clean fashion.

sub copyFile
{
    local($how,$old,$new) = @_;
    local(@args,$arg);

    @args = split(/ /,$how);
    foreach $arg ( 0 .. $#args )
    {
        eval("\$args[\$arg] = \"$args[$arg]\"");
    }
    &spawn(@args);
}

# This subroutine copies a directory.  Regular files are copied according
# to the "how" parameter, which includes an "$old" keyword specifying the
# source of the copy, and a "$new" keyword specifying the destination of
# the copy.  The "src" parameter specifies the source directory, and the
# "dest" parameter specifies the destination directory, which may or may
# not exist prior to invoking copyDir.  The "force" parameter causes regular
# files to be copied, even if the destination already exists.  Ownerships
# of the files copied and directories created are set to the "uid" and
# "gid" parameters.

sub copyDir
{
    local($how,$src,$dest,$force,$uid,$gid) = @_;
    local(@dirs,$name,$this,$spath,$dpath,$status,$s_dev,$s_ino,$s_mode);

    # Initialize the directory list
    @dirs = ( '.' );

    # Copy each directoy in the directory list.
    while ( ( $this = shift(@dirs) ) ne "" )
    {
        # "." is a special case, and we don't want to have dots
        # in paths of files that we copy.  Looks bad when the copy
        # is really a symbolic link.
        if ( $this eq '.' )
        {
            $dpath = $dest;
            $spath = $src;
        }
        else
        {
            $dpath = "$dest/$this";
            $spath = "$src/$this";
        }

        # See that the dest directory exists.
        if ( -d $dpath )
        {
            0; # Do nothing
        }
        elsif ( -e $dpath )
        {
            print STDERR "Cannot create directory $dpath, ";
            print STDERR "as it already exists\n";
            next;
        }
        else
        {
            if ( mkdir($dpath,(0777 & ~ $umask)) == 0 )
            {
                print STDERR "Unable to create $dpath:\n$!\n";
                next;
            }
        }

        # Copy everything in the src directory to the dest directory,
        # except for . and ..
        if ( opendir(DIR,$spath) eq "" )
        {
            print STDERR "Unable to read directory $spath:\n$!\n";
            next;
        }
        while ( ( $name = readdir(DIR) ) ne "" )
        {
            if ( ( $name eq '.' ) ||
                 ( $name eq '..' ) )
            {
                next;
            }

            # Remove . from paths.  They look bad when the copy
            # of regular files are really symbolic links.
            if ( $this eq '.' )
            {
                $spath = "$src/$name";
                $dpath = "$dest/$name";
            }
            else
            {
                $spath = "$src/$this/$name";
                $dpath = "$dest/$this/$name";
            }
            if ( -d $spath )
            {
                # Src is a directory, add it to the directory
                # list for later processing.
                if ( $this eq '.' )
                {
                    unshift(@dirs,"$name");
                }
                else
                {
                    unshift(@dirs,"$this/$name");
                }
            }
            else
            {
                # Copy a regular file
                if ( $this eq '.' )
                {
                    print "\t$name\n";
                }
                else
                {
                    print "\t$this/$name\n";
                }

                # Forced copy, unlink the destination file
                # if it already exists.
                if ( ( -e $dpath ) && ( $force ) )
                {
                    unlink($dpath);
                }

                # Copy the file, if the dest doesn't already
                # exist, and change ownership if needed.
                if ( ! -e $dpath )
                {
                    ©File($how,$spath,$dpath);
                    ( $s_dev,$s_ino,$s_mode ) =
                        stat($dpath);
                    chmod(($s_mode | 0200),$dpath);
                    if ( $uid != $< )
                    {
                        chown($uid,$gid,$dpath);
                    }
                }
            }
        }
        closedir(DIR);
    }

    # Change the ownership of the directory just processed.  This is
    # done afterwards so that we have write permission into the directory
    # for making copies.
    if ( $uid != $< )
    {
        chown($uid,$gid,"$dest/$this");
    }
}

# This subroutine copies system files distributed with A/UX

sub appleStuff
{
    # Create subdirectories; copy or link files
    print "Shared files ...\n";
    ©Dir('/bin/ln -s $old $new',"$systemdir/shared",$mydir,1,
             $p_uid,$p_gid);

    print "Private files ...\n";
    ©Dir('/bin/cp $old $new',"$systemdir/private",$mydir,
             $force,$p_uid,$p_gid);

    foreach $file ( "Desktop DF", "Desktop DB", ".fs_cache", ".fs_dirIDs" )
    {
        $spath = "$systemfolder/$file";
        $dpath = "$mydir/$file";
        if ( ( ! -f $dpath ) && ( -f $spath ) )
        {
            ©File('/bin/cp $old $new',$spath,$dpath);
        }
    }
}

# This subroutine copies products installed locally for private system files.

sub localStuff
{
    # Copy products
    if ( ( -d $products ) && ( opendir(PDIR,$products) ne "" ) )
    {
        # Scan each product
        while ( ( $this = readdir(PDIR) ) ne "" )
        {
            # Skip if . or ..
            if ( ( $this eq '.' ) || ( $this eq '..' ) )
            {
                next;
            }

            # Copy a specific product.  First create symlinks
            # to the sharable files, then copy the ones that must
            # be unique.
            print "$this ...\n";
            $spath = "$products/$this/shared";
            if ( -d $spath )
            {
                ©Dir('/bin/ln -s $old $new',$spath,
                         $mydir,1,$p_uid,$p_gid);
            }
            $spath = "$products/$this/private";
            if ( -d $spath )
            {
                ©Dir('/bin/cp $old $new',$spath,
                         $mydir,$force,$p_uid,$p_gid);
            }
        }
        closedir(PDIR);
    }
}

# This subroutine spawns a child process and waits for it to finish.  The
# command line is treated in an 8-bit clean fashion.

sub spawn
{
    local($forking);

    $forking = 1;
    while ( $forking )
    {
        if ( $pid = fork )
        {
            waitpid($pid,0);
            $forking = 0;
        }
        elsif ( defined $pid )
        {
            exec(@_);
            print STDERR "Failed to exec \'@_'\n";
            die;
        }
        elsif ( $! =~ /No more process/ )
        {
            sleep(5);
        }
        else
        {
            print "Failed to fork:  $!\n";
            die;
        }
    }
}

# This subroutine displays a usage message.

sub usage
{
    print 'usage: mksystem [-f] [-u user]\n';
    print '       mksystem24 [-f] [-u user]\n';
    exit 1;
}

### End of File ###