view release on metacpan or  search on metacpan

lib/Slaughter/API/generic.pm  view on Meta::CPAN

=head2 SetPermissions

This method allows the file owner,group, and mode-bits of a local file
to be changed.

=for example begin

  SetPermissions( File => "/etc/motd" ,
                  Owner => "root",
                  Group => "root",
                  Mode => "644" );

=for example end

The following parameters are supported:

=over 8

=item File [mandatory]

The filename to work with.

=item Group

The group to set as the owner for the file.

=item User

The username to set as the files owner.

=item Mode

The permissions bits to set for the file.  B<NOTE> if this doesn't start with a leading
"0" then it will be passed through the "oct" function - this allows you to use the
obvious construct :

=for example begin

  Mode => "755"

=for example end

=back

=cut

sub SetPermissions
{
    my (%params) = (@_);

    my $file  = $params{ 'File' }  || return;
    my $group = $params{ 'Group' } || undef;
    my $owner = $params{ 'Owner' } || undef;
    my $mode  = $params{ 'Mode' }  || undef;

    # file missing is an error
    return (-1) if ( !-e $file );

    # Numeric values
    my $uid = undef;
    my $gid = undef;

    # invalid user?
    if ( defined($owner) )
    {
        $uid = getpwnam($owner);
        return -2 if ( !defined($uid) );

        $::verbose && print "Owner:$owner -> UID:$uid\n";
    }

    # invalid group?
    if ( defined($group) )
    {
        $gid = getgrnam($group);
        return -2 if ( !defined($gid) );
        $::verbose && print "Group:$group -> GID:$gid\n";
    }

    my $changed = 0;

    if ( $params{ 'Owner' } )
    {

        #
        #  Find the current UID/GID of the file, so we
        # can change just the owner.
        #
        my ( $dev,      $ino,     $mode, $nlink, $orig_uid,
             $orig_gid, $rdev,    $size, $atime, $mtime,
             $ctime,    $blksize, $blocks
           )
          = stat($file);

        $::verbose && print "\tSetting owner to $owner/$uid\n";
        chown( $uid, $orig_gid, $file );

        $changed += 1;
    }
    if ( $params{ 'Group' } )
    {

        #
        #  Find the current UID/GID of the file, so we
        # can change just the group.
        #
        my ( $dev,      $ino,     $mode, $nlink, $orig_uid,
             $orig_gid, $rdev,    $size, $atime, $mtime,
             $ctime,    $blksize, $blocks
           )
          = stat($file);

        $::verbose && print "\tSetting group to $group/$gid\n";
        chown( $orig_uid, $gid, $file );

        $changed += 1;
    }
    if ( $params{ 'Mode' } )
    {
        $::verbose && print "\tSetting mode to $mode\n";
        my $mode = $params{ 'Mode' };
        if ( $mode !~ /^0/ )
        {
            $mode = oct("0$mode");
            $::verbose && print "\tOctal mode is now $mode\n";
        }
        chmod( $mode, $file );
        $changed += 1;
    }

    return ($changed);
}



=head2 UserDetails

This primitive will return a hash of data about the local Unix user
specified, if it exists.

=for example begin

   if ( UserExists( User => "skx" ) )
   {
      my %data = UserDetails( User => "skx" );
   }

=for example end

The following parameters are available:

=over

=item User [mandatory]

The unix username to retrieve details of.

=back

The return value of this function is a hash of data conprising of the
following Keys/Values

=over

=item Home

The user's home directory

=item UID

The user's UID

=item GID

The user's GID

=item Quota

The user's quota.

=item Comment

The user's comment

=item Shell

The user's login shell.

=item Login

The user's username.

=back

Undef will be returned on failure.

=cut

sub UserDetails
{
    my (%params) = (@_);


    my ( $name, $pwcode, $uid, $gid, $quota, $comment, $gcos, $home, $logprog )
      = getpwnam( $params{ 'User' } );

    #
    #  This is undef.
    #
    return $name if ( !defined($name) );

    #
    #  Return the values as a hash
    #
    return (
             { Home    => $home,
               UID     => $uid,
               GID     => $gid,
               Quota   => $quota,
               Comment => $comment,
               Shell   => $logprog,
               Login   => $name
             } );
}



=head2 UserExists

This primitive will test to see whether the given local user exists.

=for example begin

   if ( UserExists( User => "skx" ) )
   {
      # skx exists
   }

=for example end

The following parameters are available:

=over

=item User [mandatory]

The unix username to test for.

=back

The return value of this function is 1 if the user exists, and 0 otherwise.

=cut


sub UserExists
{
    my (%params) = (@_);

    my ( $login, $pass, $uid, $gid ) = getpwnam( $params{ 'User' } );

    if ( !defined($login) )
    {
        return 0;
    }
    else
    {
        return 1;
    }
}




=head2 UserCreate

Create a new user for the system.

=for example begin

  # TODO

=for example end

The following parameters are required:

=over 8

=item Login

The username to create.

=item UID

The UID for the user.

=item GID

The primary GID for the user.

=back

You may optionally specify the GCos field to use.

=cut

sub UserCreate
{
    print "UserCreate - not implemented for $^O\n";
}



1;



=head1 AUTHOR

Steve Kemp <steve@steve.org.uk>