view release on metacpan or  search on metacpan

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

    print STDERR "[start | stop | restart | status]\n";
    foreach my $command (@commands) {
        my $cmd = sprintf("  --%-${max_length}s", $command);
        my $desc = shift @desc;
        my $value = shift @values;
        print STDERR "$cmd$desc: $value\n";
    }
    exit;
}

sub parse_options {
    my $self = shift;

    my %options;
    my %option_keys;
    my @options = ($self->default_options, @_);
    while(@options) {
        my $option = shift @options;
        my $default_value = shift @options;
        my $help = shift @options;
        $option_keys{$option} = $help;
        my ($key) = $option =~/(\w+)/;
        $options{$key} = $default_value if(defined $default_value);
    }
    GetOptions(\%options, keys %option_keys);
    $self->options(\%options);
    $self->options_desc(\%option_keys);
    $self->assign_options(qw(user group name chroot foreground daemon pidfile));
    $self->init();
    return \%options;

}

sub init {}

sub print_version {
    my $self = shift;
    my $name = $self->name;
    my $version = $self->version;
    print STDERR "$name $version (Working::Daemon: $VERSION)\n";
}


sub assign_options {
    my ($self, @options) = @_;
    foreach my $option (@options) {
        $self->$option($self->options->{$option})
            if (exists $self->options->{$option});
    }
}


sub change_root {
    my $self = shift;
    return unless $self->chroot;

    my $tmpdir = $self->tmpdir;
    mkdir ($tmpdir)
        || croak "Cannot create directory '$tmpdir': $!";

    chown($self->uid,$self->gid, $tmpdir)
        || croak("Cannot chown $tmpdir to (". $self->uid . ":". $self->gid . "): $!");

    my $dirs  = $self->{__PACKAGE__}->{chroot_clean_dirs} = [];
    my $files = $self->{__PACKAGE__}->{chroot_clean_files} = [];

    foreach my $dir ($self->chroot_dirs) {
        push @$dirs, "$tmpdir/$dir";
        mkdir("$tmpdir/$dir")
            || croak "Cannot create $tmpdir/$dir: $!";
    }

    foreach my $file_to_copy ($self->chroot_files) {
        push @$files, "$tmpdir/$file_to_copy";
        copy("$file_to_copy", "$tmpdir/$file_to_copy")
            || croak "Cannot copy $file_to_copy -> $tmpdir/$file_to_copy: $!";
    }

    chroot("$tmpdir/")
        || croak ("Can't chroot to $tmpdir: $!");
    chdir("/")
        || croak ("Can't chdir to '/': $!");
}

sub version {
    my $self = shift;
    my $caller = caller(2);
    no strict 'refs';
    my $varname = "${caller}::VERSION";
    my $version = $$varname;
    return $version || "";
}

sub write_pidfile {
    my $self = shift;
    my $pidfile = $self->pidfile;
    open(my $pidfh, "+>$pidfile") || croak "Cannot open '$pidfile': $!";
    print $pidfh "$$";
    close $pidfh;
}


sub delete_pidfile {
    my $self = shift;
    unlink($self->pidfile) || croak "Cannot remove pidfile '".$self->pidfile."': $!";
}


sub cleanup_chroot {
#    unlink("/tmp/glbdns.$pid/etc/protocols") || die "$!";
#    rmdir("/tmp/glbdns.$pid/etc/") || die;
#    rmdir("/tmp/glbdns.$pid/") || die;
#    unlink($config{pidfile}) || die $!;
}

sub action_start {
    my $self = shift;
    my $name = $self->name;
    if(my $pid = $self->get_pid) {
        $self->log(0, "fatal", "Cannot start '$name' because it is already running at $pid");
        $self->exit_error;
    }