File Coverage

blib/lib/Filesys/POSIX/Bits/System.pm

Criterion	Covered	Total	%
statement	66	68	97.0
branch	68	76	89.4
condition	1	2	50.0
subroutine	8	8	100.0
pod	3	3	100.0
total	146	157	92.9

# Copyright (c) 2014, cPanel, Inc.
# All rights reserved.
# http://cpanel.net/
#
# This is free software; you can redistribute it and/or modify it under the same
# terms as Perl itself.  See the LICENSE file for further details.

package Filesys::POSIX::Bits::System;

use strict;
use warnings;

use Fcntl ();
use Filesys::POSIX::Bits;

=head1 NAME

Filesys::POSIX::Bits::System - Bitfield and constant conversions for file modes
and system call flags to system values

=head1 DESCRIPTION

This file contains functions to convert the values of bitfields and constants
from the values defined in C to the values used by the
system, defined in C.  Only exported values are supported.

The following (unexported) functions are provided:

=over

=item C

Converts the constants beginning with 'C<$O_>' to their values on the current
system.  These constants are generally used in the C<$flags> field of
C.

Values that are not supported by this system will throw a warning and will be
left out of the returned value.  The flags must include an access mode (e.g.
C<$O_RDONLY>, C<$O_WRONLY>, xor C<$O_RDWR>) in addition to any other values
desired.  If an access mode is not provided or its value is unknown to
C, then the function will die.

Note that C<$O_EVTONLY> is specific to this module and unsupported by C.
Trying to convert it to a system value will result in a warning.

=cut

sub convertFlagsToSystem {
    my $value = shift;
    my $out;

    # Handle access modes first
    my $access = $value & $Filesys::POSIX::Bits::O_MODE;
    if ( $access == $O_RDWR ) {
        $out = &Fcntl::O_RDWR;
    }
    elsif ( $access == $O_WRONLY ) {
        $out = &Fcntl::O_WRONLY;
    }
    elsif ( $access == $O_RDONLY ) {
        $out = &Fcntl::O_RDONLY;
    }
    else {
        die "Unknown access mode: $access";
    }

    $out |= _getOrWarn('O_APPEND')   if $value & $O_APPEND;
    $out |= _getOrWarn('O_CREAT')    if $value & $O_CREAT;
    $out |= _getOrWarn('O_EXCL')     if $value & $O_EXCL;
    $out |= _getOrWarn('O_EXLOCK')   if $value & $O_EXLOCK;
    $out |= _getOrWarn('O_NOFOLLOW') if $value & $O_NOFOLLOW;
    $out |= _getOrWarn('O_NONBLOCK') if $value & $O_NONBLOCK;
    $out |= _getOrWarn('O_SHLOCK')   if $value & $O_SHLOCK;
    $out |= _getOrWarn('O_TRUNC')    if $value & $O_TRUNC;

    warn "O_EVTONLY is not supported by Fcntl" if $value & $O_EVTONLY;

    return $out;
}

=item C

Converts the constants beginning with 'C<$S_I>' to their values on the current
system.  These constants are generally used in the C<$mode> field of C
and in the C<$mode> field of C.

File types that are not supported by this system will throw a warning and will
be left out of the returned value.  The mode may include zero or one file type
(values beginning with C<$S_IF>), but not more.  If a file type unknown to
C is provided, then the function will die.

=cut

sub convertModeToSystem {
    my $value = shift;

    my $out = 0;

    # Convert file types (system support may vary)
    my $type = $value & $S_IFMT;
    if ($type) {
        my $name;
        $name = 'S_IFIFO'  if $type == $S_IFIFO;
        $name = 'S_IFCHR'  if $type == $S_IFCHR;
        $name = 'S_IFDIR'  if $type == $S_IFDIR;
        $name = 'S_IFBLK'  if $type == $S_IFBLK;
        $name = 'S_IFREG'  if $type == $S_IFREG;
        $name = 'S_IFLNK'  if $type == $S_IFLNK;
        $name = 'S_IFSOCK' if $type == $S_IFSOCK;
        $name = 'S_IFWHT'  if $type == $S_IFWHT;
        die "Unknown file type: $type" if !$name;

        $out = _getOrWarn($name);
    }

    # Convert permissions
    $out |= &Fcntl::S_IRUSR if $value & $S_IRUSR;
    $out |= &Fcntl::S_IWUSR if $value & $S_IWUSR;
    $out |= &Fcntl::S_IXUSR if $value & $S_IXUSR;
    $out |= &Fcntl::S_IRGRP if $value & $S_IRGRP;
    $out |= &Fcntl::S_IWGRP if $value & $S_IWGRP;
    $out |= &Fcntl::S_IXGRP if $value & $S_IXGRP;
    $out |= &Fcntl::S_IROTH if $value & $S_IROTH;
    $out |= &Fcntl::S_IWOTH if $value & $S_IWOTH;
    $out |= &Fcntl::S_IXOTH if $value & $S_IXOTH;

    # Convert sticky bits
    $out |= &Fcntl::S_ISUID if $value & $S_ISUID;
    $out |= &Fcntl::S_ISGID if $value & $S_ISGID;
    $out |= &Fcntl::S_ISVTX if $value & $S_ISVTX;

    return $out;
}

=item C

Converts the constants beginning with 'C<$SEEK_>' to their values on the
current system.  These constants are generally used in the C<$whence> field
of C.

If a value unknown to C is provided, then the function
will die.

=cut

sub convertWhenceToSystem {
    my $value = shift;

    if ( $value == $SEEK_SET ) {
        return &Fcntl::SEEK_SET;
    }
    elsif ( $value == $SEEK_CUR ) {
        return &Fcntl::SEEK_CUR;
    }
    elsif ( $value == $SEEK_END ) {
        return &Fcntl::SEEK_END;
    }
    else {
        die "Unknown whence value: $value";
    }
}

=back

=cut

# Private function that either returns the requested value from Fcntl or
# throws a warning.  If a warning is thrown, the value 0 is returned.
sub _getOrWarn {
    my $var = shift;

    my $value = eval("\&Fcntl::$var") || 0;
    warn "$var is not supported by this system" if $@;

    return $value;
}

1;

=head1 DIAGNOSTICS

=over

=item I is not supported by this system

The system's Fcntl does not have a value defined for the given I and
thus it can't (and won't) be converted.

=item I is not supported by Fcntl

The Fcntl module does not define the given I and thus it can't (and
won't) be converted.

=item Unknown access mode: I

The access mode provided does not match C<$O_RDONLY>, C<$O_WRONLY>, xor
C<$O_RDWR>; or an access mode was not provided at all.

=item Unknown file type: I

The optional file type component that was provided does not match one of:
C<$S_IFIFO>, C<$S_IFCHR>, C<$S_IFDIR>, C<$S_IFBLK>, C<$S_IFREG>, C<$S_IFLNK>,
C<$S_IFSOCK>, xor C<$S_IFWHT>.

=item Unknown whence value: I

The whence value provided was not one of: C<$SEEK_SET>, C<$SEEK_CUR>, xor
C<$SEEK_END>.

=back

=head1 KNOWN ISSUES

=over

=item SEEK_END is assumed to exist

The C value C is assumed to exist when it is not specified
by POSIX, but is rather an almost ubiquitously supported extension.

=back

=head1 AUTHORS

=over

=item Rikus Goodell

=item Brian Carlson

=back

=head1 COPYRIGHT

Copyright (c) 2014, cPanel, Inc.  Distributed under the terms of the Perl
Artistic license.