#!/usr/bin/env perl

BEGIN {
	binmode STDOUT, ':encoding(utf8)';
}

use lib 'lib';
use warnings;
use strict;

our $VERSION = "1.003000";
$VERSION = eval $VERSION;

use Getopt::Long qw/:config no_ignore_case no_auto_abbrev pass_through/;
use Term::ANSIColor qw/:constants/;
use Term::ShellUI;
use Pod::Usage;

=head1 NAME

svsh - Process supervision shell for daemontools/perp/s6/runit

=head1 SYNOPSIS

svsh [OPTIONS]

Options:

  --basedir=BASEDIR (-d)   Service directory (on which supervisor was started).
  --suite=SUITE     (-s)   Supervision suite managing the directory (perp, s6 or runit).
  --bindir=BINDIR   (-b)   Directory where the supervisor is installed (e.g. /usr/sbin). Optional.
  --collapse        (-c)   Collapse numbered services into one line.

Example:

  svsh --suite perp --basedir /etc/services
  svsh --suite runit --basedir /var/services restart nginx

=head1 DESCRIPTION

=begin markdown

![screenshot](https://ido50.github.io/Svsh/screenshot.png)

=end markdown

C<svsh> is a command line shell for process supervision suites of the L<daemontools|http://cr.yp.to/daemontools.html> family. Currently, it supports
daemontools, L<perp|http://b0llix.net/perp/>, L<s6|http://www.skarnet.org/software/s6/index.html>
and L<runit|http://smarden.org/runit/>. It provides a unified interface allowing easy inspection
and manipulation of services (i.e. processes) managed by supported supervision suites.

C<svsh> does not require any configurations or changes to your suite's service directories;
just point it at a base directory and you immediately get a usable shell, listing all
services and their statuses, and accepting commands to perform on them.

The shell provides a very simple syntax that is easy to remember, far simpler than the
particular syntax of the underlying supervision suite. Instead of having to execute
C<perpctl -b /services q nginx> to restart an C<nginx> service running from C</services/nginx>,
just execute C<restart nginx>. Couldn't be simpler. Want to send a C<HUP> signal to all
services whose names begin with C<"worker">? just execute C<signal hup worker*>.

C<svsh> is inspired by L<supervisord|http://www.supervisord.org/>'s C<supervisorctl> shell. I've
attempted to provide a similar syntax and feature set.

=head1 OPTIONS

=head2 -s, --suite

The supervision suite managing the base directory. Either C<daemontools>, C<perp>,
C<s6> or C<runit>. If not provided, the C<SVSH_SUITE> environment variable will
be checked. An error will be raised if no suite is defined.

=head2 -d, --basedir

Base directory of services supervised by the supervision suite. If not provided,
the C<SVSH_BASE> environment variable will be checked, and if not set, the default
base directory of the selected suite will be used. Check the documentation of
the specific suite class for its default directory. If no directory is found,
an error will be raised.

=head2 -b, --bindir

If the supervision suite's tools are not in the environment C<PATH> variable,
you can provide the directory where they are located (e.g. C</usr/local/bin>).

=head2 -c, --collapse

Collapse multi-process services to one line in C<status>. See L</"COLLAPSE">
for more details. This can be changed from inside the shell too.

=head1 COMMANDS

The following commands are provided by C<svsh>. Note that some suites do not
support all commands.

=head2 status

Prints a list of all services, their statuses (up, down, etc.), uptimes (or
downtimes) and process IDs. This command is automatically executed upon
initialization of the shell.

=head2 start service, ...

Starts a list of one or more services, if they are not already up.

	svsh> start nginx haproxy

=head2 stop service, ...

Stops a list of one or more services. The services stopped will not be restarted.

	svsh> stop nginx haproxy

=head2 restart service, ...

Restarts a list of one or more services. Generally, this means sending a QUIT signal
to the services, which I<should> cause them to shutdown and be restarted by the
supervisor.

	svsh> restart nginx haproxy

=head2 signal sig service, ...

Send a UNIX signal to a list of one or more services. The name of the signal can
be lowercase or uppercase, and may include the prefix C<"SIG">.

	svsh> signal term nginx
	svsh> signal SIGUSR1 haproxy

=head2 rescan

I<Alias: update>.

Causes the supervision suite to rescan the base directory for new or removed services.

=head2 fg service

"Moves" a service to the foreground, so that its output streams (at least standard output,
possibly standard error) are printed on screen. In reality, it determines where the process'
log file is located, and tails it with C<tail -f>. See L</"LOG INSPECTION"> for more details, as this
is a complicated subject.

	svsh> fg nginx

=head2 terminate

I<Alias: shutdown>.

Terminate the supervision suite. This will cause all services managed by the supervisor to
terminate as well.

=head2 toggle option

Toggles a shell option on or off. Currently, only the C<collapse> option is supported. The
C<status> command will be automatically called after toggling the option.

	svsh> toggle collapse

=head2 help [ command ]

Prints help information. Can also provide information about specific commands.

	svsh> help signal

=head2 quit

I<Alias: exit>.

Quits the shell.

=head1 ADVANCED FEATURES AND IMPORTANT INFORMATION

=head2 LOG INSPECTION

All of the supported supervision suites do not enforce a logging scheme on managed
services. While all of them provide a logging tool (C<daemontools> provides C<multilog>,
C<perp> provides C<tinylog> and C<sissylog>; C<s6> provides C<s6-log>; C<runit>
provides C<svlogd>), none of them enforce their usage. It is actually not uncommon
among users of these suites to use a logging tool provided by one suite for services
managed by another one. This means it is hard for an external program such as C<svsh>
to determine where log files are stored, if at all.

Currently, C<svsh> will attempt to find the log file of a service by checking the
pid of the associated log process, and if (and only if) that process is one of the
supported loggers (C<multilog>, C<tinylog>, C<s6-log> or C<svlogd>), it will try to find the
file descriptor used by that process under C<< /proc/<pid>/fd >>. As long as your services
are being logged by one of these tools, C<svsh> I<should> be able to C<tail> their log
files  when the L<fg|/"fg service"> command is used. However, if the log file is being rotated
while it is being tailed, behavior is currently undefined (will probably stop working until
the command is run again).

=head2 HISTORY

C<svsh> provides bash-like history so you can use your up arrow key to cycle back through
past commands, or use C<Ctrl+R> to search your history. The history file is saved under
the name C<.svsh_history> under the home directory of the running user (C<~/.svsh_history>).

Note that history is saved only when the shell is properly terminated, such as with the
L<quit> command. C<Ctrl+C> will not trigger history saving.

It is highly recommended to install L<Term::ReadLine::Gnu> for proper history support.

=head2 AUTOCOMPLETION

C<svsh> provides autocompletion for all its commands. Tap the tab key at any moment while
typing in commands and arguments, and C<svsh> will attempt to autocomplete your current
word, or display a list if multiple options are available. Again, L<Term::ReadLine::Gnu>
is recommended for better autocompletion.

=head2 WILDCARDS

C<svsh> makes it easy to manipulate multiple services at once. Wildcards are supported
by the C<start>, C<stop>, C<restart> and C<signal> commands. If, for example, you have
several services whose names start with "worker", you can stop them all by executing
C<stop worker*>. Wildcards are also supported at the beginning of the name, so
C<signal term *d> will send a C<TERM> signal to all services whose names end with "d".

	svsh> status
	   process |     status | duration |   pid
	  worker-1 |         up |    9813s | 25984
	  worker-2 |         up |    9813s | 25976
	  worker-3 |         up |    4393s | 2990

	svsh> stop worker*

	svsh> status
	   process |     status | duration |   pid
	  worker-1 |       down |       2s |     -
	  worker-2 |       down |       2s |     -
	  worker-3 |       down |       2s |     -

=head2 COLLAPSE

Often times you would like to run a certain service with X number of identical processes.
None of the supervision suites have any mechanism to allow this (none that I
know of at least), apart from creating identical copies of a service directory for every
process needed. While C<svsh> can't help you with that, it provides a nice feature for collapsing
these identical services in the output of the L</"status"> command to just one line. This can
be very useful with lots of multi-process services.

Currently, C<svsh> determines multi-process services if their names are postfixed with a dash
and a number. For example, if you have a service called C<worker> that you need 3 processes
of which to run, you can create C<worker-1>, C<worker-2> and C<worker-3> service directories.
If the L<collapse|/"-c, --collapse"> option is on, C<svsh> will collapse all of these into
just one line, under the name C<status>.

	svsh> status
	   process |     status | duration |   pid
	  worker-1 |         up |    9813s | 25984
	  worker-2 |         up |    9813s | 25976
	  worker-3 |         up |    4393s | 2990

	svsh> toggle collapse
	   process |     status | duration |   pid
	    worker |       3 up |    9850s |     -

This feature combines well with the L</"WILDCARDS"> feature.

Hopefully, future versions will find a more generic way of identifying multi-process services.

=cut

my ($basedir, $suite, $bindir, $collapse, $help, $man);

GetOptions(
    'basedir|d=s' => \$basedir,
    'suite|s=s' => \$suite,
    'bindir|b:s' => \$bindir,
    'collapse|c' => \$collapse,
    'help|h' => \$help,
    'man' => \$man
);
pod2usage(1) if $help;
pod2usage(-exitval => 0, -verbose => 2) if $man;

# if a suite is not provided, check the SVSH_SUITE environment
# variable
$suite ||= $ENV{SVSH_SUITE};

# check the selected suite is valid
_check_suite($suite);

# load the adapter class for the suite
my $class = 'Svsh::'.ucfirst($suite);
eval "require $class";
die $@ if $@;

# if a base directory was not defined, guess it
{
	no strict 'refs';
	$basedir ||= $ENV{SVSH_BASE} || ${"${class}::DEFAULT_BASEDIR"};
}

# make sure the base directory exists
_check_basedir($basedir);

# create a new instance of the adapter class
my $svsh = $class->new(
    basedir => $basedir,
    bindir => $bindir,
    collapse => $collapse
);

# configure the shell
my $term = Term::ShellUI->new(
	commands => {
		status => {
			desc => 'Lists all processes and their statuses',
			method => sub {
				my %statuses = %{$svsh->status(@_)};

				if ($svsh->collapse) {
					my $collapsed = {};
					foreach my $sv (keys %statuses) {
						next unless $sv =~ m/-\d+$/;
						$collapsed->{$`} ||= [];
						push(@{$collapsed->{$`}}, delete $statuses{$sv});
					}
					foreach my $sv (keys %$collapsed) {
						my $status_counters = {};
						my $duration = 0;
						foreach my $proc (@{$collapsed->{$sv}}) {
							$status_counters->{$proc->{status}} += 1;
							$duration = $proc->{duration}
								if $proc->{duration} > $duration;
						}
						$statuses{$sv} = {
							status => join(', ', map($status_counters->{$_}.' '.$_, sort(keys(%$status_counters)))),
							pid => '-',
							duration => $duration
						};
					}
				}

				print BOLD BLACK ON_WHITE
					join(' | ',
						sprintf('%16s', 'process'),
						sprintf('%10s',  'status'),
						sprintf('%8s', 'duration'),
						sprintf('%5s',      'pid')
					), ' ', RESET, "\n";
				foreach (sort keys %statuses) {
					my $s = $statuses{$_};
					my $color = $s->{status} =~ m/^(\d+ )?up$/ ? GREEN :
							$s->{status} eq 'resetting' ? YELLOW : RED;
					print BOLD sprintf('%16s', $_), RESET, ' | ',
						$color, sprintf('%10s', $s->{status}), RESET, ' | ',
						sprintf('%8s', $s->{duration}.'s'), ' | ',
						sprintf('%5s', $s->{pid}), " \n";
				}
				print "\n";
			}
		},
		toggle => {
			desc => 'Toggle svsh switches (e.g. collapse)',
			minargs => 1,
			maxargs => 1,
			method => sub {
				foreach (@{$_[1]->{args}}) {
					next unless $svsh->can($_);
					$svsh->$_($svsh->$_ ? 0 : 1);
				}
				$_[0]->process_a_cmd('status');
			}
		},
		start => {
			desc => 'Starts a list of processes',
			minargs => 1,
			args => \&_service_grep,
			method => sub { print $svsh->start(@_) }
		},
		stop => {
			desc => 'Stops a list of running processes',
			minargs => 1,
			args => \&_service_grep,
			method => sub { print $svsh->stop(@_) }
		},
		restart => {
			desc => 'Restarts a list of processes',
			minargs => 1,
			args => \&_service_grep,
			method => sub { print $svsh->restart(@_) }
		},
		signal => {
			desc => 'Sends a signal to a list of processes',
			minargs => 2,
			args => \&_signal_grep,
			method => sub { print $svsh->signal(@_) }
		},
		rescan => {
			desc => 'Rescans the service directory to look for new/removed services',
			maxargs => 0,
			method => sub {
				if ($svsh->can('rescan')) {
					print $svsh->rescan;
				} else {
					print ref($svsh).' does not support the rescan command', "\n";
				}
			}
		},
		update => { alias => 'rescan' },
		fg => {
			desc => 'Move a process to the foreground',
			minargs => 1,
			maxargs => 1,
			args => \&_service_grep,
			method => sub { $svsh->fg(@_) }
		},
		terminate => {
			desc => 'Shut down the process supervisor (all processes will terminate)',
			method => sub {
				if ($svsh->can('terminate')) {
					$svsh->terminate();
					shift->process_a_cmd('quit');
				} else {
					print ref($svsh).' does not support the terminate command', "\n";
				}
			}
		},
		shutdown => { alias => 'terminate' },
		help => {
			desc => 'Print helpful information',
			args => sub { shift->help_args(undef, @_); },
			method => sub { shift->help_call(undef, @_); }
		},
		quit => {
			desc => 'Quit this program',
			maxargs => 0,
			method => sub { shift->exit_requested(1) }
		},
		exit => { alias => 'quit' }
	},
	prompt => $svsh->basedir.'> ',
	history_file => '~/.svsh_history'
);

