smeserver-lib/root/usr/share/perl5/vendor_perl/esmith/console.pm

604 lines
14 KiB
Perl
Raw Normal View History

#----------------------------------------------------------------------
# Copyright 1999-2006 Mitel Corporation
# This program is free software; you can redistribute it and/or
# modify it under the same terms as Perl itself.
#----------------------------------------------------------------------
=head1 NAME
esmith::console - A class to provide a backend library to the server console.
=head1 SYNOPSIS
use esmith::console;
my $console = esmith::console->new();
($rc, $choice) = $console->message_page
(
title => gettext("Administrator password not set"),
text => gettext("Sorry, you must set the administrator password."),
);
=head1 DESCRIPTION
This class provides a backend library of methods for the frontend console on
the server. The intent is that all of the whiptail code is hidden in this
library, and the frontend can just concern itself with the logical progression
through any and all applicable screens.
=head1 Methods
=cut
package esmith::console;
use strict;
use vars qw($VERSION @ISA @EXPORT_OK);
use esmith::util;
use Locale::gettext;
use esmith::ConfigDB;
use esmith::I18N;
@ISA = qw(Exporter);
use constant SCREEN_ROWS => 22;
use constant SCREEN_COLUMNS => 76;
use constant CONSOLE_SCREENS => "/sbin/e-smith/console-screens";
BEGIN
{
# disable CTRL-C
$SIG{INT} = 'IGNORE';
# Set PATH explicitly and clear related environment variables so that calls
# to external programs do not cause results to be tainted. See
# "perlsec" manual page for details.
$ENV {'PATH'} = '/sbin:/bin:/usr/sbin:/usr/bin:/usr/local/sbin:/usr/local/bin';
$ENV {'SHELL'} = '/bin/bash';
delete $ENV {'ENV'};
delete $ENV {'BASH_ENV'};
}
=head2 new
This is the class constructor.
=cut
sub new
{
my $class = ref($_[0]) || $_[0];
my $self = {};
esmith::util::setRealToEffective ();
my $i18n = new esmith::I18N;
$i18n->setLocale("server-console");
#------------------------------------------------------------
# Set stdin, stdout and stderr to console
#------------------------------------------------------------
if (defined $ARGV [0])
{
$ARGV[0] =~ /(console|tty\d*)/ && -c "/dev/$1"
or die gettext("Bad ttyname:"), " ", $ARGV[0], "\n";
my $tty = $1;
open (STDIN, "</dev/$tty") or die gettext("Can't redirect stdin"), ": $!\n";
open (STDOUT, ">/dev/$tty") or die gettext("Can't redirect stdout"), ": $!\n";
my $pid = open(STDERR, "|-");
die gettext("Can't fork"), ": $!\n" unless defined $pid;
unless ($pid)
{
exec qw(/usr/bin/logger -p local1.info -t console);
}
}
$self = bless $self, $class;
return $self;
}
=head2 screen and dialog
These method are wrappers around whiptail and dialog, and permit the creation
of custom screens depending on the arguments passed. They are typically not
called directly, but are used by all of the other page methods that
follow. You should only call these method directly if none of the other
methods apply.
=cut
sub screen
{
_screen(shift, "/usr/bin/dialog", @_);
}
sub dialog
{
_screen(shift, "/usr/bin/dialog", @_);
}
sub whiptail
{
_screen(shift, "/usr/bin/whiptail", @_);
}
sub _screen
{
my $self = shift;
my $whiptail = shift;
my @whiptailArgs = @_;
# now would be a good time to flush output buffers, so the partial
# buffers don't get copied:
$| = 1;
print "";
pipe (READER, WRITER)
or die gettext("Couldn't create pipe") . ": $!\n";
my $pid = fork;
if (! defined $pid)
{
die gettext("Couldn't fork") . ": $!\n";
}
elsif ($pid == 0)
{
#----------------------------------------
# Child
#----------------------------------------
# Attach child's STDIN to the reading end of the pipe
close READER
or die gettext("Couldn't close reading end of pipe") , ": $!\n";
if ($whiptail =~ m{\bwhiptail$} ) {
# whiptail sends its output via STDERR. We temporarily
# shut off warnings so they don't interfere with that.
local $^W = 0;
open STDERR, ">& WRITER"
or die gettext("Couldn't connect STDERR to pipe"), ": $!\n";
close WRITER
or die gettext("Couldn't close writing end of pipe"), ": $!\n";
unshift @whiptailArgs, $whiptail,
'--backtitle', $self->backtitle;
} else {
use Fcntl qw/F_SETFD/;
# Clear close-on-exec on WRITER so that it stays open for dialog to use
fcntl(WRITER, F_SETFD, 0);
unshift @whiptailArgs, $whiptail,
'--backtitle', $self->backtitle, "--output-fd", fileno(WRITER);
}
exec @whiptailArgs;
die gettext("Couldn't exec:"), ": $!\n";
}
#----------------------------------------
# Parent
#----------------------------------------
close WRITER;
my $choice = <READER>;
close READER;
waitpid ($pid, 0);
my $rc = $?;
return ($rc, $choice);
}
=head2 backtitle
Console header line for each page
=cut
sub backtitle
{
my $self = shift;
my $db = esmith::ConfigDB->open_ro or die "Couldn't open ConfigDB\n";
sprintf("%-33s%45s",
($db->get_prop('sysconfig', 'ProductName') || "SME Server") . " " .
($db->get_prop('sysconfig', 'ReleaseVersion') || "UNKNOWN"),
"Copyright (C) 1999-2006 Mitel Corporation, Copyright (C) ____COPYYEARS____ Koozali Foundation, Inc."
);
}
=head2 message_page
This method should be used whenever a screen that displays a simple message
is required.
=cut
sub message_page
{
my $self = shift;
my %params = @_;
my $title = $params{title};
my $message_box = $params{text};
my $left = defined $params{left} ? $params{left} : gettext("Back");
my $right = defined $params{right} ? $params{right} : gettext("Next");
$self->screen ("--title", $title,
"--cancel-label", $left,
"--ok-label", $right,
"--clear",
"--msgbox", $message_box,
SCREEN_ROWS,
SCREEN_COLUMNS,
);
}
=head2 tryagain_page
This method displays a simple "try again" screen.
=cut
sub tryagain_page
{
my $self = shift;
my %params = @_;
my $title = $params{title};
my $choice = $params{choice};
my $try_again = "; " . gettext("please try again");
my $message_box = $title . ":'${choice}'" . $try_again;
$self->screen ("--title", $title,
"--cancel-label", gettext("Back"),
"--ok-label", gettext("Next"),
"--clear",
"--msgbox", $message_box,
SCREEN_ROWS,
SCREEN_COLUMNS,
);
}
=head2 password_page
This method displays a screen suitable for entering a password.
=cut
sub password_page
{
my $self = shift;
my %params = @_;
my $title = $params{title};
my $message_box = $params{text};
my $left = defined $params{left} ? $params{left} : gettext("Back");
my $right = defined $params{right} ? $params{right} : gettext("Next");
$self->dialog ("--title", $title,
"--insecure",
"--cancel-label", $left,
"--ok-label", $right,
"--clear",
"--passwordbox", "\n" . $message_box,
SCREEN_ROWS,
SCREEN_COLUMNS,
);
}
=head2 yesno_page
This method displays a simple yes/no screen, so the user can make a
simple binary selection.
=cut
sub yesno_page
{
my $self = shift;
my %params = @_;
my $title = $params{title};
my $text = $params{text};
my $left = defined $params{left} ? $params{left} : gettext("Yes");
my $right = defined $params{right} ? $params{right} : gettext("No");
my @args = (
"--title" => $title,
"--yes-label" => $left,
"--no-label" => $right,
);
push @args, "--defaultno" if defined $params{defaultno};
push @args, "--clear";
$self->screen (@args,
"--yesno", $text,
SCREEN_ROWS,
SCREEN_COLUMNS,
);
}
=head2 input_page
This method displays a simple input screen with an input box.
=cut
sub input_page
{
my $self = shift;
my %params = @_;
my $title = $params{title};
my $text = $params{text};
my $value = $params{value};
my $left = defined $params{left} ? $params{left} : gettext("Back");
my $right = defined $params{right} ? $params{right} : gettext("Next");
$self->screen("--title", $title,
"--cancel-label", $left,
"--ok-label", $right,
"--clear",
"--inputbox", $text,
SCREEN_ROWS,
SCREEN_COLUMNS,
$value
);
}
=head2 infobox
This method is similar to a messagebox, but exits immediately, without clearing the screen.
=cut
sub infobox
{
my $self = shift;
my %params = @_;
my $title = $params{title};
my $text = $params{text};
my $height = $params{height} || "8";
my $width = $params{width} || SCREEN_COLUMNS;
$self->screen("--title", $title,
"--infobox", $text,
$height,
$width,
);
}
=head2 textbox
A text box lets you display the contents of a text file in a dialog box.
It is like a simple text file viewer.
=cut
sub textbox
{
my $self = shift;
my %params = @_;
my $title = $params{title};
my $file = $params{file};
my $height = $params{height} || '20';
my $width = $params{width} || SCREEN_COLUMNS;
$self->screen("--title", $title,
"--textbox", $file,
$height,
$width,
);
}
=head2 menu_page
This method displays a screen with a menu.
=cut
sub menu_page
{
my $self = shift;
my %params = @_;
my $title = $params{title};
my $text = $params{text};
my @args = ("--clear", "--title", $title);
if ($params{default})
{
push @args, "--default-item", $params{default};
}
my $value = $params{value};
my $argsref = $params{argsref};
my $menu_rows = scalar @$argsref / 2;
$menu_rows = 10 if ($menu_rows > 10);
my $left = defined $params{left} ? $params{left} : gettext("Back");
my $right = defined $params{right} ? $params{right} : gettext("Next");
$self->dialog(@args,
"--cancel-label", $left,
"--ok-label", $right,
"--menu", $text,
SCREEN_ROWS,
SCREEN_COLUMNS,
$menu_rows,
@$argsref,
);
}
=head2 keep_option
??
=cut
sub keep_option
{
my $self = shift;
my ($value) = @_;
my $keep_phrase = gettext("Keep the current setting");
return ( gettext("keep"), "${keep_phrase}: $value" );
}
=head2 gauge
This method displays a progress bar. It takes a coderef as parameter, and uses
the coderef to drive the --gauge widget of the dialog program, as well as to
perform whatever actions are being reported by the progress bar. The coderef
should take one parameter, which is the file handle to write the controlling
text to. If the return value of the coderef is defined, it is displayed by a
message_page after the progress bar terminates.
All text used to update the progress bar should either be numbers between 0
and 100, or arbitrary text sandwiched between leading and training lines
of 'XXX' followed by newline. The numbers will update the percentage complete
of the display, and the text will update the displayed text. Updating the
displayed text will reset the precentage complete to 0, so text should always
be followed by number.
=cut
sub gauge
{
my $self = shift;
my $sub = shift;
my %params = @_;
my $title = $params{title} || 'Progress';
my $feedback_title = $params{feedback_title} || 'Status';
my $init_text = $params{text} || 'Progress';
my @args = (
'--backtitle', $self->backtitle,
'--title', gettext($title),
);
push @args, "--clear" if $params{clear};
push @args, "--colors" if $params{colors};
push @args, "--no-collapse" if $params{no_collapse};
use FileHandle;
unless (open(WR, '|-'))
{
exec('/usr/bin/dialog',
@args,
'--gauge',
gettext($init_text),
SCREEN_ROWS,
SCREEN_COLUMNS,
);
}
WR->autoflush(1);
my $text = &$sub(*WR);
close(WR);
$self->message_page('title' => $feedback_title, 'text' => $text)
if defined $text;
}
=head2 run_screens
This method takes a directory of screens to run, and runs them in order.
To support navigation between screens, this method respects an integer
return value from the screens.
0 = all is well, continue to the next screen
1 = all is not well, go back to the previous screen
2 = catastrophic failure - return from run_screen
=cut
sub run_screens
{
my $self = shift;
my ($subdir) = @_;
my $dir = CONSOLE_SCREENS . "/$subdir";
# This is fine. Noop if the directory isn't there.
unless (-d $dir)
{
return 1;
}
# This is not fine. If it's there, we should be able to open it.
unless ( opendir(SCREENS, $dir) )
{
warn "Failed to open directory $dir: $!\n";
return 0;
}
my @screens = sort grep (!/^(\.\.?)$/, readdir (SCREENS));
my @previous_screens = ();
while (@screens)
{
my $screen = shift @screens;
unless ( $screen =~ /(S\d\d[\d\w]+)/ )
{
warn "Unknown screen type $dir/$screen\n";
next;
}
$screen = $1;
my $rv = system( "$dir/$screen" );
$rv >>= 8;
if ($rv == 0)
{
# Success, move to next screen.
push @previous_screens, $screen;
}
elsif ($rv == 1)
{
# Failure, go back one screen.
unshift @screens, $screen;
if (@previous_screens)
{
unshift @screens, pop @previous_screens;
}
else
{
# We're at the beginning of the stack. Just return.
return 0;
}
}
else
{
# Catastrophic failure, return. While 2 is the agreed-upon
# return code for this, consider it a catastrophic failure
# if we don't get a valid return code.
return 0;
}
}
return 1;
}
=head1 AUTHOR
SME Server Developers <smebugs@mitel.com>
=cut
1;