pax_global_header00006660000000000000000000000064125142536270014521gustar00rootroot0000000000000052 comment=cbd3713761ea33f32e7d130dcab13d31de037ef0 erlsvc-1.02/000077500000000000000000000000001251425362700127415ustar00rootroot00000000000000erlsvc-1.02/ChangeLog000066400000000000000000000010431251425362700145110ustar00rootroot000000000000002015-04-17 Balint Reczey 1.02 - Minor fixes: Update to use CLI::Framework 0.05 API Replace README template with an empty README Remove packaging directory Use packaged CLI::Framework Raise file descriptors' soft limit to hard limit when setting it to hardcoded value fails Allow numbers at the end of the Erlang release, like R16B03 New Erlang release is "17" instead of "R17B" Fix UTF-8 encoding in META.yml 2010-03-14 Jean-Sébastien Pédron First stable release of "erlsvc". erlsvc-1.02/INSTALL.SKIP000066400000000000000000000001741251425362700145410ustar00rootroot00000000000000# Avoid Subversion control files. \B\.svn\b # Avoid Vim swap files. \.swp$ # Avoid Makefiles. \bMakefile$ \bMakefile\.PL$ erlsvc-1.02/LICENSE000066400000000000000000000023601251425362700137470ustar00rootroot00000000000000Copyright 2011 Yakaz. All rights reserved. Redistribution and use in source and binary forms, with or without modification, are permitted provided that the following conditions are met: 1. Redistributions of source code must retain the above copyright notice, this list of conditions and the following disclaimer. 2. Redistributions in binary form must reproduce the above copyright notice, this list of conditions and the following disclaimer in the documentation and/or other materials provided with the distribution. THIS SOFTWARE IS PROVIDED BY YAKAZ ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL YAKAZ OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. erlsvc-1.02/MANIFEST000066400000000000000000000035641251425362700141020ustar00rootroot00000000000000ChangeLog INSTALL.SKIP lib/ErlSvc/Ctl.pm lib/ErlSvc/Ctl/Command.pm lib/ErlSvc/Ctl/Command/help.pm lib/ErlSvc/Ctl/Command/mnesia.pm lib/ErlSvc/Ctl/Command/mnesia/checkconsistency.pm lib/ErlSvc/Ctl/Command/mnesia/cluster.pm lib/ErlSvc/Ctl/Command/mnesia/destroy.pm lib/ErlSvc/Ctl/Command/mnesia/dir.pm lib/ErlSvc/Ctl/Command/mnesia/init.pm lib/ErlSvc/Ctl/Command/mnesia/isclustered.pm lib/ErlSvc/Ctl/Command/mnesia/isdirused.pm lib/ErlSvc/Ctl/Command/mnesia/othernodes.pm lib/ErlSvc/Ctl/Command/release.pm lib/ErlSvc/Ctl/Command/release/current.pm lib/ErlSvc/Ctl/Command/release/default.pm lib/ErlSvc/Ctl/Command/release/dir.pm lib/ErlSvc/Ctl/Command/release/list.pm lib/ErlSvc/Ctl/Command/release/remove.pm lib/ErlSvc/Ctl/Command/release/reset.pm lib/ErlSvc/Ctl/Command/release/syncvanilla.pm lib/ErlSvc/Ctl/Command/release/upgradable.pm lib/ErlSvc/Ctl/Command/release/upgrade.pm lib/ErlSvc/Ctl/Command/reload.pm lib/ErlSvc/Ctl/Command/restart.pm lib/ErlSvc/Ctl/Command/shell.pm lib/ErlSvc/Ctl/Command/start.pm lib/ErlSvc/Ctl/Command/status.pm lib/ErlSvc/Ctl/Command/stop.pm lib/ErlSvc/Ctl/Command/target.pm lib/ErlSvc/Ctl/Command/target/clean.pm lib/ErlSvc/Ctl/Command/target/deploy.pm lib/ErlSvc/Ctl/Command/target/destroy.pm lib/ErlSvc/Ctl/Command/version.pm lib/ErlSvc/Ctl/Erlang/Env.pm lib/ErlSvc/Ctl/Erlang/Node.pm lib/ErlSvc/Ctl/Erlang/Script.pm lib/ErlSvc/Ctl/Exceptions.pm lib/ErlSvc/Ctl/Log.pm lib/ErlSvc/Ctl/Mnesia.pm lib/ErlSvc/Ctl/Proc.pm lib/ErlSvc/Ctl/Release.pm lib/ErlSvc/Ctl/Resources.pm lib/ErlSvc/Ctl/Service.pm lib/ErlSvc/Ctl/Target.pm lib/ErlSvc/Ctl/Usage.pm LICENSE Makefile.PL MANIFEST This list of files MANIFEST.SKIP META.yml README script/erlsvc share/erlsvc.erl share/erlsvc.hrl share/erlsvc_controller.erl share/erlsvc_erlenv.erl share/erlsvc_lib.erl share/erlsvc_mnesia.erl share/erlsvc_release.erl share/erlsvc_service.erl share/erlsvc_worker.erl share/Makefile.PL t/erlsvc.t erlsvc-1.02/MANIFEST.SKIP000066400000000000000000000002101251425362700146300ustar00rootroot00000000000000^blib/ ^inc/ ^Makefile$ ^Makefile.old$ ^MANIFEST.bak$ ^Makefile$ ^pm_to_blib$ ^erlsvc.*/ ^erlsvc.*.tar.gz$ ^share/Makefile$ .svn/ .swp$ erlsvc-1.02/META.yml000066400000000000000000000012201251425362700142050ustar00rootroot00000000000000--- author: - 'Jean-Sébastien Pédron ' build_requires: ExtUtils::MakeMaker: 6.42 configure_requires: ExtUtils::MakeMaker: 6.42 distribution_type: module generated_by: 'Module::Install version 1' license: bsd meta-spec: url: http://module-build.sourceforge.net/META-spec-v1.4.html version: 1.4 name: erlsvc no_index: directory: - inc - share - t requires: Class::Inspector: 0 Exception::Class: 0 Exception::Class::TryCatch: 0 File::ShareDir: 0 Getopt::Long::Descriptive: 0 YAML::Tiny: 0 CLI::Framework: 0.05 resources: license: http://opensource.org/licenses/bsd-license.php version: 1.02 erlsvc-1.02/Makefile.PL000066400000000000000000000025211251425362700147130ustar00rootroot00000000000000# $Id: Makefile.PL 6244 2010-10-20 14:41:40Z jean.sebastien.pedron $ use strict; use warnings; use utf8; use inc::Module::Install; # Define metadata name 'erlsvc'; version_from 'lib/ErlSvc/Ctl.pm'; author 'Jean-Sébastien Pédron '; license 'bsd'; requires 'Class::Inspector' => 0; requires 'Exception::Class' => 0; requires 'Exception::Class::TryCatch' => 0; requires 'Getopt::Long::Descriptive' => 0; requires 'YAML::Tiny' => 0; requires 'File::ShareDir' => 0; requires 'CLI::Framework' => 0.05; # Specific dependencies install_script 'script/erlsvc'; install_share; WriteAll; sub MY::postamble { return if $Module::Install::VERSION > 0.76; my $cmd = "cd share && perl Makefile.PL"; print "$cmd\n"; system($cmd); return <<'EOF'; subdirs :: $(NOECHO) cd share && $(MAKE) $(USEMAKEFILE) $(FIRST_MAKEFILE) all $(PASSTHRU) clean :: $(ABSPERLRUN) -e 'chdir '\''share'\''; system '\''$(MAKE) clean'\'' if -f '\''$(FIRST_MAKEFILE)'\'';' -- realclean :: - $(ABSPERLRUN) -e 'chdir '\''share'\''; system '\''$(MAKE) $(USEMAKEFILE) $(MAKEFILE_OLD) realclean'\'' if -f '\''$(MAKEFILE_OLD)'\'';' -- - $(ABSPERLRUN) -e 'chdir '\''share'\''; system '\''$(MAKE) $(USEMAKEFILE) $(FIRST_MAKEFILE) realclean'\'' if -f '\''$(FIRST_MAKEFILE)'\'';' -- EOF } erlsvc-1.02/README000066400000000000000000000000021251425362700136110ustar00rootroot00000000000000 erlsvc-1.02/lib/000077500000000000000000000000001251425362700135075ustar00rootroot00000000000000erlsvc-1.02/lib/ErlSvc/000077500000000000000000000000001251425362700147055ustar00rootroot00000000000000erlsvc-1.02/lib/ErlSvc/Ctl.pm000066400000000000000000000166751251425362700160040ustar00rootroot00000000000000#- # Copyright 2011 Yakaz. All rights reserved. # # Redistribution and use in source and binary forms, with or without # modification, are permitted provided that the following conditions # are met: # # 1. Redistributions of source code must retain the above copyright # notice, this list of conditions and the following disclaimer. # # 2. Redistributions in binary form must reproduce the above # copyright notice, this list of conditions and the following # disclaimer in the documentation and/or other materials provided # with the distribution. # # THIS SOFTWARE IS PROVIDED BY YAKAZ ``AS IS'' AND ANY EXPRESS OR # IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED # WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE # ARE DISCLAIMED. IN NO EVENT SHALL YAKAZ OR CONTRIBUTORS BE LIABLE # FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR # CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT # OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR # BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, # WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE # OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, # EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. package ErlSvc::Ctl; use base qw(CLI::Framework ErlSvc::Ctl::Resources); use 5.010000; use strict; use warnings; use utf8; our $VERSION = '1.02'; use Cwd qw(abs_path); use File::ShareDir qw(dist_dir); use YAML::Tiny; use ErlSvc::Ctl::Log; use ErlSvc::Ctl::Usage qw(progname abstract); use ErlSvc::Ctl::Service; use ErlSvc::Ctl::Erlang::Env; use ErlSvc::Ctl::Erlang::Node; use ErlSvc::Ctl::Exceptions qw(:all); sub init { my ($self, $opts) = @_; # Save global options. $self->cache->set('global_opts' => $opts); # Set default configuration. my $default_mods_dir = eval { dist_dir('erlsvc') }; my %default_config = ( 'node' => 'myservice', 'host' => ErlSvc::Ctl::Erlang::Node::local_hostname(), 'mods_dir' => $default_mods_dir, 'pipe_dir' => '/var/run/my_service', 'log_dir' => '/var/log/my_service' ); $self->cache->set('default_config' => \%default_config); my $node = $opts->{'node'} || $default_config{'node'}; my $host = $opts->{'host'} || $default_config{'host'}; # Load the configuration file. if ($opts->{'config'} && -f $opts->{'config'}) { $opts->{'config'} = abs_path($opts->{'config'}); } my $config_file; my @cf = ( $ENV{'HOME'}."/.config/erlsvc/config-$node\@$host.yaml", $ENV{'HOME'}."/.config/erlsvc/config-$node.yaml", $ENV{'HOME'}.'/.config/erlsvc/config.yaml', "/etc/my_service/erlsvc-$node\@$host.yaml", "/etc/my_service/erlsvc-$node.yaml", '/etc/my_service/erlsvc.yaml', '/etc/default/'.progname() ); unshift @cf, $opts->{'config'} if ($opts->{'config'}); foreach my $cf (@cf) { if (-f $cf) { $config_file = $cf; last; } } my $yaml_errstr; if ($config_file) { local $@; my $yaml = eval { local $SIG{'__DIE__'}; YAML::Tiny->read($config_file) }; unless ($yaml) { $yaml_errstr = $@ || YAML::Tiny->errstr; } $self->cache->set('config' => $yaml); $self->cache->set('config_file' => $config_file); } # Initialize the logging facility. my $logger = ErlSvc::Ctl::Log->new($self); $self->cache->set('logger' => $logger); $self->log->debug("APP", "erlsvc $VERSION -- CLI::Framework ".$CLI::Framework::VERSION."\n"); if ($config_file) { $self->log->debug('APP', "Config file: $config_file\n"); if ($yaml_errstr) { $self->log->error( "Problem:\n", " Failed to read configuration file.\n", " Configuration file is:\n", " $config_file\n", " YAML::Tiny reports:\n", " $yaml_errstr\n"); command_run_failure(); return; } } my $erl_env = ErlSvc::Ctl::Erlang::Env->new($self); $self->cache->set('erl_env', $erl_env); $self->log->debug("APP", "Ready to execute command\n"); } sub option_spec { return ( [ 'config|C=s', 'specify configuration file path' ], [ 'user|u=s', 'run the Erlang node under the specified user', ], [ 'group|g=s', 'run the Erlang node under the specified group' ], [ 'node|n=s', 'specify Erlang node name' ], [ 'host|h=s', 'specify Erlang node host' ], [ 'cookie|c=s', 'specify Erlang cookie' ], [ 'release|r=s', 'specify release if the node is not running' ], [ 'releases-dir|d=s', 'specify the releases directory used by SASL' ], [], # Following options should be used carefully. They're intended # for development and debugging purposes. [ 'erlang|E=s', 'specify Erlang root directory' ], [ 'erllibs-dir|L=s@', 'set the path to Erlang libraries' ], [ 'mods-dir|M=s', 'set the path to erlsvc\'s modules' ], [ 'pipe-dir|P=s', 'set the path where runtime files are stored' ], [ 'log-dir|O=s', 'set the path where log files are stored' ], [ 'verbose|V:s@', 'print debugging messages for specified components' ], [], [ 'help', 'print usage and exit' ], [ 'version', 'print program version and exit' ] ); } sub command_map { 'help' => 'ErlSvc::Ctl::Command::help', 'mnesia' => 'ErlSvc::Ctl::Command::mnesia', 'release' => 'ErlSvc::Ctl::Command::release', 'reload' => 'ErlSvc::Ctl::Command::reload', 'restart' => 'ErlSvc::Ctl::Command::restart', 'shell' => 'ErlSvc::Ctl::Command::shell', 'start' => 'ErlSvc::Ctl::Command::start', 'status' => 'ErlSvc::Ctl::Command::status', 'stop' => 'ErlSvc::Ctl::Command::stop', 'target' => 'ErlSvc::Ctl::Command::target', 'version' => 'ErlSvc::Ctl::Command::version', } sub command_alias { '--help' => 'help', '--version' => 'version' } sub usage_text { my ($self) = @_; my $service_name = ErlSvc::Ctl::Service->name; my $usage = progname()." $VERSION - Start and control $service_name\n"; $usage .= "\nUsage:\n".$self->get_default_usage(); my $commands = $self->command_map_hashref(); my @cmd_names = sort keys %$commands; my $max_len = 0; foreach my $cmd_name (@cmd_names) { my $len = length($cmd_name); $max_len = $len if ($len > $max_len); } $usage .= "\nAvailable commands:\n"; foreach my $cmd_name (@cmd_names) { my $cmd = $commands->{$cmd_name}; $usage .= sprintf(" %-${max_len}s - %s\n", $cmd_name, abstract($cmd)); } return $usage; } sub handle_exception { my ($self, $e) = @_; if (ref($e) eq 'ErlSvc::Ctl::Exception::CmdRunException') { print $e->reason."\n" if $e->reason; } else { print $e->error."\n" if $e->error; } } sub uninit { my ($self) = @_; # Shutdown the target node. my $target = $self->node('no_init' => 1); $target->stop if (defined $target); # Shutdown the controller node. my $controller = $self->controller('no_init' => 1); $controller->stop if (defined $controller); } 1; erlsvc-1.02/lib/ErlSvc/Ctl/000077500000000000000000000000001251425362700154275ustar00rootroot00000000000000erlsvc-1.02/lib/ErlSvc/Ctl/Command.pm000066400000000000000000000052631251425362700173510ustar00rootroot00000000000000#- # Copyright 2011 Yakaz. All rights reserved. # # Redistribution and use in source and binary forms, with or without # modification, are permitted provided that the following conditions # are met: # # 1. Redistributions of source code must retain the above copyright # notice, this list of conditions and the following disclaimer. # # 2. Redistributions in binary form must reproduce the above # copyright notice, this list of conditions and the following # disclaimer in the documentation and/or other materials provided # with the distribution. # # THIS SOFTWARE IS PROVIDED BY YAKAZ ``AS IS'' AND ANY EXPRESS OR # IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED # WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE # ARE DISCLAIMED. IN NO EVENT SHALL YAKAZ OR CONTRIBUTORS BE LIABLE # FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR # CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT # OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR # BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, # WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE # OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, # EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. package ErlSvc::Ctl::Command; use base qw(CLI::Framework::Command ErlSvc::Ctl::Resources); use strict; use warnings; use utf8; use Getopt::Long::Descriptive; use ErlSvc::Ctl::Usage qw(progname abstract); sub short_desc () { abstract(shift); } sub desc () { ''; } sub usage_text { my $self = shift; my $progname = progname(); my $cmd_name = ref($self) || $self; $cmd_name =~ s/.*::Command:://o; $cmd_name =~ s/::/ /go; my $usage = $progname.' '.$cmd_name.' - '.abstract($self)."\n"; my $desc = $self->desc; $usage .= "\n".$desc if ($desc); my $format = $progname.' '.$cmd_name.' %o ...'; my ($opts, $opts_usage); eval { ($opts, $opts_usage) = describe_options($format, $self->option_spec()); }; $usage .= "\nUsage:\n".$opts_usage->text(); my @subcmd_names = $self->registered_subcommand_names(); if (scalar @subcmd_names) { my $max_len = 0; foreach my $subcmd_name (@subcmd_names) { my $len = length($subcmd_name); $max_len = $len if ($len > $max_len); } $usage .= "\nAvailable subcommands:\n"; foreach my $subcmd_name (@subcmd_names) { my $subcmd = $self->registered_subcommand_object($subcmd_name); $usage .= sprintf(" %-${max_len}s - %s\n", $subcmd_name, abstract($subcmd)); } } return $usage; } 1 erlsvc-1.02/lib/ErlSvc/Ctl/Command/000077500000000000000000000000001251425362700170055ustar00rootroot00000000000000erlsvc-1.02/lib/ErlSvc/Ctl/Command/help.pm000066400000000000000000000034631251425362700203010ustar00rootroot00000000000000#- # Copyright 2011 Yakaz. All rights reserved. # # Redistribution and use in source and binary forms, with or without # modification, are permitted provided that the following conditions # are met: # # 1. Redistributions of source code must retain the above copyright # notice, this list of conditions and the following disclaimer. # # 2. Redistributions in binary form must reproduce the above # copyright notice, this list of conditions and the following # disclaimer in the documentation and/or other materials provided # with the distribution. # # THIS SOFTWARE IS PROVIDED BY YAKAZ ``AS IS'' AND ANY EXPRESS OR # IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED # WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE # ARE DISCLAIMED. IN NO EVENT SHALL YAKAZ OR CONTRIBUTORS BE LIABLE # FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR # CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT # OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR # BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, # WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE # OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, # EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. package ErlSvc::Ctl::Command::help; use base qw(CLI::Framework::Command::Meta); =head1 NAME ErlSvc::Ctl::Command::help - Print usage =cut use strict; use warnings; use utf8; sub run { my ($self, $opts, @args) = @_; my $app = $self->get_app(); if (scalar @args) { my %aliases = $app->command_alias(); my $cmd_name = shift @args; $cmd_name = $aliases{$cmd_name} if (exists($aliases{$cmd_name})); $app->usage($cmd_name, @args); } else { $app->usage(); } } 1; erlsvc-1.02/lib/ErlSvc/Ctl/Command/mnesia.pm000066400000000000000000000036471251425362700206310ustar00rootroot00000000000000#- # Copyright 2011 Yakaz. All rights reserved. # # Redistribution and use in source and binary forms, with or without # modification, are permitted provided that the following conditions # are met: # # 1. Redistributions of source code must retain the above copyright # notice, this list of conditions and the following disclaimer. # # 2. Redistributions in binary form must reproduce the above # copyright notice, this list of conditions and the following # disclaimer in the documentation and/or other materials provided # with the distribution. # # THIS SOFTWARE IS PROVIDED BY YAKAZ ``AS IS'' AND ANY EXPRESS OR # IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED # WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE # ARE DISCLAIMED. IN NO EVENT SHALL YAKAZ OR CONTRIBUTORS BE LIABLE # FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR # CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT # OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR # BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, # WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE # OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, # EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. package ErlSvc::Ctl::Command::mnesia; use base qw(ErlSvc::Ctl::Command); =head1 NAME ErlSvc::Ctl::Command::mnesia - Manage Mnesia schema =cut use strict; use warnings; use utf8; sub option_spec { my ($self) = @_; if (ref($self) !~ /:mnesia$/o) { return; } return ( ['directory|d=s', 'specify Mnesia directory'] ); } sub notify_of_subcommand_dispatch { my ($self, $subcmd, $opts, @args) = @_; if ($opts->{'directory'}) { $self->cache->set('mnesia_dir', $opts->{'directory'}); } } sub run { shift->usage(); } sub mnesia_dir () { shift->cache->get('mnesia_dir'); } 1; erlsvc-1.02/lib/ErlSvc/Ctl/Command/mnesia/000077500000000000000000000000001251425362700202615ustar00rootroot00000000000000erlsvc-1.02/lib/ErlSvc/Ctl/Command/mnesia/checkconsistency.pm000066400000000000000000000043401251425362700241570ustar00rootroot00000000000000#- # Copyright 2011 Yakaz. All rights reserved. # # Redistribution and use in source and binary forms, with or without # modification, are permitted provided that the following conditions # are met: # # 1. Redistributions of source code must retain the above copyright # notice, this list of conditions and the following disclaimer. # # 2. Redistributions in binary form must reproduce the above # copyright notice, this list of conditions and the following # disclaimer in the documentation and/or other materials provided # with the distribution. # # THIS SOFTWARE IS PROVIDED BY YAKAZ ``AS IS'' AND ANY EXPRESS OR # IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED # WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE # ARE DISCLAIMED. IN NO EVENT SHALL YAKAZ OR CONTRIBUTORS BE LIABLE # FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR # CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT # OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR # BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, # WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE # OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, # EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. package ErlSvc::Ctl::Command::mnesia::checkconsistency; use base qw(ErlSvc::Ctl::Command::mnesia); =head1 NAME ErlSvc::Ctl::Command::mnesia::checkconsistency - Check cluster consistency =cut use strict; use warnings; use utf8; use ErlSvc::Ctl::Exceptions qw(:all); use ErlSvc::Ctl::Mnesia; sub desc () { return <<'EOF'; This command checks the consistency of the cluster. While using this command on a running and/or remote node is possible, options modifying the release or the Mnesia directory have no effects. EOF } sub run { my ($self, $opts, @args) = @_; my $mnesia = ErlSvc::Ctl::Mnesia->new($self); my %params = (); my $directory = $self->mnesia_dir; if ($directory) { $params{'directory'} = $directory; } else { $params{'release'} = $self->opts('release'); } my $ret = $mnesia->check_consistency(%params); unless ($ret) { command_run_failure(); } return; } 1; erlsvc-1.02/lib/ErlSvc/Ctl/Command/mnesia/cluster.pm000066400000000000000000000053061251425362700223040ustar00rootroot00000000000000#- # Copyright 2011 Yakaz. All rights reserved. # # Redistribution and use in source and binary forms, with or without # modification, are permitted provided that the following conditions # are met: # # 1. Redistributions of source code must retain the above copyright # notice, this list of conditions and the following disclaimer. # # 2. Redistributions in binary form must reproduce the above # copyright notice, this list of conditions and the following # disclaimer in the documentation and/or other materials provided # with the distribution. # # THIS SOFTWARE IS PROVIDED BY YAKAZ ``AS IS'' AND ANY EXPRESS OR # IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED # WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE # ARE DISCLAIMED. IN NO EVENT SHALL YAKAZ OR CONTRIBUTORS BE LIABLE # FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR # CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT # OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR # BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, # WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE # OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, # EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. package ErlSvc::Ctl::Command::mnesia::cluster; use base qw(ErlSvc::Ctl::Command::mnesia); =head1 NAME ErlSvc::Ctl::Command::mnesia::cluster - List the nodes forming the cluster =cut use strict; use warnings; use utf8; use ErlSvc::Ctl::Exceptions qw(:all); use ErlSvc::Ctl::Mnesia; sub desc () { return <<'EOF'; This command lists the nodes belonging to the Mnesia cluster, and their respective state. While using this command on a running and/or remote node is possible, options modifying the release or the Mnesia directory have no effects. EOF } sub run { my ($self, $opts, @args) = @_; my $mnesia = ErlSvc::Ctl::Mnesia->new($self); my %params = (); my $directory = $self->mnesia_dir; if ($directory) { $params{'directory'} = $directory; } else { $params{'release'} = $self->opts('release'); } my %nodes = $mnesia->cluster_nodes(%params); unless (scalar keys %nodes) { command_run_failure(); } my $max_len = length('Node'); foreach my $node (keys %nodes) { my $len = length($node); $max_len = ($len > $max_len) ? $len : $max_len; } my $output = ''; $output .= sprintf("\e[1m%-${max_len}s %s\e[0m\n", 'Node', 'State'); foreach my $node (sort keys %nodes) { $output .= sprintf("%-${max_len}s %s\n", $node, $nodes{$node} ? "\e[32mUP\e[0m" : "\e[31mDOWN\e[0m"); } return $output; } 1; erlsvc-1.02/lib/ErlSvc/Ctl/Command/mnesia/destroy.pm000066400000000000000000000042551251425362700223160ustar00rootroot00000000000000#- # Copyright 2011 Yakaz. All rights reserved. # # Redistribution and use in source and binary forms, with or without # modification, are permitted provided that the following conditions # are met: # # 1. Redistributions of source code must retain the above copyright # notice, this list of conditions and the following disclaimer. # # 2. Redistributions in binary form must reproduce the above # copyright notice, this list of conditions and the following # disclaimer in the documentation and/or other materials provided # with the distribution. # # THIS SOFTWARE IS PROVIDED BY YAKAZ ``AS IS'' AND ANY EXPRESS OR # IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED # WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE # ARE DISCLAIMED. IN NO EVENT SHALL YAKAZ OR CONTRIBUTORS BE LIABLE # FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR # CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT # OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR # BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, # WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE # OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, # EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. package ErlSvc::Ctl::Command::mnesia::destroy; use base qw(ErlSvc::Ctl::Command::mnesia); =head1 NAME ErlSvc::Ctl::Command::mnesia::destroy - Destroy Mnesia schema =cut use strict; use warnings; use utf8; use ErlSvc::Ctl::Exceptions qw(:all); use ErlSvc::Ctl::Mnesia; sub desc () { return <<'EOF'; This command remove the node from an existing cluster if he's part of one, and remove Mnesia files. Using this command on a running and/or remote node is not possible. EOF } sub run { my ($self, $opts, @args) = @_; my $mnesia = ErlSvc::Ctl::Mnesia->new($self); my %params = (); my $directory = $self->mnesia_dir; if ($directory) { $params{'directory'} = $directory; } else { $params{'release'} = $self->opts('release'); } my $ret = $mnesia->remove_schema(%params); unless ($ret) { command_run_failure(); } return; } 1; erlsvc-1.02/lib/ErlSvc/Ctl/Command/mnesia/dir.pm000066400000000000000000000044071251425362700214020ustar00rootroot00000000000000#- # Copyright 2011 Yakaz. All rights reserved. # # Redistribution and use in source and binary forms, with or without # modification, are permitted provided that the following conditions # are met: # # 1. Redistributions of source code must retain the above copyright # notice, this list of conditions and the following disclaimer. # # 2. Redistributions in binary form must reproduce the above # copyright notice, this list of conditions and the following # disclaimer in the documentation and/or other materials provided # with the distribution. # # THIS SOFTWARE IS PROVIDED BY YAKAZ ``AS IS'' AND ANY EXPRESS OR # IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED # WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE # ARE DISCLAIMED. IN NO EVENT SHALL YAKAZ OR CONTRIBUTORS BE LIABLE # FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR # CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT # OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR # BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, # WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE # OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, # EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. package ErlSvc::Ctl::Command::mnesia::dir; use base qw(ErlSvc::Ctl::Command::mnesia); =head1 NAME ErlSvc::Ctl::Command::mnesia::dir - Print the directory containing Mnesia data =cut use strict; use warnings; use utf8; use ErlSvc::Ctl::Exceptions qw(:all); use ErlSvc::Ctl::Mnesia; sub desc () { return <<'EOF'; This command prints the directory used by Mnesia to store its data. While using this command on a running and/or remote node is possible, options modifying the release or the Mnesia directory have no effects. EOF } sub run { my ($self, $opts, @args) = @_; my $mnesia = ErlSvc::Ctl::Mnesia->new($self); my %params = (); my $directory = $self->mnesia_dir; if ($directory) { $params{'directory'} = $directory; } else { $params{'release'} = $self->opts('release'); } my $ret = $mnesia->directory(%params); unless (defined $ret) { command_run_failure(); } return $ret ? "$ret\n" : "(unknown)\n"; } 1; erlsvc-1.02/lib/ErlSvc/Ctl/Command/mnesia/init.pm000066400000000000000000000046331251425362700215700ustar00rootroot00000000000000#- # Copyright 2011 Yakaz. All rights reserved. # # Redistribution and use in source and binary forms, with or without # modification, are permitted provided that the following conditions # are met: # # 1. Redistributions of source code must retain the above copyright # notice, this list of conditions and the following disclaimer. # # 2. Redistributions in binary form must reproduce the above # copyright notice, this list of conditions and the following # disclaimer in the documentation and/or other materials provided # with the distribution. # # THIS SOFTWARE IS PROVIDED BY YAKAZ ``AS IS'' AND ANY EXPRESS OR # IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED # WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE # ARE DISCLAIMED. IN NO EVENT SHALL YAKAZ OR CONTRIBUTORS BE LIABLE # FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR # CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT # OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR # BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, # WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE # OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, # EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. package ErlSvc::Ctl::Command::mnesia::init; use base qw(ErlSvc::Ctl::Command::mnesia); =head1 NAME ErlSvc::Ctl::Command::mnesia::init - Initialize Mnesia schema =cut use strict; use warnings; use utf8; use ErlSvc::Ctl::Exceptions qw(:all); use ErlSvc::Ctl::Mnesia; sub desc () { return <<'EOF'; This command creates a new Mnesia schema. Using this command on a running and/or remote node is not possible. If this command is used to join a cluster, the remote node must be running and part of the cluster. EOF } sub option_spec { return ( ['cluster|c=s@', 'join a cluster using the specified node(s)'] ); } sub run { my ($self, $opts, @args) = @_; my $mnesia = ErlSvc::Ctl::Mnesia->new($self); my %params = (); my $directory = $self->mnesia_dir; if ($directory) { $params{'directory'} = $directory; } else { $params{'release'} = $self->opts('release'); } if ($opts->{'cluster'}) { $params{'cluster'} = $opts->{'cluster'}; } my $ret = $mnesia->create_schema(%params); unless ($ret) { command_run_failure(); } return; } 1; erlsvc-1.02/lib/ErlSvc/Ctl/Command/mnesia/isclustered.pm000066400000000000000000000052611251425362700231510ustar00rootroot00000000000000#- # Copyright 2011 Yakaz. All rights reserved. # # Redistribution and use in source and binary forms, with or without # modification, are permitted provided that the following conditions # are met: # # 1. Redistributions of source code must retain the above copyright # notice, this list of conditions and the following disclaimer. # # 2. Redistributions in binary form must reproduce the above # copyright notice, this list of conditions and the following # disclaimer in the documentation and/or other materials provided # with the distribution. # # THIS SOFTWARE IS PROVIDED BY YAKAZ ``AS IS'' AND ANY EXPRESS OR # IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED # WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE # ARE DISCLAIMED. IN NO EVENT SHALL YAKAZ OR CONTRIBUTORS BE LIABLE # FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR # CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT # OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR # BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, # WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE # OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, # EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. package ErlSvc::Ctl::Command::mnesia::isclustered; use base qw(ErlSvc::Ctl::Command::mnesia); =head1 NAME ErlSvc::Ctl::Command::mnesia::isclustered - Indicates if the node is part of a Mnesia cluster =cut use strict; use warnings; use utf8; use ErlSvc::Ctl::Exceptions qw(:all); use ErlSvc::Ctl::Mnesia; sub desc () { return <<'EOF'; This command indicates if the node belongs to a Mnesia cluster. While using this command on a running and/or remote node is possible, options modifying the release or the Mnesia directory have no effects. EOF } sub option_spec { return ( ['short|s', 'just print "YES" or "NO" instead of a full sentence'] ); } sub run { my ($self, $opts, @args) = @_; my $mnesia = ErlSvc::Ctl::Mnesia->new($self); my %params = (); my $directory = $self->mnesia_dir; if ($directory) { $params{'directory'} = $directory; } else { $params{'release'} = $self->opts('release'); } my %nodes = $mnesia->cluster_nodes(%params); my $nodes_count = scalar keys %nodes; unless ($nodes_count) { command_run_failure(); } my $clustered = $nodes_count > 1; if ($opts->{'short'}) { return ($clustered ? 'YES' : 'NO')."\n"; } else { my $node = $self->node; return "The node '$node' ". ($clustered ? 'belongs' : "doesn't belong"). " to a cluster.\n"; } } 1; erlsvc-1.02/lib/ErlSvc/Ctl/Command/mnesia/isdirused.pm000066400000000000000000000051241251425362700226140ustar00rootroot00000000000000#- # Copyright 2011 Yakaz. All rights reserved. # # Redistribution and use in source and binary forms, with or without # modification, are permitted provided that the following conditions # are met: # # 1. Redistributions of source code must retain the above copyright # notice, this list of conditions and the following disclaimer. # # 2. Redistributions in binary form must reproduce the above # copyright notice, this list of conditions and the following # disclaimer in the documentation and/or other materials provided # with the distribution. # # THIS SOFTWARE IS PROVIDED BY YAKAZ ``AS IS'' AND ANY EXPRESS OR # IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED # WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE # ARE DISCLAIMED. IN NO EVENT SHALL YAKAZ OR CONTRIBUTORS BE LIABLE # FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR # CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT # OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR # BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, # WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE # OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, # EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. package ErlSvc::Ctl::Command::mnesia::isdirused; use base qw(ErlSvc::Ctl::Command::mnesia); =head1 NAME ErlSvc::Ctl::Command::mnesia::isdirused - Tell if Mnesia directory is in use =cut use strict; use warnings; use utf8; use ErlSvc::Ctl::Exceptions qw(:all); use ErlSvc::Ctl::Mnesia; sub desc () { return <<'EOF'; This command tells if Mnesia directory is in use. While using this command on a running and/or remote node is possible, options modifying the release or the Mnesia directory have no effects. EOF } sub option_spec { return ( ['short|s', 'just print "YES" or "NO" instead of a full sentence'] ); } sub run { my ($self, $opts, @args) = @_; my $mnesia = ErlSvc::Ctl::Mnesia->new($self); my %params = (); my $directory = $self->mnesia_dir; if ($directory) { $params{'directory'} = $directory; } else { $params{'release'} = $self->opts('release'); } my $is_used = $mnesia->is_directory_used(%params); unless (defined $is_used) { command_run_failure(); } if ($opts->{'short'}) { return ($is_used ? 'YES' : 'NO')."\n"; } else { $directory = $mnesia->directory unless ($directory); return "The directory '$directory' is ".($is_used ? '' : 'NOT '). "used by Mnesia\n"; } } 1; erlsvc-1.02/lib/ErlSvc/Ctl/Command/mnesia/othernodes.pm000066400000000000000000000050401251425362700227700ustar00rootroot00000000000000#- # Copyright 2011 Yakaz. All rights reserved. # # Redistribution and use in source and binary forms, with or without # modification, are permitted provided that the following conditions # are met: # # 1. Redistributions of source code must retain the above copyright # notice, this list of conditions and the following disclaimer. # # 2. Redistributions in binary form must reproduce the above # copyright notice, this list of conditions and the following # disclaimer in the documentation and/or other materials provided # with the distribution. # # THIS SOFTWARE IS PROVIDED BY YAKAZ ``AS IS'' AND ANY EXPRESS OR # IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED # WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE # ARE DISCLAIMED. IN NO EVENT SHALL YAKAZ OR CONTRIBUTORS BE LIABLE # FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR # CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT # OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR # BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, # WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE # OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, # EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. package ErlSvc::Ctl::Command::mnesia::othernodes; use base qw(ErlSvc::Ctl::Command::mnesia); =head1 NAME ErlSvc::Ctl::Command::mnesia::othernodes - List all clustered nodes but the target node =cut use strict; use warnings; use utf8; use ErlSvc::Ctl::Exceptions qw(:all); use ErlSvc::Ctl::Mnesia; sub desc () { return <<'EOF'; This command lists all the nodes of a Mnesia cluster, except the target node. While using this command on a running and/or remote node is possible, options modifying the release or the Mnesia directory have no effects. EOF } sub option_spec { return ( ['short|s', 'just print "YES" or "NO" instead of a full sentence'] ); } sub run { my ($self, $opts, @args) = @_; my $mnesia = ErlSvc::Ctl::Mnesia->new($self); my %params = (); my $directory = $self->mnesia_dir; if ($directory) { $params{'directory'} = $directory; } else { $params{'release'} = $self->opts('release'); } my %nodes = $mnesia->cluster_nodes(%params); unless (scalar keys %nodes) { command_run_failure(); } my $node = $self->node; my @nodes = grep { $_ ne $node->full_node_name } keys %nodes; return unless (scalar @nodes); return join("\n", sort @nodes)."\n"; } 1; erlsvc-1.02/lib/ErlSvc/Ctl/Command/release.pm000066400000000000000000000030051251425362700207610ustar00rootroot00000000000000#- # Copyright 2011 Yakaz. All rights reserved. # # Redistribution and use in source and binary forms, with or without # modification, are permitted provided that the following conditions # are met: # # 1. Redistributions of source code must retain the above copyright # notice, this list of conditions and the following disclaimer. # # 2. Redistributions in binary form must reproduce the above # copyright notice, this list of conditions and the following # disclaimer in the documentation and/or other materials provided # with the distribution. # # THIS SOFTWARE IS PROVIDED BY YAKAZ ``AS IS'' AND ANY EXPRESS OR # IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED # WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE # ARE DISCLAIMED. IN NO EVENT SHALL YAKAZ OR CONTRIBUTORS BE LIABLE # FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR # CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT # OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR # BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, # WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE # OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, # EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. package ErlSvc::Ctl::Command::release; use base qw(ErlSvc::Ctl::Command); =head1 NAME ErlSvc::Ctl::Command::release - Manage Erlang releases =cut use strict; use warnings; use utf8; sub run { shift->usage(); } 1; erlsvc-1.02/lib/ErlSvc/Ctl/Command/release/000077500000000000000000000000001251425362700204255ustar00rootroot00000000000000erlsvc-1.02/lib/ErlSvc/Ctl/Command/release/current.pm000066400000000000000000000041201251425362700224420ustar00rootroot00000000000000#- # Copyright 2011 Yakaz. All rights reserved. # # Redistribution and use in source and binary forms, with or without # modification, are permitted provided that the following conditions # are met: # # 1. Redistributions of source code must retain the above copyright # notice, this list of conditions and the following disclaimer. # # 2. Redistributions in binary form must reproduce the above # copyright notice, this list of conditions and the following # disclaimer in the documentation and/or other materials provided # with the distribution. # # THIS SOFTWARE IS PROVIDED BY YAKAZ ``AS IS'' AND ANY EXPRESS OR # IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED # WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE # ARE DISCLAIMED. IN NO EVENT SHALL YAKAZ OR CONTRIBUTORS BE LIABLE # FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR # CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT # OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR # BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, # WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE # OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, # EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. package ErlSvc::Ctl::Command::release::current; use base qw(ErlSvc::Ctl::Command::release); =head1 NAME ErlSvc::Ctl::Command::release::current - Print current release name =cut use strict; use warnings; use utf8; use ErlSvc::Ctl::Exceptions qw(:all); use ErlSvc::Ctl::Release; sub desc () { return <<'EOF'; This command prints the current release name. On a non-running node, this is the same as the default release name. While using this command on a running and/or remote node is possible, options modifying the release has no effects. EOF } sub run { my ($self, $opts, @args) = @_; my $release = ErlSvc::Ctl::Release->new($self); my $rel = $release->current; if ($rel) { return "$rel\n"; } else { command_run_failure('reason' => '(unknown)'); } } 1; erlsvc-1.02/lib/ErlSvc/Ctl/Command/release/default.pm000066400000000000000000000040121251425362700224040ustar00rootroot00000000000000#- # Copyright 2011 Yakaz. All rights reserved. # # Redistribution and use in source and binary forms, with or without # modification, are permitted provided that the following conditions # are met: # # 1. Redistributions of source code must retain the above copyright # notice, this list of conditions and the following disclaimer. # # 2. Redistributions in binary form must reproduce the above # copyright notice, this list of conditions and the following # disclaimer in the documentation and/or other materials provided # with the distribution. # # THIS SOFTWARE IS PROVIDED BY YAKAZ ``AS IS'' AND ANY EXPRESS OR # IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED # WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE # ARE DISCLAIMED. IN NO EVENT SHALL YAKAZ OR CONTRIBUTORS BE LIABLE # FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR # CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT # OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR # BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, # WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE # OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, # EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. package ErlSvc::Ctl::Command::release::default; use base qw(ErlSvc::Ctl::Command::release); =head1 NAME ErlSvc::Ctl::Command::release::default - Print default release name =cut use strict; use warnings; use utf8; use ErlSvc::Ctl::Exceptions qw(:all); use ErlSvc::Ctl::Release; sub desc () { return <<'EOF'; This command prints the default release name. While using this command on a running and/or remote node is possible, options modifying the release has no effects. EOF } sub run { my ($self, $opts, @args) = @_; my $release = ErlSvc::Ctl::Release->new($self); my $rel = $release->default; if ($rel) { return "$rel\n"; } else { command_run_failure('reason' => '(unknown)'); } } 1; erlsvc-1.02/lib/ErlSvc/Ctl/Command/release/dir.pm000066400000000000000000000040101251425362700215340ustar00rootroot00000000000000#- # Copyright 2011 Yakaz. All rights reserved. # # Redistribution and use in source and binary forms, with or without # modification, are permitted provided that the following conditions # are met: # # 1. Redistributions of source code must retain the above copyright # notice, this list of conditions and the following disclaimer. # # 2. Redistributions in binary form must reproduce the above # copyright notice, this list of conditions and the following # disclaimer in the documentation and/or other materials provided # with the distribution. # # THIS SOFTWARE IS PROVIDED BY YAKAZ ``AS IS'' AND ANY EXPRESS OR # IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED # WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE # ARE DISCLAIMED. IN NO EVENT SHALL YAKAZ OR CONTRIBUTORS BE LIABLE # FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR # CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT # OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR # BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, # WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE # OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, # EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. package ErlSvc::Ctl::Command::release::dir; use base qw(ErlSvc::Ctl::Command::release); =head1 NAME ErlSvc::Ctl::Command::release::dir - Print the release(s) directory =cut use strict; use warnings; use utf8; use ErlSvc::Ctl::Exceptions qw(:all); sub desc () { return <<'EOF'; This command prints the directory of a release or, if no release is specified, the releases directory. EOF } sub run { my ($self, $opts, @args) = @_; my $erl_env = $self->erl_env; my $dir; if ($args[0]) { $dir = $erl_env->release_dir($args[0]); } else { $dir = $erl_env->releases_dir; } if ($dir) { return "$dir\n"; } else { command_run_failure('reason' => '(unknown)'); } } 1; erlsvc-1.02/lib/ErlSvc/Ctl/Command/release/list.pm000066400000000000000000000046071251425362700217450ustar00rootroot00000000000000#- # Copyright 2011 Yakaz. All rights reserved. # # Redistribution and use in source and binary forms, with or without # modification, are permitted provided that the following conditions # are met: # # 1. Redistributions of source code must retain the above copyright # notice, this list of conditions and the following disclaimer. # # 2. Redistributions in binary form must reproduce the above # copyright notice, this list of conditions and the following # disclaimer in the documentation and/or other materials provided # with the distribution. # # THIS SOFTWARE IS PROVIDED BY YAKAZ ``AS IS'' AND ANY EXPRESS OR # IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED # WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE # ARE DISCLAIMED. IN NO EVENT SHALL YAKAZ OR CONTRIBUTORS BE LIABLE # FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR # CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT # OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR # BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, # WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE # OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, # EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. package ErlSvc::Ctl::Command::release::list; use base qw(ErlSvc::Ctl::Command::release); =head1 NAME ErlSvc::Ctl::Command::release::list - List available releases =cut use strict; use warnings; use utf8; use ErlSvc::Ctl::Exceptions qw(:all); use ErlSvc::Ctl::Release; sub desc () { return <<'EOF'; This command lists available releases and their respective state. EOF } sub run { my ($self, $opts, @args) = @_; my $release = ErlSvc::Ctl::Release->new($self); my %rels = $release->list; if (%rels) { my $max_len = length('Release'); foreach my $rel (keys %rels) { my $len = length($rel); $max_len = ($len > $max_len) ? $len : $max_len; } my $output = ''; $output .= sprintf("\e[1m%-${max_len}s %s\e[0m\n", 'Release', 'State'); my @relnames = sort { $a cmp $b } keys %rels; foreach my $rel ( @relnames) { $output .= sprintf("%-${max_len}s %s\n", $rel, $rels{$rel}->{'state'}); } return $output; } else { command_run_failure(); } } 1; erlsvc-1.02/lib/ErlSvc/Ctl/Command/release/remove.pm000066400000000000000000000037201251425362700222620ustar00rootroot00000000000000#- # Copyright 2011 Yakaz. All rights reserved. # # Redistribution and use in source and binary forms, with or without # modification, are permitted provided that the following conditions # are met: # # 1. Redistributions of source code must retain the above copyright # notice, this list of conditions and the following disclaimer. # # 2. Redistributions in binary form must reproduce the above # copyright notice, this list of conditions and the following # disclaimer in the documentation and/or other materials provided # with the distribution. # # THIS SOFTWARE IS PROVIDED BY YAKAZ ``AS IS'' AND ANY EXPRESS OR # IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED # WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE # ARE DISCLAIMED. IN NO EVENT SHALL YAKAZ OR CONTRIBUTORS BE LIABLE # FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR # CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT # OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR # BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, # WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE # OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, # EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. package ErlSvc::Ctl::Command::release::remove; use base qw(ErlSvc::Ctl::Command::release); =head1 NAME ErlSvc::Ctl::Command::release::remove - Remove specified release =cut use strict; use warnings; use utf8; use ErlSvc::Ctl::Exceptions qw(:all); sub desc () { return <<'EOF'; This command removes the specified release. The release must not be in use or permanent. EOF } sub run { my ($self, $opts, @args) = @_; my $release = ErlSvc::Ctl::Release->new($self); my $victim = $args[0]; my $ret = $release->remove($victim); if (!$ret) { # Failed to remove the release. command_run_failure(); return; } return; } 1; erlsvc-1.02/lib/ErlSvc/Ctl/Command/release/reset.pm000066400000000000000000000037361251425362700221160ustar00rootroot00000000000000#- # Copyright 2011 Yakaz. All rights reserved. # # Redistribution and use in source and binary forms, with or without # modification, are permitted provided that the following conditions # are met: # # 1. Redistributions of source code must retain the above copyright # notice, this list of conditions and the following disclaimer. # # 2. Redistributions in binary form must reproduce the above # copyright notice, this list of conditions and the following # disclaimer in the documentation and/or other materials provided # with the distribution. # # THIS SOFTWARE IS PROVIDED BY YAKAZ ``AS IS'' AND ANY EXPRESS OR # IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED # WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE # ARE DISCLAIMED. IN NO EVENT SHALL YAKAZ OR CONTRIBUTORS BE LIABLE # FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR # CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT # OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR # BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, # WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE # OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, # EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. package ErlSvc::Ctl::Command::release::reset; use base qw(ErlSvc::Ctl::Command::release); =head1 NAME ErlSvc::Ctl::Command::release::reset - Restore Erlang vanilla release =cut use strict; use warnings; use utf8; use ErlSvc::Ctl::Exceptions qw(:all); sub desc () { return <<'EOF'; This command restores the Erlang vanilla release. EOF } sub run { my ($self, $opts, @args) = @_; my $release = ErlSvc::Ctl::Release->new($self); my $current = $release->current; my $ret = $release->reset; unless ($ret) { # Failed to reset the release. command_run_failure(); } if ($ret != 2) { $release->remove($current); } return; } 1; erlsvc-1.02/lib/ErlSvc/Ctl/Command/release/syncvanilla.pm000066400000000000000000000043221251425362700233070ustar00rootroot00000000000000#- # Copyright 2011 Yakaz. All rights reserved. # # Redistribution and use in source and binary forms, with or without # modification, are permitted provided that the following conditions # are met: # # 1. Redistributions of source code must retain the above copyright # notice, this list of conditions and the following disclaimer. # # 2. Redistributions in binary form must reproduce the above # copyright notice, this list of conditions and the following # disclaimer in the documentation and/or other materials provided # with the distribution. # # THIS SOFTWARE IS PROVIDED BY YAKAZ ``AS IS'' AND ANY EXPRESS OR # IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED # WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE # ARE DISCLAIMED. IN NO EVENT SHALL YAKAZ OR CONTRIBUTORS BE LIABLE # FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR # CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT # OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR # BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, # WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE # OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, # EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. package ErlSvc::Ctl::Command::release::syncvanilla; use base qw(ErlSvc::Ctl::Command::release); =head1 NAME ErlSvc::Ctl::Command::release::syncvanilla - Synchronize the releases directory with default =cut use strict; use warnings; use utf8; use ErlSvc::Ctl::Exceptions qw(:all); use ErlSvc::Ctl::Release; sub desc () { return <<'EOF'; This command synchronizes the effective releases directory (set by the -d global flags) with the default Erlang releases directory. EOF } sub option_spec { return ( ['from-scratch|f', 'clean releases directory and synchronize from scratch'] ); } sub run { my ($self, $opts, @args) = @_; my $release = ErlSvc::Ctl::Release->new($self); my %params = (); if ($opts->{'from_scratch'}) { $params{'from_scratch'} = 1; } my $ret = $release->sync_vanilla_releases(%params); unless ($ret) { command_run_failure; } return; } 1; erlsvc-1.02/lib/ErlSvc/Ctl/Command/release/upgradable.pm000066400000000000000000000037571251425362700231050ustar00rootroot00000000000000#- # Copyright 2011 Yakaz. All rights reserved. # # Redistribution and use in source and binary forms, with or without # modification, are permitted provided that the following conditions # are met: # # 1. Redistributions of source code must retain the above copyright # notice, this list of conditions and the following disclaimer. # # 2. Redistributions in binary form must reproduce the above # copyright notice, this list of conditions and the following # disclaimer in the documentation and/or other materials provided # with the distribution. # # THIS SOFTWARE IS PROVIDED BY YAKAZ ``AS IS'' AND ANY EXPRESS OR # IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED # WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE # ARE DISCLAIMED. IN NO EVENT SHALL YAKAZ OR CONTRIBUTORS BE LIABLE # FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR # CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT # OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR # BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, # WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE # OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, # EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. package ErlSvc::Ctl::Command::release::upgradable; use base qw(ErlSvc::Ctl::Command::release); =head1 NAME ErlSvc::Ctl::Command::release::upgradable - Verify release upgrade possibilities =cut use strict; use warnings; use utf8; sub desc () { return <<'EOF'; This command verifies that the specified release supports upgrade from the current release. EOF } sub option_spec { return ( ['from|f=s', 'Use release FROM as basis for the check'] ); } sub run { my ($self, $opts, @args) = @_; my $release = ErlSvc::Ctl::Release->new($self); my $target = $args[0]; my $ret = $release->upgradable($target, 'from' => $opts->{'from'}); return $ret ? "Yes\n" : "No\n"; } 1; erlsvc-1.02/lib/ErlSvc/Ctl/Command/release/upgrade.pm000066400000000000000000000046551251425362700224240ustar00rootroot00000000000000#- # Copyright 2011 Yakaz. All rights reserved. # # Redistribution and use in source and binary forms, with or without # modification, are permitted provided that the following conditions # are met: # # 1. Redistributions of source code must retain the above copyright # notice, this list of conditions and the following disclaimer. # # 2. Redistributions in binary form must reproduce the above # copyright notice, this list of conditions and the following # disclaimer in the documentation and/or other materials provided # with the distribution. # # THIS SOFTWARE IS PROVIDED BY YAKAZ ``AS IS'' AND ANY EXPRESS OR # IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED # WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE # ARE DISCLAIMED. IN NO EVENT SHALL YAKAZ OR CONTRIBUTORS BE LIABLE # FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR # CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT # OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR # BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, # WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE # OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, # EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. package ErlSvc::Ctl::Command::release::upgrade; use base qw(ErlSvc::Ctl::Command::release); =head1 NAME ErlSvc::Ctl::Command::release::upgrade - Upgrade to specified release =cut use strict; use warnings; use utf8; use ErlSvc::Ctl::Exceptions qw(:all); sub desc () { return <<'EOF'; This command upgrades the current release to a specified release. Using this command on a remote node is not possible. EOF } sub option_spec { return ( ['extra-flags|E=s@', 'add extra flags to the node start command line'] ); } sub run { my ($self, $opts, @args) = @_; my $release = ErlSvc::Ctl::Release->new($self); my $current = $release->current; my $target = $args[0]; my %params = (); if ($opts->{'extra_flags'}) { $params{'extra_flags'} = $opts->{'extra_flags'}; } my $ret = $release->upgrade($target, %params); unless ($ret) { # Failed to upgrade the release. command_run_failure(); } if ($ret == 2) { return "Service is already using release '$target'\n"; } else { return "Service upgraded from release '$current' to '$target'\n"; } } 1; erlsvc-1.02/lib/ErlSvc/Ctl/Command/reload.pm000066400000000000000000000036741251425362700206230ustar00rootroot00000000000000#- # Copyright 2011 Yakaz. All rights reserved. # # Redistribution and use in source and binary forms, with or without # modification, are permitted provided that the following conditions # are met: # # 1. Redistributions of source code must retain the above copyright # notice, this list of conditions and the following disclaimer. # # 2. Redistributions in binary form must reproduce the above # copyright notice, this list of conditions and the following # disclaimer in the documentation and/or other materials provided # with the distribution. # # THIS SOFTWARE IS PROVIDED BY YAKAZ ``AS IS'' AND ANY EXPRESS OR # IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED # WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE # ARE DISCLAIMED. IN NO EVENT SHALL YAKAZ OR CONTRIBUTORS BE LIABLE # FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR # CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT # OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR # BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, # WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE # OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, # EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. package ErlSvc::Ctl::Command::reload; use base qw(ErlSvc::Ctl::Command); =head1 NAME ErlSvc::Ctl::Command::reload - Reload configuration =cut use strict; use warnings; use utf8; use ErlSvc::Ctl::Exceptions qw(:all); use ErlSvc::Ctl::Service; sub desc () { return <<'EOF'; This command reloads the configuration without restarting the service. The target node must be running. EOF } sub run { my ($self, $opts, @args) = @_; my $service = ErlSvc::Ctl::Service->new($self); my $ret = $service->reload; if (!$ret) { # Failed to reload the configuration. command_run_failure(); return; } return; } 1; erlsvc-1.02/lib/ErlSvc/Ctl/Command/restart.pm000066400000000000000000000066331251425362700210370ustar00rootroot00000000000000#- # Copyright 2011 Yakaz. All rights reserved. # # Redistribution and use in source and binary forms, with or without # modification, are permitted provided that the following conditions # are met: # # 1. Redistributions of source code must retain the above copyright # notice, this list of conditions and the following disclaimer. # # 2. Redistributions in binary form must reproduce the above # copyright notice, this list of conditions and the following # disclaimer in the documentation and/or other materials provided # with the distribution. # # THIS SOFTWARE IS PROVIDED BY YAKAZ ``AS IS'' AND ANY EXPRESS OR # IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED # WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE # ARE DISCLAIMED. IN NO EVENT SHALL YAKAZ OR CONTRIBUTORS BE LIABLE # FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR # CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT # OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR # BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, # WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE # OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, # EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. package ErlSvc::Ctl::Command::restart; use base qw(ErlSvc::Ctl::Command); =head1 NAME ErlSvc::Ctl::Command::restart - Restart the service =cut use strict; use warnings; use utf8; use ErlSvc::Ctl::Exceptions qw(:all); use ErlSvc::Ctl::Service; use ErlSvc::Ctl::Usage qw(abs_progname); sub desc () { return <<'EOF'; This command restarts the service. If the service is not running, the command starts the service. Using this command on a remote node is not possible. EOF } sub option_spec { return ( ['force|f', 'kill the service without a graceful stop at first'], ['timeout|t=i', 'kill the node if it\'s not down after TIMEOUT seconds'], [], ['disable-heart|H', 'disable node monitoring with heart(1)'], ['foreground|F', 'start the service in an Erlang shell'], ['load-only|L', 'load the service but do not start it'], ['extra-flags|E=s@', 'add extra flags to the node start command line'] ); } sub run { my ($self, $opts, @args) = @_; my $service = ErlSvc::Ctl::Service->new($self); my %params = (); if (exists $opts->{'timeout'}) { $params{'timeout'} = $opts->{'timeout'}; } if ($opts->{'force'}) { $params{'force'} = 1; } # Heart and SASL command to restart the node. We don't want to pass # -f and -t to the heart command. my %cleaned_opts = %$opts; delete $cleaned_opts{'force'}; delete $cleaned_opts{'timeout'}; $params{'restart_cmd'} = join(' ', abs_progname(), $self->opts_to_list, 'restart', $self->opts_to_list(\%cleaned_opts) ); if (!$opts->{'disable_heart'}) { $params{'heart'} = 1; } if ($opts->{'foreground'}) { $params{'embedded'} = 0; } if ($opts->{'load_only'}) { $params{'embedded'} = 0; $params{'load_only'} = 1; } if ($opts->{'extra_flags'}) { $params{'extra_flags'} = $opts->{'extra_flags'}; } my $ret = $service->restart(%params); if (!$ret) { # Failed to restart the service. command_run_failure(); return; } return; } 1; erlsvc-1.02/lib/ErlSvc/Ctl/Command/shell.pm000066400000000000000000000055621251425362700204620ustar00rootroot00000000000000#- # Copyright 2011 Yakaz. All rights reserved. # # Redistribution and use in source and binary forms, with or without # modification, are permitted provided that the following conditions # are met: # # 1. Redistributions of source code must retain the above copyright # notice, this list of conditions and the following disclaimer. # # 2. Redistributions in binary form must reproduce the above # copyright notice, this list of conditions and the following # disclaimer in the documentation and/or other materials provided # with the distribution. # # THIS SOFTWARE IS PROVIDED BY YAKAZ ``AS IS'' AND ANY EXPRESS OR # IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED # WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE # ARE DISCLAIMED. IN NO EVENT SHALL YAKAZ OR CONTRIBUTORS BE LIABLE # FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR # CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT # OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR # BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, # WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE # OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, # EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. package ErlSvc::Ctl::Command::shell; use base qw(ErlSvc::Ctl::Command); =head1 NAME ErlSvc::Ctl::Command::shell - Open a shell connected to a running service =cut use strict; use warnings; use utf8; use ErlSvc::Ctl::Exceptions qw(:all); use ErlSvc::Ctl::Service; use ErlSvc::Ctl::Usage qw(abs_progname); sub desc () { return <<'EOF'; This command opens a shell on a running service. Two modes are available: o Based on to_erl(1), this shell provides completion and history. Furthermore, everything is logged in erlang.log.*. However, only one shell can be opened at a time and the service must be local. o The remote shell allows one to connect to a remote service but the commands history isn't kept after the shell is closed and completion isn't available. If the node is local, this command tries the first mode and, if it fails, falls back on the second mode. If the node is remote, this command tries only the second mode. The mode can be forced using command options. EOF } sub option_spec { return ( ['to-erl|t', 'open a shell using to_erl(1)'], ['remsh|r', 'open a shell using erl -remsh'] ); } sub run { my ($self, $opts, @args) = @_; my $service = ErlSvc::Ctl::Service->new($self); my %params = (); if ($opts->{'to_erl'}) { $params{'mode'} = 'to_erl'; } if ($opts->{'remsh'}) { $params{'mode'} = 'remsh'; } my $ret = $service->shell(%params); if (!$ret) { # Failed to shell the service. command_run_failure(); return; } return; } 1; erlsvc-1.02/lib/ErlSvc/Ctl/Command/start.pm000066400000000000000000000061141251425362700205020ustar00rootroot00000000000000#- # Copyright 2011 Yakaz. All rights reserved. # # Redistribution and use in source and binary forms, with or without # modification, are permitted provided that the following conditions # are met: # # 1. Redistributions of source code must retain the above copyright # notice, this list of conditions and the following disclaimer. # # 2. Redistributions in binary form must reproduce the above # copyright notice, this list of conditions and the following # disclaimer in the documentation and/or other materials provided # with the distribution. # # THIS SOFTWARE IS PROVIDED BY YAKAZ ``AS IS'' AND ANY EXPRESS OR # IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED # WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE # ARE DISCLAIMED. IN NO EVENT SHALL YAKAZ OR CONTRIBUTORS BE LIABLE # FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR # CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT # OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR # BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, # WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE # OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, # EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. package ErlSvc::Ctl::Command::start; use base qw(ErlSvc::Ctl::Command); =head1 NAME ErlSvc::Ctl::Command::start - Start the service =cut use strict; use warnings; use utf8; use ErlSvc::Ctl::Exceptions qw(:all); use ErlSvc::Ctl::Service; use ErlSvc::Ctl::Usage qw(abs_progname); sub desc () { return <<'EOF'; This command starts the service. If the service is already running, the command does nothing and returns successfully. Using this command on a remote node is not possible. EOF } sub option_spec { return ( ['disable-heart|H', 'disable node monitoring with heart(1)'], ['foreground|F', 'start the service in an Erlang shell'], ['load-only|L', 'load the service but do not start it'], ['extra-flags|E=s@', 'add extra flags to the node start command line'] ); } sub run { my ($self, $opts, @args) = @_; my $service = ErlSvc::Ctl::Service->new($self); my $service_name = ucfirst($service->name); my %params = (); # Heart and SASL command to restart the node. $params{'restart_cmd'} = join(' ', abs_progname(), $self->opts_to_list, 'restart', $self->opts_to_list($opts) ); if (!$opts->{'disable_heart'}) { $params{'heart'} = 1; } if ($opts->{'foreground'}) { $params{'embedded'} = 0; } if ($opts->{'load_only'}) { $params{'embedded'} = 0; $params{'load_only'} = 1; } if ($opts->{'extra_flags'}) { $params{'extra_flags'} = $opts->{'extra_flags'}; } my $ret = $service->start(%params); if (!$ret) { # Failed to start the service. command_run_failure(); return; } elsif ($ret eq 2) { # Service already up. return "$service_name is already running\n"; } return; } 1; erlsvc-1.02/lib/ErlSvc/Ctl/Command/status.pm000066400000000000000000000051201251425362700206640ustar00rootroot00000000000000#- # Copyright 2011 Yakaz. All rights reserved. # # Redistribution and use in source and binary forms, with or without # modification, are permitted provided that the following conditions # are met: # # 1. Redistributions of source code must retain the above copyright # notice, this list of conditions and the following disclaimer. # # 2. Redistributions in binary form must reproduce the above # copyright notice, this list of conditions and the following # disclaimer in the documentation and/or other materials provided # with the distribution. # # THIS SOFTWARE IS PROVIDED BY YAKAZ ``AS IS'' AND ANY EXPRESS OR # IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED # WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE # ARE DISCLAIMED. IN NO EVENT SHALL YAKAZ OR CONTRIBUTORS BE LIABLE # FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR # CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT # OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR # BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, # WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE # OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, # EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. package ErlSvc::Ctl::Command::status; use base qw(ErlSvc::Ctl::Command); =head1 NAME ErlSvc::Ctl::Command::status - Tell if the service is running =cut use strict; use warnings; use utf8; use ErlSvc::Ctl::Exceptions qw(:all); use ErlSvc::Ctl::Service; sub desc () { return <<'EOF'; This command tells if the service is up and running. EOF } sub option_spec { return ( ['batch|b', 'exit with 0 if the service is running, otherwise 1; nothing printed'], ['short|s', 'just print "YES" or "NO" instead of a full sentence'] ); } sub run { my ($self, $opts, @args) = @_; my $service = ErlSvc::Ctl::Service->new($self); my $is_running = $service->is_running; if ($opts->{'batch'}) { command_run_failure() unless ($is_running); return; } elsif ($opts->{'short'}) { # The -s option is used by My service's Debian package and, because # the maintainer scripts use sh -e, we can't exit with 1 or # those scripts would exit too. return ($is_running) ? 'YES' : 'NO'; } else { my $name = ucfirst($service->name); if ($is_running) { return "$name is up and running\n"; } else { command_run_failure('reason' => "$name is NOT running"); return; } } } 1; erlsvc-1.02/lib/ErlSvc/Ctl/Command/stop.pm000066400000000000000000000051331251425362700203320ustar00rootroot00000000000000#- # Copyright 2011 Yakaz. All rights reserved. # # Redistribution and use in source and binary forms, with or without # modification, are permitted provided that the following conditions # are met: # # 1. Redistributions of source code must retain the above copyright # notice, this list of conditions and the following disclaimer. # # 2. Redistributions in binary form must reproduce the above # copyright notice, this list of conditions and the following # disclaimer in the documentation and/or other materials provided # with the distribution. # # THIS SOFTWARE IS PROVIDED BY YAKAZ ``AS IS'' AND ANY EXPRESS OR # IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED # WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE # ARE DISCLAIMED. IN NO EVENT SHALL YAKAZ OR CONTRIBUTORS BE LIABLE # FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR # CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT # OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR # BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, # WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE # OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, # EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. package ErlSvc::Ctl::Command::stop; use base qw(ErlSvc::Ctl::Command); =head1 NAME ErlSvc::Ctl::Command::stop - Stop the service =cut use strict; use warnings; use utf8; use ErlSvc::Ctl::Exceptions qw(:all); use ErlSvc::Ctl::Service; use ErlSvc::Ctl::Usage qw(abs_progname); sub desc () { return <<'EOF'; This command stops the service. If the service is not running, the command does nothing and returns successfully. Using this command on a remote node is supported but it's not possible to restart it remotely! EOF } sub option_spec { return ( ['force|f', 'kill the service without a graceful stop at first'], ['timeout|t=i', 'kill the node if it\'s not down after TIMEOUT seconds'] ); } sub run { my ($self, $opts, @args) = @_; my $service = ErlSvc::Ctl::Service->new($self); my $service_name = ucfirst($service->name); my %params = (); if (exists $opts->{'timeout'}) { $params{'timeout'} = $opts->{'timeout'}; } if ($opts->{'force'}) { $params{'force'} = 1; } my $ret = $service->stop(%params); if (!$ret) { # Failed to stop the service. command_run_failure(); return; } elsif ($ret eq 2) { # Service already down. return "$service_name is not running\n"; } return; } 1; erlsvc-1.02/lib/ErlSvc/Ctl/Command/target.pm000066400000000000000000000030111251425362700206240ustar00rootroot00000000000000#- # Copyright 2011 Yakaz. All rights reserved. # # Redistribution and use in source and binary forms, with or without # modification, are permitted provided that the following conditions # are met: # # 1. Redistributions of source code must retain the above copyright # notice, this list of conditions and the following disclaimer. # # 2. Redistributions in binary form must reproduce the above # copyright notice, this list of conditions and the following # disclaimer in the documentation and/or other materials provided # with the distribution. # # THIS SOFTWARE IS PROVIDED BY YAKAZ ``AS IS'' AND ANY EXPRESS OR # IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED # WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE # ARE DISCLAIMED. IN NO EVENT SHALL YAKAZ OR CONTRIBUTORS BE LIABLE # FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR # CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT # OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR # BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, # WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE # OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, # EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. package ErlSvc::Ctl::Command::target; use base qw(ErlSvc::Ctl::Command); =head1 NAME ErlSvc::Ctl::Command::target - Manage Erlang target systems =cut use strict; use warnings; use utf8; sub run { shift->usage(); } 1; erlsvc-1.02/lib/ErlSvc/Ctl/Command/target/000077500000000000000000000000001251425362700202735ustar00rootroot00000000000000erlsvc-1.02/lib/ErlSvc/Ctl/Command/target/clean.pm000066400000000000000000000044041251425362700217150ustar00rootroot00000000000000#- # Copyright 2011 Yakaz. All rights reserved. # # Redistribution and use in source and binary forms, with or without # modification, are permitted provided that the following conditions # are met: # # 1. Redistributions of source code must retain the above copyright # notice, this list of conditions and the following disclaimer. # # 2. Redistributions in binary form must reproduce the above # copyright notice, this list of conditions and the following # disclaimer in the documentation and/or other materials provided # with the distribution. # # THIS SOFTWARE IS PROVIDED BY YAKAZ ``AS IS'' AND ANY EXPRESS OR # IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED # WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE # ARE DISCLAIMED. IN NO EVENT SHALL YAKAZ OR CONTRIBUTORS BE LIABLE # FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR # CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT # OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR # BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, # WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE # OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, # EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. package ErlSvc::Ctl::Command::target::clean; use base qw(ErlSvc::Ctl::Command::target); =head1 NAME ErlSvc::Ctl::Command::target::clean - Remove unused ERTS and applications =cut use strict; use warnings; use utf8; use ErlSvc::Ctl::Exceptions qw(:all); use ErlSvc::Ctl::Target; sub desc () { return <<'EOF'; This command remove unused ERTS and applications by looking at the RELEASES file. Every applications not referenced in this file is removed. The same applies to ERTS version not referenced. Using this command on a remote node is not possible. EOF } sub option_spec { return ( ['dry-run|n', 'just tell what would be removed'] ); } sub run { my ($self, $opts, @args) = @_; my $target_system = ErlSvc::Ctl::Target->new($self); my %params = (); if ($opts->{'dry_run'}) { $params{'dry_run'} = 1; } my $ret = $target_system->remove_unused(%params); unless ($ret) { command_run_failure; } return; } 1; erlsvc-1.02/lib/ErlSvc/Ctl/Command/target/deploy.pm000066400000000000000000000046661251425362700221410ustar00rootroot00000000000000#- # Copyright 2011 Yakaz. All rights reserved. # # Redistribution and use in source and binary forms, with or without # modification, are permitted provided that the following conditions # are met: # # 1. Redistributions of source code must retain the above copyright # notice, this list of conditions and the following disclaimer. # # 2. Redistributions in binary form must reproduce the above # copyright notice, this list of conditions and the following # disclaimer in the documentation and/or other materials provided # with the distribution. # # THIS SOFTWARE IS PROVIDED BY YAKAZ ``AS IS'' AND ANY EXPRESS OR # IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED # WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE # ARE DISCLAIMED. IN NO EVENT SHALL YAKAZ OR CONTRIBUTORS BE LIABLE # FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR # CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT # OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR # BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, # WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE # OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, # EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. package ErlSvc::Ctl::Command::target::deploy; use base qw(ErlSvc::Ctl::Command::target); =head1 NAME ErlSvc::Ctl::Command::target::deploy - Deploy or update a target system directory =cut use strict; use warnings; use utf8; use ErlSvc::Ctl::Exceptions qw(:all); use ErlSvc::Ctl::Target; sub desc () { return <<'EOF'; This command deploys or update a target system directory. In other words, it uses rsync(1) to copy the system Erlang root directory to a directory which will be the root directory of the node. Using this command on a remote node is not possible. EOF } sub option_spec { return ( ['directory|d=s', 'specify the target system directory'], ['from-scratch|f', 'remove existing directory first'] ); } sub run { my ($self, $opts, @args) = @_; my $target_system = ErlSvc::Ctl::Target->new($self); my %params = (); if ($opts->{'directory'}) { $params{'directory'} = $opts->{'directory'}; } if ($opts->{'from_scratch'}) { $params{'from_scratch'} = 1; } my $ret = $target_system->deploy(%params); unless ($ret) { command_run_failure; } return; } 1; erlsvc-1.02/lib/ErlSvc/Ctl/Command/target/destroy.pm000066400000000000000000000043151251425362700223250ustar00rootroot00000000000000#- # Copyright 2011 Yakaz. All rights reserved. # # Redistribution and use in source and binary forms, with or without # modification, are permitted provided that the following conditions # are met: # # 1. Redistributions of source code must retain the above copyright # notice, this list of conditions and the following disclaimer. # # 2. Redistributions in binary form must reproduce the above # copyright notice, this list of conditions and the following # disclaimer in the documentation and/or other materials provided # with the distribution. # # THIS SOFTWARE IS PROVIDED BY YAKAZ ``AS IS'' AND ANY EXPRESS OR # IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED # WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE # ARE DISCLAIMED. IN NO EVENT SHALL YAKAZ OR CONTRIBUTORS BE LIABLE # FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR # CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT # OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR # BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, # WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE # OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, # EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. package ErlSvc::Ctl::Command::target::destroy; use base qw(ErlSvc::Ctl::Command::target); =head1 NAME ErlSvc::Ctl::Command::target::destroy - Delete the content of a target system directory =cut use strict; use warnings; use utf8; use ErlSvc::Ctl::Exceptions qw(:all); use ErlSvc::Ctl::Target; sub desc () { return <<'EOF'; This command deletes the content of the target system directory but not the directory itself. Using this command on a remote node is not possible. EOF } sub option_spec { return ( ['directory|d=s', 'specify the target system directory'] ); } sub run { my ($self, $opts, @args) = @_; my $target_system = ErlSvc::Ctl::Target->new($self); my %params = (); if ($opts->{'directory'}) { $params{'directory'} = $opts->{'directory'}; } my $ret = $target_system->destroy(%params); unless ($ret) { command_run_failure; } return; } 1; erlsvc-1.02/lib/ErlSvc/Ctl/Command/version.pm000066400000000000000000000031711251425362700210320ustar00rootroot00000000000000#- # Copyright 2011 Yakaz. All rights reserved. # # Redistribution and use in source and binary forms, with or without # modification, are permitted provided that the following conditions # are met: # # 1. Redistributions of source code must retain the above copyright # notice, this list of conditions and the following disclaimer. # # 2. Redistributions in binary form must reproduce the above # copyright notice, this list of conditions and the following # disclaimer in the documentation and/or other materials provided # with the distribution. # # THIS SOFTWARE IS PROVIDED BY YAKAZ ``AS IS'' AND ANY EXPRESS OR # IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED # WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE # ARE DISCLAIMED. IN NO EVENT SHALL YAKAZ OR CONTRIBUTORS BE LIABLE # FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR # CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT # OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR # BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, # WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE # OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, # EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. package ErlSvc::Ctl::Command::version; use base qw(CLI::Framework::Command::Meta); =head1 NAME ErlSvc::Ctl::Command::version - Print program version =cut use strict; use warnings; use utf8; use ErlSvc::Ctl::Usage qw(progname); sub run { my ($self, $opts, @args) = @_; return progname().' '.$ErlSvc::Ctl::VERSION."\n"; } 1; erlsvc-1.02/lib/ErlSvc/Ctl/Erlang/000077500000000000000000000000001251425362700166375ustar00rootroot00000000000000erlsvc-1.02/lib/ErlSvc/Ctl/Erlang/Env.pm000066400000000000000000000230571251425362700177340ustar00rootroot00000000000000#- # Copyright 2011 Yakaz. All rights reserved. # # Redistribution and use in source and binary forms, with or without # modification, are permitted provided that the following conditions # are met: # # 1. Redistributions of source code must retain the above copyright # notice, this list of conditions and the following disclaimer. # # 2. Redistributions in binary form must reproduce the above # copyright notice, this list of conditions and the following # disclaimer in the documentation and/or other materials provided # with the distribution. # # THIS SOFTWARE IS PROVIDED BY YAKAZ ``AS IS'' AND ANY EXPRESS OR # IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED # WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE # ARE DISCLAIMED. IN NO EVENT SHALL YAKAZ OR CONTRIBUTORS BE LIABLE # FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR # CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT # OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR # BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, # WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE # OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, # EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. package ErlSvc::Ctl::Erlang::Env; use strict; use warnings; use utf8; use File::Spec; use ErlSvc::Ctl::Erlang::Script; use ErlSvc::Ctl::Release; sub new ($) { my ($class, $app) = @_; $class = ref($class) || $class; my $self = { 'cmd' => {}, 'app' => $app }; bless $self => $class; $self->_set_erl_cmd; return $self; } sub _set_erl_cmd (;$) { my ($self, $root_dir) = @_; # Set the path to erl(1). my $cmd = 'erl'; $root_dir = $self->app->opts('erlang') unless ($root_dir); if ($root_dir && -d $root_dir) { my $erl_cmd = File::Spec->catfile($root_dir, 'bin', $cmd); if (-x $erl_cmd) { $self->app->log->debug('ERLENV', "$cmd(1) binary is '$erl_cmd' ". "(--erlang/-E was specified)\n"); $self->{'cmd'}->{$cmd} = $erl_cmd; } } if (!$self->{'cmd'}->{$cmd} && $ENV{'ERL'}) { my $erl_cmd = $ENV{'ERL'}; if (-x $erl_cmd) { $self->app->log->debug('ERLENV', "$cmd(1) binary is '$erl_cmd' ". "(taken from \$ERL environment variable)\n"); $self->{'cmd'}->{$cmd} = $erl_cmd; } } if (!$self->{'cmd'}->{$cmd}) { $self->app->log->debug('ERLENV', "$cmd(1) binary is '$cmd' ". "(will be searched in \$PATH)\n"); $self->{'cmd'}->{$cmd} = $cmd; } } sub finish_init() { my ($self) = @_; # Get the target node and check he's running. my $target = $self->app->node; my $controller = $self->app->controller; if (!$target->is_alive) { # The target node is down. We check if he's local to this host # to determine if we can start it. if (!$target->is_local) { $self->app->log->error( "Problem:\n", " The node '$target' is not started and can't be started\n", " automatically because the host is remote.\n" ); return; } } else { # The command will run on the target node but we use the controller # node as a gateway. $controller->set_target($target) or return; } my $script = ErlSvc::Ctl::Erlang::Script->new($self->app); my ($command, %result); # Set root dir. my $root_dir = $self->app->opts('erlang'); unless ($root_dir) { $command = "{erlsvc_erlenv, root_dir, []}"; %result = $script->eval($controller, $command); unless ($result{'status'} && $result{'status'} eq 'ok') { return; } $root_dir = $result{'return'}; } unless (-d $root_dir) { $self->app->log->error( "Problem:\n", " The Erlang root directory '$root_dir' isn't usable.\n", " System reports:\n", " $!\n"); return; } $self->{'root_dir'} = $root_dir; $self->app->log->debug('ERLENV', "Erlang root dir: '$root_dir'\n"); # Set bin dir. $self->{'bin_dir'} = File::Spec->catfile($root_dir, 'bin'); $self->app->log->debug('ERLENV', "Erlang bin dir: ".$self->{'bin_dir'}."\n"); # The "releases" and "lib" directories are onl relevant for local # operation. if ($target->is_local) { # Set releases dir. my $releases_dir = $self->app->opts('releases_dir'); unless ($releases_dir) { $command = "{erlsvc_erlenv, releases_dir, []}"; %result = $script->eval($controller, $command); unless ($result{'status'} && $result{'status'} eq 'ok') { return; } $releases_dir = $result{'return'}; } unless (-d $releases_dir) { $self->app->log->error( "Problem:\n", " The Erlang releases directory '$releases_dir' isn't ". "usable.\n", " System reports:\n", " $!\n"); return; } $self->{'releases_dir'} = $releases_dir; $self->app->log->debug('ERLENV', "Erlang releases dir: $releases_dir\n"); # Set lib dir. $command = "{erlsvc_erlenv, lib_dir, []}"; %result = $script->eval($controller, $command); unless ($result{'status'} && $result{'status'} eq 'ok') { return; } $self->{'lib_dir'} = $result{'return'}; $self->app->log->debug('ERLENV', "Erlang lib dir: ".$self->{'lib_dir'}."\n"); } # Set path for various commands. my @cmds = ('run_erl', 'start_erl', 'to_erl'); foreach my $name (@cmds) { my $cmd = File::Spec->catfile($self->{'bin_dir'}, $name); $self->{'cmd'}->{$name} = $cmd; $self->app->log->debug('ERLENV', "Erlang $name(1) binary: $cmd\n"); } # Set ERTS version and directory. $command = "{erlsvc_erlenv, erts_version, []}"; %result = $script->eval($controller, $command); unless ($result{'status'} && $result{'status'} eq 'ok') { return; } $self->{'erts_version'} = $result{'return'}; $self->app->log->debug('ERLENV', "Erlang ERTS version: ".$self->{'erts_version'}."\n"); $self->{'erts_dir'} = File::Spec->catfile($root_dir, 'erts-'.$result{'return'}); return 1; } sub change_root_dir ($) { my ($self, $root_dir) = @_; my $previous_root_dir = $self->root_dir; $self->app->log->debug('ERLENV', "Change Erlang root directory\n", " from: $previous_root_dir\n", " to: $root_dir\n"); # We first stop the controller and target nodes, because # they rely on the previous Erlang environment. $self->app->node->stop; $self->app->controller->stop; # Setup the environment again. $self->_set_erl_cmd($root_dir); $self->finish_init; } sub change_releases_dir ($) { my ($self, $releases_dir) = @_; $self->{'releases_dir'} = $releases_dir; } sub erts_version () { my ($self) = @_; return $self->{'erts_version'}; } sub erts_dir () { my ($self) = @_; return $self->{'erts_dir'}; } sub erl_cmd (;%) { my ($self, %opts) = @_; my $cmd = $opts{'cmd'} || 'erl'; return $self->{'cmd'}->{$cmd}; } sub root_dir () { my ($self) = @_; return $self->{'root_dir'}; } sub bin_dir () { my ($self) = @_; return $self->{'bin_dir'}; } sub lib_dir () { my ($self) = @_; return $self->{'lib_dir'}; } sub releases_dir () { my ($self) = @_; return $self->{'releases_dir'}; } sub default_releases_dir () { my ($self) = @_; return File::Spec->catfile($self->root_dir, 'releases'); } sub release_dir ($) { my ($self, $release) = @_; return File::Spec->catfile($self->releases_dir, $release); } sub default_release_dir ($) { my ($self, $release) = @_; return File::Spec->catfile($self->default_releases_dir, $release); } sub release_boot_script ($) { my ($self, $release) = @_; my $boot_script = File::Spec->catfile($self->release_dir($release), 'start.boot'); my $boot_script_source = $boot_script; $boot_script_source =~ s/\.boot$/.rel/o; unless (-f $boot_script && -f $boot_script_source) { $boot_script = File::Spec->catfile($self->release_dir($release), 'start_sasl.boot'); } return $boot_script; } sub release_sysconfig ($) { my ($self, $release) = @_; return File::Spec->catfile($self->release_dir($release), 'sys.config'); } sub release_relup ($) { my ($self, $release) = @_; return File::Spec->catfile($self->release_dir($release), 'relup'); } sub start_erl_data () { my ($self) = @_; return File::Spec->catfile($self->releases_dir, 'start_erl.data'); } sub parse_start_erl_data (;$) { my ($self, $start_erl_data) = @_; $start_erl_data = $self->start_erl_data unless ($start_erl_data); open(my $fh, '<', $start_erl_data) or return; my $first_line = <$fh>; close($fh); chomp($first_line); my @start_erl_data = split(/ /o, $first_line); my $debug_sub = sub { map { " $_\n"; } @start_erl_data; }; $self->app->log->debug("ERLENV", "Erlang start_erl_data contains the following fields:\n", $debug_sub); return @start_erl_data; } sub RELEASES () { my ($self) = @_; return File::Spec->catfile($self->releases_dir, 'RELEASES'); } sub app () { shift->{'app'}; } 1; erlsvc-1.02/lib/ErlSvc/Ctl/Erlang/Node.pm000066400000000000000000000240331251425362700200640ustar00rootroot00000000000000#- # Copyright 2011 Yakaz. All rights reserved. # # Redistribution and use in source and binary forms, with or without # modification, are permitted provided that the following conditions # are met: # # 1. Redistributions of source code must retain the above copyright # notice, this list of conditions and the following disclaimer. # # 2. Redistributions in binary form must reproduce the above # copyright notice, this list of conditions and the following # disclaimer in the documentation and/or other materials provided # with the distribution. # # THIS SOFTWARE IS PROVIDED BY YAKAZ ``AS IS'' AND ANY EXPRESS OR # IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED # WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE # ARE DISCLAIMED. IN NO EVENT SHALL YAKAZ OR CONTRIBUTORS BE LIABLE # FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR # CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT # OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR # BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, # WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE # OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, # EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. package ErlSvc::Ctl::Erlang::Node; use strict; use warnings; use utf8; use overload ('""' => 'stringify'); use Cwd qw(abs_path); use POSIX qw(strftime); use Sys::Hostname; use ErlSvc::Ctl::Erlang::Script; use ErlSvc::Ctl::Proc; sub local_hostname () { my $hostname = hostname; $hostname =~ /^([^.]+)/o; return $1; } sub new ($$;$) { my ($class, $app, $node, $host) = @_; $class = ref($class) || $class; if ($node =~ /^([^@]+)@(.*)/o) { # The node name given contains the host part. Parse it. $node = $1; $host = $2; } # No host was specified. Therefore, it defaults to the local # hostname. $host = local_hostname() unless $host; # We determine if the node is local by looking at the host part. my $is_local = 0; if ($host) { $is_local = 1 if ($host eq local_hostname()); } else { $host = local_hostname(); $is_local = 1; } my $self = { 'node' => $node, 'host' => $host, 'is_local' => $is_local, 'controller' => 0, 'erl_app_args' => {}, 'erl_cmd_args' => [], 'proc' => ErlSvc::Ctl::Proc->new($app), 'app' => $app }; bless $self => $class; } sub new_from_app_opts ($) { my ($class, $app) = @_; my $node = $app->opts('node'); my $host = $app->opts('host'); my $cookie = $app->opts('cookie'); my $rels_dir = $app->opts('releases_dir'); my $self = $class->new($app, $node, $host); $self->set_cookie($cookie); $self->set_releases_dir($rels_dir); return $self; } sub node_name () { my ($self) = @_; return $self->{'node'}; } sub full_node_name () { my ($self) = @_; return $self->{'node'}.'@'.$self->{'host'}; } sub cookie () { my ($self) = @_; return $self->{'cookie'}; } sub set_cookie ($) { my ($self, $cookie) = @_; if ($cookie) { $self->{'cookie'} = $cookie; } else { delete $self->{'cookie'}; } } sub releases_dir () { my ($self) = @_; return $self->{'releases_dir'}; } sub set_releases_dir ($) { my ($self, $releases_dir) = @_; if ($releases_dir) { $self->{'releases_dir'} = $releases_dir; } else { delete $self->{'releases_dir'}; } } sub is_local () { my ($self) = @_; return $self->{'is_local'}; } sub is_controller () { my ($self) = @_; return $self->{'controller'}; } sub flag_as_controller () { my ($self) = @_; $self->{'controller'} = 1; $self->{'target'} = 'self'; } sub use_release ($) { my ($self, $release) = @_; $self->{'release'} = $release; } sub add_erl_cmd_args (@) { my $self = shift; push @{$self->{'erl_cmd_args'}}, @_; } sub set_erl_app_args (%) { my ($self, %all_args) = @_; while (my ($app, $new_args) = each %all_args) { if (exists $self->{'erl_app_args'}->{$app}) { my %args = ( %{$self->{'erl_app_args'}->{$app}}, %$new_args ); $self->{'erl_app_args'}->{$app} = \%args; } else { $self->{'erl_app_args'}->{$app} = $new_args; } } } sub proc () { my ($self) = @_; return $self->{'proc'}; } sub autostarted () { my ($self) = @_; return ($self->proc->pid) ? 1 : 0; } sub start () { my ($self) = @_; # If the node is already started, return immediately. return 1 if ($self->proc->pid); my $path = $self->app->opts('mods_dir'); $self->app->log->debug("ERLNODE", "Prepare launch of Erlang node '$self'". ($self->is_controller ? ' (controller node)' : '')."\n"); my $erl_env = $self->app->erl_env; my $erl_cmd = $erl_env->erl_cmd; my @cmdline = ( $erl_cmd, '+Bd', '-noshell', '-hidden', '-connect_all', 'false', '-sname', $self->node_name ); if ($self->cookie) { push @cmdline, ('-setcookie', $self->cookie); } # Check if we must use a release's sys.config file. my $release = $self->{'release'}; if ($release) { $self->app->log->debug("ERLNODE", "Use sys.config from release '$release'\n"); my $sysconfig = $erl_env->release_sysconfig($release); push @cmdline, ('-config', $sysconfig); } # Set the modules path if specified. if (-d $path) { $path = abs_path($path); $self->app->log->debug("ERLNODE", "Use '$path' as modules directory (ie. -pa)\n"); push @cmdline, ('-pa', $path); } # Setup SASL. $self->set_erl_app_args('sasl' => { 'sasl_error_logger' => 'false' }); if ($self->releases_dir) { if (!$self->{'erl_app_args'}->{'sasl'}->{'releases_dir'}) { $self->set_erl_app_args('sasl' => { 'releases_dir' => '"'.$self->releases_dir.'"' }); } } # Push Erlang application arguments. while (my ($app, $args) = each %{$self->{'erl_app_args'}}) { while (my ($arg, $value) = each %$args) { push @cmdline, ("-$app", $arg, $value); } } # Push additionnal arguments specified by caller. push @cmdline, @{$self->{'erl_cmd_args'}}; # Format script options. push @cmdline, ('-eval', "erlsvc:run(), halt()."); # Set the erlsvc version in the environment. $self->proc->add_env('ERLSVC' => $ErlSvc::Ctl::VERSION); # Log final command line. my $debug_sub = sub { my @output = ("Final Erlang node command line:\n"); my $line = ''; foreach my $arg (@cmdline) { if (length($line) + length($arg) > 65) { push @output, " $line \\\n"; $line = $arg; } elsif (!$line) { $line = $arg; } else { $line .= " $arg"; } } push @output, " $line\n"; return @output; }; $self->app->log->debug("ERLNODE", $debug_sub); # Fork the process. $self->proc->start(@cmdline) or return; $self->_read_pre_command_output(); return 1; } sub _read_pre_command_output () { my ($self) = @_; my $proc = $self->proc; my $child_fh = $proc->fh; my $stop = 0; while (<$child_fh>) { chomp; my $line = $_; # Interpret Erlang output. if ($line =~ /^CTL READY$/o) { $self->app->log->debug("ERLNODE", "Erlang node '$self' ready!\n"); $stop = 1; } else { $proc->interpret_generic_output($line); } last if ($stop); } } sub stop () { my ($self) = @_; # If the node is not started, return immediately. return unless ($self->autostarted); my $command = 'stop'; $self->app->log->debug("ERLNODE", "Stop Erlang node '$self'". ($self->is_controller ? ' (controller node)' : '')."\n"); my $script = ErlSvc::Ctl::Erlang::Script->new($self->app); $script->eval($self, $command, 'ignore_eof' => 1); $self->proc->wait_for_child; } sub is_alive () { my ($self) = @_; # To know if a node is alive, we make a ping from the controller # node. my $controller = $self->app->controller; $self->app->log->debug("ERLNODE", "Ping Erlang node '$self' from '$controller'\n"); my $command = "{net_adm, ping, ['$self']}"; my $script = ErlSvc::Ctl::Erlang::Script->new($self->app); my %result = $script->eval($controller, $command); if ($result{'status'} && $result{'status'} eq 'ok' && $result{'return'} eq 'pong') { $self->app->log->debug("ERLNODE", "Erlang node '$self' is ALIVE\n"); return 1; } else { $self->app->log->debug("ERLNODE", "Erlang node '$self' is DOWN\n"); return 0; } } sub set_target ($) { my ($self, $target) = @_; # This is only available on a controller node. return unless ($self->is_controller); my $target_name = ref($target) ? $target->full_node_name : $target; return 1 if ($target_name eq $self->{'target'}); # Start the node. $self->start or return; $self->app->log->debug("ERLNODE", "Set Erlang target node to '$target'\n"); my $command = "{target_node, '$target'}"; my $script = ErlSvc::Ctl::Erlang::Script->new($self->app); my %result = $script->eval($self, $command); if ($result{'status'} && $result{'status'} eq 'ok') { $self->{'target'} = $target_name; return 1; } else { $self->app->log->error( "Problem:\n", " Failed to set target node to '$target'\n"); $self->stop; return; } } sub unset_target () { my ($self) = @_; $self->set_target('self'); } sub app () { shift->{'app'}; } sub stringify () { shift->full_node_name; } 1; erlsvc-1.02/lib/ErlSvc/Ctl/Erlang/Script.pm000066400000000000000000000131231251425362700204410ustar00rootroot00000000000000#- # Copyright 2011 Yakaz. All rights reserved. # # Redistribution and use in source and binary forms, with or without # modification, are permitted provided that the following conditions # are met: # # 1. Redistributions of source code must retain the above copyright # notice, this list of conditions and the following disclaimer. # # 2. Redistributions in binary form must reproduce the above # copyright notice, this list of conditions and the following # disclaimer in the documentation and/or other materials provided # with the distribution. # # THIS SOFTWARE IS PROVIDED BY YAKAZ ``AS IS'' AND ANY EXPRESS OR # IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED # WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE # ARE DISCLAIMED. IN NO EVENT SHALL YAKAZ OR CONTRIBUTORS BE LIABLE # FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR # CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT # OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR # BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, # WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE # OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, # EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. package ErlSvc::Ctl::Erlang::Script; use strict; use warnings; use utf8; use YAML::Tiny; use Data::Dumper; $Data::Dumper::Indent = 1; sub new ($) { my ($class, $app) = @_; my $self = { 'app' => $app }; bless $self => $class; } sub eval ($$;%) { my ($self, $node, $command, %options) = @_; # Start the node. unless ($node->start) { $self->app->log->error( "Problem:\n", " Failed to start node for command execution\n"); return; } $self->app->log->debug("ERLSCRIPT", "Execute command '$command' on node '$node'\n"); # Get the filehandle to communicate with the node. my $proc = $node->proc; # First step: send the command. $self->_send_command($proc, $command, %options); # Second step: read script output. my $result = $self->_read_child_output($proc, %options); # Cleanup known result keys. if ($result->{'return'}) { chomp $result->{'return'}; } if ($result->{'reason'}) { chomp $result->{'reason'}; } if ($result->{'stacktrace'}) { for (my $i = 0; $i < scalar @{$result->{'stacktrace'}}; ++$i) { chomp $result->{'stacktrace'}->[$i]; } } if (keys %$result) { $self->app->log->debug("ERLSCRIPT", ( "Result:\n", map { " $_\n" } split("\n", Dumper($result)) )); } else { $self->app->log->debug("ERLSCRIPT", "Result: none\n"); } if ($result->{'status'} && $result->{'status'} eq 'exception') { # The command raised an exception. my @stacktrace = (); if ($result->{'stacktrace'}) { @stacktrace = ( "\n", " The stacktrace is:\n", map { " $_\n"; } @{$result->{'stacktrace'}} ); } my @reason = map { " $_\n" } split("\n", $result->{'reason'}); $self->app->log->error( "Problem:\n", " The following command raised an exception:\n", " $command\n", "\n", " The reason is:\n", @reason, @stacktrace ); return; } return %$result; } sub _send_command ($$;%) { my ($self, $proc, $command) = @_; my $child_fh = $proc->fh; print $child_fh $command.".\n"; } sub _read_child_output ($;%) { my ($self, $proc, %options) = @_; my $child_fh = $proc->fh; my @result_lines = (); my $stop = 0; while (<$child_fh>) { chomp; my $line = $_; # Interpret Erlang output. if ($line =~ /^CTL RESULT BEGIN$/o) { # Ok, the result! # The result start with the line "CTL RESULT BEGIN" and ends # with the line "CTL RESULT END". The format used is YAML. while (<$child_fh>) { chomp; $line = $_; if ($line =~ /^CTL RESULT END$/o) { # We reached the end of the result text. $stop = 1; last; } else { push @result_lines, $line; } } } else { $proc->interpret_generic_output($line); } last if ($stop); } if ($stop == 0) { unless ($options{'ignore_eof'}) { $self->app->log->debug("ERLSCRIPT", "Child file handle closed: the process exited prematurely!\n"); $proc->wait_for_child(); } return; } my $yaml; { # With a few parsing errors, YAML::Tiny dies instead of returning # "undef". Here, we want to catch this signal. local $@; $yaml = eval { local $SIG{'__DIE__'}; YAML::Tiny->read_string(join("\n", @result_lines)."\n") }; unless ($yaml) { my $yaml_errstr = $@ || YAML::Tiny->errstr; $self->app->log->error( "Problem:\n", " Failed to parse result from script:\n", " The YAML parser reports:\n", " $yaml_errstr\n", "\n", " The command output was:\n", map { " $_\n"; } @result_lines); return; } } return $yaml->[0]; } sub app () { shift->{'app'}; } 1; erlsvc-1.02/lib/ErlSvc/Ctl/Exceptions.pm000066400000000000000000000036731251425362700201170ustar00rootroot00000000000000#- # Copyright 2011 Yakaz. All rights reserved. # # Redistribution and use in source and binary forms, with or without # modification, are permitted provided that the following conditions # are met: # # 1. Redistributions of source code must retain the above copyright # notice, this list of conditions and the following disclaimer. # # 2. Redistributions in binary form must reproduce the above # copyright notice, this list of conditions and the following # disclaimer in the documentation and/or other materials provided # with the distribution. # # THIS SOFTWARE IS PROVIDED BY YAKAZ ``AS IS'' AND ANY EXPRESS OR # IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED # WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE # ARE DISCLAIMED. IN NO EVENT SHALL YAKAZ OR CONTRIBUTORS BE LIABLE # FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR # CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT # OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR # BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, # WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE # OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, # EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. package ErlSvc::Ctl::Exceptions; use strict; use warnings; use utf8; use CLI::Framework::Exceptions; use Exporter qw(import); our @EXPORT_OK = qw(command_run_failure); our %EXPORT_TAGS = (all => \@EXPORT_OK); use Exception::Class ( 'ErlSvc::Ctl::Exception::CmdRunException' => { 'description' => 'Command run exception', 'alias' => 'command_run_failure', 'isa' => 'CLI::Framework::Exception::CmdRunException', # Can't use the standard 'error' field with Debian Lenny's # Exception::Class because it uses $! if no error message is # provided. 'fields' => ['reason'] } ); 1; erlsvc-1.02/lib/ErlSvc/Ctl/Log.pm000066400000000000000000000233401251425362700165100ustar00rootroot00000000000000#- # Copyright 2011 Yakaz. All rights reserved. # # Redistribution and use in source and binary forms, with or without # modification, are permitted provided that the following conditions # are met: # # 1. Redistributions of source code must retain the above copyright # notice, this list of conditions and the following disclaimer. # # 2. Redistributions in binary form must reproduce the above # copyright notice, this list of conditions and the following # disclaimer in the documentation and/or other materials provided # with the distribution. # # THIS SOFTWARE IS PROVIDED BY YAKAZ ``AS IS'' AND ANY EXPRESS OR # IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED # WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE # ARE DISCLAIMED. IN NO EVENT SHALL YAKAZ OR CONTRIBUTORS BE LIABLE # FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR # CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT # OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR # BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, # WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE # OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, # EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. package ErlSvc::Ctl::Log; use strict; use warnings; use utf8; use POSIX qw(strftime); use Sys::Syslog qw(:standard :macros); use Time::HiRes qw (setitimer ITIMER_REAL); use ErlSvc::Ctl::Usage qw(progname); our $SPIN_INTV = 0.03; our @SPIN = ( ' /', ' -', ' \\', ' |' ); sub new ($) { my ($class, $app) = @_; $class = ref($class) || $class; # Use tput(1) to obtain the number of columns for this terminal. If # $TERM is not defined (tput(1) will fail), assume a default of 80 # columns. This is the case when running erlsvc through ssh(1), # like this: # ssh user@host erlsvc status. my $columns = $ENV{'TERM'} ? `tput cols` + 0 : 80; my $self = { 'updating' => 0, 'waiting' => 0, 'unfinished_lines' => [], 'unfinished_ctx' => {}, 'spinning' => 0, 'spin_frame' => 0, 'columns' => $columns, 'app' => $app }; bless $self => $class; # Hide cursor. $self->show_cursor(0); # Setup syslog. my $ident = progname(); my $logopts = 'pid'; my $facility = $self->app->opts('syslog_facility') || 'LOG_USER'; openlog($ident, $logopts, $facility); return $self; } sub DESTROY { my ($self) = @_; # Stop spinning. $self->waiting(0); # Terminate unfinished lines. if (scalar @{$self->{'unfinished_lines'}}) { print STDERR "\n"; } # Close syslog. closelog(); # Unhide cursor. $self->show_cursor(1); } sub error { my $self = shift; my $color_start = "\e[31m"; my $color_end = "\e[0m"; my $prefix = ($self->app->verbose) ? $self->timestamp : ''; my @expanded = $self->_expand_lines(@_); $self->_syslog('ERROR', @expanded); $self->_log('ERROR', $prefix, $color_start, $color_end, @expanded); } sub warning { my $self = shift; my $color_start = "\e[33m"; my $color_end = "\e[0m"; my $prefix = ($self->app->verbose) ? $self->timestamp : ''; my @expanded = $self->_expand_lines(@_); $self->_syslog('WARNING', @expanded); $self->_log('WARNING', $prefix, $color_start, $color_end, @expanded); } sub info { my $self = shift; my $prefix = ($self->app->verbose) ? $self->timestamp : ''; my @expanded = $self->_expand_lines(@_); $self->_syslog('INFO', @expanded); $self->_log('INFO', $prefix, '', '', @expanded); } sub debug { my $self = shift; my $component = shift; my @expanded = $self->_expand_lines(@_); $self->_syslog($component, @expanded); return unless ($self->app->verbose($component)); $self->_log($component, $self->timestamp, '', '', @expanded); } sub timestamp () { strftime("[%Y-%m-%d %H:%M:%S] ", localtime); } sub _expand_lines (@) { my ($self, @lines) = @_; my @expanded = (); foreach my $line (@lines) { if (ref($line) eq 'CODE') { my @sublines = $self->_expand_lines($line->()); push @expanded, @sublines; } else { push @expanded, $line; } } return @expanded; } sub _log ($$$$@) { my ($self, $context, $prefix, $color_start, $color_end, @lines) = @_; return unless (scalar @lines > 0); $self->{'updating'} = 1; foreach my $line (@lines) { $self->_log_line($context, $prefix, $color_start, $color_end, $line); } $self->{'spinning'} = 0; $self->{'updating'} = 0; } sub _log_line ($$$$$) { my ($self, $context, $prefix, $color_start, $color_end, $line) = @_; my $unfinished_count = scalar @{$self->{'unfinished_lines'}}; my $columns = $self->{'columns'}; my $unfinished_rows_count = 0; if ($columns > 0) { foreach my $ul (@{$self->{'unfinished_lines'}}) { $unfinished_rows_count += int((length($prefix) + length($ul)) / $columns) + 1; } } else { $unfinished_rows_count = $unfinished_count; } if ($unfinished_rows_count > 1) { # Go $unfinished_rows_count lines backward. my $backward = $unfinished_rows_count - 1; print STDERR "\e[${backward}A\r"; } elsif ($unfinished_rows_count > 0) { # Only go to the beginning of the line. print STDERR "\r"; } my $newline = (chomp $line) ? "\n" : ''; if ($color_start) { $line =~ s,,\e[1m,o; $line =~ s,,\e[0m,o; } else { $line =~ s,,\e[32m,o; $line =~ s,,\e[0m,o; } my $rewind = ''; if ($line =~ //o) { $line =~ s,,,go; $rewind = "\r"; } if ($newline) { # Remove the previous unfinished context, if any. my $state = $self->{'unfinished_ctx'}->{$context}; if ($state) { my $i = $state->{'line'}; my $whole_line = splice @{$self->{'unfinished_lines'}}, $i, 1; delete $self->{'unfinished_ctx'}->{$context}; $line = $state->{'rewind'} ? $line : $whole_line.$line; } print STDERR "$rewind$prefix$color_start$line$color_end\e[K\n"; } else { my $state = $self->{'unfinished_ctx'}->{$context}; if ($state) { my $i = $state->{'line'}; if ($rewind) { $self->{'unfinished_lines'}->[$i] = $line; } else { $self->{'unfinished_lines'}->[$i] .= $line; } } else { push @{$self->{'unfinished_lines'}}, $line; $self->{'unfinished_ctx'}->{$context} = { 'line' => $unfinished_count, 'color_start' => $color_start, 'color_end' => $color_end, 'rewind' => $rewind }; $unfinished_count++; } } if ($unfinished_count > 0) { my @lines = (); foreach my $state (values %{$self->{'unfinished_ctx'}}) { my $i = $state->{'line'}; my $color_start = $state->{'color_start'}; my $color_end = $state->{'color_end'}; my $rewind = $state->{'rewind'}; my $line = $self->{'unfinished_lines'}->[$i]; $lines[$state->{'line'}] = "$rewind$prefix$color_start$line$color_end"; } my $lines = join("\e[K\n", @lines)."\e[K"; print STDERR $lines; } } sub _syslog ($@) { my ($self, $context, @lines) = @_; return unless (scalar @lines > 0); foreach my $line (@lines) { $self->_syslog_line($context, $line); } } sub _syslog_line ($$) { my ($self, $context, $line) = @_; my $priority; if ($context eq 'ERROR') { $priority = LOG_ERR; } elsif ($context eq 'WARNING') { $priority = LOG_WARNING; } elsif ($context eq 'INFO') { $priority = LOG_NOTICE } else { $priority = LOG_DEBUG } # Remove formatting tags. $line =~ s/<\/?[br]>//go; syslog($priority, $line); } sub show_cursor ($) { my ($self, $show) = @_; if ($show) { print STDERR "\e[?25h"; } else { print STDERR "\e[?25l"; } } sub waiting ($) { my ($self, $waiting) = @_; if ($waiting) { # Check that we're not already waiting. return if ($self->{'waiting'}); $self->{'waiting'} = 1; # Start spinning. $SIG{'ALRM'} = sub { if ($self->{'waiting'} && !$self->{'updating'}) { if ($self->{'spinning'}) { my $prev_spin = $SPIN[$self->{'spin_frame'}]; print STDERR ("\b" x length($prev_spin)).$self->_next_spin; } else { print STDERR $self->_next_spin; } $self->{'spinning'} = 1; } }; setitimer(ITIMER_REAL, $SPIN_INTV, $SPIN_INTV); print STDERR $self->_next_spin; $self->{'spinning'} = 1; } else { return unless ($self->{'waiting'}); $self->{'waiting'} = 0; # Stop spinning. setitimer(ITIMER_REAL, 0); if ($self->{'spinning'}) { # Remove the last frame of the animation. my $prev_spin = $SPIN[$self->{'spin_frame'}]; print STDERR ("\b" x length($prev_spin))."\e[K"; $self->{'spinning'} = 0; } } } sub is_waiting () { my ($self) = @_; return $self->{'waiting'}; } sub _next_spin () { my ($self) = @_; my $n = $self->{'spin_frame'}; $self->{'spin_frame'} = ($n + 1) % scalar(@SPIN); return $SPIN[$n]; } sub app () { shift->{'app'}; } 1; erlsvc-1.02/lib/ErlSvc/Ctl/Mnesia.pm000066400000000000000000000346351251425362700172140ustar00rootroot00000000000000#- # Copyright 2011 Yakaz. All rights reserved. # # Redistribution and use in source and binary forms, with or without # modification, are permitted provided that the following conditions # are met: # # 1. Redistributions of source code must retain the above copyright # notice, this list of conditions and the following disclaimer. # # 2. Redistributions in binary form must reproduce the above # copyright notice, this list of conditions and the following # disclaimer in the documentation and/or other materials provided # with the distribution. # # THIS SOFTWARE IS PROVIDED BY YAKAZ ``AS IS'' AND ANY EXPRESS OR # IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED # WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE # ARE DISCLAIMED. IN NO EVENT SHALL YAKAZ OR CONTRIBUTORS BE LIABLE # FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR # CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT # OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR # BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, # WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE # OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, # EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. package ErlSvc::Ctl::Mnesia; use strict; use warnings; use utf8; use File::Path qw(rmtree); use ErlSvc::Ctl::Release; sub new ($) { my ($class, $app) = @_; $class = ref($class) || $class; my $self = { 'app' => $app }; bless $self => $class; } sub directory (;%) { my ($self, %opts) = @_; # Get the target node and check he's running. my $target = $self->app->node; my $node; if (!$target->is_alive || $target->autostarted) { # The target node is down. We check if he's local to this # host to determine if we can start it. if (!$target->is_local) { $self->app->log->error( "Problem:\n", " The node '$target' is not started and running this\n", " action on a remote host isn't supported.\n" ); return; } $target->stop; $self->_set_dir_or_release($target, %opts); $node = $target; } else { # The command will run on the target node but we use the controller # node as a gateway. my $controller = $self->app->controller; $controller->set_target($target) or return; $node = $controller; } my $script = ErlSvc::Ctl::Erlang::Script->new($self->app); my $command = "{erlsvc_mnesia, directory, []}"; $self->app->log->debug("MNESIA", "Query Mnesia directory on node '$node'\n"); my %result = $script->eval($node, $command); if ($target->autostarted) { # The target was started by this function. We stop it because # the node has special arguments for Mnesia and we don't want # any potential side effects. $target->stop; } unless ($result{'status'} && $result{'status'} eq 'ok') { return; } $self->app->log->debug("MNESIA", "Mnesia directory: ".$result{'return'}."\n"); return $result{'return'}; } sub is_directory_used (;%) { my ($self, %opts) = @_; # Get the target node and check he's running. my $target = $self->app->node; my $node; if (!$target->is_alive || $target->autostarted) { # The target node is down. We check if he's local to this # host to determine if we can start it. if (!$target->is_local) { $self->app->log->error( "Problem:\n", " The node '$target' is not started and running this\n", " action on a remote host isn't supported.\n" ); return; } $target->stop; $self->_set_dir_or_release($target, %opts); $node = $target; } else { # The command will run on the target node but we use the controller # node as a gateway. my $controller = $self->app->controller; $controller->set_target($target) or return; $node = $controller; } my $script = ErlSvc::Ctl::Erlang::Script->new($self->app); my $command = "{erlsvc_mnesia, is_directory_used, []}"; $self->app->log->debug("MNESIA", 'Check if Mnesia directory is used'); my %result = $script->eval($node, $command); if ($target->autostarted) { # The target was started by this function. We stop it because # the node has special arguments for Mnesia and we don't want # any potential side effects. $target->stop; } unless ($result{'status'} && $result{'status'} eq 'ok') { return; } if ($result{'return'} eq 'true') { $self->app->log->debug("MNESIA", 'Mnesia directory is in use'); return 1; } else { $self->app->log->debug("MNESIA", 'Mnesia directory is unused'); return 0; } } sub cluster_nodes (;%) { my ($self, %opts) = @_; # Get the target node and check he's running. my $target = $self->app->node; my $node; if (!$target->is_alive || $target->autostarted) { # The target node is down. We check if he's local to this # host to determine if we can start it. if (!$target->is_local) { $self->app->log->error( "Problem:\n", " The node '$target' is not started and running this\n", " action on a remote host isn't supported.\n" ); return; } $target->stop; $self->_set_dir_or_release($target, %opts); $node = $target; } else { # The command will run on the target node but we use the controller # node as a gateway. my $controller = $self->app->controller; $controller->set_target($target) or return; $node = $controller; } my $script = ErlSvc::Ctl::Erlang::Script->new($self->app); my $command = "{erlsvc_mnesia, db_nodes, []}"; $self->app->log->debug("MNESIA", "Query Mnesia DB nodes on node '$node'\n"); my %result = $script->eval($node, $command); if ($target->autostarted) { # The target was started by this function. We stop it because # the node has special arguments for Mnesia and we don't want # any potential side effects. $target->stop; } unless ($result{'status'} && $result{'status'} eq 'ok') { return; } my %nodes = %{$result{'return'}}; foreach my $node (keys %nodes) { $nodes{$node} = ($nodes{$node} eq 'up') ? 1 : 0; } my $debug_sub = sub { my @output = ("Cluster nodes:\n"); foreach my $node (keys %nodes) { push @output, " - $node". ' ('.($nodes{$node} ? 'UP' : 'DOWN').")\n"; } return @output; }; $self->app->log->debug("MNESIA", $debug_sub); return %nodes; } sub create_schema (;%) { my ($self, %opts) = @_; # Get the target node and check he's running. my $target = $self->app->node; if (!$target->is_local) { $self->app->log->error( "Problem:\n", " The node '$target' is remote.\n" ); return; } elsif ($target->is_alive && !$target->autostarted) { $self->app->log->error( "Problem:\n", " The node '$target' is already started.\n", "\n", "Solution(s):\n", " 1. Stop the node and call this command again.\n" ); return; } $target->stop; $target->proc->run_as_user($self->app->user, $self->app->group); if ($opts{'directory'}) { $self->app->log->debug("MNESIA", 'Create Mnesia schema (directory: \''. $opts{'directory'}."')\n"); $target->set_erl_app_args('mnesia' => { 'dir' => '"'.$opts{'directory'}.'"' }); } elsif ($opts{'release'}) { $self->app->log->debug("MNESIA", 'Create Mnesia schema (directory: '. 'taken from release \''.$opts{'release'}."' sys.config)\n"); $target->use_release($opts{'release'}); } my $script = ErlSvc::Ctl::Erlang::Script->new($self->app); my %result; if ($opts{'cluster'}) { unless (ref($opts{'cluster'}) eq 'ARRAY') { $self->app->log->error( "Problem:\n", " The cluster argument must be an array even if it\n", " contains only one node.\n"); return; } my @nodes = map { "'$_'" } @{$opts{'cluster'}}; my $extra_db_nodes = join(', ', @nodes); $self->app->log->debug("MNESIA", "Join cluster using remote nodes $extra_db_nodes\n"); my $command = "{erlsvc_mnesia, join_cluster, [[$extra_db_nodes]]}"; %result = $script->eval($target, $command); } else { my $command = "{erlsvc_mnesia, create_schema, []}"; %result = $script->eval($target, $command); } # The target was started by this function. We stop it because # the node has special arguments for Mnesia and we don't want # any potential side effects. $target->stop; $target->proc->run_as_user(undef, undef); unless ($result{'status'} && $result{'status'} eq 'ok') { return; } return 1; } sub remove_schema (;%) { my ($self, %opts) = @_; # Get the target node and check he's running. my $target = $self->app->node; if (!$target->is_local) { $self->app->log->error( "Problem:\n", " The node '$target' is remote.\n" ); return; } elsif ($target->is_alive && !$target->autostarted) { $self->app->log->error( "Problem:\n", " The node '$target' is already started.\n", "\n", "Solution(s):\n", " 1. Stop the node and call this command again.\n" ); return; } $target->stop; if ($opts{'directory'}) { $self->app->log->debug("MNESIA", 'Leave Mnesia cluster (directory: \''. $opts{'directory'}."')\n"); $target->set_erl_app_args('mnesia' => { 'dir' => '"'.$opts{'directory'}.'"' }); } elsif ($opts{'release'}) { $self->app->log->debug("MNESIA", 'Leave Mnesia cluster (directory: '. 'taken from release \''.$opts{'release'}."' sys.config)\n"); $target->use_release($opts{'release'}); } my $script = ErlSvc::Ctl::Erlang::Script->new($self->app); my $command = "{erlsvc_mnesia, leave_cluster, []}"; my %result = $script->eval($target, $command); # The target was started by this function. We stop it because # the node has special arguments for Mnesia and we don't want # any potential side effects. $target->stop; unless ($result{'status'} && $result{'status'} eq 'ok') { return; } my $dir = $opts{'directory'} ? $opts{'directory'} : $self->directory(%opts); $self->app->log->debug("MNESIA", "Remove files in directory '$dir'\n"); my $errors; rmtree($dir, { 'keep_root' => 1, 'error' => \$errors }); if (@$errors) { my $error_sub = sub { my @output = (); foreach my $error (@$errors) { my ($file, $msg) = %$error; if ($file eq '') { push @output, " General error: $msg\n"; } else { push @output, " $file: $msg\n"; } } return @output; }; $self->app->log->error( "Problem:\n", " Failed to remove Mnesia files in directory '$dir'\n", " System reports:\n", $error_sub ); return; } return 1; } sub check_consistency (;%) { my ($self, %opts) = @_; # Get the target node and check he's running. my $target = $self->app->node; if (!$target->is_alive || $target->autostarted) { # The target node is down: this is bad. $self->app->log->error( "Problem:\n", " The node '$target' is not started.\n", "\n", "Solution(s):\n", " 1. Start this node.\n", " 2. Point to another node of the cluster.\n"); return; } # The command will run on the controller. my $controller = $self->app->controller; $controller->unset_target; my $script = ErlSvc::Ctl::Erlang::Script->new($self->app); my $verbose = $self->app->verbose('MNESIA') ? 'true' : 'false'; my $command = "{erlsvc_mnesia, check_consistency, ". "['$target', [{verbose, $verbose}]]}"; my %result = $script->eval($controller, $command); unless ($result{'status'} && $result{'status'} eq 'ok') { return; } return 1; } sub _init_script () { my ($self) = @_; my $script = ErlSvc::Ctl::Erlang::Script->new($self->app, 'erlsvc_mnesia'); $script->run_as_user($self->app->user, $self->app->group); my $node = $self->app->node; $script->set_node_identity($node); return $script; } sub _set_dir_or_release ($%) { my ($self, $node, %opts) = @_; if ($opts{'directory'}) { if (!$node->is_local) { $self->app->log->warning( 'The specified directory is not taken into account when the '. 'target node is remote.'); } elsif ($node->is_alive) { $self->app->log->warning( 'The specified directory is not taken into account when the '. 'target node is alive.'); } else { $node->set_erl_app_args('mnesia' => { 'dir' => '"'.$opts{'directory'}.'"' }); } } elsif ($opts{'release'}) { if (!$node->is_local) { $self->app->log->warning( 'The specified release is not taken into account when the '. 'target node is remote.'); } elsif ($node->is_alive) { $self->app->log->warning( 'The specified release is not taken into account when the '. 'target node is alive.'); } else { $node->use_release($opts{'release'}); } } elsif ($node->is_local && !$node->is_alive) { my $release = ErlSvc::Ctl::Release->new($self->app); my $current = $release->current; unless ($release->is_vanilla($current)) { $node->use_release($current); } } } sub app () { shift->{'app'}; } 1; erlsvc-1.02/lib/ErlSvc/Ctl/Proc.pm000066400000000000000000000321171251425362700166740ustar00rootroot00000000000000#- # Copyright 2011 Yakaz. All rights reserved. # # Redistribution and use in source and binary forms, with or without # modification, are permitted provided that the following conditions # are met: # # 1. Redistributions of source code must retain the above copyright # notice, this list of conditions and the following disclaimer. # # 2. Redistributions in binary form must reproduce the above # copyright notice, this list of conditions and the following # disclaimer in the documentation and/or other materials provided # with the distribution. # # THIS SOFTWARE IS PROVIDED BY YAKAZ ``AS IS'' AND ANY EXPRESS OR # IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED # WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE # ARE DISCLAIMED. IN NO EVENT SHALL YAKAZ OR CONTRIBUTORS BE LIABLE # FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR # CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT # OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR # BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, # WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE # OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, # EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. package ErlSvc::Ctl::Proc; use strict; use warnings; use utf8; use BSD::Resource; use Config; use IO::Handle; use POSIX qw(setuid setgid :sys_wait_h); use Socket; use User::grent; use User::pwent; our %SYSEXITS = ( 'EX_OK' => 0, 'EX_USAGE' => 64, 'EX_DATAERR' => 65, 'EX_NOINPUT' => 66, 'EX_NOUSER' => 67, 'EX_NOHOST' => 68, 'EX_UNAVAILABLE' => 69, 'EX_SOFTWARE' => 70, 'EX_OSERR' => 71, 'EX_OSFILE' => 72, 'EX_CANTCREAT' => 73, 'EX_IOERR' => 74, 'EX_TEMPFAIL' => 75, 'EX_PROTOCOL' => 76, 'EX_NOPERM' => 77, 'EX_CONFIG' => 78 ); our %SYSEXITS_REVERSED = map { $SYSEXITS{$_} => $_; } keys %SYSEXITS; sub new ($) { my ($class, $app) = @_; my $self = { 'reopen_stdio' => 1, 'env' => {}, 'app' => $app }; bless $self => $class; } sub run_as_user ($;$) { my ($self, $user, $group) = @_; if ($user) { $self->{'user'} = $user; } else { delete $self->{'user'}; } if ($group) { $self->{'group'} = $group; } else { delete $self->{'group'}; } } sub set_open_files_limit ($) { my ($self, $limit) = @_; $self->{'open_files_limit'} = $limit; } sub reopen_stdio ($) { my ($self, $reopen) = @_; $self->{'reopen_stdio'} = $reopen; } sub set_env (%) { my ($self, %export_env) = @_; $self->{'env'} = \%export_env; } sub add_env (%) { my ($self, %export_env) = @_; while (my ($key, $value) = each %export_env) { $self->{'env'}->{$key} = $value; } } sub working_dir () { my ($self) = @_; my $wd = $self->{'working_dir'}; unless ($wd) { if (defined $self->{'user'}) { $wd = $self->app->home($self->{'user'}); } else { return; } } return $wd; } sub set_working_dir ($) { my ($self, $wd) = @_; unless (-d $wd) { $self->app->log->error( "Problem:\n", " Working directory '$wd' isn't a directory. It'll be ignored.", " System reports:", " $!"); return; } $self->{'working_dir'} = $wd; } sub pid () { my ($self) = @_; return $self->{'pid'}; } sub fh () { my ($self) = @_; return $self->{'fh'}; } sub start (@) { my ($self, @cmdline) = @_; # We use fork() to spawn a process to execute the script. We use # this method instead of the simple backticks to get a chance to # execute some code, like changing (dropping) process privileges, # before executing the real command. # We communicate with the child process using a Unix socket. We # ignore SIGPIPE here and let any read handle the error. my ($child_fh, $parent_fh); $SIG{'PIPE'} = 'IGNORE'; socketpair($child_fh, $parent_fh, AF_UNIX, SOCK_STREAM, PF_UNSPEC) or return; $child_fh->autoflush(1); $parent_fh->autoflush(1); # Setup a handler for SIGINT. $SIG{'INT'} = \&_sighandler_SIGINT; # We're ready to fork! $self->app->log->debug("PROC", "Fork the child process\n"); my $pid = fork(); if ($pid == 0) { # In the CHILD process. close $child_fh; unless ($self->{'reopen_stdio'}) { # Backup original STDIN and STDOUT. my ($oldin, $oldout); open($oldin, '<&STDIN') or return; open($oldout, '>&STDOUT') or return; $self->{'oldin'} = $oldin; $self->{'oldout'} = $oldout; } # Reopen STDIN and STDOUT to use the Unix socket. open(STDIN, '<&', $parent_fh) or return; open(STDOUT, '>&', $parent_fh) or return; # Continue with child specific code. $self->_child_run(@cmdline); } elsif (defined $pid) { # In the PARENT process. close $parent_fh; $self->app->log->debug("PROC", "Child process PID: $pid\n"); while (<$child_fh>) { chomp; my $line = $_; if ($line eq 'CTL EXEC') { $self->app->log->debug("PROC", "Child: exec $cmdline[0]\n"); last; } else { $self->interpret_generic_output($line); } } # Keep child's PID and file handle (to communicate). $self->{'pid'} = $pid; $self->{'fh'} = $child_fh; return 1; } } sub _child_run (@) { my ($self, @cmdline) = @_; # Because this function runs in the child process, the return value # isn't relevant. Instead we communicate with the parent process # through STDOUT. The private functions _report_* take care of this. # We want core dump! $self->_report_debug("setrlimit: Enable core dumps"); my $ret = setrlimit(RLIMIT_CORE, RLIM_INFINITY, RLIM_INFINITY); unless ($ret) { $self->_report_warning( "Problem:", " Failed to enable core dump:", " System reports:", " $!"); } # Raise open files limit. my $nofile = $self->{'open_files_limit'}; if ($nofile) { $self->_report_debug( "setrlimit: Raise file descriptors limit to $nofile"); $ret = setrlimit(RLIMIT_NOFILE, $nofile, $nofile); unless ($ret) { (my $nowsoft, my $nowhard) = getrlimit(RLIMIT_NOFILE); $ret = setrlimit(RLIMIT_NOFILE, $nowhard, $nowhard); if ($ret) { $self->_report_warning( "Problem:", " Failed to raise the file descriptors limit to $nofile.", " Raised to $nowhard (hard limit) instead."); } else { $self->_report_warning( "Problem:", " Failed to raise the file descriptors limit to $nofile:", " System reports:", " $!"); } } } # We change user and group ID. my $user = $self->{'user'}; my $group = $self->{'group'}; # We change the group first, because we may not have the # permission to do it once the user has changed. if ($group && $self->app->group_changed($group)) { my $gid = $self->app->gid($group); unless (defined $gid) { $self->_report_exception( "Failed to get GID for group $group:", $!); exit($SYSEXITS{'EX_NOUSER'}); } $self->_report_debug("Change process GID to '$group' ($gid)"); my $ret = setgid($gid); unless ($ret) { $self->_report_exception( "Failed to set process GID to $group ($gid):", $!); exit($SYSEXITS{'EX_NOPERM'}); } } if ($user && $self->app->user_changed($user)) { my $uid = $self->app->uid($user); unless (defined $uid) { $self->_report_exception( "Failed to get UID for user $user:", $!); exit($SYSEXITS{'EX_NOUSER'}); } $self->_report_debug("Change process UID to '$user' ($uid)"); my $ret = setuid($uid); unless ($ret) { $self->_report_exception( "Failed to set process UID to $user ($uid):", $!); exit($SYSEXITS{'EX_NOPERM'}); } # We need to update $HOME to point to the effective user home # directory, not the original user one. $ENV{'HOME'} = $self->app->home($user); $self->_report_debug('Set $HOME to \''.$ENV{'HOME'}."\'"); } if (keys %{$self->{'env'}}) { $self->_report_debug("Export environment variables:"); foreach my $var (keys %{$self->{'env'}}) { my $value = $self->{'env'}->{$var}; $self->_report_debug(" $var = $value"); $ENV{$var} = $value; } } # Change the working directory to the given directory or, if a user # was specified, to its home directory. my $wd = $self->working_dir; if ($wd) { $ret = chdir($wd); if ($ret) { $self->_report_debug( "Changed working directory to '$wd'"); } else { $self->_report_warning( "Problem:\n", " Failed to change working directory to '$wd'", " System reports:", " $!"); } } # Tell the parent that we're about to exec(). $self->_report_exec; unless ($self->{'reopen_stdio'}) { # Restore STDIN and STDOUT. $self->_report_debug("Restore STDIN and STDOUT"); open(STDIN, '<&', $self->{'oldin'}); open(STDOUT, '>&', $self->{'oldout'}); } # Ready to run the script. exec { $cmdline[0] } @cmdline; } sub _report_warning (@) { my ($self, @message) = @_; foreach my $line (@message) { print "CTL LOG WARNING $line\n"; } } sub _report_debug (@) { my ($self, @message) = @_; foreach my $line (@message) { print "CTL LOG PROC $line\n"; } } sub _report_exception (@) { my ($self, @reason) = @_; print << "EOF"; status: exception: reason: | EOF foreach my $line (@reason) { print " $line\n"; } } sub _report_exec () { print "CTL EXEC\n"; } sub interpret_generic_output ($) { my ($self, $line) = @_; if ($line =~ /^CTL LOG ([A-Z]+) (.*)$/o) { # Something to log. my $loglevel = $1; my $message = $2; # Check if the message should end with a newline character. my $newline = 1; if ($message =~ / NONL$/o) { $message =~ s/ NONL$//o; $newline = 0; } if ($loglevel eq 'ERROR') { $self->app->log->error( $message.($newline ? "\n" : '')); } elsif ($loglevel eq 'WARNING') { $self->app->log->warning( $message.($newline ? "\n" : '')); } elsif ($loglevel eq 'INFO') { $self->app->log->info( $message.($newline ? "\n" : '')); } else { # $loglevel contains the facility's name here. $self->app->log->debug($loglevel, $message.($newline ? "\n" : '')); } } elsif ($line =~ /^CTL WAITING (START|STOP)$/o) { if ($1 eq 'START') { # The script is waiting for something. Thanks to this # notification, we can let the user know through some # animation that the program didn't crashed. $self->app->log->waiting(1); } else { $self->app->log->waiting(0); } } else { $self->app->log->debug('PROC', "Unexpected output: $line\n"); } } sub wait_for_child () { my ($self) = @_; my $pid = $self->pid; return unless $pid; delete $self->{'pid'}; my $child_fh = $self->fh; delete $self->{'fh'}; # Read remaining data from child process. while (<$child_fh>) { chomp; my $line = $_; # Interpret Erlang output. $self->interpret_generic_output($line); } close($child_fh); # Get the process exit status. $self->app->log->debug("PROC", "Wait for child process ($pid) to exit\n"); waitpid($pid, 0); my $exit_code = $?; my $interrupted = WIFSIGNALED($exit_code); if ($interrupted and $self->app->log->is_waiting) { $self->app->log->info(" (interrupted)\n"); } $exit_code = WEXITSTATUS($exit_code); my $exit_code_name = $SYSEXITS_REVERSED{$exit_code}; if ($exit_code_name) { $self->app->log->debug("PROC", "Process $pid exit code: $exit_code_name ($exit_code)". ($interrupted ? ' (interrupted)' : '')."\n"); } else { $self->app->log->debug("PROC", "Process $pid exit code: $exit_code". ($interrupted ? ' (interrupted)' : '')."\n"); } return ($interrupted) ? -1 : $exit_code; } sub sysexit_name ($) { my ($self, $code) = @_; return $SYSEXITS_REVERSED{$code}; } sub sysexit_code ($) { my ($self, $name) = @_; return $SYSEXITS{$name}; } sub _sighandler_SIGINT {} sub app () { shift->{'app'}; } 1; erlsvc-1.02/lib/ErlSvc/Ctl/Release.pm000066400000000000000000001025531251425362700173530ustar00rootroot00000000000000#- # Copyright 2011 Yakaz. All rights reserved. # # Redistribution and use in source and binary forms, with or without # modification, are permitted provided that the following conditions # are met: # # 1. Redistributions of source code must retain the above copyright # notice, this list of conditions and the following disclaimer. # # 2. Redistributions in binary form must reproduce the above # copyright notice, this list of conditions and the following # disclaimer in the documentation and/or other materials provided # with the distribution. # # THIS SOFTWARE IS PROVIDED BY YAKAZ ``AS IS'' AND ANY EXPRESS OR # IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED # WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE # ARE DISCLAIMED. IN NO EVENT SHALL YAKAZ OR CONTRIBUTORS BE LIABLE # FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR # CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT # OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR # BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, # WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE # OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, # EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. package ErlSvc::Ctl::Release; use strict; use warnings; use utf8; use File::Copy; use File::stat; use File::Path qw(rmtree); require ErlSvc::Ctl::Target; sub new ($) { my ($class, $app) = @_; $class = ref($class) || $class; my $self = { 'app' => $app }; bless $self => $class; } sub list () { my ($self) = @_; # Get the target node and check he's running. my $target = $self->app->node; my $controller = $self->app->controller; if (!$target->is_alive) { # The target node is down. We check if he's local to this # host to determine if we can execute this action with the # controller. if (!$target->is_local) { $self->app->log->error( "Problem:\n", " The node '$target' is not started and running this\n", " action on a remote host isn't supported.\n" ); return; } } else { # The command will run on the target node but we use the controller # node as a gateway. $controller->set_target($target) or return; } my $script = ErlSvc::Ctl::Erlang::Script->new($self->app); $self->app->log->debug("REL", "Query releases list\n"); my $command = '{erlsvc_release, list, []}'; my %result = $script->eval($controller, $command); unless ($result{'status'} && $result{'status'} eq 'ok') { return; } return %{$result{'return'}}; } sub current () { my ($self) = @_; my %rels = $self->list; return unless (%rels); $self->app->log->debug("REL", "Determine current release name\n"); my $permanent; foreach my $rel (keys %rels) { if ($rels{$rel}->{'state'} eq 'current') { $self->app->log->debug("REL", "Current release name: $rel (current)\n"); return $rel; } elsif ($rels{$rel}->{'state'} eq 'permanent') { $permanent = $rel; } } if ($permanent) { $self->app->log->debug("REL", "Current release name: $permanent (permanent)\n"); return $permanent; } return; } sub default () { my ($self) = @_; my %rels = $self->list; return unless (%rels); $self->app->log->debug("REL", "Determine default release name\n"); foreach my $rel (keys %rels) { if ($rels{$rel}->{'state'} eq 'permanent') { $self->app->log->debug("REL", "Default release name: $rel\n"); return $rel; } } return; } sub exists ($) { my ($self, $release) = @_; my %rels = $self->list; return unless (%rels); $self->app->log->debug("REL", "Check if release '$release' exists\n"); unless (exists $rels{$release}) { # The release doesn't exist at all. $self->app->log->debug("REL", "Release '$release' doesn't exist: ". "no entry in the RELEASES file\n"); return; } # Ok, the release exists. But we must ensure that it contains a # sys.config file. my $erl_env = $self->app->erl_env; unless ($erl_env->release_sysconfig($release)) { $self->app->log->debug("REL", "Release '$release' doesn't exist: no sys.config file\n"); return; } $self->app->log->debug("REL", "Release '$release' exists\n"); return 1; } sub state ($) { my ($self, $release) = @_; my %rels = $self->list; return unless (%rels); $self->app->log->debug("REL", "Determine release '$release' state\n"); unless (exists $rels{$release}) { $self->app->log->debug("REL", "Release '$release' doesn't exist\n"); } my $state = $rels{$release}->{'state'}; $self->app->log->debug("REL", "Release '$release' state: $state\n"); return $state; } sub upgradable ($;%) { my ($self, $release, %opts) = @_; # Get the target node and check he's running. my $target = $self->app->node; my $controller = $self->app->controller; if (!$target->is_alive) { # The target node is down. We check if he's local to this # host to determine if we can execute this action with the # controller. if (!$target->is_local) { $self->app->log->error( "Problem:\n", " The node '$target' is not started and running this\n", " action on a remote host isn't supported.\n" ); return; } } else { # The command will run on the target node but we use the controller # node as a gateway. $controller->set_target($target) or return; } $self->app->log->debug("REL", "Verify that the current release can be upgraded to ". "release '$release'\n"); my $erl_env = $self->app->erl_env; my $relup = $opts{'relup'} || $erl_env->release_relup($release); if (-f $relup) { # Determine the release to upgrade from. my $service = ErlSvc::Ctl::Service->new($self->app); my $from; if ($opts{'from'}) { # The release was specified by the caller. $from = $opts{'from'}; } elsif ($service->is_running) { # Use the running service's release. $from = $self->current; } else { # Use the release from the "start_erl.data" file. my $start_erl_data = $erl_env->start_erl_data; my ($erts, $default_release) = $erl_env->parse_start_erl_data( $start_erl_data); unless ($default_release) { $self->app->log->error( "Problem:\n", " Failed to determined the current release.\n", " The file '$start_erl_data' couln't be parsed.\n"); return; } $from = $default_release; } my $script = ErlSvc::Ctl::Erlang::Script->new($self->app); my $command = "{erlsvc_release, upgradable, [\"$relup\", \"$from\"]}"; my %result = $script->eval($controller, $command); if ($result{'status'} && $result{'status'} eq 'ok') { if ($result{'return'} eq 'true') { $self->app->log->debug('REL', "Release '$from' can be upgraded to '$release'\n"); return 1; } else { $self->app->log->debug('REL', "Release '$from' CANNOT be upgraded to '$release'\n"); return; } } } else { $self->app->log->debug('REL', "Release '$release' doesn't support live upgrade\n", "Relup script '$relup' unreadable:\n", " $!\n"); } return; } sub is_vanilla (;$) { my ($self, $release) = @_; $release = $self->current unless ($release); return $release =~ /^R?\d+[A|B]?\d*$/o; } sub upgrade ($;%) { my ($self, $release, %opts) = @_; my $target = $self->app->node; my $controller = $self->app->controller; $self->app->log->debug('REL', "Upgrade node '$target' to release '$release'\n"); my $erl_env = $self->app->erl_env; my $rels_dir = $erl_env->releases_dir; unless (-f $erl_env->RELEASES) { $self->app->log->error( "Problem:\n", " The releases directory must be bootstrapped first.\n", " The releases directory is set to:\n", " $rels_dir\n", "\n", "Solution(s):\n", " 1. Bootstrap the directory using the \"release syncvanilla\"\n", " command.\n" ); return; } # Check that the current release isn't already the target release. my $current_release = $self->current; if ($release eq $current_release) { $self->app->log->debug('REL', "Release '$release' is already installed\n"); return 2; } # Check that node is local. Remote operation isn't supported because # it may need a node restart. if (!$target->is_local) { $self->app->log->error( "Problem:\n", " The node '$target' is remote.\n" ); return; } my $rel_dir = $erl_env->release_dir($release); my $boot_script = $erl_env->release_boot_script($release); my $sys_config = $erl_env->release_sysconfig($release); # The caller is responsible for installing release's files in the # releases directory. my $boot_script_source = $erl_env->release_boot_script($release); unless (-d $rel_dir && -f $boot_script && -f $sys_config) { $self->app->log->error( "Problem:\n", " The release '$release' isn't available on node '$target'\n", "\n", "Solution(s):\n", " 1. Check that the release directory exists. It should\n", " be '$rel_dir'.\n", " 2. Check that this directory contains a 'start.boot' file\n", " and a 'sys.config' file.\n" ); return 0; } my %ret; my $ignore_is_running_test = $opts{'ignore_is_running_test'}; my $service = ErlSvc::Ctl::Service->new($self->app); my $is_running = $service->is_running unless ($ignore_is_running_test); my $relup = $erl_env->release_relup($release); if (($ignore_is_running_test || $is_running) && $self->upgradable($release, 'relup' => $relup)) { # The new release supports live upgrade. The steps are as follows: # 1. mark the release as unpacked (if it's not already done) # 2. install the release # 3. make it permanent my $node; if (!$target->is_alive) { # The target node is down. It'll be started for the upgrade, # but the service won't run on it. $node = $target; $target->proc->run_as_user($self->app->user, $self->app->group); } else { # The command will run on the target node but we use the controller # node as a gateway. $controller->set_target($target) or return; $node = $controller; } # When the node is a target system, we need to synchronize # the lib directory: the source environment may contain new # applications. my $target_system = ErlSvc::Ctl::Target->new($self->app); if ($target_system->is_target_system) { $target_system->sync_lib_dir or return; } my $script = ErlSvc::Ctl::Erlang::Script->new($self->app); # The node may have to update files which don't belong to the # user/group running the script. my %permissions = $self->_grant_permissions; $self->app->log->debug('REL', "Mark release '$release' as unpacked\n"); my $boot_script_source = $boot_script; $boot_script_source =~ s/\.boot$/.rel/o; my $command = "{erlsvc_release, set_unpacked, [\"$boot_script_source\"]}"; my %result = $script->eval($node, $command); unless ($result{'status'} && $result{'status'} eq 'ok') { $self->_restore_permissions(%permissions); return; } if ($release ne $result{'return'}) { $self->app->log->error( "Problem:\n", " The given release ($release) and the unpacked\n", " release (".$result{'return'}.") doesn't match.\n"); $self->_restore_permissions(%permissions); return; } $self->app->log->debug('REL', "Proceed with upgrade to '$release'\n"); $command = "{erlsvc_release, upgrade, [\"$release\"]}"; %result = $script->eval($node, $command); # After upgrade, we must restore files ownership. $self->_restore_permissions(%permissions); unless ($result{'status'} && $result{'status'} eq 'ok') { return; } my $old_release = $opts{'original_release'} || $current_release; unless ($self->is_vanilla($old_release)) { my $ret = $self->remove($old_release); unless ($ret) { $self->app->log->warning( "Failed to mark release '$old_release' ". "as removed\n"); } } } else { # The new release doesn't support live upgrade. We must do the # following steps: # 1. query the start options # 2. stop the service # 3. reset the release (back to Erlang vanilla release) # 4. do "hot" upgrade # 5. start the service my %start_opts = (); if (exists $opts{'extra_flags'}) { $start_opts{'extra_flags'} = $opts{'extra_flags'}; } $service->add_start_opts_of_running_node(\%start_opts); my $ret; if ($is_running) { $ret = $service->stop(); return unless ($ret); } $ret = $self->reset(); return unless ($ret); if ($opts{'ignore_is_running_test'} && $ret == 2) { $self->app->log->error( "Problem:\n", " The given release ($release) doesn't support upgrade from\n", " Erlang vanilla release '$current_release'.\n"); return; } # The new release may include a new Erlang version. The # reset above restored the old vanilla release. We must call # synchronize with the new vanilla before proceeding with # upgrade. $ret = $self->sync_vanilla_releases(); $ret = $self->upgrade($release, %opts, 'ignore_is_running_test' => 1, 'original_release' => $current_release ); # The target node is started during upgrade but not the service. # We stop the node or the service will refuse to start. $controller->unset_target; $target->stop; return unless ($ret); if ($is_running) { $ret = $service->start(%start_opts); return unless ($ret); } } return 1; } sub reset () { my ($self) = @_; # Check that the current release isn't a vanilla release. my $current_release = $self->current; if ($self->is_vanilla($current_release)) { $self->app->log->debug('REL', "The current release is already a vanilla release\n", "No need to reset\n"); return 2; } # Get the target node and check he's running. my $target = $self->app->node; my $controller = $self->app->controller; if (!$target->is_alive) { # The target node is down. We check if he's local to this # host to determine if we can execute this action with the # controller. if (!$target->is_local) { $self->app->log->error( "Problem:\n", " The node '$target' is not started and running this\n", " action on a remote host isn't supported.\n" ); return; } } else { # The command will run on the target node but we use the controller # node as a gateway. $controller->set_target($target) or return; } $self->app->log->debug("REL", "Reset release to Erlang vanilla release\n"); # The node may have to update files which don't belong to the # user/group running the script. my %permissions = $self->_grant_permissions; my $script = ErlSvc::Ctl::Erlang::Script->new($self->app); my $command = "{erlsvc_release, reset, []}"; my %result = $script->eval($controller, $command); # After upgrade, we must restore files ownership. $self->_restore_permissions(%permissions); unless ($result{'status'} && $result{'status'} eq 'ok') { return; } return 1; } sub remove ($) { my ($self, $release) = @_; # It's forbidden to remove an Erlang release (eg. R13B04). if ($self->is_vanilla($release)) { $self->app->log->error( "Problem:\n", " Removing an Erlang vanilla release is not allowed.\n"); return; } # Get the target node and check he's running. my $target = $self->app->node; my $controller = $self->app->controller; if (!$target->is_alive) { # The target node is down. We check if he's local to this # host to determine if we can execute this action with the # controller. if (!$target->is_local) { $self->app->log->error( "Problem:\n", " The node '$target' is not started and running this\n", " action on a remote host isn't supported.\n" ); return; } } else { # The command will run on the target node but we use the controller # node as a gateway. $controller->set_target($target) or return; } $self->app->log->debug("REL", "Mark release '$release' as removed\n"); # The node may have to update files which don't belong to the # user/group running the script. my %permissions = $self->_grant_permissions; my $script = ErlSvc::Ctl::Erlang::Script->new($self->app); my $command = "{erlsvc_release, set_removed, [\"$release\"]}"; my %result = $script->eval($controller, $command); # After upgrade, we must restore files ownership. $self->_restore_permissions(%permissions); unless ($result{'status'} && $result{'status'} eq 'ok') { return; } return 1; } sub sync_vanilla_releases (;%) { my ($self, %opts) = @_; $self->app->log->debug('REL', "Synchronize Erlang vanilla releases\n"); my $erl_env = $self->app->erl_env; my $rels_dir = $erl_env->releases_dir; my $default_rels_dir = $erl_env->default_releases_dir; $self->app->log->debug('REL', "Source: $default_rels_dir\n", "Destination: $rels_dir\n"); return 1 if ($rels_dir eq $default_rels_dir); if ($opts{'from_scratch'}) { $self->_clear_releases_directory($rels_dir); } # To update the release_handler's state files, we must use an # Erlang node. my $target = $self->app->node; my $controller = $self->app->controller; if (!$target->is_alive) { # The target node is down. We check if he's local to this # host to determine if we can execute this action with the # controller. if (!$target->is_local) { $self->app->log->error( "Problem:\n", " The node '$target' is not started and running this\n", " action on a remote host isn't supported.\n" ); return; } } else { # The command will run on the target node but we use the controller # node as a gateway. $controller->set_target($target) or return; } my $script = ErlSvc::Ctl::Erlang::Script->new($self->app); # We first determine the list of releases. my @default_rels = $self->_list_vanilla_releases($script, $controller, $default_rels_dir, 'in default directory'); return unless (scalar @default_rels); if (-e $erl_env->RELEASES) { # The releases directory was previously populated. Our job is to # check if a new Erlang vanilla release is available and add it. $self->app->log->debug('REL', "Releases directory already populated: update\n"); # List "old" vanilla releases. my @effective_rels = $self->_list_vanilla_releases($script, $controller, $rels_dir, 'in effective directory'); my %old_rels = (); my %new_rels = (); foreach my $rel (@default_rels, @effective_rels) { my $in_default = grep { $rel eq $_; } @default_rels; my $in_effective = grep { $rel eq $_; } @effective_rels; if ($in_default && $in_effective) { next; } elsif ($in_default) { $new_rels{$rel} = 1; } else { $old_rels{$rel} = 1; } } my @old_rels = sort(keys %old_rels); my @new_rels = sort(keys %new_rels); if (scalar @old_rels == 0 && scalar @new_rels == 0) { $self->app->log->debug('REL', "Effective directory already up-to-date\n"); return 2; } # Copy releases. foreach my $rel (@new_rels) { my $ret = $self->_copy_vanilla_release($default_rels_dir, $rels_dir, $rel); return unless ($ret); } # We must check if one of the old releases is currently # permanent. This is used to set properly the state of the # newest release. my $permanent = 'none'; foreach my $rel (@old_rels) { if ($self->state($rel) eq 'permanent') { $permanent = '"'.$new_rels[$#new_rels].'"'; last; } } $self->app->log->debug('REL', "Set releases as unpacked:"); foreach my $rel (@new_rels) { $self->app->log->debug('REL', " $rel"); my $file = $erl_env->release_boot_script($rel); $file =~ s/\.boot$/.rel/o; my $command = "{erlsvc_release, set_unpacked, [\"$file\"]}"; my %result = $script->eval($controller, $command); unless ($result{'status'} && $result{'status'} eq 'ok') { $self->app->log->debug('REL', " failed.\n"); return; } } $self->app->log->debug('REL', ".\n"); my $command = '{erlsvc_release, sync_vanilla, ['; $command .= '"'.$erl_env->releases_dir.'", '; $command .= '['.join(', ', map { "\"$_\"" } @old_rels).'], '; $command .= '['.join(', ', map { "\"$_\"" } @new_rels).'], '; $command .= "$permanent]}"; $self->app->log->debug('REL', "Update manually SASL state files:"); my %result = $script->eval($controller, $command); unless ($result{'status'} && $result{'status'} eq 'ok') { $self->app->log->debug('REL', " failed.\n"); return; } $self->app->log->debug('REL', ".\n"); # Remove old releases. $self->app->log->debug('REL', "Remove old vanilla releases:"); foreach my $rel (@old_rels) { if ($self->is_vanilla($rel)) { my $to_remove = File::Spec->catfile($rels_dir, $rel); if (-d $to_remove) { $self->app->log->debug('REL', " $rel"); rmtree($to_remove); } } } $self->app->log->debug('REL', ".\n"); } else { # The releases directory is freshly created (or will be), we # just copy files from default releases directory. $self->app->log->debug('REL', "Releases directory NOT populated: create\n"); unless (-d $rels_dir || mkdir($rels_dir)) { $self->app->log->error( "Problem:\n", " Releases directory '$rels_dir' isn't usable.\n", " System reports:\n", " $!\n"); return; } # Copy releases. foreach my $rel (@default_rels) { my $ret = $self->_copy_vanilla_release($default_rels_dir, $rels_dir, $rel); return unless ($ret); } # Copy release_handler's state files. $self->app->log->debug('REL', "Copy release_handler's state files:"); my @files = ('RELEASES', 'start_erl.data'); for my $file (@files) { my $from = File::Spec->catfile($default_rels_dir, $file); my $to = File::Spec->catfile($rels_dir, $file); if (-e $to) { $self->app->log->debug('REL', " ($file)"); next; } $self->app->log->debug('REL', " $file"); my $ret = copy($from, $to); unless ($ret) { $self->app->log->error( "Problem:\n", " Failed to copy file '$file' from default releases\n", " directory to effective releases directory.\n", " Source and destination are:\n", " $from\n", " $to\n", " System reports:\n", " $!\n"); $self->app->log->debug('REL', " failed.\n"); return; } # Allow the user running the service to update this file. # This is mandatory for live upgrade to work. my $uid = $self->app->uid; my $gid = $self->app->gid; if (defined $uid || defined $gid) { $uid = -1 unless (defined $uid); $gid = -1 unless (defined $gid); $ret = chown $uid, $gid, $to; unless ($ret == 1) { $self->app->log->warning( "Problem:\n", " Failed to change owner of file '$file' in\n", " effective releases directory.\n", " System reports:\n", " $!\n"); } } } $self->app->log->debug('REL', ".\n"); } return 1; } sub _clear_releases_directory ($) { my ($self, $dir, $comment) = @_; # Remove vanilla releases. my $dh; unless (opendir($dh, $dir)) { $self->app->log->error( "Problem:\n", " Failed to open releases directory '$dir'.\n", " System reports:\n", " $!\n"); return; } $self->app->log->debug('REL', "Remove vanilla releases:"); while (my $entry = readdir($dh)) { next if ($entry =~ /^\./o); if ($self->is_vanilla($entry)) { my $to_remove = File::Spec->catfile($dir, $entry); if (-d $to_remove) { $self->app->log->debug('REL', " $entry"); rmtree($to_remove); } } } closedir($dh); $self->app->log->debug('REL', ".\n"); # Remove release_handler's state files. $self->app->log->debug('REL', "Remove release_handler's state files:"); my @files = ('RELEASES', 'start_erl.data'); foreach my $file (@files) { my $to_remove = File::Spec->catfile($dir, $file); if (-f $to_remove) { $self->app->log->debug('REL', " $file"); unlink $to_remove; } } $self->app->log->debug('REL', ".\n"); } sub _list_vanilla_releases ($;$) { my ($self, $script, $node, $dir, $comment) = @_; my $RELEASES = File::Spec->catfile($dir, 'RELEASES'); my $command = "{erlsvc_release, list, [\"$RELEASES\"]}"; my %result = $script->eval($node, $command); unless ($result{'status'} && $result{'status'} eq 'ok') { return; } if ($comment) { $self->app->log->debug('REL', "Get vanilla releases list $comment:"); } else { $self->app->log->debug('REL', "Get vanilla releases list:"); } unless (defined $result{'return'}) { $self->app->log->debug('REL', " none.\n"); return; } my @rels = (); foreach my $rel (keys %{$result{'return'}}) { if ($self->is_vanilla($rel)) { $self->app->log->debug('REL', " $rel"); push @rels, $rel; } } $self->app->log->debug('REL', ".\n"); return sort(@rels); } sub _copy_vanilla_release ($$$) { my ($self, $default_rels_dir, $rels_dir, $release) = @_; return 1 if ($rels_dir eq $default_rels_dir); $self->app->log->debug('REL', "Copy Erlang vanilla release '$release':"); # Get ownership. my $uid = $self->app->uid; $uid = -1 unless (defined $uid); my $gid = $self->app->gid; $gid = -1 unless (defined $gid); # Create the release directory if necessary. my $erl_env = $self->app->erl_env; my $rel_dir = $erl_env->release_dir($release); my $default_rel_dir = $erl_env->default_release_dir($release); unless (-d $rel_dir || mkdir($rel_dir)) { $self->app->log->error( "Problem:\n", " Release directory '$rel_dir' isn't usable.\n", " System reports:\n", " $!\n"); $self->app->log->debug('REL', " failed.\n"); return; } if ($uid != -1 && $gid != -1) { unless (chown($uid, $gid, $rel_dir)) { $self->app->log->error( "Problem:\n", " Failed to set ownership on release directory '$rel_dir'.\n", " System reports:\n", " $!\n"); $self->app->log->debug('REL', " failed.\n"); return; } } # Copy the following files: # - start_clean.* # - start_sasl.* my @files = ( 'start.boot', 'start.script', 'start_clean.boot', 'start_clean.rel', 'start_clean.script', 'start_sasl.boot', 'start_sasl.rel', 'start_sasl.script' ); foreach my $file (@files) { my $from = File::Spec->catfile($default_rel_dir, $file); my $to = File::Spec->catfile($rel_dir, $file); if (-e $to) { $self->app->log->debug('REL', " ($file)"); next; } $self->app->log->debug('REL', " $file"); my $ret = copy($from, $to); unless ($ret) { $self->app->log->error( "Problem:\n", " Failed to copy file '$file' from default releases\n", " directory to effective releases directory.\n", " Source and destination are:\n", " $from\n", " $to\n", " System reports:\n", " $!\n"); $self->app->log->debug('REL', " failed.\n"); return; } if ($uid != -1 && $gid != -1) { unless (chown($uid, $gid, $to)) { $self->app->log->error( "Problem:\n", " Failed to set ownership on file '$to'.\n", " System reports:\n", " $!\n"); $self->app->log->debug('REL', " failed.\n"); return; } } } $self->app->log->debug('REL', ".\n"); return 1; } sub _grant_permissions () { my ($self) = @_; # The node may have to update files which don't belong to the # user/group running the script. my %chown = (); if ($self->app->user_changed || $self->app->group_changed) { my $uid = $self->app->uid; $uid = -1 unless (defined $uid); my $gid = $self->app->gid; $gid = -1 unless (defined $gid); my $erl_env = $self->app->erl_env; my @files = ( $erl_env->start_erl_data, $erl_env->RELEASES ); foreach my $file (@files) { my $stat = stat($file); if (($uid != -1 && $uid != $stat->uid) || ($gid != -1 && $gid != $stat->gid)) { $self->app->log->debug('REL', "Change owner of '$file' to $uid:$gid\n"); my $ret = chown($uid, $gid, $file); unless ($ret) { $self->app->log->warning( "Failed to change ownership of the file '$file'.\n", "The upgrade/reset may fail if the node can't update ". "these files.\n", "System reports:\n", " $!\n" ); next; } $chown{$file} = [$stat->uid, $stat->gid]; } } } return %chown; } sub _restore_permissions (%) { my ($self, %chown) = @_; foreach my $file (keys %chown) { my ($uid, $gid) = @{$chown{$file}}; $self->app->log->debug('REL', "Restore owner of '$file' to $uid:$gid\n"); my $ret = chown($uid, $gid, $file); unless ($ret) { $self->app->log->warning( "Failed to restore ownership of the file '$file'.\n", "You should restore them yourself; the owner was $uid:$gid.\n", "System reports:\n", " $!\n" ); } } } sub app () { shift->{'app'}; } 1; erlsvc-1.02/lib/ErlSvc/Ctl/Resources.pm000066400000000000000000000150431251425362700177420ustar00rootroot00000000000000#- # Copyright 2011 Yakaz. All rights reserved. # # Redistribution and use in source and binary forms, with or without # modification, are permitted provided that the following conditions # are met: # # 1. Redistributions of source code must retain the above copyright # notice, this list of conditions and the following disclaimer. # # 2. Redistributions in binary form must reproduce the above # copyright notice, this list of conditions and the following # disclaimer in the documentation and/or other materials provided # with the distribution. # # THIS SOFTWARE IS PROVIDED BY YAKAZ ``AS IS'' AND ANY EXPRESS OR # IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED # WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE # ARE DISCLAIMED. IN NO EVENT SHALL YAKAZ OR CONTRIBUTORS BE LIABLE # FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR # CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT # OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR # BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, # WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE # OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, # EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. package ErlSvc::Ctl::Resources; use strict; use warnings; use utf8; use User::pwent; use User::grent; sub opts ($) { my ($self, $opt) = @_; my $val = $self->cache->get('global_opts')->{$opt}; unless (defined $val) { my $yaml = $self->cache->get('config'); $val = $yaml->[0]->{$opt} if (defined $yaml); } unless (defined $val) { $val = $self->cache->get('default_config')->{$opt}; } return $val; } sub opts_to_list (;$) { my ($self, $opts) = @_; $opts = $self->cache->get('global_opts') unless ($opts); my @list = (); foreach my $opt (keys %$opts) { my $val = $opts->{$opt}; my $opt_flag = '--'.$opt; $opt_flag =~ s/_/-/go; if (ref($val) eq 'ARRAY') { foreach my $v (@$val) { my $val_escaped = $v; $val_escaped =~ s/(["' ])/\\$1/g; push @list, $opt_flag, $val_escaped; } } elsif (ref($val) eq 'HASH') { while (my ($key, $v) = each %$val) { my $val_escaped = $v; $val_escaped =~ s/(["' ])/\\$1/g; push @list, $opt_flag, "$key=$val_escaped"; } } else { if ($val eq '0' || $val eq '1') { push @list, $opt_flag; } else { my $val_escaped = $val; $val_escaped =~ s/(["' ])/\\$1/g; push @list, $opt_flag, $val_escaped; } } } return @list; } sub node (;%) { my ($self, %options) = @_; $self->_initialize_nodes() unless ($options{'no_init'}); $self->cache->get('target_node'); } sub controller (;%) { my ($self, %options) = @_; $self->_initialize_nodes() unless ($options{'no_init'}); $self->cache->get('controller_node'); } sub _initialize_nodes () { my ($self) = @_; return 1 if ($self->cache->get('controller_node')); # The controller node is an Erlang node on this local host. It's used # as the source for every Erlang calls. my $controller = ErlSvc::Ctl::Erlang::Node->new($self, "erlsvc-controller-$$"); $controller->flag_as_controller; $controller->set_releases_dir($self->opts('releases_dir')); $self->cache->set('controller_node', $controller); $self->log->debug("APP", "Working from controller node '$controller'\n"); # The target node is an Erlang node on this local host or on a # remote host. This is where the commands will mostly run. my $target = ErlSvc::Ctl::Erlang::Node->new_from_app_opts($self); # If the user specified extra_flags and erllibs_path, setup the # target node for these. my $erlapp_args = $self->opts('erlapp_args'); if ($erlapp_args && ref($erlapp_args) eq 'HASH') { $target->set_erl_app_args(%$erlapp_args); } my $extra_flags = $self->opts('extra_flags'); if ($extra_flags && ref($extra_flags) eq 'ARRAY') { $target->add_erl_cmd_args(@$extra_flags); } my $erllibs_path = $self->opts('erllibs_path'); if ($erllibs_path && ref($erllibs_path) eq 'ARRAY') { $target->proc->set_env('ERL_LIBS' => join(':', @$erllibs_path)); } $self->cache->set('target_node', $target); $self->log->debug("APP", "Working with target node '$target'\n"); # The controller node and the target node share the same cookie. $controller->set_cookie($target->cookie); $self->erl_env->finish_init(); $self->log->debug("APP", "Nodes initialized\n"); return 1; } sub user () { shift->opts('user'); } sub user_changed (;$) { my ($self, $user) = @_; my $uid = $self->uid($user); return 0 unless (defined $uid); return $uid != $<; } sub uid (;$) { my ($self, $user) = @_; $user = $self->user unless ($user); return unless $user; my $pwent = getpwnam($user); return unless $pwent; return $pwent->uid; } sub home (;$) { my ($self, $user) = @_; $user = $self->user unless ($user); return unless $user; my $pwent = getpwnam($user); return unless $pwent; return $pwent->dir; } sub group () { shift->opts('group'); } sub group_changed (;$) { my ($self, $group) = @_; my $gid = $self->gid($group); return 0 unless (defined $gid); return $gid != $(; } sub gid (;$) { my ($self, $group) = @_; $group = $self->group unless ($group); return unless $group; my $grent = getgrnam($group); return unless $grent; return $grent->gid; } sub erl_env (;%) { my ($self, %options) = @_; $self->_initialize_nodes() unless ($options{'no_init'}); $self->cache->get('erl_env'); } sub log () { shift->cache->get('logger'); } sub verbose (;$) { my ($self, $component) = @_; my $verbose = $self->opts('verbose'); return unless (defined $verbose); my @components = @$verbose; return 0 if (scalar @components == 0); if (scalar @components == 1) { return 0 if $components[0] eq '!ALL'; return 1 if $components[0] eq 'ALL'; return 1 if $components[0] eq ''; } if ($component) { if (grep(/^!$component$/, @components)) { return 0; } unless (grep(/^$component$/, @components) || grep(/^ALL$/, @components)) { return 0; } } return 1; } 1; erlsvc-1.02/lib/ErlSvc/Ctl/Service.pm000066400000000000000000000757271251425362700174070ustar00rootroot00000000000000#- # Copyright 2011 Yakaz. All rights reserved. # # Redistribution and use in source and binary forms, with or without # modification, are permitted provided that the following conditions # are met: # # 1. Redistributions of source code must retain the above copyright # notice, this list of conditions and the following disclaimer. # # 2. Redistributions in binary form must reproduce the above # copyright notice, this list of conditions and the following # disclaimer in the documentation and/or other materials provided # with the distribution. # # THIS SOFTWARE IS PROVIDED BY YAKAZ ``AS IS'' AND ANY EXPRESS OR # IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED # WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE # ARE DISCLAIMED. IN NO EVENT SHALL YAKAZ OR CONTRIBUTORS BE LIABLE # FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR # CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT # OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR # BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, # WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE # OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, # EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. package ErlSvc::Ctl::Service; use strict; use warnings; use utf8; use Cwd qw(getcwd abs_path); use Data::Dumper; use File::Spec; use File::Temp qw(tempfile); use POSIX qw(strftime); use Sys::CPU; use Time::HiRes qw(usleep); use ErlSvc::Ctl::Erlang::Script; use ErlSvc::Ctl::Proc; use ErlSvc::Ctl::Target; use ErlSvc::Ctl::Usage qw(abs_progname); sub new ($) { my ($class, $app) = @_; $class = ref($class) || $class; my $self = { 'app' => $app }; bless $self => $class; } sub name () { 'My service'; } sub start (;%) { my ($self, %opts) = @_; my $node = $self->app->node; my $target_system = ErlSvc::Ctl::Target->new($self->app); my $is_target_system = $target_system->is_target_system; # Check that the node is local and not already started. For a local # node, if the service is already running, it's ok. Otherwise, we # report an error. # # Starting a remote node would require an SSH access. if (!$node->is_local) { $self->app->log->error( "Problem:\n", " The node '$node' is remote.\n" ); return; } elsif ($node->is_alive) { if ($self->is_running) { # The service is already running. return 2; } $self->app->log->error( "Problem:\n", " The node '$node' is already started but the service\n", " is NOT running.\n", "\n", "Solution(s):\n", " 1. Check that an Erlang shell using the same node name\n", " is not running.\n" ); return; } $self->app->log->debug("SERV", "Starting service on node '$node'\n"); # Set default options. $opts{'embedded'} = 1 unless (exists $opts{'embedded'}); $opts{'max_users'} = 10000 unless ($opts{'max_users'}); # If the called only wants to open a shell with sys.config # specified, don't try to start an embedded node. delete $opts{'embedded'} if ($opts{'load_only'}); my $erl_env = $self->app->erl_env; # The file start_erl.data is used by run_erl(1) to know which # release to boot. my $start_erl_data = $erl_env->start_erl_data; my $start_erl_data_is_tmp = 0; # Regardless of start_erl.data content, the caller may specify a # release. When the embedded mode is selected, we'll have to create # a fake start_erl.data indicating this specific release. my $release = $self->app->opts('release'); # If the start_erl.data file doesn't exist and if no release was # specified, we can't determine the release to boot. unless ($release || -f $start_erl_data) { $self->app->log->error( "Problem:\n", " Failed to determine the release to boot.\n", " The start_erl.data file '$start_erl_data' doesn't exist.\n", "\n", "Solution(s):\n", " 1. Check that the releases directory is correct.\n", " 2. Specify a release explicitly by using the\n", " global -r flag.\n" ); return; } # If the start_erl.data file doesn't exist or if the explicitly # specified release differs from the default release, we must create # a temporary start_erl.data overriding the default release. if ($opts{'embedded'}) { # In embedded mode, the start_erl.data file is required by # run_erl(1). If it doesn't exist, we must create a fake one. # # Likewise, if the specified release differs from the one # indicated by start_erl.data, we must create a fake one to # change the release. my ($erts, $default_release); if (-f $start_erl_data) { ($erts, $default_release) = $erl_env->parse_start_erl_data( $start_erl_data); # If the release was not specified, we select the default # release. $release = $default_release unless ($release); } if (!$default_release || $release ne $default_release) { # We must create the fake start_erl.data file. $self->app->log->debug("SERV", 'Preare a fake start_erl.data ', $default_release ? "(release $release != default release $default_release)\n" : "(file '$start_erl_data' doesn't exist)\n" ); # This file contains a single line with two fields: ERTS # version and the default release. If we coudn't get ERTS # version because start_erl.data doesn't exist, we query it. unless ($erts) { $erts = $erl_env->erts_version; } my $fh; my $template = File::Spec->catfile($ENV{'HOME'}, 'start_erl.data.XXXX'); ($fh, $start_erl_data) = tempfile($template); print $fh "$erts $release\n"; close($fh); # This temporary file will be removed after the node start. $start_erl_data_is_tmp = 1; } } else { # In shell mode, start_erl.data isn't required. But if the # release was not specified, we need this file to get the # default one. unless ($release) { my ($erts, $default_release) = $erl_env->parse_start_erl_data( $start_erl_data); # If the release was not specified, we select the default # release. $release = $default_release; } } if ($opts{'embedded'}) { my $service_name = $self->name; $self->app->log->info("Starting $service_name ($release):"); $self->app->log->waiting(1); } $self->app->log->debug("SERV", "Release: $release\n"); $self->app->log->debug("SERV", "start_erl.data: '$start_erl_data'\n"); # Now that we know the release, we determine the sys.config file. my $sysconfig = $erl_env->release_sysconfig($release); unless (-f $sysconfig) { # The sys.config file doesn't exist but it's required for the # node to start. my $error = $!; if ($start_erl_data_is_tmp) { # Remove the temporary start_erl.data file. $self->app->log->debug("SERV", "Remove temporary start_erl.data '$start_erl_data'\n"); unlink $start_erl_data; } $self->app->log->error( "Problem:\n", " sys.config file '$sysconfig' isn't readable.\n", " The node won't start without it.\n", " System reports:\n", " $error\n" ); $self->app->log->info(" failed\n") if ($opts{'embedded'}); return; } $sysconfig = abs_path($sysconfig); $self->app->log->debug("SERV", "sys.config: '$sysconfig'\n"); # We can determine the boot script too. my $boot_script = $erl_env->release_boot_script($release); unless (-f $boot_script || $opts{'load_only'}) { # The boot script file doesn't exist but it's required for the # node to start. my $error = $!; if ($start_erl_data_is_tmp) { # Remove the temporary start_erl.data file. $self->app->log->debug("SERV", "Remove temporary start_erl.data '$start_erl_data'\n"); unlink $start_erl_data; } $self->app->log->error( "Problem:\n", " boot script file '$boot_script' isn't readable.\n", " The node won't start without it.\n", " System reports:\n", " $error\n" ); $self->app->log->info(" failed\n") if ($opts{'embedded'}); return; } $boot_script = abs_path($boot_script); $self->app->log->debug("SERV", "boot script: '$boot_script'\n"); # At this stage, we have the release name, a sys.config file and a # boot script. # Compute settings from the expected maximum number of users. my $erl_max_ports = exists $opts{'ERL_MAX_PORTS'} ? $opts{'ERL_MAX_PORTS'} : $opts{'max_users'} * 2; my $erl_max_ets_tables = exists $opts{'ERL_MAX_ETS_TABLES'} ? $opts{'ERL_MAX_ETS_TABLES'} : $opts{'max_users'} * 2; my $max_processes = exists $opts{'max_processes'} ? $opts{'max_processes'} : $opts{'max_users'} * 4; # Compute settings from hardware informations. my $cpu_count = Sys::CPU::cpu_count(); my $async_threads = $cpu_count * 4; # Prepare environment. my %export_env = ( 'ERL_MAX_PORTS' => $erl_max_ports, 'ERL_MAX_ETS_TABLES' => $erl_max_ets_tables, 'WCTL_VERSION' => $ErlSvc::Ctl::VERSION ); if ($self->app->opts('erllibs_dir')) { my @erllibs = @{$self->app->opts('erllibs_dir')}; $export_env{'ERL_LIBS'} = join(':', @erllibs); } if ($self->app->opts('releases_dir')) { # Set SASL's releases directory. We use an environment variable # instead of the application parameter to keep node command line # as simple as possible. my $rels_dir = $self->app->opts('releases_dir'); $export_env{'RELDIR'} = $rels_dir; } # We put the options given to the start function in the environment # too. This is later used by restart. my $serialized; { local $Data::Dumper::Indent = 0; local $Data::Dumper::Purity = 1; $serialized = Dumper(\%opts); } $export_env{'WCTL_START_OPTS'} = $serialized; if ($opts{'embedded'}) { # Change default log rotation for run_erl(1) log files # (erlang.log.$N). unless (exists $ENV{'RUN_ERL_LOG_GENERATIONS'}) { $export_env{'RUN_ERL_LOG_GENERATIONS'} = 10; } unless (exists $ENV{'RUN_ERL_LOG_MAXSIZE'}) { $export_env{'RUN_ERL_LOG_MAXSIZE'} = 10 * 1024 * 1024; } } # Initialize the flags. my @cmdline = (); my @flags = ( '+Ww', '+K', 'true', '+A', "$async_threads", '+P', "$max_processes", '-sname', $node->node_name, ); if ($opts{'embedded'}) { unshift @flags, '+Bi'; } if ($node->cookie) { push @flags, ('-setcookie', $node->cookie); } # Setup heart(1). $self->app->log->debug("SERV", 'Heart monitoring: '. ($opts{'heart'} ? 'enabled' : 'disabled')."\n"); if ($opts{'heart'}) { push @flags, '-heart'; my $heart_cmd; if ($opts{'restart_cmd'} && $opts{'embedded'}) { $export_env{'HEART_COMMAND'} = $opts{'restart_cmd'}; $heart_cmd = $opts{'restart_cmd'}; } else { $heart_cmd = ($opts{'embedded'}) ? '(none specified)' : '(none in shell mode)'; } $self->app->log->debug("SERV", "Heart command: $heart_cmd\n"); } # SASL start_prg can't have argument. Therefore, we set an # environment variable and erlsvc will launch the command found in # this variable. $export_env{'WCTL_SASL_START_PRG'} = $opts{'restart_cmd'}; push @flags, ( '-sasl', 'start_prg', '"'.abs_progname().'"' ); # Append Erlang application args. my $erlapp_args = $opts{'erlapp_args'} || $self->app->opts('erlapp_args'); if ($erlapp_args && ref($erlapp_args) eq 'HASH') { while (my ($app, $args) = each %$erlapp_args) { while (my ($arg, $value) = each %$args) { push @flags, ("-$app", $arg, $value); } } } # Append extra flags. my $extra_flags = $opts{'extra_flags'} || $self->app->opts('extra_flags'); if ($extra_flags && ref($extra_flags) eq 'ARRAY') { push @flags, @$extra_flags; } if ($opts{'embedded'}) { # Setup an embedded node using run_erl(1). $self->app->log->debug("SERV", "Execution mode: embedded\n"); my $erl_cmd = $erl_env->erl_cmd('cmd' => 'run_erl'); push @cmdline, ($erl_cmd, '-daemon'); # run_erl(1) needs a directory to put its pipe and its log files. my $pipe_dir = $self->app->opts('pipe_dir'); unless (-d $pipe_dir || mkdir($pipe_dir)) { # The pipe directory file doesn't exist. my $error = $!; if ($start_erl_data_is_tmp) { # Remove the temporary start_erl.data file. $self->app->log->debug("SERV", "Remove temporary start_erl.data '$start_erl_data'\n"); unlink $start_erl_data; } $self->app->log->error( "Problem:\n", " The run directory '$pipe_dir' is invalid.\n", " It's required by run_erl(1).\n", " System reports:\n", " $error\n" ); $self->app->log->info(" failed\n"); return; } $pipe_dir = abs_path($pipe_dir).'/'; push @cmdline, $pipe_dir; my $log_dir = $self->app->opts('log_dir'); unless (-d $log_dir || mkdir($log_dir)) { # The log directory file doesn't exist. my $error = $!; if ($start_erl_data_is_tmp) { # Remove the temporary start_erl.data file. $self->app->log->debug("SERV", "Remove temporary start_erl.data '$start_erl_data'\n"); unlink $start_erl_data; } $self->app->log->error( "Problem:\n", " The log directory '$log_dir' is invalid.\n", " It's required by run_erl(1).\n", " System reports:\n", " $error\n" ); $self->app->log->info(" failed\n"); return; } $log_dir = abs_path($log_dir); push @cmdline, $log_dir; my $start_erl = abs_path($erl_env->erl_cmd('cmd' => 'start_erl')); my $root_dir = abs_path($erl_env->root_dir); my $rels_dir = abs_path($erl_env->releases_dir); my $command = "exec $start_erl $root_dir $rels_dir $start_erl_data"; # When adding additionnal flags, we must escape quotes and # double-quotes. my @flags_escaped = map { $_ =~ s/(["' ])/\\$1/g; $_; } @flags; $command .= ' '.join(' ', @flags_escaped); push @cmdline, $command; } else { # Start the service in a standard shell using erl(1). $self->app->log->debug("SERV", "Execution mode: shell\n"); my $erl_cmd = $erl_env->erl_cmd(); push @cmdline, $erl_cmd; push @cmdline, @flags; unless ($opts{'load_only'}) { # Unless load_only was specified, we indicate which boot # script to use. # # On erl(1) command line, the boot script file must not have # its file extension. my $boot_script_stripped = $boot_script; $boot_script_stripped =~ s/\.boot$//o; push @cmdline, ('-boot', $boot_script_stripped); } # On erl(1) command line, the sys.config file must not have its # file extension. my $sysconfig_stripped = $sysconfig; $sysconfig_stripped =~ s/\.config$//o; push @cmdline, ('-config', $sysconfig_stripped); } my $debug_sub = sub { my @output = ("Final node command line:\n"); my $line = ''; foreach my $arg (@cmdline) { if (length($line) + length($arg) > 65) { push @output, " $line \\\n"; $line = $arg; } elsif (!$line) { $line = $arg; } else { $line .= ' '.$arg; } } push @output, " $line\n"; return @output; }; $self->app->log->debug("SERV", $debug_sub); # Run as a child process. my $proc = ErlSvc::Ctl::Proc->new($self->app); $proc->run_as_user($self->app->user, $self->app->group); $proc->set_open_files_limit(131072); $proc->set_env(%export_env); $proc->reopen_stdio(0); # The working directory is the effective user home directory by # default. But if the Erlang environment is a target system, we use # this environment's root directory. $proc->set_working_dir($erl_env->root_dir) if ($is_target_system); # In this working directory, we backup old "erl_crash.dump" if it's present. my $wd = $proc->working_dir || getcwd; my $erl_crash_dump = File::Spec->catfile($wd, 'erl_crash.dump'); if (-e $erl_crash_dump) { my $old_erl_crash_dump = File::Spec->catfile($wd, strftime("erl_crash-%Y%m%d-%H%M%S.dump", localtime())); $self->app->log->debug("SERV", "Rename old erl_crash.dump to '$old_erl_crash_dump'\n"); unless (rename($erl_crash_dump, $old_erl_crash_dump)) { $self->app->log->warning( "Problem:\n", " Failed to rename old erl_crash.dump to ". "'$old_erl_crash_dump'\n", " System reports:\n", " $!\n", ); } } unless ($opts{'embedded'}) { # Unhide cursor. $self->app->log->show_cursor(1); } unless ($proc->start(@cmdline)) { $proc->wait_for_child; if ($start_erl_data_is_tmp) { # Remove the temporary start_erl.data file. $self->app->log->debug("SERV", "Remove temporary start_erl.data '$start_erl_data'\n"); unlink $start_erl_data; } $self->app->log->error( "Problem:\n", " Failed to start service on node '$node'.\n", " Check erlang.log.* files in the logs directory.\n", ); $self->app->log->info(" failed\n") if ($opts{'embedded'}); return; } my $ret = 1; if ($opts{'embedded'}) { # run_erl(1) returns before the node is fully started. Therefore # we use an Erlang script which monitors applications start. # This allows this function to block until the node is ready. my $controller = $self->app->controller; unless ($controller->set_target($node)) { if ($start_erl_data_is_tmp) { # Remove the temporary start_erl.data file. $self->app->log->debug("SERV", "Remove temporary start_erl.data '$start_erl_data'\n"); unlink $start_erl_data; } $self->app->log->info(" failed\n"); return; } my $script = ErlSvc::Ctl::Erlang::Script->new($self->app); my $verbose = $self->app->verbose('SERV') ? 'true' : 'false'; my $command = "{erlsvc_service, watch_start, [[{verbose, $verbose}]]}"; my %result = $script->eval($controller, $command); $self->app->log->waiting(0); if ($result{'status'} && $result{'status'} eq 'ok') { $self->app->log->debug("SERV", "Service on node '$node' is up and running\n"); } else { $self->stop('force' => 1); $ret = 0; } } else { # Wait for the shell to exit. $proc->wait_for_child; # Hide cursor. $self->app->log->show_cursor(0); } if ($start_erl_data_is_tmp) { # Remove the temporary start_erl.data file. $self->app->log->debug("SERV", "Remove temporary start_erl.data '$start_erl_data'\n"); unlink $start_erl_data; } return $ret; } sub is_running () { my ($self) = @_; # Get the target node and check he's running. my $target = $self->app->node; if (!$target->is_alive) { # The node is down, the service too. return 0; } # The command will run on the target node but we use the controller # node as a gateway. my $controller = $self->app->controller; $controller->set_target($target) or return; my $script = ErlSvc::Ctl::Erlang::Script->new($self->app); $self->app->log->debug("SERV", "Checking service status on node '$target'\n"); my $command = "{erlsvc_service, is_running, []}"; my %result = $script->eval($controller, $command); unless ($result{'status'} && $result{'status'} eq 'ok') { return; } my $is_up = ($result{'return'} eq 'true') ? 1 : 0; $self->app->log->debug("SERV", "Service on node '$target' is ".($is_up ? 'UP' : 'DOWN')."\n"); return $is_up; } sub reload () { my ($self) = @_; my $target = $self->app->node; unless ($target->is_alive) { $self->app->log->error( "Problem:\n", " The node '$target' is not running.\n" ); return; } my $controller = $self->app->controller; $controller->set_target($target) or return; $self->app->log->debug("SERV", "Reload configuration on node '$target'\n"); my $script = ErlSvc::Ctl::Erlang::Script->new($self->app); my $command = "{erlsvc_service, reload_config, []}"; my %result = $script->eval($controller, $command); unless ($result{'status'} && $result{'status'} eq 'ok') { return; } return 1; } sub add_start_opts_of_running_node ($) { my ($self, $opts) = @_; my $target = $self->app->node; # If the target node is down, we obviously can't query the start # options. return unless ($target->is_alive); $self->app->log->debug('SERV', "Retrieve previous start options\n"); my $controller = $self->app->controller; $controller->set_target($target) or return; my $script = ErlSvc::Ctl::Erlang::Script->new($self->app); my $command = "{erlsvc_service, get_start_opts, []}"; my %result = $script->eval($controller, $command); unless ($result{'status'} && $result{'status'} eq 'ok') { return; } my $VAR1; eval $result{'return'}; my %old_opts = %$VAR1; # Let's merge options. while (my ($k, $v) = each %old_opts) { unless (exists $opts->{$k}) { $self->app->log->debug('SERV', "Use previous value for $k\n"); $opts->{$k} = $v; } } } sub restart (;%) { my ($self, %opts) = @_; my $target = $self->app->node; # We can't restart a remote node. if (!$target->is_local) { $self->app->log->error( "Problem:\n", " The node '$target' is remote.\n" ); return; } elsif ($target->is_alive && !$self->is_running) { # The node is up but the service is not running. We don't touch # a node we don't know. $self->app->log->error( "Problem:\n", " The node '$target' is started but the service is NOT\n", " running.\n", "\n", "Solution(s):\n", " 1. Check that an Erlang shell using the same node name\n", " is not running.\n" ); return; } if ($target->is_alive) { # The node is already started. Here's the plan: # - query the start options # - stop the node # - start it again $self->add_start_opts_of_running_node(\%opts); $self->app->log->debug("SERV", "Restart service on node '$target'\n"); # We're ready to stop the service. my $ret = $self->stop(%opts); return unless ($ret); } else { # The node is not started. We simply start it. $self->app->log->debug("SERV", "Restart service on node '$target'\n"); $self->app->log->debug('SERV', "Service already stopped\n"); } # At this point, the service is stopped and %opts contains the final # options. $self->start(%opts); } sub stop (;%) { my ($self, %opts) = @_; my $target = $self->app->node; # Check that the node is already started. If the service is not # running, it's ok, we return immediately. if (!$opts{'force'} && !$target->is_alive) { # The node is down, there's nothing to do. Really nothing... # I'd give anything to... I don't know... Go to the beach! I've # never seen the ocean :( I can't even see: as a program, I # have no eyeballs! Life is awful :( But... I... I don't live! # AAAAAAHHHH! return 2; } elsif (!$opts{'force'} && !$self->is_running) { # The node is here but it doesn't run the service. This node # belongs to someone else. It's none of my business. $self->app->log->error( "Problem:\n", " The node '$target' is up but it doesn't run the service.\n", "\n", "Solution(s):\n", " 1. Check that an Erlang shell using the same node name\n", " is not running.\n" ); return; } $self->app->log->debug("SERV", "Stopping service on node '$target'\n"); my $service_name = $self->name; $self->app->log->info("Stopping $service_name:"); $self->app->log->waiting(1); # Set default options. $opts{'timeout'} = 30 unless (exists $opts{'timeout'}); my $controller = $self->app->controller; $controller->set_target('self'); # To stop the service, we just send an init:stop() to the node. # After that, the script will watch the node. This way, we'll be # notified when the service will be really down. my $timeout = $opts{'timeout'} * 1000; my $force = $opts{'force'} ? 'true' : 'false'; my $verbose = $self->app->verbose('SERV') ? 'true' : 'false'; my $script = ErlSvc::Ctl::Erlang::Script->new($self->app); my $command = "{erlsvc_service, stop, ['$target', ". "[{timeout, $timeout}, {force, $force}, {verbose, $verbose}]]}"; my %result = $script->eval($controller, $command); $self->app->log->waiting(0); unless ($result{'status'} && $result{'status'} eq 'ok') { return; } $self->app->log->info(' '.$result{'return'}.".\n"); if ($result{'return'} eq 'failed') { return; } $self->app->log->debug("SERV", "Service on node '$target' is stopped\n"); return 1; } sub shell (;%) { my ($self, %opts) = @_; my $target = $self->app->node; unless ($target->is_alive) { $self->app->log->error( "Problem:\n", " The node '$target' is not running.\n" ); return; } my $mode = $opts{'mode'}; if (!$target->is_local && $mode && $mode eq 'to_erl') { # We can't use to_erl(1) to connect to a remote node. $self->app->log->error( "Problem:\n", " Can't use to_erl(1) to open a shell on a remote.\n" ); return; } unless ($mode) { # Default mode is "to_erl" for local node, "remsh" otherwise. $mode = ($target->is_local) ? 'to_erl' : 'remsh'; } # Stop the controller node, because he could receive the ^C too. my $controller = $self->app->controller('no_init' => 1); $controller->stop if (defined $controller); my $ret; if ($mode eq 'to_erl') { $ret = $self->_shell_to_erl; } if (!$ret && !$opts{'mode'}) { if ($mode eq 'to_erl') { $self->app->log->warning("Fallback to \"remsh\" mode\n"); } $ret = $self->_shell_remsh; } return $ret; } sub _shell_to_erl () { my ($self) = @_; my $target = $self->app->node; my $erl_env = $self->app->erl_env; my $to_erl_cmd = $erl_env->erl_cmd('cmd' => 'to_erl'); my $pipe_dir = $self->app->opts('pipe_dir'); # We want to send ^L to run_erl(1) to force it to redraw. Thanks # to this, the prompt will be displayed. To send this ^L, we need # the name of the write side of the named pipe: we walk through the # $pipe_dir and look for the erlang.pipe.*.w entries. We take all # pipes because we don't know which one will be used. # # TODO: If there're dead pipes lying in this directory, writing ^L # will block this process. my @pipes = glob(File::Spec->catfile($pipe_dir, 'erlang.pipe.*.w')); my $proc = ErlSvc::Ctl::Proc->new($self->app); $proc->reopen_stdio(0); my @cmdline = ( $to_erl_cmd, $pipe_dir.'/' ); $self->app->log->debug('SERV', "Start a shell (mode: to_erl)\n"); $self->app->log->info( "\n", " ---------------------------------\n", " To close this shell, hit Ctrl+D\n", " ---------------------------------\n", "\n" ); # Restore cursor. $self->app->log->show_cursor(1); $proc->start(@cmdline); # Now that to_erl(1) is running, send the ^L. We sleep 100 ms to let # to_erl(1) some time to negotiate with run_erl(1). usleep(100000); my $fh; foreach my $pipe (@pipes) { $self->app->log->debug('SERV', "Send ^L to pipe $pipe\n"); unless (open($fh, '>'.$pipe)) { $self->app->log->warning( "Failed to open pipe $pipe: $!\n"); next; } print $fh " "; close($fh); } my $exit_code = $proc->wait_for_child; # Hide cursor again. $self->app->log->show_cursor(0); return ($exit_code == 0) ? 1 : 0; } sub _shell_remsh () { my ($self) = @_; my $target = $self->app->node; my $erl_env = $self->app->erl_env; my $erl_cmd = $erl_env->erl_cmd; my $proc = ErlSvc::Ctl::Proc->new($self->app); $proc->reopen_stdio(0); my @cmdline = ( $erl_cmd, '-sname', "erlsvc-remsh-$$", '-remsh', $target->full_node_name, '-hidden' ); if ($target->cookie) { push @cmdline, ('-setcookie', $target->cookie); } $self->app->log->debug('SERV', "Start a shell (mode: remsh)\n"); $self->app->log->info( "\n", " ---------------------------------------\n", " To close this shell, hit Ctrl+C twice\n", " ---------------------------------------\n", "\n" ); # Restore cursor. $self->app->log->show_cursor(1); $proc->start(@cmdline); my $exit_code = $proc->wait_for_child; # Hide cursor again. $self->app->log->show_cursor(0); return ($exit_code == 0) ? 1 : 0; } sub app () { shift->{'app'}; } 1; erlsvc-1.02/lib/ErlSvc/Ctl/Target.pm000066400000000000000000000402201251425362700172110ustar00rootroot00000000000000#- # Copyright 2011 Yakaz. All rights reserved. # # Redistribution and use in source and binary forms, with or without # modification, are permitted provided that the following conditions # are met: # # 1. Redistributions of source code must retain the above copyright # notice, this list of conditions and the following disclaimer. # # 2. Redistributions in binary form must reproduce the above # copyright notice, this list of conditions and the following # disclaimer in the documentation and/or other materials provided # with the distribution. # # THIS SOFTWARE IS PROVIDED BY YAKAZ ``AS IS'' AND ANY EXPRESS OR # IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED # WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE # ARE DISCLAIMED. IN NO EVENT SHALL YAKAZ OR CONTRIBUTORS BE LIABLE # FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR # CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT # OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR # BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, # WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE # OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, # EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. package ErlSvc::Ctl::Target; use strict; use warnings; use utf8; use File::Basename; use File::Path qw(mkpath rmtree); use File::Spec; use YAML::Tiny; use ErlSvc::Ctl::Proc; require ErlSvc::Ctl::Release; sub new ($) { my ($class, $app) = @_; $class = ref($class) || $class; my $self = { 'app' => $app }; bless $self => $class; } sub deploy (;%) { my ($self, %opts) = @_; my $target = $self->app->node; my $target_dir = $opts{'directory'} || $self->_default_target_dir; $self->app->log->debug('TARGET', "Deploy '$target' target system tree in $target_dir\n"); if (-e $target_dir && $opts{'from_scratch'}) { $self->destroy(%opts) or return; } # Create the directory if it doesn't exist yet. unless (-d $target_dir) { $self->app->log->debug('TARGET', "Create directory\n"); my $errors; mkpath($target_dir, { 'error' => \$errors }); if (@$errors) { my $error_sub = sub { my @output = (); foreach my $error (@$errors) { my ($file, $msg) = %$error; if ($file eq '') { push @output, " General error: $msg\n"; } else { push @output, " $file: $msg\n"; } } return @output; }; $self->app->log->error( "Problem:", " Failed to create target system directory '$target_dir'", " System reports:", $error_sub ); return; } } my $erl_env = $self->app->erl_env; my $root_dir = $erl_env->root_dir; my $proc = ErlSvc::Ctl::Proc->new($self->app); $proc->run_as_user($self->app->user, $self->app->group); $proc->reopen_stdio(0); # The directory is now created. We copy/update the files from the # system's Erlang environment that do not need any modification. $self->app->log->debug('TARGET', "Sync target directory with system root directory\n"); my @cmdline = ( 'rsync', '-rlptD', '--exclude', 'COPYRIGHT', '--exclude', 'Install', '--exclude', 'PR.template', '--exclude', 'README', '--exclude', 'bin/dialyzer', '--exclude', 'bin/erlc', '--exclude', 'bin/run_test', '--exclude', 'bin/start', '--exclude', 'bin/typer', '--exclude', 'erts-*/doc', '--exclude', 'erts-*/include', '--exclude', 'erts-*/info', '--exclude', 'erts-*/lib', '--exclude', 'erts-*/man', '--exclude', 'erts-*/src', '--exclude', 'lib', '--exclude', 'doc', '--exclude', 'man', '--exclude', 'misc', '--exclude', 'releases/RELEASES', '--exclude', 'releases/start_erl.data', '--exclude', 'releases/R*', '--exclude', 'usr', $root_dir.'/', $target_dir.'/' ); $proc->start(@cmdline); my $exit_code = $proc->wait_for_child; return if ($exit_code != 0); # The "lib" directory is copied in a second pass, because we don't # want to copy symlinks to external applications but the actual # application directory. return unless $self->_rsync_lib_dir($proc, $root_dir, $target_dir); # The bin/erl script contains an absolute path to the root # directory. We must update it to point to the target directory. my @dirs = ('bin'); my $dh; unless (opendir($dh, $target_dir)) { $self->app->log->error( "Problem:\n", " Failed to open target system directory '$target_dir'.\n", " System reports:\n", " $!\n"); return; } while (my $entry = readdir($dh)) { if ($entry =~ /^erts-/o) { push @dirs, File::Spec->catfile($entry, 'bin'); } } closedir($dh); foreach my $dir (@dirs) { my $erl_script = File::Spec->catfile($target_dir, $dir, 'erl'); my $ret = $self->_update_erl_script($erl_script, $target_dir); return unless ($ret); } # Now that the node is deployed, we must reset the Erlang # environment. $erl_env->change_root_dir($target_dir) || return; $erl_env->change_releases_dir( File::Spec->catfile($target_dir, 'releases')); # The "releases" directory was not synchronized on purpose: we # delegate this action to ErlSvc::Ctl::Release. my $release = ErlSvc::Ctl::Release->new($self->app); $release->sync_vanilla_releases || return; # We write a hidden file in the target directory. This file is used # to known in other function if the root directory was created by # this function. my $fh; my $mark = $self->_mark_filename($target_dir); unless (open($fh, '>', $mark)) { $self->app->log->warning( "Problem:\n", " Failed to mark the target system directorytarget as created\n", " by this program.\n", " System reports:\n", " $!\n"); return; } print $fh 'erlsvc_version: '.$ErlSvc::Ctl::VERSION."\n"; print $fh 'source_root_dir: "'.$root_dir."\"\n"; close($fh); return 1; } sub sync_lib_dir (;%) { my ($self, %opts) = @_; unless ($self->is_target_system) { $self->app->log->error( "Problem:\n", " This Erlang environment is not a target system created by\n", " this program\n"); return; } my $erl_env = $self->app->erl_env; my $target_dir = $erl_env->root_dir; my $source_dir = $opts{'source_dir'}; unless ($source_dir) { my $mark = $self->_mark_filename($target_dir); my $yaml = YAML::Tiny->read($mark); unless ($yaml) { $self->app->log->error( "Problem:\n", " Failed to read the target system's meta-data\n", " The file is:\n", " $mark\n", " YAML::Tiny reports:\n", " ".YAML::Tiny->errstr."\n"); return; } $source_dir = $yaml->[0]->{'source_root_dir'}; } unless (-d $source_dir) { $self->app->log->error( "Problem:\n", " The source root directory isn't usable.\n", " The directory is:\n", " $source_dir\n", " System reports:\n", " $!\n"); return; } my $proc = ErlSvc::Ctl::Proc->new($self->app); $proc->run_as_user($self->app->user, $self->app->group); $proc->reopen_stdio(0); $self->_rsync_lib_dir($proc, $source_dir, $target_dir); } sub _rsync_lib_dir ($$$) { my ($self, $proc, $source_dir, $target_dir) = @_; # The "src" sub-directory is copied because some applications, like # syslogger, need their source files. my @cmdline = ( 'rsync', '-rLptD', '--exclude', '*/doc', '--exclude', '*/examples', '--exclude', '*/info', File::Spec->catfile($source_dir, 'lib').'/', File::Spec->catfile($target_dir, 'lib').'/' ); $proc->start(@cmdline); my $exit_code = $proc->wait_for_child; return ($exit_code == 0); } sub remove_unused () { my ($self, %opts) = @_; unless ($self->is_target_system) { $self->app->log->error( "Problem:\n", " This Erlang environment is not a target system created by\n", " this program\n"); return; } my $target = $self->app->node; my $erl_env = $self->app->erl_env; my $target_dir = $erl_env->root_dir; $self->app->log->debug('TARGET', "Remove unused ERTS and applications from '$target' target ". "system tree in $target_dir\n"); my $release = ErlSvc::Ctl::Release->new($self->app); my %releases = $release->list; # We build a list of applications referenced by at least one # release. We build another list for ERTS versions. my %apps = (); my %ERTS = (); foreach my $rel (values (%releases)) { $ERTS{$rel->{'erts'}} = 1; foreach my $app (@{$rel->{'applications'}}) { my $name = $app->{'name'}.'-'.$app->{'version'}; $apps{$name} = 1; } } # Remove unused ERTS. my $dh; unless (opendir($dh, $target_dir)) { $self->app->log->error( "Problem:\n", " Failed to open target system directory '$target_dir'.\n", " System reports:\n", " $!\n"); return; } $self->app->log->debug('TARGET', "Remove unused ERTS:"); while (my $entry = readdir($dh)) { next unless ($entry =~ /^erts-([0-9.]+)/o); next if ($ERTS{$1}); # This version of ERTS is not used anymore: remove it. $self->app->log->debug('TARGET', " $1"); my $dir = File::Spec->catfile($target_dir, "erts-$1"); if ($opts{'dry_run'}) { $self->app->log->info("Remove ERTS $1 ($dir)\n"); next; } my $errors = []; rmtree($dir, { 'error' => \$errors }); if (@$errors) { my $error_sub = sub { my @output = (); foreach my $error (@$errors) { my ($file, $msg) = %$error; if ($file eq '') { push @output, " General error: $msg\n"; } else { push @output, " $file: $msg\n"; } } return @output; }; $self->app->log->warning( "Problem:\n", " Failed to remove ERTS $1 directory". "'$dir'\n", " System reports:\n", $error_sub ); } } closedir($dh); $self->app->log->debug('TARGET', ".\n"); # Remove unused applications. my $lib_dir = File::Spec->catfile($target_dir, 'lib'); unless (opendir($dh, $lib_dir)) { $self->app->log->error( "Problem:\n", " Failed to open target system directory '$target_dir'.\n", " System reports:\n", " $!\n"); return; } $self->app->log->debug('TARGET', "Remove unused applications:"); while (my $entry = readdir($dh)) { next if ($entry =~ /^\./o); next if ($apps{$entry}); # Keep Erlang modules associated with used ERTS. if ($entry =~ /^erts-([0-9.]+)/o) { next if ($ERTS{$1}); } # This application is not used anymore: remove it. $self->app->log->debug('TARGET', " $entry"); my $dir = File::Spec->catfile($lib_dir, $entry); if ($opts{'dry_run'}) { $self->app->log->info("Remove application $entry ($dir)\n"); next; } if (-l $dir) { unless (unlink $dir) { $self->app->log->warning( "Problem:\n", " Failed to remove application $entry directory". "'$dir'\n", " System reports:\n", " $!\n"); } } else { my $errors = []; rmtree($dir, { 'error' => \$errors }); if (@$errors) { my $error_sub = sub { my @output = (); foreach my $error (@$errors) { my ($file, $msg) = %$error; if ($file eq '') { push @output, " General error: $msg\n"; } else { push @output, " $file: $msg\n"; } } return @output; }; $self->app->log->warning( "Problem:\n", " Failed to remove application $entry directory". "'$dir'\n", " System reports:\n", $error_sub ); } } } closedir($dh); $self->app->log->debug('TARGET', ".\n"); } sub destroy (;%) { my ($self, %opts) = @_; my $target = $self->app->node; if ($target->is_alive && !$target->autostarted) { $self->app->log->error( "Problem:\n", " The node '$target' is already running.\n" ); return; } my $target_dir = $opts{'directory'} || $self->_default_target_dir; $self->app->log->debug('TARGET', "Remove content of target directory $target_dir\n"); my $errors; rmtree($target_dir, { 'keep_root' => 1, 'error' => \$errors }); if (@$errors) { my $error_sub = sub { my @output = (); foreach my $error (@$errors) { my ($file, $msg) = %$error; if ($file eq '') { push @output, " General error: $msg\n"; } else { push @output, " $file: $msg\n"; } } return @output; }; $self->app->log->error( "Problem:", " Failed to remove target system files in directory ". "'$target_dir'", " System reports:", $error_sub ); return; } return 1; } sub is_target_system () { my ($self) = @_; my $erl_env = $self->app->erl_env; my $root_dir = $erl_env->root_dir; my $mark = $self->_mark_filename($root_dir); return (-e $mark); } sub _update_erl_script ($$) { my ($self, $erl_script, $target_dir) = @_; $self->app->log->debug('TARGET', "Update ROOTDIR in $erl_script\n"); # Read the file and update ROOTDIR. my $fh; unless (open($fh, '<', $erl_script)) { $self->app->log->error( "Problem:\n", " Failed to open erl script '$erl_script' for reading.\n", " System reports:\n", " $!\n"); return; } my @lines = (); foreach my $line (<$fh>) { if ($line =~ /^(\s*ROOTDIR=\s*)/o) { push @lines, "$1$target_dir\n"; } else { push @lines, $line; } } close($fh); # Write the new content, overwriting the previous one. unless (open($fh, '>', $erl_script)) { $self->app->log->error( "Problem:\n", " Failed to open erl script '$erl_script' for writing.\n", " System reports:\n", " $!\n"); return; } print $fh @lines; close($fh); return 1; } sub _default_target_dir () { my ($self) = @_; my $home = $self->app->home; my $target = $self->app->node; # Default directory is: # $HOME/target-systems/$node@$host my $target_dir = File::Spec->catfile($home, 'target-systems', $target->full_node_name); return $target_dir; } sub _mark_filename ($) { my ($self, $root_dir) = @_; File::Spec->catfile($root_dir, '.erlsvc_target_system.yaml'); } sub app () { shift->{'app'}; } 1; erlsvc-1.02/lib/ErlSvc/Ctl/Usage.pm000066400000000000000000000043521251425362700170350ustar00rootroot00000000000000#- # Copyright 2011 Yakaz. All rights reserved. # # Redistribution and use in source and binary forms, with or without # modification, are permitted provided that the following conditions # are met: # # 1. Redistributions of source code must retain the above copyright # notice, this list of conditions and the following disclaimer. # # 2. Redistributions in binary form must reproduce the above # copyright notice, this list of conditions and the following # disclaimer in the documentation and/or other materials provided # with the distribution. # # THIS SOFTWARE IS PROVIDED BY YAKAZ ``AS IS'' AND ANY EXPRESS OR # IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED # WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE # ARE DISCLAIMED. IN NO EVENT SHALL YAKAZ OR CONTRIBUTORS BE LIABLE # FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR # CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT # OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR # BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, # WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE # OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, # EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. package ErlSvc::Ctl::Usage; use strict; use warnings; use utf8; require Exporter; our @ISA = qw(Exporter); our @EXPORT_OK = qw(abs_progname progname abstract); use File::Basename; use Cwd qw(abs_path); sub abs_progname () { return abs_path($0); } sub progname () { return basename($0); } sub abstract ($) { my ($class) = @_; $class = ref $class if ref $class; my $result; (my $pm_file = $class) =~ s!::!/!g; $pm_file .= '.pm'; require $pm_file unless (exists $INC{$pm_file}); $pm_file = $INC{$pm_file}; return "(failed to require '$class')" unless ($pm_file); open my $fh, "<", $pm_file or return "(unknown)"; local $/ = "\n"; my $inpod; while (local $_ = <$fh>) { $inpod = /^=cut/ ? !$inpod : $inpod || /^=(?!cut)/; next unless $inpod; chomp; next unless /^(?:$class\s-\s)(.*)/; $result = $1; last; } return $result || "(unknown)"; } 1; erlsvc-1.02/script/000077500000000000000000000000001251425362700142455ustar00rootroot00000000000000erlsvc-1.02/script/erlsvc000077500000000000000000000231341251425362700154740ustar00rootroot00000000000000#!/usr/bin/perl # $Id: erlsvc 8543 2011-01-06 14:15:26Z jean.sebastien.pedron $ =head1 NAME erlsvc - CLI to control My service =head1 SYNOPSIS B [B<-C I>] [B<-u I>] [B<-g I>] [B<-n I>] [B<-h I>] [B<-c I>] [B<-r I>] [B<-d I>] [B<-E I>] [B<-L I>] [B<-M I>] [B<-P I>]] [B<-O I>]] [B<-V I>] I [] B help [I] =head1 DESCRIPTION B is the command line interface to manage the Erlang nodes making My service. This includes bootstrapping a new node, starting and stopping it or handling release upgrade. Technically speaking, it starts a "controller" locally (an Erlang node). This node may spawn a process on a running target node to execute the command. This way, it's possible to manage a node on a remote host. You can get a summary of the command line options and a list of available commands by issueing the command C. To get a help message for a specific command, use C>. =head1 OPTIONS =over 5 =item B<-C> I or B<--config> I This specifies the path to a configuration file. See L for more informations about the format of this file and the options available. Command line options always override values from the configuration file. By default, B looks for the following files: =over =item 1. F<$HOME/.config/erlsvc/config-I@I.yaml> =item 2. F<$HOME/.config/erlsvc/config-I.yaml> =item 3. F<$HOME/.config/erlsvc/config.yaml> =item 4. F@I.yaml> =item 5. F.yaml> =item 6. F =item 7. F =back =item B<-u> I or B<--user> I This specifies the user under which the service must run. The target node will first start with the caller's user ID (eg. root) and will drop to I before starting the service. By default, the user is not changed. =item B<-g> I or B<--group> I This specified the group under which the service must run. See the B<-u> option above for an explanation. By default, the gorup is not changed. =item B<-n> I or B<--node> I This specifies the name of the target node to start or manage. The default is "myservice". =item B<-h> I or B<--host> I This specifies the hostname of the target node to manage. The hostname must be in a "short" form: only up-to the first dot, not a full qualified domain name. The default is the local hostname. =item B<-c> I or B<--cookie> I This specifies the Erlang cookie to be used for inter-node communication. This cookie is also used as the starting target node's cookie. By default, use whatever default cookie erl(1) would use. =item B<-r> I or B<--release> I This specifies the Erlang release to boot when starting the service. The default is the permanent release. =item B<-d> I or B<--releases-dir> I This specifies the Erlang releases directory. The default is the system Erlang releases directory, ie. the "releases" directory under the Erlang root directory. =item B<-E> I or B<--erlang> I This specifies the Erlang root directory. This is useful when L is not in the PATH or the one in the PATH is not to be used. By default, L in the PATH is used. =item B<-L> I or B<--erllibs-path> I This specifies additionnal directories where Erlang application may be found. This option may be specified multiple times to set several paths. By default, none. =item B<-M> I or B<--mods-dir> I This specifies the directory where B's Erlang modules are. The default is the B's distribution-level shared data directory as returned by C from L. =item B<-R> I or B<--pipe-dir> I This specifies the directory where L puts the named pipe required by L. The default is F. =item B<-O> I or B<--log-dir> I This specifies the directory where L puts its log files, such as F or F. The default is F. =item B<-V> I or B<--verbose> I This sets the verbosity per component or for all at once. This option may be specified multiple times to enable/disable several components. To specify all components, use C. A component may be prefixed by '!' to disable verbosity only for it. Available components are: =over =item * C =item * C =item * C =item * C =item * C =item * C =item * C =item * C =back For instance, to enable verbosity for anything touching the service, use C<-V SERV>. To enable everything but the service's message, use C<-V ALL -V !SERV> (note that it may be necessary to escape the '!' character to workaround shell interpretation). =back =head1 COMMANDS =head2 Available commands Here is a list of available commands. Some commands don't have any action; they rather provide sub-commands. =over 5 =item B This command provides sub-commands to configure the bosh4yaws application. =item B This command provides sub-commands to configure the ejabberd application. =item B This command provides sub-commands to configure the ejabberd_client application. =item B This command provides sub-commands to configure the ephp4yaws application. =item B This command display a generic help about B or a more detailed help about a specified command. =item B This command provides sub-commands to handle the Mnesia database. =item B This command provides sub-commands to handle the PHP interpreter. =item B This command provides sub-commands to handle the Erlang releases. Especially, it's used during live upgrade. =item B This command restarts the service. =item B This command starts the service. =item B This command tells if the service is running. =item B This command stops the service. =item B This command provides sub-commands to manipulate a target system. =item B This command provides sub-commands to configure the token_bucket application. =item B This command provides sub-commands to configure the yaws application. =back =head2 Detailed help about a command To obtain a more detailed help about a command, use the "help" command: B help I =head1 CONFIGURATION =head2 Configuration format A configuration file can be specified using the B<-C> option. The file format conforms to YAML, or more exactly a subset of the YAML specification, as documented in L. This may still be overrident by any command line option. By default, B looks for the following files: =over =item 1. F<$HOME/.config/erlsvc/config-I@I.yaml> =item 2. F<$HOME/.config/erlsvc/config-I.yaml> =item 3. F<$HOME/.config/erlsvc/config.yaml> =item 4. F@I.yaml> =item 5. F.yaml> =item 6. F =item 7. F =back The expected structure of the YAML document is a hash where the keys are the long option names (with "-" replaced by "_") and the value are obviously the values for these options. If an option may be given multiple times to specify multiple values, the configuration entry will have only one key pointing to a list of values. =head2 Non-option variables Beside variables mapping the command line options, B supports the following additional variables : =over 5 =item erlapp_args This specifies all the Erlang applications environment variable that must be passed on the L command line. The structure pointed by the key must be a hash where the keys are the application names and the values are a hash again, where the keys are the environment variable name and the values, the variable's values. =item extra_flags This specifies extra command line flags to pass to L. The structure pointed by the key must a list of strings. =back =head2 Examples Here is a configuration file setting the user and group for the target node and enabling all debug messages. It also shows how to specify Mnesia's data directory and how to disable SMP in the Erlang emulator. # Set the service identity to wayne:wayne. user: wayne group: wayne # Be verbose. verbose: - ALL # Set Mnesia's directory. Note how the quotes and double-quotes are # used so that Erlang interprets the string correctly. erlapp_args: mnesia: dir: '"/var/db/mnesia"' extra_flags: - "-smp" - "disable" =cut use strict; use warnings; use utf8; if ($ENV{'WCTL_SASL_START_PRG'}) { # The script is executed by SASL during a live upgrade requiring an # emulator restart. Because SASL can't take a program with argument, # the real command line is put in the environment. # Get the command and clear the environment variable to avoid # infinite loop. my $command = $ENV{'WCTL_SASL_START_PRG'}; delete $ENV{'WCTL_SASL_START_PRG'}; exec $command; } binmode(STDOUT, ":utf8"); binmode(STDERR, ":utf8"); use ErlSvc::Ctl; # Run the application code. my $app = ErlSvc::Ctl->new(); my $ret = $app->run(); $app->uninit(); # If the application terminated with an exception, exit with 1. my $exit_code = ($ret) ? 0 : 1; eval { $app->log->debug('APP', "Exit with exit code $exit_code\n"); }; exit(1) unless ($ret); erlsvc-1.02/share/000077500000000000000000000000001251425362700140435ustar00rootroot00000000000000erlsvc-1.02/share/Makefile.PL000066400000000000000000000012231251425362700160130ustar00rootroot00000000000000use strict; use warnings; use utf8; my $share_dir = '../blib/lib/auto/share/dist/erlsvc'; my @erl = glob '*.erl'; my %beam = map { my $e = $_; my $b = $e; $b =~ s/\.erl$/.beam/o; $share_dir.'/'.$b => $e } @erl; my $beam_var = join(' ', keys %beam); open(my $fh, '>', "Makefile") or die $!; print $fh <<"EOF"; # Generated Makefile. BEAM = $beam_var all: \$(BEAM) test: clean: -rm -f \$(BEAM) realclean: clean -rm -f Makefile.old Makefile .PHONY: all test clean realclean EOF while (my ($beam, $erl) = each %beam) { print $fh <<"EOF"; $beam: $erl erlsvc.hrl \@install -d $share_dir erlc -o $share_dir $erl EOF } close($fh); erlsvc-1.02/share/erlsvc.erl000066400000000000000000000047361251425362700160570ustar00rootroot00000000000000%%- %% Copyright 2011 Yakaz. All rights reserved. %% %% Redistribution and use in source and binary forms, with or without %% modification, are permitted provided that the following conditions %% are met: %% %% 1. Redistributions of source code must retain the above copyright %% notice, this list of conditions and the following disclaimer. %% %% 2. Redistributions in binary form must reproduce the above %% copyright notice, this list of conditions and the following %% disclaimer in the documentation and/or other materials provided %% with the distribution. %% %% THIS SOFTWARE IS PROVIDED BY YAKAZ ``AS IS'' AND ANY EXPRESS OR %% IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED %% WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE %% ARE DISCLAIMED. IN NO EVENT SHALL YAKAZ OR CONTRIBUTORS BE LIABLE %% FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR %% CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT %% OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR %% BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, %% WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE %% OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, %% EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. -module(erlsvc). -include("erlsvc.hrl"). -export([ run/0, run/1 ]). run() -> run(self). run(Node_Name) -> %% We want to catch controller's exit reason. process_flag(trap_exit, true), %% Start the controller process. He's responsible for starting the %% worker and doing all the communication with the Perl side and the %% worker. Exit_Code = case erlsvc_controller:start_link(Node_Name) of {ok, Controller} -> receive {controller, done, Code} when is_integer(Code) -> %% The controller finished is job and exited %% normally, no matter the job's result. Code; {'EXIT', Controller, Reason} -> %% The controller creashed. erlsvc_lib:report_error("Controller crashed:~n~p~n", [Reason]), ?EX_SOFTWARE end; {error, Reason} -> %% The controller couldn't be started. erlsvc_lib:report_error("Failed to start controller:~n~p~n", [Reason]), ?EX_CANTCREAT end, halt(Exit_Code). erlsvc-1.02/share/erlsvc.hrl000066400000000000000000000034201251425362700160470ustar00rootroot00000000000000%%- %% Copyright 2011 Yakaz. All rights reserved. %% %% Redistribution and use in source and binary forms, with or without %% modification, are permitted provided that the following conditions %% are met: %% %% 1. Redistributions of source code must retain the above copyright %% notice, this list of conditions and the following disclaimer. %% %% 2. Redistributions in binary form must reproduce the above %% copyright notice, this list of conditions and the following %% disclaimer in the documentation and/or other materials provided %% with the distribution. %% %% THIS SOFTWARE IS PROVIDED BY YAKAZ ``AS IS'' AND ANY EXPRESS OR %% IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED %% WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE %% ARE DISCLAIMED. IN NO EVENT SHALL YAKAZ OR CONTRIBUTORS BE LIABLE %% FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR %% CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT %% OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR %% BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, %% WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE %% OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, %% EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. -define(EX_OK, 0). -define(EX_USAGE, 64). -define(EX_DATAERR, 65). -define(EX_NOINPUT, 66). -define(EX_NOUSER, 67). -define(EX_NOHOST, 68). -define(EX_UNAVAILABLE, 69). -define(EX_SOFTWARE, 70). -define(EX_OSERR, 71). -define(EX_OSFILE, 72). -define(EX_CANTCREAT, 73). -define(EX_IOERR, 74). -define(EX_TEMPFAIL, 75). -define(EX_PROTOCOL, 76). -define(EX_NOPERM, 77). -define(EX_CONFIG, 78). erlsvc-1.02/share/erlsvc_controller.erl000066400000000000000000000215651251425362700203210ustar00rootroot00000000000000%%- %% Copyright 2011 Yakaz. All rights reserved. %% %% Redistribution and use in source and binary forms, with or without %% modification, are permitted provided that the following conditions %% are met: %% %% 1. Redistributions of source code must retain the above copyright %% notice, this list of conditions and the following disclaimer. %% %% 2. Redistributions in binary form must reproduce the above %% copyright notice, this list of conditions and the following %% disclaimer in the documentation and/or other materials provided %% with the distribution. %% %% THIS SOFTWARE IS PROVIDED BY YAKAZ ``AS IS'' AND ANY EXPRESS OR %% IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED %% WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE %% ARE DISCLAIMED. IN NO EVENT SHALL YAKAZ OR CONTRIBUTORS BE LIABLE %% FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR %% CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT %% OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR %% BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, %% WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE %% OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, %% EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. -module(erlsvc_controller). -behaviour(gen_fsm). -include("erlsvc.hrl"). -export([ start_link/1 ]). %% gen_fsm's callbacks. -export([ init/1, handle_event/3, handle_sync_event/4, handle_info/3, terminate/3, code_change/4, next_command/2, wait_for_command/2 ]). -record(state, { parent, node, worker }). %% ------------------------------------------------------------------- %% Public API. %% ------------------------------------------------------------------- start_link(Node) -> Parent = self(), gen_fsm:start_link(?MODULE, [Parent, Node], []). %% ------------------------------------------------------------------- %% Command execution. %% ------------------------------------------------------------------- exec_command(#state{worker = Worker} = State, Command) -> try %% Send the command to the worker. Ret = case erlsvc_worker:exec_command(Worker, Command) of {exception, Exception1, Stacktrace1} -> {command, exception, Exception1, Stacktrace1}; Result -> {command, return, Result} end, %% Report the result. gen_fsm:send_event(self(), Ret), State catch _:Exception -> %% Couldn't execute the command: return the exception and %% the stacktrace. Stacktrace = erlang:get_stacktrace(), gen_fsm:send_event(self(), {command, exception, Exception, Stacktrace}), State end. %% ------------------------------------------------------------------- %% gen_fsm's callbacks. %% ------------------------------------------------------------------- init([Parent, Node]) -> process_flag(trap_exit, true), State = #state{ parent = Parent }, case target_node(State, Node) of {ok, State2} -> erlsvc_lib:report_ready(), {ok, next_command, State2, 0}; Ret -> {stop, Ret} end. next_command(timeout, State) -> %% We read the next command from stdin. Prompt = case os:getenv("ERLSVC") of false -> "wctl> "; _ -> "" end, case io:read(standard_io, Prompt) of {ok, {target_node, Node}} -> case target_node(State, Node) of {ok, State2} -> erlsvc_lib:report_cmd_result(), {next_state, next_command, State2, 0}; {error, Code} -> {next_state, {exit, Code}, State} end; {ok, {Fun, Args}} when is_atom(Fun), is_list(Args) -> %% The peer sent a command for execution. State2 = exec_command(State, {Fun, Args}), {next_state, wait_for_command, State2}; {ok, {Mod, Fun, Args}} when is_atom(Mod), is_atom(Fun), is_list(Args) -> %% The peer sent a command for execution. State2 = exec_command(State, {Mod, Fun, Args}), {next_state, wait_for_command, State2}; {ok, stop} -> %% The peer doesn't need this node anymore, exit. {stop, normal, State}; {ok, Bad_Command} -> %% The term sent by the peer is not expected. erlsvc_lib:report_error( "Problem:~n" " Unexpected command:~n" " ~p~n", [Bad_Command]), {stop, {exit, ?EX_USAGE}, State}; {error, Reason} -> erlsvc_lib:report_error( "Problem:~n" " Failed to parse command:~n" " ~p~n", [Reason]), {stop, {exit, ?EX_PROTOCOL}, State}; eof -> {stop, normal, State} end. wait_for_command({command, return, Ret}, State) -> %% The command finished: we can format and print the result. erlsvc_lib:report_cmd_result(Ret), {next_state, next_command, State, 0}; wait_for_command({command, exception, Exception, Stacktrace}, State) -> %% The command crashed: we format and print the exception. erlsvc_lib:report_cmd_exception("Failed to execute the command:~n~p~n", [Exception], Stacktrace), {next_state, next_command, State, 0}. handle_event(_, State_Name, State) -> {next_state, State_Name, State}. handle_sync_event(_, _, State_Name, State) -> {reply, ok, State_Name, State}. handle_info({nodedown, Node}, State_Name, State) -> % A node stopped: it doesn't have the uploaded modules anymore. erlsvc_lib:mods_not_uploaded(Node), {next_state, State_Name, State}; handle_info({'EXIT', Parent, Reason}, _, #state{parent = Parent} = State) -> erlsvc_lib:report_error( "Problem:~n" " Lost link with parent:~n" " ~p~n", [Reason]), {stop, normal, State}; handle_info({'EXIT', Worker, Reason}, _, #state{worker = Worker} = State) -> erlsvc_lib:report_error( "Problem:~n" " Lost link with worker:~n" " ~p~n", [Reason]), {stop, {exit, ?EX_UNAVAILABLE}, State}. terminate(Reason, _, #state{parent = Parent, worker = Worker}) -> %% Stop the worker process. erlsvc_worker:stop(Worker), %% Remove the link with the parent only when we terminate normally %% or with a specified exit code. erlsvc_lib:report_debug("Erlang controller node terminating~n", []), case Reason of normal -> erlang:unlink(Parent), Parent ! {controller, done, ?EX_OK}; {exit, Code} -> erlang:unlink(Parent), Parent ! {controller, done, Code}; _ -> ok end. code_change(_, State_Name, State, _) -> {ok, State_Name, State}. %% ------------------------------------------------------------------- %% Internal functions. %% ------------------------------------------------------------------- target_node(#state{node = Prev_Node, worker = Prev_Worker} = State, Node0) -> case norm_node_name(Node0) of undefined -> erlsvc_lib:report_error( "Problem:~n" " Invalid node name:~n" " ~s~n", [Node0]), {error, badarg}; Prev_Node -> {ok, State}; Node -> case Node of self -> erlsvc_lib:report_debug( "Install worker on controller node~n", []), ok; _ -> erlsvc_lib:report_debug( "Install worker on node '~s'~n", [Node]), erlsvc_lib:wait_nodeup(Node), erlang:monitor_node(Node, true) end, case erlsvc_worker:start_link(Node) of {ok, Worker} -> case Prev_Node of undefined -> ok; _ -> erlsvc_worker:stop(Prev_Worker) end, State2 = State#state{ node = Node, worker = Worker }, {ok, State2}; Ret -> erlsvc_lib:report_error( "Problem:~n" " Failed to start worker on node ~s:~n" " ~p~n", [Node0, Ret]), {error, nodedown} end end. norm_node_name(Node_Name) -> %% Check and eventually convert the target node name. case Node_Name of self -> self; undefined -> self; _ when is_atom(Node_Name) -> Node_Name; _ -> case io_lib:deep_char_list(Node_Name) of true -> list_to_atom(lists:flatten(Node_Name)); false -> undefined end end. erlsvc-1.02/share/erlsvc_erlenv.erl000066400000000000000000000044101251425362700174170ustar00rootroot00000000000000%%- %% Copyright 2011 Yakaz. All rights reserved. %% %% Redistribution and use in source and binary forms, with or without %% modification, are permitted provided that the following conditions %% are met: %% %% 1. Redistributions of source code must retain the above copyright %% notice, this list of conditions and the following disclaimer. %% %% 2. Redistributions in binary form must reproduce the above %% copyright notice, this list of conditions and the following %% disclaimer in the documentation and/or other materials provided %% with the distribution. %% %% THIS SOFTWARE IS PROVIDED BY YAKAZ ``AS IS'' AND ANY EXPRESS OR %% IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED %% WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE %% ARE DISCLAIMED. IN NO EVENT SHALL YAKAZ OR CONTRIBUTORS BE LIABLE %% FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR %% CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT %% OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR %% BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, %% WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE %% OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, %% EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. -module(erlsvc_erlenv). %% Public API. -export([ erlsvc_cm_deps/0, erts_version/0, root_dir/0, lib_dir/0, lib_dir/1, priv_dir/1, releases_dir/0 ]). %% ------------------------------------------------------------------- %% Public API. %% ------------------------------------------------------------------- erlsvc_cm_deps() -> []. erts_version() -> erlang:system_info(version). root_dir() -> code:root_dir(). lib_dir() -> code:lib_dir(). lib_dir(App) -> code:lib_dir(App). priv_dir(App) -> code:priv_dir(App). releases_dir() -> %% This code was stolen from release_handler.erl (R13B04). {ok, [[Root]]} = init:get_argument(root), case application:get_env(sasl, releases_dir) of undefined -> case os:getenv("RELDIR") of false -> filename:join([Root, "releases"]); RELDIR -> RELDIR end; {ok, Dir} -> Dir end. erlsvc-1.02/share/erlsvc_lib.erl000066400000000000000000000263021251425362700166760ustar00rootroot00000000000000%%- %% Copyright 2011 Yakaz. All rights reserved. %% %% Redistribution and use in source and binary forms, with or without %% modification, are permitted provided that the following conditions %% are met: %% %% 1. Redistributions of source code must retain the above copyright %% notice, this list of conditions and the following disclaimer. %% %% 2. Redistributions in binary form must reproduce the above %% copyright notice, this list of conditions and the following %% disclaimer in the documentation and/or other materials provided %% with the distribution. %% %% THIS SOFTWARE IS PROVIDED BY YAKAZ ``AS IS'' AND ANY EXPRESS OR %% IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED %% WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE %% ARE DISCLAIMED. IN NO EVENT SHALL YAKAZ OR CONTRIBUTORS BE LIABLE %% FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR %% CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT %% OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR %% BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, %% WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE %% OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, %% EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. -module(erlsvc_lib). %% Command modules handling. -export([ erlsvc_cm_deps/0, is_command_module/1, send_module/2, mods_not_uploaded/1 ]). %% Node monitoring. -export([ wait_nodeup/1, wait_nodeup/2, wait_nodedown/1, wait_nodedown/2 ]). %% Syslog loglevels. -export([ any_to_loglevel/1 ]). %% Report handling. -export([ report_ready/0, report_cmd_result/0, report_cmd_result/1, report_cmd_exception/2, report_cmd_exception/3, report_error/1, report_error/2, report_warning/1, report_warning/2, report_info/1, report_info/2, report_debug/1, report_debug/2, report_debug/3, report_waiting/1 ]). %% ------------------------------------------------------------------- %% Command modules handling. %% ------------------------------------------------------------------- erlsvc_cm_deps() -> []. is_command_module(Mod) -> catch Mod:module_info(), erlang:function_exported(Mod, erlsvc_cm_deps, 0). send_module(Node, _) when Node == node() -> ok; send_module(Node, Mod) -> %% A command module may depend on other erlsvc Erlang modules. The %% function erlsvc_cm_deps/0 returns a list of those modules. All_Mods = get_cm_deps(Mod, []), %% We can now send all those modules to the node. send_modules2(Node, All_Mods). get_cm_deps(Mod, All_Deps) -> case lists:member(Mod, All_Deps) of true -> All_Deps; false -> get_cm_deps2(Mod:erlsvc_cm_deps(), lists:sort([Mod | All_Deps])) end. get_cm_deps2([Mod | Rest], All_Deps) -> Mod_Deps = get_cm_deps(Mod, []), New_Deps = lists:umerge(All_Deps, lists:sort(Mod_Deps)), get_cm_deps2(Rest, New_Deps); get_cm_deps2([], All_Deps) -> All_Deps. send_modules2(Node, [Mod | Rest]) -> case is_mod_uploaded(Node, Mod) of true -> send_modules2(Node, Rest); false -> report_debug("Upload module '~s' from '~s' to ~s~n", [Mod, node(), Node]), Ret = do_send_module(Node, Mod), case Ret of {module, _} -> %% This module was loaded correctly. Record it and %% continue with the next one. mod_uploaded(Node, Mod), send_modules2(Node, Rest); {error, Reason} -> %% Failed to load this module! {error, Mod, Reason} end end; send_modules2(_, []) -> ok. is_mod_uploaded(Node, Mod) -> Key = {erlsvc_uploaded_mods, Node}, case erlang:get(Key) of undefined -> false; Mods -> lists:member(Mod, Mods) end. mod_uploaded(Node, Mod) -> Key = {erlsvc_uploaded_mods, Node}, Previous_Mods = case erlang:get(Key) of undefined -> []; Mods -> Mods end, erlang:put(Key, [Mod | Previous_Mods]). mods_not_uploaded(Node) -> Key = {erlsvc_uploaded_mods, Node}, erlang:erase(Key). do_send_module(Node, Mod) -> {_, Bin, File} = code:get_object_code(Mod), do_send_module2(Node, Mod, Bin, File). do_send_module2(Node, Mod, Bin, File) -> Ret = rpc:call(Node, code, load_binary, [Mod, File, Bin], infinity), case Ret of {badrpc, {'EXIT', {badarg, [{code_server, call, 2} | _]}}} -> %% Sometimes, remote code_server isn't ready but the exact %% reason couldn't be found. To work around this case, we %% try the upload again. This could lead to an infinite %% loop, though. report_debug("Retry module '~s' upload~n", [Mod]), timer:sleep(100), do_send_module2(Node, Mod, Bin, File); {badrpc, _} -> {error, Ret}; _ -> Ret end. %% ------------------------------------------------------------------- %% Node monitoring. %% ------------------------------------------------------------------- wait_nodeup(Node) -> wait_nodeup(Node, infinity). wait_nodeup(Node, Timeout) -> report_debug("Wait for node '~s' to start:", [Node]), wait_nodeup2(Node, Timeout). wait_nodeup2(Node, Timeout) -> {Time, Ret} = timer:tc(net_adm, ping, [Node]), case Ret of pong -> report_debug(" ok", []), ok; pang -> timer:sleep(100), case Timeout of infinity -> report_debug(" (retry)", []), wait_nodeup2(Node, Timeout); _ -> Timeout2 = Timeout - (Time / 1000) - 100, if Timeout2 =< 0 -> report_debug(" failed~n", []), error; true -> report_debug(" (retry)", []), wait_nodeup2(Node, Timeout2) end end end. wait_nodedown(Node) -> wait_nodedown(Node, infinity). wait_nodedown(Node, Timeout) -> report_debug("Wait for node '~s' to stop:", [Node]), erlang:monitor_node(Node, true), receive {nodedown, Node} -> report_debug(" ok~n"), ok after Timeout -> report_debug(" failed~n"), error end. %% ------------------------------------------------------------------- %% Syslog loglevels. %% ------------------------------------------------------------------- any_to_loglevel(debug) -> debug; any_to_loglevel(info) -> info; any_to_loglevel(notice) -> notice; any_to_loglevel(warning) -> warning; any_to_loglevel(error) -> error; any_to_loglevel(critical) -> critical; any_to_loglevel(alert) -> alert; any_to_loglevel(emergency) -> emergency; any_to_loglevel("debug") -> debug; any_to_loglevel("info") -> info; any_to_loglevel("notice") -> notice; any_to_loglevel("warning") -> warning; any_to_loglevel("error") -> error; any_to_loglevel("critical") -> critical; any_to_loglevel("alert") -> alert; any_to_loglevel("emergency") -> emergency; any_to_loglevel("7") -> debug; any_to_loglevel("6") -> info; any_to_loglevel("5") -> notice; any_to_loglevel("4") -> warning; any_to_loglevel("3") -> error; any_to_loglevel("2") -> critical; any_to_loglevel("1") -> alert; any_to_loglevel("0") -> emergency; any_to_loglevel(7) -> debug; any_to_loglevel(6) -> info; any_to_loglevel(5) -> notice; any_to_loglevel(4) -> warning; any_to_loglevel(3) -> error; any_to_loglevel(2) -> critical; any_to_loglevel(1) -> alert; any_to_loglevel(0) -> emergency; any_to_loglevel(_) -> undefined. %% ------------------------------------------------------------------- %% Report handling. %% ------------------------------------------------------------------- report_ready() -> io:format("CTL READY~n", []). report_cmd_result() -> io:format( "CTL RESULT BEGIN~n" "status: ok~n" "CTL RESULT END~n", []). report_cmd_result({Status, Result}) when Status == ok orelse Status == error -> Formatted = case Result of {yaml, YAML} -> io_lib:format( "return:~n" "~s", [YAML]); _ -> case io_lib:deep_char_list(Result) of true -> Lines = string:tokens(lists:flatten(Result), "\n"), io_lib:format( "return: |~n" "~s", [[" " ++ Line ++ "\n" || Line <- Lines]]); false -> io_lib:format( "return: |~n" " ~p~n", [Result]) end end, io:format( "CTL RESULT BEGIN~n" "status: ~s~n" "~s" "CTL RESULT END~n", [Status, Formatted]); report_cmd_result(Result) -> report_cmd_result({ok, Result}). report_cmd_exception(Format, Fmt_Args) -> report_cmd_exception(Format, Fmt_Args, []). report_cmd_exception(Format, Fmt_Args, Stacktrace) -> Reason1 = io_lib:format(Format, Fmt_Args), Reason2 = re:replace(Reason1, "^", " ", [global, multiline]), Stacktrace2 = case Stacktrace of [] -> ""; _ -> "stacktrace:\n" ++ [ if is_integer(Args) -> io_lib:format(" - \"~s:~s/~b\"~n", [Mod, Fun, Args]); true -> io_lib:format(" - |~n ~s:~s(~p)~n", [Mod, Fun, Args]) end || {Mod, Fun, Args} <- Stacktrace ] end, io:format( "CTL RESULT BEGIN~n" "status: exception~n" "reason: |~n" "~s~n" "~s" "CTL RESULT END~n", [Reason2, Stacktrace2]). report_error(Format) -> report_error(Format, []). report_error(Format, Args) -> report_log("ERROR", Format, Args). report_warning(Format) -> report_warning(Format, []). report_warning(Format, Args) -> report_log("WARNING", Format, Args). report_info(Format) -> report_info(Format, []). report_info(Format, Args) -> report_log("INFO", Format, Args). report_debug(Format) -> report_debug(Format, []). report_debug(Format, Args) -> report_log("ERLSCRIPT", Format, Args). report_debug(Facility, Format, Args) -> report_log(Facility, Format, Args). report_log(Level, Format, Args) -> Message1 = lists:flatten(io_lib:format(Format, Args)), {Newline_Terminated, Message2} = case lists:reverse(Message1) of [$\n | Rest] -> {true, lists:reverse(Rest)}; _ -> {false, Message1} end, Message3 = re:replace(Message2, "^", "CTL LOG " ++ Level ++ " ", [multiline, global, {return, iodata}]), if Newline_Terminated -> io:format("~s~n", [Message3]); true -> io:format("~s NONL~n", [Message3]) end. report_waiting(true) -> io:format("CTL WAITING START~n"); report_waiting(false) -> io:format("CTL WAITING STOP~n"). erlsvc-1.02/share/erlsvc_mnesia.erl000066400000000000000000000465321251425362700174130ustar00rootroot00000000000000%%- %% Copyright 2011 Yakaz. All rights reserved. %% %% Redistribution and use in source and binary forms, with or without %% modification, are permitted provided that the following conditions %% are met: %% %% 1. Redistributions of source code must retain the above copyright %% notice, this list of conditions and the following disclaimer. %% %% 2. Redistributions in binary form must reproduce the above %% copyright notice, this list of conditions and the following %% disclaimer in the documentation and/or other materials provided %% with the distribution. %% %% THIS SOFTWARE IS PROVIDED BY YAKAZ ``AS IS'' AND ANY EXPRESS OR %% IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED %% WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE %% ARE DISCLAIMED. IN NO EVENT SHALL YAKAZ OR CONTRIBUTORS BE LIABLE %% FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR %% CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT %% OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR %% BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, %% WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE %% OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, %% EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. -module(erlsvc_mnesia). %% Public API. -export([ erlsvc_cm_deps/0, directory/0, is_directory_used/0, db_nodes/0, create_schema/0, join_cluster/1, leave_cluster/0, check_consistency/2 ]). %% Internal exports. -export([ get_db_nodes/0, get_local_replicas/0, get_table_snapshot/1 ]). %% ------------------------------------------------------------------- %% Public API. %% ------------------------------------------------------------------- erlsvc_cm_deps() -> [erlsvc_lib, erlsvc_service]. directory() -> mnesia:system_info(directory). is_directory_used() -> mnesia:system_info(use_dir). db_nodes() -> {All_Nodes, Running_Nodes} = get_db_nodes(), {yaml, [ case lists:member(Node, Running_Nodes) of true -> io_lib:format(" ~s: up~n", [Node]); false -> io_lib:format(" ~s: down~n", [Node]) end || Node <- All_Nodes ]}. create_schema() -> %% Mnesia must be stopped in order for create_schema/1 to work. mnesia:stop(), Node = node(), Dir = directory(), case mnesia:create_schema([Node]) of ok -> erlsvc_lib:report_debug("Schema created in '~s'~n", [Dir]); {error, {_, {already_exists, _}}} -> erlsvc_lib:report_debug("Schema already present in '~s'~n", [Dir]); {error, Reason} -> erlsvc_lib:report_error( "Problem:~n" " Failed to create schema in directory '~s'.~n" " Mnesia reports:~n" " ~p~n" "~n" "Solution(s):~n" " 1. Check that the user has permission to write to the~n" " directory above. If this directory doesn't exist,~n" " check that the parent directory exists and the user~n" " has write permission on it.~n", [Dir, Reason]), {error, Reason} end. join_cluster([]) -> erlsvc_lib:report_error( "Problem:~n" " Can't join a cluster without at least one one in argument~n"), {error, failed}; join_cluster(Extra_DB_Nodes) -> %% Mnesia must be started for change_config/2 et %% change_table_copy_type/3 to work. mnesia:start(), Node = node(), case mnesia:change_config(extra_db_nodes, Extra_DB_Nodes) of {ok, []} -> %% Mnesia couldn't contact any node. erlsvc_lib:report_error( "Problem:~n" " Failed to contact a node while joining cluster.~n" "~n" "Solution(s):~n" " 1. Check that the given nodes are up and runs Mnesia and~n" " that they ping from this node.~n"), {error, failed}; {ok, _} -> %% Ok, we could contact some nodes. Now, we must change the %% copy type for the schema and a few other tables. join_cluster2(Node, Extra_DB_Nodes); {error, Reason} -> {error, Reason} end. join_cluster2(Node, Extra_DB_Nodes) -> case mnesia:change_table_copy_type(schema, Node, disc_copies) of {atomic, _} -> %% We're part of the cluster now \o/ Dir = mnesia:system_info(directory), Nodes_S = [ io_lib:format(" - ~s~n", [N]) || N <- lists:sort(mnesia:system_info(db_nodes))], erlsvc_lib:report_info( "Schema created in '~s'~n" "Joined cluster comprising the following nodes now:~n" "~s", [Dir, Nodes_S]), Tables = [ %% Use Ejabberd default storage type. {acl, disc_copies}, {config, disc_copies}, {local_config, disc_copies}, %% Ejabberd forgets to add a copy of the %% session_counter table. {session_counter, ram_copies} ], Fun = fun({Table, Type}) -> add_table_copy(Table, Node, Type) end, lists:foreach(Fun, Tables), ok; {aborted, {already_exists, schema, _, _}} -> %% The schema already exists. We check if we're %% already part of the cluster. Dir = mnesia:system_info(directory), Nodes = mnesia:system_info(db_nodes), Clustered = lists:member(Node, Nodes) andalso Extra_DB_Nodes -- Nodes /= Extra_DB_Nodes, Nodes_S = [ io_lib:format(" - ~s~n", [N]) || N <- lists:sort(mnesia:system_info(db_nodes))], if Clustered -> erlsvc_lib:report_info( "Schema already exists in '~s'~n" "Node '~s' is already part of the cluster comprising " "the following nodes:~n" "~s", [Dir, Node, Nodes_S]), ok; true -> erlsvc_lib:report_error( "Problem:~n" " Schema already exists in '~s' and~n" " Node '~s' is not part of the cluster comprising " "the following nodes:~n" "~s" "~n" "Solution(s):~n" " 1. Leave the current cluster or remove the~n" " schema if not part of a cluster.~n", [Dir, Node, Nodes_S]), {error, failed} end; {aborted, Reason} -> erlsvc_lib:report_error( "Problem:~n" " Failed join cluster.~n" " Mnesia reports:~n" " ~p~n", [Reason]), {error, Reason} end. leave_cluster() -> %% Mnesia must be stopped in order for del_table_copy/2 to work. mnesia:stop(), Node = node(), Nodes = mnesia:system_info(running_db_nodes), case Nodes of [] -> All_Nodes = mnesia:system_info(db_nodes) -- [Node], case All_Nodes of [] -> erlsvc_lib:report_debug( "Node '~s' is not part of a cluster~n", [Node]), ok; _ -> Nodes_S = [ " - " ++ atom_to_list(N) ++ "\n" || N <- All_Nodes], erlsvc_lib:report_error( "Problem:~n" " Failed to leave cluster because no other nodes~n" " are currently running.~n" "~n" "Solutions(s):~n" " 1. Start one of the following nodes:~n" "~s" " 2. Check that the cluster is not partitioned.~n", [Nodes_S]), {error, cluster_down} end; _ -> leave_cluster2(Node, Nodes) end. leave_cluster2(Node, [Remote | Rest]) -> case rpc:call(Remote, mnesia, del_table_copy, [schema, Node], infinity) of {atomic, _} -> erlsvc_lib:report_debug( "Nodes '~s' removed from cluster using remote node '~s'~n", [Node, Remote]), ok; {aborted, Reason} -> erlsvc_lib:report_debug( "Failed to remove node '~s' from cluster " "using remote node '~s'.~n" "Mnesia reports:~n" " ~p~n", [Node, Remote, Reason]), leave_cluster2(Node, Rest); {badrpc, Reason} -> erlsvc_lib:report_debug( "Failed contact remote node '~s' " "to remove node '~s' from cluster.~n" "Erlang reports:~n" " ~p~n", [Remote, Node, Reason]), leave_cluster2(Node, Rest) end; leave_cluster2(Node, []) -> erlsvc_lib:report_error( "Problem:~n" " Failed to remove node '~s' from cluster.~n" " None of the cluster nodes could be contacted or could remove~n" " the node.~n", [Node]), {error, failed}. check_consistency(Node, Options) -> Verbose = proplists:get_bool(verbose, Options), %% We query the given node to get the list of running and stopped DB %% nodes. case get_db_nodes(Node) of {error, Reason} -> {error, Reason}; {All_Nodes, Running_Nodes} -> Stopped_Nodes = All_Nodes -- Running_Nodes, %% The first step consists of checking if the stopped DB %% nodes are really stopped or at least, don't run the %% service. check_stopped_nodes(lists:sort(All_Nodes), Stopped_Nodes), %% The next step consists of checking the data in each %% version of each table (ie. each replica on each node). check_tables(Running_Nodes, Verbose) end. %% ------------------------------------------------------------------- %% Internal functions. %% ------------------------------------------------------------------- get_db_nodes() -> { mnesia:system_info(db_nodes), mnesia:system_info(running_db_nodes) }. add_table_copy(Table, Node, Type) -> case mnesia:add_table_copy(Table, Node, Type) of {atomic, _} -> ok; {aborted, Reason} -> erlsvc_lib:report_warning( "Problem:~n" " Failed to add copy of type ~s for table '~s'.~n" " Mnesia reports:~n" " ~p~n", [Type, Table, Reason]), {error, Reason} end. get_worker(Node) -> Key = {erlsvc_worker, Node}, case erlang:get(Key) of Worker when is_pid(Worker) -> Worker; undefined -> case erlsvc_worker:start_link(Node) of {ok, Worker} -> erlsvc_worker:silence(Worker), erlang:put(Key, Worker), Worker; {error, Reason} -> erlsvc_lib:report_error( "Problem:~n" " Failed to start a worker on node '~s'~n" " Erlang reports:~n" " ~p~n", [Node, Reason]), {error, Reason} end end. check_stopped_nodes(Nodes, Stopped) -> erlsvc_lib:report_info("Checking cluster members consistency:~n", []), Max = lists:max([length(atom_to_list(N)) || N <- Nodes]), Total = length(Nodes), Total_S = integer_to_list(Total), Format = lists:flatten(io_lib:format(" ~~~bb/~s ~~~bs: ", [length(Total_S), Total_S, Max])), check_stopped_nodes2(Nodes, Stopped, 1, Total, 0, Format). check_stopped_nodes2([Node | Rest], Stopped, Count, Total, Bad_Count, Format) -> erlsvc_lib:report_info(Format, [Count, Node]), Ret = case lists:member(Node, Stopped) of false -> {ok, running}; true -> case net_adm:ping(Node) of pang -> {ok, pang}; pong -> case erlsvc_worker:start_link(Node) of {ok, Worker} -> Is_Running = erlsvc_worker:exec_command(Worker, {erlsvc_service, is_running, []}), erlsvc_worker:stop(Worker), case Is_Running of false -> {ok, service_down}; true -> {error, service_up} end; {error, Reason} -> erlsvc_lib:report_error( "Problem:~n" " Failed to start a worker on node '~s'~n" " Erlang reports:~n" " ~p~n", [Node, Reason]), ok end end end, Bad_Count2 = case Ret of {ok, running} -> erlsvc_lib:report_info("OK - service up~n", []), Bad_Count; {ok, pang} -> erlsvc_lib:report_info("OK - node down~n", []), Bad_Count; {ok, service_down} -> erlsvc_lib:report_info("OK - node up but service down~n", []), Bad_Count; {error, service_up} -> erlsvc_lib:report_info( "NOT OK - service up but out of cluster~n", []), Bad_Count + 1 end, check_stopped_nodes2(Rest, Stopped, Count + 1, Total, Bad_Count2, Format); check_stopped_nodes2([], _, _, Total, Bad_Count, _) -> if Bad_Count > 0 -> erlsvc_lib:report_info(" ~b out of ~n nodes(s) suspicious!~n", [Bad_Count, Total]); true -> erlsvc_lib:report_info(" OK~n", []) end. check_tables(Nodes, Verbose) -> erlsvc_lib:report_info("Checking tables consistency:~n", []), Tables = get_tables_list(Nodes, dict:new()), Max = lists:max([length(atom_to_list(T)) || {T, _} <- Tables]), Total = length(Tables), Total_S = integer_to_list(Total), Format = case Verbose of false -> lists:flatten(io_lib:format(" ~~~bb/~s ~~~bs: ~~s", [length(Total_S), Total_S, Max])); true -> lists:flatten(io_lib:format(" ~~~bb/~s ~~~bs: ~~s~n", [length(Total_S), Total_S, Max])) end, check_tables2(Tables, 1, Total, 0, Format, Verbose). check_tables2([{Table, Nodes} | Rest], Count, Total, Bad_Count, Format, Verbose) -> Fun1 = fun ({N, {error, Reason}}, D) -> erlsvc_lib:report_error( "Problem:~n" " Failed to get snapshot of table '~s' on node '~s'." " Erlang reports:~n" " ~p~n", [Table, N, Reason]), D; ({N, S}, D) -> try dict:append(S, N, D) catch _:_ -> dict:store(S, [N], D) end end, Samples = [{N, get_table_snapshot(N, Table)} || N <- Nodes], Table_Versions = lists:foldl(Fun1, dict:new(), Samples), Bad_Count2 = case dict:size(Table_Versions) of 1 -> erlsvc_lib:report_info(Format, [Count, Table, "OK"]), Bad_Count; Diff -> erlsvc_lib:report_info(Format, [Count, Table, "INCONSISTENT"]), display_diff(Diff, Table_Versions, Verbose), Bad_Count + 1 end, check_tables2(Rest, Count + 1, Total, Bad_Count2, Format, Verbose); check_tables2([], _, Total, Bad_Count, _, _) -> if Bad_Count > 0 -> erlsvc_lib:report_info( " ~b out of ~n table(s) inconsistent(s)!~n", [Bad_Count, Total]); true -> erlsvc_lib:report_info(" OK~n", []) end. get_tables_list([Node | Rest], Dict) -> case get_local_replicas(Node) of {error, Reason} -> {error, Reason}; Local_Tables -> Fun = fun(T, D) -> try dict:append(T, Node, D) catch _:_ -> dict:store(T, [Node], D) end end, Dict2 = lists:foldl(Fun, Dict, Local_Tables), get_tables_list(Rest, Dict2) end; get_tables_list([], Dict) -> lists:keysort(1, dict:to_list(Dict)). get_db_nodes(Node) -> case get_worker(Node) of Worker when is_pid(Worker) -> Ret = erlsvc_worker:exec_command(Worker, {erlsvc_mnesia, get_db_nodes, []}), case Ret of {error, Reason} -> {error, Reason}; DB_Nodes -> DB_Nodes end; {error, Reason} -> {error, Reason} end. get_local_replicas(Node) -> case get_worker(Node) of Worker when is_pid(Worker) -> erlsvc_worker:exec_command(Worker, {erlsvc_mnesia, get_local_replicas, []}); {error, Reason} -> {error, Reason} end. get_local_replicas() -> Local_Tables = mnesia:system_info(local_tables), get_local_replicas2(Local_Tables, []). get_local_replicas2([Table | Rest], Local_Replicas) -> case mnesia:table_info(Table, local_content) of true -> get_local_replicas2(Rest, Local_Replicas); false -> get_local_replicas2(Rest, [Table | Local_Replicas]) end; get_local_replicas2([], Local_Replicas) -> Local_Replicas -- [schema]. get_table_snapshot(Node, Table) -> case get_worker(Node) of Worker when is_pid(Worker) -> erlsvc_worker:exec_command(Worker, {erlsvc_mnesia, get_table_snapshot, [Table]}); {error, Reason} -> {error, Reason} end. get_table_snapshot(Table) -> lists:keysort(2, ets:tab2list(Table)). display_diff(2, Table_Versions, _) -> [V1, V2] = dict:fetch_keys(Table_Versions), Fun2 = fun(N, Str) -> lists:flatten(io_lib:format("~s, ~s", [Str, N])) end, Fun3 = fun(E) -> not lists:member(E, V2) end, Fun4 = fun(E) -> not lists:member(E, V1) end, Only_In_V1 = lists:filter(Fun3, V1), Only_In_V2 = lists:filter(Fun4, V2), erlsvc_lib:report_info("~n 2 different versions:~n", []), Ns1 = dict:fetch(V1, Table_Versions), Ns2 = dict:fetch(V2, Table_Versions), [N1 | R1] = lists:sort(Ns1), [N2 | R2] = lists:sort(Ns2), Nodes_String1 = lists:foldl(Fun2, "", R1), Nodes_String2 = lists:foldl(Fun2, "", R2), io:format(" - Only on node(s) ~s~s:~n ~p~n~n", [N1, Nodes_String1, Only_In_V1]), io:format(" - Only on node(s) ~s~s:~n ~p~n~n", [N2, Nodes_String2, Only_In_V2]); display_diff(Size, Table_Versions, _) -> erlsvc_lib:report_info("~n ~b different versions:~n", [Size]), Fun2 = fun(N, Str) -> lists:flatten(io_lib:format("~s, ~s", [Str, N])) end, Fun3 = fun(V, Ns, Acc) -> [N | R] = lists:sort(Ns), Nodes_String = lists:foldl(Fun2, "", R), io:format(" - Node(s) ~s~s:~n ~p~n~n", [N, Nodes_String, V]), Acc end, dict:fold(Fun3, ok, Table_Versions). erlsvc-1.02/share/erlsvc_release.erl000066400000000000000000000404331251425362700175510ustar00rootroot00000000000000%%- %% Copyright 2011 Yakaz. All rights reserved. %% %% Redistribution and use in source and binary forms, with or without %% modification, are permitted provided that the following conditions %% are met: %% %% 1. Redistributions of source code must retain the above copyright %% notice, this list of conditions and the following disclaimer. %% %% 2. Redistributions in binary form must reproduce the above %% copyright notice, this list of conditions and the following %% disclaimer in the documentation and/or other materials provided %% with the distribution. %% %% THIS SOFTWARE IS PROVIDED BY YAKAZ ``AS IS'' AND ANY EXPRESS OR %% IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED %% WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE %% ARE DISCLAIMED. IN NO EVENT SHALL YAKAZ OR CONTRIBUTORS BE LIABLE %% FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR %% CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT %% OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR %% BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, %% WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE %% OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, %% EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. -module(erlsvc_release). %% Public API. -export([ erlsvc_cm_deps/0, list/0, list/1, current/0, upgradable/2, set_unpacked/1, upgrade/1, reset/0, set_removed/1, sync_vanilla/4 ]). %% ------------------------------------------------------------------- %% Public API. %% ------------------------------------------------------------------- erlsvc_cm_deps() -> [erlsvc_lib, erlsvc_erlenv]. list() -> list(default). list(RELEASES) -> {yaml, [ begin Apps_S = [ io_lib:format( " - name: ~s~n" " version: ~s~n" " path: \"~s\"~n", [N, V, P]) || {N, V, P} <- Apps], io_lib:format( " ~s:~n" " id: \"~s\"~n" " erts: ~s~n" " state: ~s~n" " applications:~n" "~s", [Name, ID, ERTS, State, Apps_S]) end || {ID, Name, ERTS, Apps, State} <- get_releases(RELEASES) ]}. current() -> Rels = get_releases(default), case lists:keyfind(current, 5, Rels) of false -> case lists:keyfind(permanent, 5, Rels) of false -> undefined; Rel -> Rel end; Rel -> Rel end. upgradable(Relup, From) -> case file:consult(Relup) of {ok, [{To, Upgradable_Rels, _}]} -> case lists:keyfind(From, 1, Upgradable_Rels) of false -> erlsvc_lib:report_debug( "No instruction to upgrade from '~s' to '~s'~n", [From, To]), false; {_, _, Instructions} -> Restart = lists:member(restart_new_emulator, Instructions), case Restart of false -> erlsvc_lib:report_debug( "Release '~s' can be upgraded to '~s'~n", [From, To]), true; true -> erlsvc_lib:report_debug( "Upgrade from '~s' to '~s' requires an " "emulator restart; unacceptable~n", [From, To]), false end end; {error, Reason} -> erlsvc_lib:report_error( "Problem:~n" " Failed to read relup script '~s'~n" " file:consult/1 reports:~n" " ~p~n", [Relup, Reason]), false end. set_unpacked(Rel_File) -> case prepare_app_dirs(Rel_File) of undefined -> {error, failed}; App_Dirs -> application:start(sasl), set_unpacked2(Rel_File, App_Dirs) end. set_unpacked2(Rel_File, App_Dirs) -> case release_handler:set_unpacked(Rel_File, App_Dirs) of {ok, Rel} -> Rel; {error, {existing_release, Rel}} -> erlsvc_lib:report_warning( "Problem:~n" " The relase '~s' already exists. It'll be removed first~n" " then the unpack will be retried.~n", [Rel]), set_unpacked3(Rel_File, App_Dirs, Rel); {error, Reason} -> erlsvc_lib:report_error( "Problem:~n" " Failed to set release as unpacked.~n" " Rel script is:~n" " ~s~n" " Erlang reports:~n" " ~p~n", [Rel_File, Reason]), {error, Reason} end. set_unpacked3(Rel_File, App_Dirs, Rel) -> case release_handler:set_removed(Rel) of ok -> set_unpacked2(Rel_File, App_Dirs); {error, {permanent, _}} -> erlsvc_lib:report_warning( "Problem:~n" " The relase '~s' is permanent but not used. The current~n" " release will become permanent to permit the removal of " "'~s'.~n", [Rel, Rel]), case current() of undefined -> erlsvc_lib:report_error( "Problem:~n" " Failed to get the current release.~n", []), {error, failed}; {_, Rel, _, _} -> erlsvc_lib:report_error( "Problem:~n" " The current release is used.~n" " This should never happen...~n", []), {error, failed}; {_, Current_Rel, _, _} -> case release_handler:make_permanent(Current_Rel) of ok -> set_unpacked3(Rel_File, App_Dirs, Rel); {error, Reason} -> erlsvc_lib:report_error( "Problem:~n" " Failed to make current release '~s' " "permanent.~n" " Erlang reports:~n" " ~p~n", [Current_Rel, Reason]), {error, Reason} end end; {error, Reason} -> erlsvc_lib:report_error( "Problem:~n" " Failed to remove existing version of release '~s'.~n" " Erlang reports:~n" " ~p~n", [Rel, Reason]), {error, Reason} end. upgrade(Rel) -> application:start(sasl), case release_handler:install_release(Rel) of {ok, _, _} -> case release_handler:make_permanent(Rel) of ok -> ok; {error, Reason} -> erlsvc_lib:report_error( "Problem:~n" " Failed to make release '~s' permanent.~n" " Erlang reports:~n" " ~p~n", [Rel, Reason]), {error, Reason} end; {error, Reason} -> %% There's little to no chance that we end up here: either %% the release was upgraded properly or the node has crashed %% during upgrade because an application didn't make it. erlsvc_lib:report_error( "Problem:~n" " Failed to install release '~s'.~n" " Erlang reports:~n" " ~p~n", [Rel, Reason]), {error, Reason} end. reset() -> application:start(sasl), OTP_Rel = get_vanilla_release(), erlsvc_lib:report_debug("Reset to Erlang vanilla release '~s'~n", [OTP_Rel]), case OTP_Rel of undefined -> erlsvc_lib:report_error( "Problem:~n" " No suitable Erlang vanilla release found.~n", []), {error, failed}; _ -> case release_handler:install_release(OTP_Rel) of {ok, _, _} -> case release_handler:make_permanent(OTP_Rel) of ok -> ok; {error, Reason} -> erlsvc_lib:report_error( "Problem:~n" " Failed to make Erlang release '~s' " "permanent.~n" " Erlang reports:~n" " ~p~n", [OTP_Rel, Reason]), {error, Reason} end; {error, Reason} -> erlsvc_lib:report_error( "Problem:~n" " Failed to restore Erlang release '~s'.~n" " Erlang reports:~n" " ~p~n", [OTP_Rel, Reason]), {error, Reason} end end. set_removed(Rel) -> application:start(sasl), case release_handler:set_removed(Rel) of ok -> ok; {error, {no_such_release, Rel}} -> ok; {error, Reason} -> erlsvc_lib:report_error( "Problem:~n" " Failed to remove release '~s'.~n" " Erlang reports:~n" " ~p~n", [Rel, Reason]), {error, Reason} end. sync_vanilla(Rels_Dir, Old_Rels, New_Rels, Permanent) -> application:stop(sasl), RELEASES = filename:join([Rels_Dir, "RELEASES"]), case file:consult(RELEASES) of {ok, [Releases0]} -> Releases1 = remove_old_rels(Releases0, Old_Rels), {Releases2, ERTS} = add_new_rels(Releases1, New_Rels, Permanent, "-"), erlsvc_lib:report_debug("REL", " RELEASES", []), Ret = release_handler:do_write_release(Rels_Dir, "RELEASES", Releases2), case Ret of ok -> sync_vanilla2(Rels_Dir, Permanent, ERTS); {error, Reason} -> erlsvc_lib:report_error( "Problem:~n" " Failed to write '~s'.~n" " System reports:~n" " ~p~n", [RELEASES, Reason]), {error, Reason} end; {error, Reason} -> erlsvc_lib:report_error( "Problem:~n" " Failed to read '~s'.~n" " System reports:~n" " ~p~n", [RELEASES, Reason]), {error, Reason} end. sync_vanilla2(_, none, _) -> application:start(sasl); sync_vanilla2(Rels_Dir, Permanent, ERTS) -> Start_Erl_Data = filename:join([Rels_Dir, "start_erl.data"]), erlsvc_lib:report_debug("REL", " start_erl.data", []), Ret = release_handler:do_write_file(Start_Erl_Data, ERTS ++ " " ++ Permanent ++ "\n"), case Ret of ok -> application:start(sasl); {error, {Reason, _}} -> {error, Reason} end. %% ------------------------------------------------------------------- %% Internal functions. %% ------------------------------------------------------------------- get_releases(default) -> Releases_Dir = erlsvc_erlenv:releases_dir(), RELEASES = filename:join([Releases_Dir, "RELEASES"]), get_releases(RELEASES); get_releases(RELEASES) -> erlsvc_lib:report_debug("Get releases list from '~s'~n", [RELEASES]), case file:consult(RELEASES) of {ok, [Releases]} -> [ {ID, Name, ERTS, Apps, State} || {_, ID, Name, ERTS, Apps, State} <- Releases ]; {error, Reason} -> erlsvc_lib:report_error( "Problem:~n" " Failed to read '~s'.~n" " System reports:~n" " ~p~n", [RELEASES, Reason]), [] end. get_vanilla_release() -> OTP_Rel = erlang:system_info(otp_release), Rels = release_handler:which_releases(), case lists:keyfind(OTP_Rel, 2, Rels) of false -> get_vanilla_release2(Rels); _ -> OTP_Rel end. get_vanilla_release2([{_, Rel, _, _} | Rest]) -> case re:run(Rel, "^R[0-9]+[AB]") of {match, _} -> Rel; _ -> get_vanilla_release2(Rest) end; get_vanilla_release2([]) -> undefined. prepare_app_dirs(Rel_File) -> case file:consult(Rel_File) of {ok, [{release, _, _, Apps}]} -> prepare_app_dirs2(Apps, []); {error, Reason} -> erlsvc_lib:report_error( "Problem:~n" " Failed to read '~s' to prepare release app. dirs.~n" " System reports:~n" " ~p~n", [Rel_File, Reason]), undefined end. prepare_app_dirs2([{App, Vsn} | Rest], App_Dirs) -> New_App_Dirs = prepare_app_dirs3(App, Vsn, App_Dirs), prepare_app_dirs2(Rest, New_App_Dirs); prepare_app_dirs2([{App, Vsn, _} | Rest], App_Dirs) -> New_App_Dirs = prepare_app_dirs3(App, Vsn, App_Dirs), prepare_app_dirs2(Rest, New_App_Dirs); prepare_app_dirs2([{App, Vsn, _, _} | Rest], App_Dirs) -> New_App_Dirs = prepare_app_dirs3(App, Vsn, App_Dirs), prepare_app_dirs2(Rest, New_App_Dirs); prepare_app_dirs2([], App_Dirs) -> lists:reverse(App_Dirs). prepare_app_dirs3(App, Vsn, App_Dirs) -> Lib_Dir = code:lib_dir() ++ "/", case get_app_dir(App, Vsn) of undefined -> App_Dirs; Dir -> case string:substr(Dir, 1, length(Lib_Dir)) of Lib_Dir -> App_Dirs; _ -> App_Dir = {App, Vsn, filename:dirname(Dir)}, [App_Dir | App_Dirs] end end. get_app_dir(App, Vsn) -> App_S = atom_to_list(App), case get_app_dir_from_code_path(App_S, Vsn) of undefined -> case get_app_dir_from_ERL_LIBS(App_S, Vsn) of undefined -> undefined; Dir -> Dir end; Dir -> Dir end. get_app_dir_from_code_path(App, Vsn) -> Code_Path = code:get_path(), Suffix = filename:join(["", App ++ "-" ++ Vsn, "ebin"]), get_app_dir_from_code_path2(Code_Path, Suffix). get_app_dir_from_code_path2(["." | Rest], Suffix) -> get_app_dir_from_code_path2(Rest, Suffix); get_app_dir_from_code_path2([Dir | Rest], Suffix) -> if length(Dir) > length(Suffix) -> Substr = string:substr(Dir, length(Dir) - length(Suffix) + 1, length(Suffix)), case Substr of Suffix -> filename:dirname(Dir); _ -> get_app_dir_from_code_path2(Rest, Suffix) end; true -> get_app_dir_from_code_path2(Rest, Suffix) end; get_app_dir_from_code_path2([], _) -> undefined. get_app_dir_from_ERL_LIBS(App, Vsn) -> case os:getenv("ERL_LIBS") of false -> undefined; ERL_LIBS -> Dirs = string:tokens(ERL_LIBS, ":"), Suffix = filename:join([App ++ "-" ++ Vsn, "ebin"]), get_app_dir_from_ERL_LIBS2(Dirs, Suffix) end. get_app_dir_from_ERL_LIBS2([Parent_Dir | Rest], Suffix) -> Dir = filename:join([Parent_Dir, Suffix]), case filelib:is_dir(Dir) of true -> filename:dirname(Dir); false -> get_app_dir_from_ERL_LIBS2(Rest, Suffix) end; get_app_dir_from_ERL_LIBS2([], _) -> undefined. remove_old_rels(Releases, [Rel | Rest]) -> Releases2 = lists:keydelete(Rel, 3, Releases), remove_old_rels(Releases2, Rest); remove_old_rels(Releases, []) -> Releases. add_new_rels(Releases, [Rel | Rest], Permanent, ERTS) -> Release = lists:keyfind(Rel, 3, Releases), {Release2, ERTS2} = case Permanent of Rel -> {setelement(6, Release, permanent), element(4, Release)}; _ -> {setelement(6, Release, old), ERTS} end, Releases2 = lists:keyreplace(Rel, 3, Releases, Release2), add_new_rels(Releases2, Rest, Permanent, ERTS2); add_new_rels(Releases, [], _, ERTS) -> {Releases, ERTS}. erlsvc-1.02/share/erlsvc_service.erl000066400000000000000000000302011251425362700175610ustar00rootroot00000000000000%%- %% Copyright 2011 Yakaz. All rights reserved. %% %% Redistribution and use in source and binary forms, with or without %% modification, are permitted provided that the following conditions %% are met: %% %% 1. Redistributions of source code must retain the above copyright %% notice, this list of conditions and the following disclaimer. %% %% 2. Redistributions in binary form must reproduce the above %% copyright notice, this list of conditions and the following %% disclaimer in the documentation and/or other materials provided %% with the distribution. %% %% THIS SOFTWARE IS PROVIDED BY YAKAZ ``AS IS'' AND ANY EXPRESS OR %% IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED %% WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE %% ARE DISCLAIMED. IN NO EVENT SHALL YAKAZ OR CONTRIBUTORS BE LIABLE %% FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR %% CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT %% OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR %% BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, %% WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE %% OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, %% EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. -module(erlsvc_service). %% Public API. -export([ erlsvc_cm_deps/0, is_running/0, watch_start/1, reload_config/0, stop/2, get_start_opts/0 ]). %% ------------------------------------------------------------------- %% Public API. %% ------------------------------------------------------------------- erlsvc_cm_deps() -> [erlsvc_lib, erlsvc_erlenv, erlsvc_release]. is_running() -> %% First check: The environment variable WCTL_START_OPTS must be %% set. This indicates that the node was started by erlsvc in the %% first place. %% TODO: When all deployed nodes are up-to-date, change this to %% "WCTL_VERSION". case os:getenv("WCTL_START_OPTS") of false -> erlsvc_lib:report_debug( "The node was not started with \"erlsvc start\"~n", []), false; _ -> %% Now, we need to get the list of applications started by %% the current release. case erlsvc_release:current() of {_, Rel_Name, _, _, _} -> case get_expected_apps(Rel_Name) of undefined -> false; Expected -> %% We compare this list to the currently %% running applications. The expected %% applications must be running, though %% additional applications may be started %% too. Running = get_running_apps(), case Expected -- Running of [] -> true; Diff -> Diff_S = [ io_lib:format(" ~s ~s~n", [A, V]) || {A, V} <- Diff], erlsvc_lib:report_debug( "The following applications are " "missing:~n" "~s", [Diff_S]), false end end; undefined -> false end end. watch_start(Options) -> erlsvc_lib:report_debug("Waiting for SASL's release_handler~n", []), wait_for_sasl(), {_, Rel_Name} = init:script_id(), case get_expected_apps(Rel_Name) of undefined -> {error, failed}; Expected -> Verbose = proplists:get_bool(verbose, Options), do_watch_start(Expected, Verbose), done end. reload_config() -> %% The following code was taken from a post on erlang-questions@ by %% Serge Aleynikov. %% http://www.erlang.org/pipermail/erlang-questions/2006-July/021543.html case init:get_argument(config) of {ok, [Files]} -> Conf_Files = [ begin S = filename:basename(F, ".config"), filename:join(filename:dirname(F), S ++ ".config") end || F <- Files], %% Move sys.config to the head of the list Config = lists:sort(fun ("sys.config", _) -> true; (_, _) -> false end, Conf_Files), Old_Env = application_controller:prep_config_change(), Apps = [{application, A, make_appl(A)} || {A, _, _} <- application:which_applications()], application_controller:change_application_data(Apps, Config), case application_controller:config_change(Old_Env) of ok -> ok; {error, Reason} -> erlsvc_lib:report_error( "Problem:~n" " Failed to reload configuration.~n" " Erlang reports:~n" " ~p~n", [Reason]), ok end; _ -> erlsvc_lib:report_info("No configuration file to reload~n", []), ok end. stop(Node, Options) -> %% This function doesn't run in the context of the target node but %% from the controller node! case erlsvc_lib:wait_nodedown(Node, 0) of ok -> done; error -> Force = proplists:get_bool(force, Options), Verbose = proplists:get_bool(verbose, Options), if Force -> forced_stop(Node, Verbose); true -> Timeout = proplists:get_value(timeout, Options, 30000), case graceful_stop(Node, Timeout, Verbose) of ok -> done; error -> forced_stop(Node, Verbose) end end end. get_start_opts() -> os:getenv("WCTL_START_OPTS"). %% ------------------------------------------------------------------- %% Internal functions. %% ------------------------------------------------------------------- get_expected_apps(Rel_Name) -> erlsvc_lib:report_debug("Get expected applications list~n", []), case get_rel_script(Rel_Name) of undefined -> undefined; Rel_Script -> get_release_apps(Rel_Script) end. get_running_apps() -> Apps = application:which_applications(infinity), [{A, V} || {A, _, V} <- Apps]. get_rel_script(Rel_Name) -> Rel_Dir = get_rel_dir(Rel_Name), Fun = fun(F) -> filename:join([Rel_Dir, F]) end, Rel_Files = lists:map(Fun, ["start.rel", "start_clean.rel"]), Ret = get_rel_file(Rel_Files), case Ret of undefined -> erlsvc_lib:report_info( "Problem:~n" " No rel script found for release '~s'~n", [Rel_Name]); _ -> ok end, Ret. get_rel_dir(Rel_Name) -> Rels_Dir = erlsvc_erlenv:releases_dir(), filename:join([Rels_Dir, Rel_Name]). get_rel_file([Rel_File | Rest]) -> case file:consult(Rel_File) of {ok, [Content]} -> Content; {error, Reason} -> erlsvc_lib:report_warning( "Problem:~n" " Failed to read rel script '~s':~n" " ~p~n", [Rel_File, Reason]), get_rel_file(Rest) end; get_rel_file([]) -> undefined. get_release_apps({release, _, _, Apps}) -> get_release_apps2(Apps, []). get_release_apps2([{App, Ver} | Rest], Apps) -> get_release_apps2(Rest, [{App, Ver} | Apps]); get_release_apps2([{App, Ver, Type} | Rest], Apps) when Type == permanent; Type == transient; Type == temporary -> get_release_apps2(Rest, [{App, Ver} | Apps]); get_release_apps2([{App, Ver, Type, _} | Rest], Apps) when Type == permanent; Type == transient; Type == temporary -> get_release_apps2(Rest, [{App, Ver} | Apps]); get_release_apps2([_ | Rest], Apps) -> get_release_apps2(Rest, Apps); get_release_apps2([], Apps) -> lists:reverse(Apps). do_watch_start(Expected, Verbose) -> wait_for_apps(Expected, Expected, [], Verbose). wait_for_sasl() -> timer:sleep(200), case erlang:whereis(release_handler) of undefined -> application:start(sasl), wait_for_sasl(); _ -> ok end. wait_for_apps(Expected, Pending, Started, Verbose) -> Apps1 = lists:reverse(application:which_applications(infinity)), Apps2 = [{A, V} || {A, _, V} <- Apps1], Apps = Apps2 -- Started, Ret = check_apps(Apps, Pending, Started, Verbose), case Ret of {Pending2, Started2} -> timer:sleep(500), wait_for_apps(Expected, Pending2, Started2, Verbose); _ -> ok end. check_apps(_, [], _, _) -> erlsvc_lib:report_info(".~n", []); check_apps([App | Apps_Rest], [App | Pending_Rest], Started, Verbose) -> {App_Name, _} = App, if Verbose -> erlsvc_lib:report_info(" ~s", [App_Name]); true -> case Pending_Rest of [] -> erlsvc_lib:report_info(" done", []); _ -> ok end end, check_apps(Apps_Rest, Pending_Rest, [App | Started], Verbose); check_apps([Unexpected | Apps_Rest], Pending, Started, Verbose) -> {App_Name, _} = Unexpected, if Verbose -> erlsvc_lib:report_info(" (~s)", [App_Name]); true -> ok end, check_apps(Apps_Rest, Pending, Started, Verbose); check_apps([], Pending, Started, _) -> {Pending, lists:reverse(Started)}. make_appl(App) when is_atom(App) -> App_List = element(2,application:get_all_key(App)), App_File = code:where_is_file(atom_to_list(App) ++ ".app"), case file:consult(App_File) of {ok, [{application, _, Opts}]} -> Env = proplists:get_value(env, Opts, []), lists:keyreplace(env, 1, App_List, {env, Env}); {error, Reason} -> erlsvc_lib:report_error( "Problem:~n" " Failed to read ~s's app file '~s'~n" " Erlang reports:~n" " ~p~n", [App, App_File, Reason]), lists:keyreplace(env, 1, App_List, {env, []}) end. graceful_stop(Node, Timeout, Verbose) -> if Verbose -> erlsvc_lib:report_info(" init:stop/0", []); true -> ok end, rpc:cast(Node, init, stop, []), erlsvc_lib:wait_nodedown(Node, Timeout). forced_stop(Node, Verbose) -> [Short_Node | _] = string:tokens(atom_to_list(Node), "@"), %% Note that, on FreeBSD, the following command will only work if %% /proc is mounted. Otherwise, beam arguments are not available to %% ps(1) and pgrep(1). Pgrep = string:tokens( os:cmd("pgrep -f 'beam(\.smp | ).* -sname " ++ Short_Node ++ " '"), "\n"), case Pgrep of [] -> erlsvc_lib:report_error( "Problem:~n" " Failed to get Erlang node's PID.~n" " Note that it's not possible to issue a forced stop to a~n" " remote host.~n"), {error, failed}; [Pid | _] -> if Verbose -> erlsvc_lib:report_info(" kill-heart", []); true -> ok end, os:cmd("pkill -f 'heart -pid " ++ Pid ++ "'"), if Verbose -> erlsvc_lib:report_info(" erlang:halt/0", []); true -> ok end, rpc:cast(Node, erlang, halt, []), case erlsvc_lib:wait_nodedown(Node, 3000) of ok -> done; error -> if Verbose -> erlsvc_lib:report_info(" kill-node(~s)", [Pid]); true -> ok end, os:cmd("kill " ++ Pid), killed end end. erlsvc-1.02/share/erlsvc_worker.erl000066400000000000000000000173071251425362700174460ustar00rootroot00000000000000%%- %% Copyright 2011 Yakaz. All rights reserved. %% %% Redistribution and use in source and binary forms, with or without %% modification, are permitted provided that the following conditions %% are met: %% %% 1. Redistributions of source code must retain the above copyright %% notice, this list of conditions and the following disclaimer. %% %% 2. Redistributions in binary form must reproduce the above %% copyright notice, this list of conditions and the following %% disclaimer in the documentation and/or other materials provided %% with the distribution. %% %% THIS SOFTWARE IS PROVIDED BY YAKAZ ``AS IS'' AND ANY EXPRESS OR %% IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED %% WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE %% ARE DISCLAIMED. IN NO EVENT SHALL YAKAZ OR CONTRIBUTORS BE LIABLE %% FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR %% CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT %% OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR %% BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, %% WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE %% OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, %% EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. -module(erlsvc_worker). -behaviour(gen_server). -include("erlsvc.hrl"). %% Public API. -export([ erlsvc_cm_deps/0, start_link/1, stop/1, silence/1, exec_command/2 ]). %% Basic commands. -export([ system_version/0, ulimit/0, test_log_error/0, test_log_warning/0, test_log_info/0, test_log_nonl/0, test_waiting/0 ]). %% gen_server's callbacks. -export([ init/1, handle_call/3, handle_cast/2, handle_info/2, terminate/2, code_change/3 ]). -record(state, { controller, use_syslog, silent = false }). -define(INFO(Fmt, Args), catch syslog:info_msg(erlsvc, Fmt, Args)). -define(WARNING(Fmt, Args), catch syslog:warning_msg(erlsvc, Fmt, Args)). -define(ERROR(Fmt, Args), catch syslog:error_msg(erlsvc, Fmt, Args)). %% ------------------------------------------------------------------- %% Public API. %% ------------------------------------------------------------------- erlsvc_cm_deps() -> [erlsvc_lib]. start_link(self) -> %% Spawn the worker locally. gen_server:start_link(?MODULE, [self()], []); start_link(Node) when Node == node() -> start_link(self); start_link(Node) when is_atom(Node) -> %% We want to execute the worker on a remote node, therefore we %% first load this module on the remote node. case erlsvc_lib:send_module(Node, ?MODULE) of ok -> %% Spawn the worker remotely. Ret = rpc:call(Node, gen_server, start, [?MODULE, [self()], []]), case Ret of {ok, Pid} -> erlang:link(Pid), {ok, Pid}; _ -> Ret end; Ret -> Ret end. stop(Worker) -> gen_server:cast(Worker, stop). silence(Worker) -> gen_server:cast(Worker, silence). exec_command(Worker, {Fun, Args}) -> Command = {?MODULE, Fun, Args}, do_exec_command(Worker, Command); exec_command(Worker, {Mod, _, _} = Command) -> %% The command may be provided by a commands module. All commands %% modules export the "erlsvc_cm_deps/0" function. case erlsvc_lib:is_command_module(Mod) of true -> case erlsvc_lib:send_module(node(Worker), Mod) of ok -> ok; {error, Mod, Reason} -> erlang:throw({module_load_failed, Mod, Reason}) end; false -> %% The module isn't a command module or doesn't exist at %% all: nothing to upload. ok end, do_exec_command(Worker, Command). do_exec_command(Worker, Command) -> gen_server:call(Worker, {command, Command}, infinity). %% ------------------------------------------------------------------- %% Internal commands. %% ------------------------------------------------------------------- system_version() -> lists:flatten(io_lib:format("~s", [erlang:system_info(system_version)])). ulimit() -> io_lib:format("~s", [os:cmd("bash -c 'ulimit -a'")]). test_log_error() -> erlsvc_lib:report_error("Log from test_log_error/0~n", []). test_log_warning() -> erlsvc_lib:report_warning("Log from test_log_warning/0~n", []). test_log_info() -> erlsvc_lib:report_warning("Log from test_log_info/0~n", []). test_log_nonl() -> erlsvc_lib:report_debug("Log from test_log_nonl/0:", []), erlsvc_lib:report_debug(" 1", []), erlsvc_lib:report_debug(" 2", []), erlsvc_lib:report_debug(" 3~n", []). test_waiting() -> erlsvc_lib:report_debug("Log from test_waiting/0:", []), erlsvc_lib:report_waiting(true), erlsvc_lib:report_debug(" 1", []), timer:sleep(1000), erlsvc_lib:report_debug(" 2", []), timer:sleep(1000), erlsvc_lib:report_debug(" 3", []). %% ------------------------------------------------------------------- %% gen_server's callbacks. %% ------------------------------------------------------------------- init([Controller]) -> process_flag(trap_exit, true), Use_Syslog = try syslog:add(erlsvc, "erlsvc", daemon, info, [log_pid]), true catch _:_ -> false end, ?INFO("Worker started by controller ~p on node ~s", [Controller, erlang:node(Controller)]), State = #state{ controller = Controller, use_syslog = Use_Syslog }, {ok, State}. handle_call({command, {Mod, Fun, Args}}, _, State) -> Reply = try %% Log what we're about to do. Args_S = case Args of [] -> ""; _ -> lists:flatten("\n" ++ string:join( [io_lib:format(" ~p", [Arg]) || Arg <- Args], ",\n")) end, case State#state.silent of true -> ok; false -> report_debug("Execute on node '~s':~n ~s:~s(~s)~n", [node(), Mod, Fun, Args_S]) end, %% Execute the command. apply(Mod, Fun, Args) catch _:Exception -> %% The command crashed: return the exception and the stacktrace. Stacktrace = erlang:get_stacktrace(), {exception, Exception, Stacktrace} end, {reply, Reply, State}. handle_cast(silence, State) -> State2 = State#state{ silent = true }, {noreply, State2}; handle_cast(stop, #state{controller = Controller} = State) -> erlang:unlink(Controller), {stop, normal, State}. handle_info({'EXIT', Controller, Reason}, #state{controller = Controller} = State) -> ?ERROR("Lost link with controller:~n~p", [Reason]), {stop, {controller_exited, Reason}, State}; handle_info({'EXIT', _, _}, State) -> %% For instance, *_app:set_loglevel/1 uses compile:file/2 which %% spawn_link a temporary process. We ignore the EXIT signal from %% this process. {noreply, State}; handle_info({nodedown, Node}, State) -> ?INFO("Received an out-of-sync nodedown event for node '~s', ignored~n", [Node]), {noreply, State}. terminate(_, #state{use_syslog = Use_Syslog}) -> ?INFO("Worker stopped", []), if Use_Syslog -> syslog:remove(erlsvc); true -> ok end. code_change(_, State, _) -> {ok, State}. %% ------------------------------------------------------------------- %% Internal functions. %% ------------------------------------------------------------------- report_debug(Format, Args) -> ?INFO(Format, Args), erlsvc_lib:report_debug(Format, Args). erlsvc-1.02/t/000077500000000000000000000000001251425362700132045ustar00rootroot00000000000000erlsvc-1.02/t/erlsvc.t000066400000000000000000000007231251425362700146710ustar00rootroot00000000000000# Before `make install' is performed this script should be runnable with # `make test'. After `make install' it should work as `perl erlsvc.t' ######################### # change 'tests => 1' to 'tests => last_test_to_print'; use Test::More tests => 1; BEGIN { use_ok('ErlSvc::Ctl') }; ######################### # Insert your test code below, the Test::More module is use()ed here so read # its man page ( perldoc Test::More ) for help writing this test script.