Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with HTTPS or Subversion.

Download ZIP
branch: master
Fetching contributors…

Cannot retrieve contributors at this time

executable file 405 lines (354 sloc) 13.955 kb
#!/usr/bin/env perl
#
# dancerctl - like apachectl for perl/Dancer apps
#
# Copyright (c) 2011, Nick Knutov, nick@knutov.com
# https://github.com/knutov/dancerctl
#
# License: BSD 2-Clause License (http://en.wikipedia.org/wiki/BSD_licenses)
#
our $VERSION = '0.04';
use 5.10.1;
use feature 'switch';
use feature 'say';
use strict;
# no strict 'refs';
# use Getopt::Std;
use Config::Auto;
use Data::Dumper;
my $global = $ENV{DANCERCTL_CONF} || '/etc/dancerctl.conf'; # better should be 644
# load defaults
# FIXME: it assumes now that all users are in /home/
my $default = Config::Auto::parse($global, format => "yaml") if -f $global;
$default->{conf} ||= '.dancerctl'; # default ~user/.dancerctl/appname
# TODO: or, if not exists,
# ~user/.dancerctl as one config
# for all apps
$default->{workers} ||= 2; # default number of workers
$default->{host} ||= 'localhost'; # default host to bind (localhost, ip or *)
$default->{port} ||= '3000'; # default port
$default->{sockets} ||= ''; # socket path (start from user dir or absolute or relative to app path)
$default->{pids} ||= ''; # pid path (start from user dir or absolute or relative to app path)
$default->{users} ||= ''; # TODO: enabled users for dancerctl, comma and/or space separated.
# blank means all users are enabled
$default->{server} ||= 'Starman';
$default->{env} ||= 'production'; # default environment
$default->{path} ||= 'apps/'; # relative to $home prefix to path with all apps
$default->{method} ||= 'port';
$default->{autoall} ||= 1; # auto _all action if no app specified
$default->{autostart} ||= undef; # autostart is enabled for all apps by default if enabled
$default->{debug} ||= undef;
$default->{chmod} ||= '0666'; # default chmod for socket (and pid file?)
# $default->{daemon} ||= 1; # should be plackup daemonized(-D)? Default: yes
my $debug = $default->{debug}; $debug = $ENV{DANCERCTL_DEBUG} if $ENV{DANCERCTL_DEBUG};
my $root = $< == 0; # true if user is root
my $argc = scalar(@ARGV);
my ($home,$user,$action,$app,$env);
($user,$action,$app,$env) = @ARGV if $root and $argc == 4;
($user,$action,$app, ) = @ARGV if $root and $argc == 3;
($user,$action, ) = @ARGV if $root and $argc == 2;
( $action ) = @ARGV if $root and $argc == 1;
($action,$app,$env) = @ARGV if not $root and $argc >= 3;
($action,$app ) = @ARGV if not $root and $argc == 2;
($action ) = @ARGV if not $root and $argc == 1;
$user ||= $ENV{USER};
# $action ||= @ARGV[0];
$action ||= 'help';
$home = $ENV{HOME};
# autodetect positions - you can use 'start app' and 'app start' now.
if ( $action and $app and
$action !~ /^start|stop|restart|status$/ and
$app =~ /^start|stop|restart|status$/
) {
my $tmp = $action;
$action = $app;
$app = $tmp;
}
# checking list of known actions
unless ( $action =~ /^[start|stop|restart|status]{1}[all]{0,1}|help|init$/ ) {
help();
say "\nError: unknown action: $action\n";
exit;
}
if ( $debug ) {
say 'Root?......: '.$root;
say 'Home.......: '.$home;
say 'User.......: '.$user;
say 'App........: '.$app;
say 'Action.....: '.$action;
say 'Environment: '.$env;
}
help() if $action eq 'help';
# shift @ARGV && init(@ARGV) if $action eq 'init';
# FIXME: no root for now
$action = 'statusall' if not $app and $action eq 'status' and $default->{autoall};
if ( $app ) {
start($user,$home,$app,$env) if $action eq 'start';
stop($user,$home,$app,$env) if $action eq 'stop';
status($user,$home,$app,$env) if $action eq 'status';
restart($user,$home,$app,$env) if $action eq 'restart';
init($user,$home,$app,$env) if $action eq 'init'; # env is path here
} else {
start_all($user) if $action eq 'startall';
stop_all($user) if $action eq 'stopall' ;
status_all($user) if $action eq 'statusall' ;
restart_all($user) if $action eq 'restartall' ;
}
#===============================================================================
# init will create default recommended config
# format: dancerctl init $appname $path [force]
# note: path counted from user dir: app -> /home/user/app
# when 'force' the config file will be overwritten if exists.
# example 1:
# dancerctl init app projects/app
# example 2:
# cd path/to/app
# dancerctl init app `pwd`
sub init {
my($user,$home,$app,$path) = @_;
$path =~ s#^$home\/##;
my $confdir = $home.'/'.$default->{conf};
system("mkdir -p ".$confdir) unless -d $confdir;
my $conf = $confdir.'/'.$app;
say "Config for '$app' already exists. Please remove $conf first." and exit(-1)
if -f $conf and not $ARGV[3] eq 'force';
say "Config for '$app' already exists. If will be overwritten."
if -f $conf and $ARGV[3] eq 'force';
use YAML::Tiny;
my $p; while (<DATA>) { $p .= $_ }
my $yaml = YAML::Tiny->read_string($p);
$yaml->[0] = $default->{recommended} if $default->{recommended};
$yaml->[0]->{path} = $path;
$yaml->write($conf);
# TODO: find the way to keep key order. SortKeys = 0 does not help.
# use YAML;
# local $YAML::SortKeys = 0;
# my $p; while (<DATA>) { $p .= $_ }
# my $yaml = Load($p);
# $yaml = $default->{recommended} if $default->{recommended};
# $yaml->{path} = $path;
# YAML::DumpFile($conf, $yaml);
say "Config for '$app' successfully written, please edit $conf (and change port) before first run."
}
#===============================================================================
# starts all apps of user with default environment
sub start_all {
my $user = shift;
my @apps = get_user_apps($user);
foreach my $f ( @apps ) {
my $p = $home.'/'.$default->{conf}.'/'.$f;
my $c = Config::Auto::parse($p, format => "yaml");
start($user,$home,$f) if $c->{autostart} or (not defined $c->{autostart} and $default->{autostart});
}
}
#===============================================================================
# stops all apps of user
sub stop_all {
my $user = shift;
my @apps = get_user_apps($user);
foreach my $f ( @apps ) {
stop($user,$home,$f);
}
}
#===============================================================================
# restart all apps of user, not runned apps with autostart will also be started
sub restart_all {
my $user = shift;
stop_all($user);
start_all($user);
}
#===============================================================================
# status for all apps of user (for default environment)
# TODO: check for every environment
sub status_all {
my $user = shift;
my @apps = get_user_apps($user);
foreach my $f ( @apps ) {
status($user,$home,$f);
}
}
#===============================================================================
sub get_user_apps {
my $user = shift or return undef;
my $path = $home.'/'.$default->{conf};
my @files;
my @dirs;
opendir DIR, $path or die "$path: $!\n";
for (readdir DIR) {
next if /^\.\.?$/;
push @files => $_ if -f "$path/$_";
push @dirs => $_ if -d _;
}
closedir DIR;
@files = sort @files; # each file is app
return @files;
}
#===============================================================================
sub start {
my ($user,$home,$app,$env) = @_;
my ($app_path,$server,$workers,$method,$listen,$pidfile,$opt,$chmod,$daemon);
($app_path,$env,$server,$workers,$method,$listen,$pidfile,$opt,$chmod,$daemon) =
parse_user_config($user,$home,$app,$env);
die "Error: wrong method '$method'" unless $method =~ /^socket|port$/;
my @cmd = ();
push @cmd, "cd $app_path && plackup";
push @cmd, '-E', $env;
push @cmd, '-s', $server;
push @cmd, '-w', $workers;
push @cmd, '-l', $listen;
push @cmd, '--pid', $pidfile;
# TODO: "--access-log $logs/$access.log"
# TODO: "--error-log $logs/$error.log"
# TODO: reload - reopens logs without restart
push @cmd, '-a ./bin/app.pl';
push @cmd, $opt if $opt;
push @cmd, '&& chmod', $chmod, $listen if $method eq 'socket' and $chmod;
my $cmd = join(" ", @cmd); say $cmd if $debug;
my $ok = system($cmd) == 0;
say "Application '$app' started in '$env' mode." if $daemon and $ok;
say "Browse at http://$listen" if $method eq 'port' and $daemon and $ok;
say "Listen on $listen" if $method eq 'socket' and $daemon and $ok;
}
#===============================================================================
sub parse_user_config {
my ($user,$home,$app,$env) = @_;
my ($p,$c);
$p = $home.'/'.$default->{conf}.'/'.$app if -d $home.'/'.$default->{conf};
say "Error: no config $p" and
say "You should create it first with `dancerctl init`" and exit
unless -f $p;
$c = Config::Auto::parse($p, format => "yaml");
$env ||= $c->{env};
$env ||= $default->{env};
$env = $c->{env_alias}->{$env}
if not defined $c->{$env}
and defined $c->{env_alias}->{$env}
and defined $c->{$c->{env_alias}->{$env}};
my $app_path = $home.'/'; $app_path .= $c->{path} || $default->{path}.$app;
my $method = $c->{$env}->{method} || $default->{method};
my $host = $c->{$env}->{host} || $default->{host};
my $port = $c->{$env}->{port} || $default->{port};
my @cmd = ();
push @cmd, 'cd '.$app_path.' && ';
push @cmd, 'plackup -E '.$env;
my $server = $c->{$env}->{server} || $c->{server} || $default->{server};
my $workers = $c->{$env}->{workers} || $c->{workers} || $default->{workers};
my $listen;
if ( $method eq 'socket' ) {
my $sock = $c->{$env}->{socket_path} || $c->{socket_path} || $default->{sockets};
given ( $sock ) {
when ( m#^\/# ) {} # absolute path
when ( m#^~\/# ) { $sock =~ s/^~//; $sock = $home.$sock.'/' } # relative to user home
default { $sock = $app_path.'/'.$sock}
}
my $socket_name = $c->{$env}->{socket_name} || $app.'.sock';
$listen = $sock.$socket_name;
} elsif ( $method eq 'port') {
$listen = "$host:$port";
} else {
die "Error: wrong method '$method'";
}
my $pid = $c->{$env}->{pid_path} || $c->{pid_path} || $default->{pids};
given ( $pid ) {
when ( m#^\/# ) {} # absolute path
when ( m#^~\/# ) { $pid =~ s/^~//; $pid = $home.$pid } # relative to user home
default { $pid = $app_path.'/'.$pid}
}
my $pid_name = $c->{$env}->{pid_name} || $app.'.pid';
my $pidfile = $pid.$pid_name;
my $opt = $c->{$env}->{opt};
$opt .= ' -r -R ' . $c->{$env}->{autoreload} if $c->{$env}->{autoreload};
my $daemon = 1 unless $c->{$env}->{daemon} eq '0';
$opt .= ' -D ' if $daemon;
my $chmod = $c->{$env}->{chmod} || $c->{chmod} || $default->{chmod};
return ($app_path,$env,$server,$workers,$method,$listen,$pidfile,$opt,$chmod,$daemon);
}
#===============================================================================
sub status {
my ($user,$home,$app,$env) = @_;
my ($app_path,$server,$workers,$method,$listen,$pidfile,$opt);
($app_path,$env,$server,$workers,$method,$listen,$pidfile,$opt) = parse_user_config($user,$home,$app,$env);
# based on web_ctl.pl by Puneet Kishor, https://github.com/punkish/web_ctl
# tested under Ubuntu 11.04
if (-e $pidfile) {
# open(PS_F, "ps lax | grep '[s]tarman master\|TIME COMMAND'|");
open(PS_F, "ps lax | grep '[s]tarman master'|");
say 'F UID PID PPID PRI NI VSZ RSS WCHAN STAT TTY TIME COMMAND';
PS: while (<PS_F>)
{
chomp;
my $line = $_ = trim($_);
# say $_;
# F UID PID PPID PRI NI VSZ RSS WCHAN STAT TTY TIME COMMAND
# 1 1000 6460 1 20 0 25012 15532 poll_s Ss ? 0:00 starman master
my ($f, $uid, $pid, $ppid, $pri, $ni, $sz, $rss, $wchan, $s, $tty, $time, $cmd) = split /\s+/;
my $pid_in_file = qx{head -1 $pidfile}; #"
if ($pid_in_file == $pid) {
my ($dev, $ino, $mode, $nlink, $uid, $gid, $rdev, $size, $atime, $mtime, $ctime, $blksize, $blocks) = stat($pidfile);
say $line;
say "\tApplication : $app\n" .
"\tRunning since: " . localtime($ctime) . "\n" .
"\tEnvironment : $env" ;
say "\tBrowse at : http://$listen" if $method eq 'port';
say "\tListen at : $listen" if $method eq 'socket';
last PS;
}
}
close(PS_F);
} else {
say "The app '$app' doesn't seem to be running in mode '$env'";
}
}
#===============================================================================
sub stop {
my ($user,$home,$app,$env,$force) = @_;
my ($app_path,$server,$workers,$method,$listen,$pidfile,$opt);
($app_path,$env,$server,$workers,$method,$listen,$pidfile,$opt) = parse_user_config($user,$home,$app,$env);
unless (-e $pidfile) {
say "The app '$app' doesn't seem to be running... nothing to do.";
return undef;
}
my $cmd = "cat $pidfile | xargs kill"; $cmd .= " -9" if $force;
say $cmd if $debug;
system($cmd);
say "Stopped $app"; # TODO: read error code from system and use it
}
#===============================================================================
sub restart {
stop(@_);
start(@_);
}
#===============================================================================
sub trim {
my $string = shift;
if ($string) {
$string =~ s/^\s+//;
$string =~ s/\s+$//;
return $string;
}
}
#===============================================================================
sub help {
say "dancerctl version $VERSION, Copyright (c) 2011, Nick Knutov, nick\@knutov.com";
say "Usage: dancerctl action [appname [environment]]";
say "Please see https://github.com/knutov/dancerctl for more help";
}
__DATA__
# This can also be placed in 'recommended:' section in /etc/dancerctl.conf
env: production
autostart: 1
production:
workers: 2
method: socket
chmod: 0666
development:
workers: 1
method: port
host: *
port: 3000
pid_name: dev.pid
autoreload: "./lib/Routes,./lib"
daemon: 0
env_alias:
dev: development
prod: production
Jump to Line
Something went wrong with that request. Please try again.