# if a command was supplied as arguments, just run it,
# otherwise invoke the status command and run the shell
if (scalar @ARGV) {
	$term->process_a_cmd(join(' ', @ARGV));
} else {
	$term->process_a_cmd('status');
	$term->run;
}

sub _service_grep {
	my $names = [sort keys %{$svsh->statuses}];
	if (scalar @{$_[1]->{args}} && $_[1]->{args}->[-1]) {
		return [grep { m/^$_[1]->{args}->[-1]/ } @$names];
	} else {
		return $names;
	}
}

sub _signal_grep {
	if (scalar @{$_[1]->{args}} < 2) {
		# user hasn't completed signal yet, so we're returning signals here
		my $sigs = [qw/HUP INT QUIT KILL USR1 USR2 ALRM TERM CONT WINCH/];
		return $_[1]->{args}->[0] ? [grep { m/^$_[1]->{args}->[0]/i } @$sigs] : $sigs;
	} else {
		# user has already completed signal, so we're returning services here
		return _service_grep(@_);
	}
}

sub _check_suite {
	my $suite = shift;

	$suite
		|| _error('Suite not provided');
	$suite =~ m/^(perp|s6|runit|daemontools)$/
		|| _error('Suite must be perp, s6, runit or daemontools');
}

sub _check_basedir {
	my $basedir = shift;

	$basedir
		|| _error('Base directory not provided');
	-e $basedir && -d $basedir
		|| _error("Base directory $basedir does not exist or is not a directory");

	print "Base directory: $basedir\n"
		if $ENV{SVSH_VERBOSE};
}

