view release on metacpan or  search on metacpan

lib/perfSONAR_PS/OWP.pm  view on Meta::CPAN

        $name =~ tr/a-z/A-Z/;
        if ( $name ne $_ ) {
            $args{$name} = $args{$_};
            delete $args{$_};
        }
    }

    foreach (@$must) {
        return undef if !exists $args{$_};
    }

    my @args = %args;
    return @args;
}

=head2 setids()

TDB

=cut

sub setids {
    my (%args) = @_;
    my ( $uid,  $gid );
    my ( $unam, $gnam );

    $uid = $args{'USER'}  if ( defined $args{'USER'} );
    $gid = $args{'GROUP'} if ( defined $args{'GROUP'} );

    # Don't do anything if we are not running as root.
    return if ( $> != 0 );

    die "Must set User option! (Running as root is folly!)"
        if ( !$uid );

    # set GID first to ensure we still have permissions to.
    if ( defined($gid) ) {
        if ( $gid =~ /\D/ ) {

            # If there are any non-digits, it is a groupname.
            $gid = getgrnam( $gnam = $gid )
                or die "Can't getgrnam($gnam): $!";
        }
        elsif ( $gid < 0 ) {
            $gid = -$gid;
        }
        die("Invalid GID: $gid") if ( !getgrgid($gid) );
        $) = $( = $gid;
    }

    # Now set UID
    if ( $uid =~ /\D/ ) {

        # If there are any non-digits, it is a username.
        $uid = getpwnam( $unam = $uid )
            or die "Can't getpwnam($unam): $!";
    }
    elsif ( $uid < 0 ) {
        $uid = -$uid;
    }
    die("Invalid UID: $uid") if ( !getpwuid($uid) );
    $> = $< = $uid;

    return;
}

=head2 daemonize()

TDB

=cut

sub daemonize {
    my (%args) = @_;
    my ( $dnull, $umask ) = ( '/dev/null', 022 );
    my $fh;

    $dnull = $args{'DEVNULL'} if ( defined $args{'DEVNULL'} );
    $umask = $args{'UMASK'}   if ( defined $args{'UMASK'} );

    if ( defined $args{'PIDFILE'} ) {
        $fh = new FileHandle $args{'PIDFILE'}, O_CREAT | O_RDWR | O_TRUNC;
        unless ( $fh && flock( $fh, LOCK_EX | LOCK_NB ) ) {
            die "Unable to lock pid file $args{'PIDFILE'}: $!";
        }
        $_ = <$fh>;
        if ( defined $_ ) {
            my ($pid) = /(\d+)/;
            chomp $pid;
            die "$FindBin::Script:$pid still running..."
                if ( kill( 0, $pid ) );
        }
    }

    open STDIN,  "$dnull"   or die "Can't read $dnull: $!";
    open STDOUT, ">>$dnull" or die "Can't write $dnull: $!";
    if ( !$args{'KEEPSTDERR'} ) {
        open STDERR, ">>$dnull" or die "Can't write $dnull: $!";
    }

    defined( my $pid = fork ) or die "Can't fork: $!";

    # parent
    exit if $pid;

    # child
    $fh->seek( 0, 0 );
    $fh->print($$);
    undef $fh;
    setsid or die "Can't start new session: $!";
    umask $umask;

    return 1;
}

=head2 print_hash()

TDB

=cut