view release on metacpan or  search on metacpan

lib/Daemon/Control.pm  view on Meta::CPAN

    # Shortcut caused by setting foreground or using the ENV to do it.
    if ( ( $self->foreground == 1 ) || ( $ENV{DC_FOREGROUND} ) ) {
        $self->fork( 0 );
        $self->quiet( 1 );
    }

    die "Unknown arguments to the constructor: " . join( " ", keys %$args )
        if keys( %$args );

    return $self;
}

sub with_plugins {
    my ( $class, @in ) = @_;

    # ->with_plugins()->new is just ->new...
    return $class unless @in;

    # Make sure we have Role::Tiny installed.
    local $@;
    eval "require Role::Tiny";
    if ( $@ ) {
        die "Error: Role::Tiny is required for with_plugins to function.\n";
    }

    # Take an array or arrayref as an argument
    # and mutate it into a list like this:
    #   'Module'  -> Becomes -> 'Root::Module'
    #   '+Module' ->  Becomes -> 'Module'
    my @plugins = map {
        substr( $_, 0, 1 ) eq '+'
            ? substr( $_, 1 )
            : "Daemon::Control::Plugin::$_"
    } ref $in[0] eq 'ARRAY' ? @{ $in[0] } : @in;


    # Compose the plugins into our class, and return for the user
    # to call ->new().
    return Role::Tiny->create_class_with_roles( $class, @plugins );
}

# Set the uid, triggered from getting the uid if the user has changed.
sub _set_uid_from_name {
    my ( $self ) = @_;
    return unless defined $self->user;

    my $uid = getpwnam( $self->user );
    die "Error: Couldn't get uid for non-existent user " . $self->user
        unless defined $uid;
    $self->trace( "Set UID => $uid" );
    $self->uid( $uid );
}

# Set the uid, triggered from getting the gid if the group has changed.
sub _set_gid_from_name {
    my ( $self ) = @_;

    # Grab the GID if we have a UID but no GID.
    if ( !defined $self->group && defined $self->uid ) {
        my ( $gid ) = ( (getpwuid( $self->uid ))[3] );
        $self->gid( $gid );
        $self->trace( "Implicit GID => $gid" );
        return $gid;
    }

    return unless defined $self->group;

    my $gid = getgrnam( $self->group );
    die "Error: Couldn't get gid for non-existent group " . $self->group
        unless defined $gid;
    $self->trace( "Set GID => $gid" );
    $self->gid( $gid );

}

sub redirect_filehandles {
    my ( $self ) = @_;

    if ( $self->stdout_file ) {
        my $file = $self->stdout_file;
        $file = $file eq '/dev/null' ? File::Spec->devnull : $file;

        if ( ref $file eq 'ARRAY' ) {
            my $mode = shift @$file;
            open STDOUT, $mode, @$file ? @$file : ()
                or die "Failed to open STDOUT with args $mode @$file: $!";

            $self->trace("STDOUT redirected to open(STDOUT $mode @$file)");
        }
        else {
            open STDOUT, ">>", $file
                or die "Failed to open STDOUT to $file: $!";
            $self->trace( "STDOUT redirected to $file" );
        }
    }
    if ( $self->stderr_file ) {
        my $file = $self->stderr_file;
        $file = $file eq '/dev/null' ? File::Spec->devnull : $file;

        if ( ref $file eq 'ARRAY' ) {
            my $mode = shift @$file;
            open STDERR, $mode, @$file ? @$file : ()
                or die "Failed to open STDERR with args $mode @$file: $!";

            $self->trace("STDERR redirected to open(STDERR $mode @$file)");
        }
        else {
            open STDERR, ">>", $file
                or die "Failed to open STDERR to $file: $!";
            $self->trace("STDERR redirected to $file");
        }
    }
}

sub _create_resource_dir {
    my ( $self ) = @_;
    $self->_create_dir($self->resource_dir);
}

sub _create_dir {
    my ( $self, $dir ) = @_;

    return 0 unless defined $dir;
    return 1 unless length($dir);

    if ( -d $dir ) {
        $self->trace( "Dir exists (" . $dir . ") - no need to create" );
        return 1;
    }

    my ( $created ) = make_path(
        $dir,
        {
            uid => $self->uid,
            group => $self->gid,
            error => \my $errors,
        }
    );

    if ( @$errors ) {
        for my $error ( @$errors ) {
            my ( $file, $msg ) = %$error;
            die "Error creating $file: $msg";
        }
    }

    if ( $created eq $dir ) {
        $self->trace( "Created dir (" . $dir . ")" );
        return 1;
    }

    $self->trace( "_create_dir() for $dir failed and I don't know why" );
    return 0;
}

sub _double_fork {
    my ( $self ) = @_;
    my $pid = fork();

    $self->trace( "_double_fork()" );
    if ( $pid == 0 ) { # Child, launch the process here.
        setsid(); # Become the process leader.
        my $new_pid = fork();
        if ( $new_pid == 0 ) { # Our double fork.

            if ( $self->gid ) {
                setgid( $self->gid );
                $self->trace( "setgid(" . $self->gid . ")" );
            }

            if ( $self->uid ) {
                setuid( $self->uid );

                $ENV{USER} = $self->user || getpwuid($self->uid);
                $ENV{HOME} = ((getpwuid($self->uid))[7]);

                $self->trace( "setuid(" . $self->uid . ")" );
                $self->trace( "\$ENV{USER} => " . $ENV{USER} );
                $self->trace( "\$ENV{HOME} => " . $ENV{HOME} );
            }

            if ( $self->umask ) {
                umask( $self->umask);
                $self->trace( "umask(" . $self->umask . ")" );
            }

            open( STDIN, "<", File::Spec->devnull );

            if ( $self->redirect_before_fork ) {
                $self->redirect_filehandles;
            }

            $self->_launch_program;
        } elsif ( not defined $new_pid ) {
            warn "Cannot fork: $!";
        } else {
            $self->pid( $new_pid );
            $self->trace("Set PID => $new_pid" );
            $self->write_pid;
            _exit 0;
        }
    } elsif ( not defined $pid ) { # We couldn't fork.  =(
        warn "Cannot fork: $!";
    } else { # In the parent, $pid = child's PID, return it.
        waitpid( $pid, 0 );
    }
    return $self;
}

sub _foreground { shift->_launch_program }

sub _fork {
    my ( $self ) = @_;
    my $pid = fork();

    $self->trace( "_fork()" );
    if ( $pid == 0 ) { # Child, launch the process here.
        $self->_launch_program;
    } elsif ( not defined $pid ) {
        warn "Cannot fork: $!";
    } else { # In the parent, $pid = child's PID, return it.
        $self->pid( $pid );
        $self->trace("Set PID => $pid" );
        $self->write_pid;
    }
    return $self;
}

sub _launch_program {
    my ($self) = @_;

    if ( $self->directory ) {
        chdir( $self->directory );
        $self->trace( "chdir(" . $self->directory . ")" );
    }