sub _error {
	my $msg = shift;

    pod2usage(-exitval => 1, -msg => "ERROR: $msg\n");
}

=head1 CONFIGURATION AND ENVIRONMENT

C<svsh> requires no configuration files or environment variables.

=head1 DEPENDENCIES

C<svsh> depends on the following modules:

=over

=item * L<Moo>

=item * L<namespace::clean>

=item * L<Proc::Killall>

=item * L<Term::ShellUI>

=back

For proper history and autocompletion support, and generally a better
working shell, it is recommended to install L<Term::ReadLine::Gnu>.

=head1 BUGS AND LIMITATIONS

Please report any bugs or feature requests to
L<https://github.com/ido50/Svsh/issues>.

=head1 AUTHOR

Ido Perlmuter <ido@ido50.net>

Thanks to the guys at the L<supervision mailing list|http://skarnet.org/lists.html#supervision>,
especially Colin Booth, for helping out with suggestions and information.

=head1 LICENSE AND COPYRIGHT

Copyright (c) 2015-2023, Ido Perlmuter C<< ido@ido50.net >>.

Licensed under the Apache License, Version 2.0 (the "License");
you may not use this file except in compliance with the License.
You may obtain a copy of the License at

    http://www.apache.org/licenses/LICENSE-2.0

Unless required by applicable law or agreed to in writing, software
distributed under the License is distributed on an "AS IS" BASIS,
WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
See the License for the specific language governing permissions and
limitations under the License.

=cut

1;
__END__
