# Copyright 2000-2002 Katipo Communications
-# my.cnf, etcdir and prefix code Copyright 2003 MJ Ray
+# Contains parts Copyright 2003 MJ Ray
#
# This file is part of Koha.
#
# You should have received a copy of the GNU General Public License along with
# Koha; if not, write to the Free Software Foundation, Inc., 59 Temple Place,
# Suite 330, Boston, MA 02111-1307 USA
+#
+# Recent Authors
+# MJR: my.cnf, etcdir, prefix, new display, apache conf, copying fixups
use strict;
use POSIX;
+#MJR: everyone will have these modules, right?
+# They look like part of perl core to me
+use Term::Cap;
+use Term::ANSIColor qw(:constants);
+use Text::Wrap;
require Exporter;
use vars qw($VERSION @ISA @EXPORT @EXPORT_OK %EXPORT_TAGS);
The heading function takes one string, the text to be displayed as
the heading, and returns a formatted heading (currently formatted
-in the "traditional Koha installer" style, i.e., surrounded by a
-box of equal signs).
+with ANSI colours).
This reduces the likelihood of pod2man(1) etc. misinterpreting
a line of equal signs as illegal POD directives.
=cut
+my $termios = POSIX::Termios->new();
+$termios->getattr();
+my $terminal = Term::Cap->Tgetent({OSPEED=>$termios->getospeed()});
+my $clear_string = "\n\n"; #MJR: was $terminal->Tputs('cl');
+
sub heading ($) {
- my($s) = @_;
- my $n = length($s) + 4;
- my $line = ('=' x $n) . "\n";
- "\n$line= $s =\n$line\n";
+ my $title = shift;
+ my $bal = 5;
+ return($clear_string.ON_BLUE.WHITE.BOLD." "x$bal.uc($title)." "x$bal.RESET."\n\n");
}
my $mycnf = $ENV{HOME}."/.my.cnf";
sub getmessage {
my $messagename=shift;
my $variables=shift;
- my $message=$messages->{$messagename}->{$language} || $messages->{$messagename}->{en} || "Error: No message named $messagename in Install.pm\n";
+ my $message=$messages->{$messagename}->{$language} || $messages->{$messagename}->{en} || RED.BOLD."Error: No message named $messagename in Install.pm\n";
if (defined($variables)) {
$message=sprintf $message, @$variables;
}
$result = showmessage($message, 'restrictchar CHARS');
$result = showmessage($message, 'free');
+ $result = showmessage($message, 'silentfree');
$result = showmessage($message, 'numerical');
$result = showmessage($message, 'email');
$result = showmessage($message, 'PressEnter');
display; the caller is responsible for calling getmessage if
required.
-The response type must be one of "none", "yn", "free",
+The response type must be one of "none", "yn", "free", "silentfree"
"numerical", "email", "PressEnter", or a string consisting
of "restrictchar " followed by a list of allowed characters
(space can be specified). (Case is not significant, but case is
#'
sub showmessage {
- my $message=shift;
+ #MJR: Maybe refactor to use anonymous functions that
+ # check the responses instead of RnP branching.
+ my $message=join('',fill('','',(shift)));
my $responsetype=shift;
my $defaultresponse=shift;
my $noclear=shift;
$noclear = 0 unless defined $noclear; # defaults to "clear"
- ($noclear) || (system('clear'));
+ ($noclear) || (print $clear_string);
if ($responsetype =~ /^yn$/) {
$responsetype='restrictchar ynYN';
}
- print $message;
+ print RESET.$message;
if ($responsetype =~/^restrictchar (.*)/i) {
my $response='\0';
my $options=$1;
chomp $response;
(length($response)) || ($response=$defaultresponse);
if ( $response=~/.*[\:\(\)\^\$\*\!\\].*/ ) {
- ($noclear) || (system('clear'));
- print "Response contains invalid characters. Choose from [$options].\n\n";
- print $message;
+ ($noclear) || (print $clear_string);
+ print RED."Response contains invalid characters. Choose from [$options].\n\n";
+ print RESET.$message;
$response='\0';
} else {
unless ($options=~/$response/) {
- ($noclear) || (system('clear'));
- print "Invalid Response. Choose from [$options].\n\n";
- print $message;
+ ($noclear) || (print $clear_string);
+ print RED."Invalid Response. Choose from [$options].\n\n";
+ print RESET.$message;
}
}
}
return $response;
- } elsif ($responsetype =~/^free$/i) {
+ } elsif ($responsetype =~/^(silent)?free$/i) {
(defined($defaultresponse)) || ($defaultresponse='');
+ if ($responsetype =~/^(silent)/i) { setecho(0) };
my $response=<STDIN>;
+ if ($responsetype =~/^(silent)/i) { setecho(1) };
chomp $response;
($response) || ($response=$defaultresponse);
return $response;
chomp $response;
($response) || ($response=$defaultresponse);
unless ($response=~/^\d+$/) {
- ($noclear) || (system('clear'));
- print "Invalid Response ($response). Response must be a number.\n\n";
- print $message;
+ ($noclear) || (print $clear_string);
+ print RED."Invalid Response ($response). Response must be a number.\n\n";
+ print RESET.$message;
}
}
return $response;
$response=<STDIN>;
chomp $response;
($response) || ($response=$defaultresponse);
- unless ($response=~/.*\@.*\..*/) {
- ($noclear) || (system('clear'));
- print "Invalid Response ($response). Response must be a valid email address.\n\n";
- print $message;
+ if ($response!~/.*\@.*\..*/) {
+ ($noclear) || (print $clear_string);
+ print RED."Invalid Response ($response). Response must be a valid email address.\n\n";
+ print RESET.$message;
}
}
return $response;
}
+=back
+
+=item startsysout
+
+ startsysout;
+
+Changes the display to show system output until the next showmessage call.
+At the time of writing, this means using red text.
+
+=cut
+
+sub startsysout {
+ print RED."\n";
+}
+
+
=back
=head2 Subtasks of doing an installation
unless ($] >= 5.006001) { # Bug 179
die getmessage('PerlVersionFailure', ['5.6.1']);
}
+ startsysout();
my @missing = ();
unless (eval {require DBI}) { push @missing,"DBI" };
unless (eval {require Digest::MD5}) { push @missing,"Digest::MD5" };
unless (eval {require MARC::Record}) { push @missing,"MARC::Record" };
unless (eval {require Mail::Sendmail}) { push @missing,"Mail::Sendmail" };
+ unless (eval {require Event}) {
+ if ($#missing>=0) { # only when $#missing >= 0 so this isn't fatal
+ push @missing, "Event";
+ }
+ }
unless (eval {require Net::Z3950}) {
showmessage(getmessage('NETZ3950Missing'), 'PressEnter', '', 1);
- if ($#missing>=0) { # XXX why only when $#missing >= 0?
- push @missing, "Net::Z3950";
- }
+ if ($#missing>=0) { # see above note
+ push @missing, "Net::Z3950";
+ }
}
#
}
+ startsysout();
unless (-x "/usr/bin/perl") {
my $realperl=`which perl`;
chomp $realperl;
}
my $response=showmessage(getmessage('ConfirmPerlExecutableSymlink', $realperl), 'yn', 'y', 1);
unless ($response eq 'n') {
+ startsysout();
system("ln -s $realperl /usr/bin/perl");
}
}
May I create this symlink? ([Y]/N):
: |;
-$messages->{'DirFailed'}->{en} = qq|
+$messages->{'DirFailed'}->{en} = RED.qq|
We could not create %s, but continuing anyway...
|;
# FIXME: Need better error handling for all mkdir calls here
unless ( -d $intranetdir ) {
- mkdir_parents (dirname($intranetdir), 0775) || print getmessage('DirFailed','parents of '.$intranetdir);
- mkdir ($intranetdir, 0770) || print getmessage('DirFailed',$intranetdir);
- chown (oct(0), (getgrnam($httpduser))[2], "$intranetdir");
- chmod (oct(770), "$intranetdir");
+ mkdir_parents (dirname($intranetdir), 0775) || print getmessage('DirFailed',['parents of '.$intranetdir]);
+ mkdir ($intranetdir, 0770) || print getmessage('DirFailed',[$intranetdir]);
+ if ($>==0) { chown (oct(0), (getgrnam($httpduser))[2], "$intranetdir"); }
+ chmod 0770, "$intranetdir";
}
mkdir_parents ("$intranetdir/htdocs", 0750);
mkdir_parents ("$intranetdir/cgi-bin", 0750);
mkdir_parents ("$intranetdir/modules", 0750);
mkdir_parents ("$intranetdir/scripts", 0750);
unless ( -d $opacdir ) {
- mkdir_parents (dirname($opacdir), 0775) || print getmessage('DirFailed','parents of '.$opacdir);
- mkdir ($opacdir, 0770) || print getmessage('DirFailed',$opacdir);
- chown (oct(0), (getgrnam($httpduser))[2], "$opacdir");
+ mkdir_parents (dirname($opacdir), 0775) || print getmessage('DirFailed',['parents of '.$opacdir]);
+ mkdir ($opacdir, 0770) || print getmessage('DirFailed',[$opacdir]);
+ if ($>==0) { chown (oct(0), (getgrnam($httpduser))[2], "$opacdir"); }
chmod (oct(770), "$opacdir");
}
mkdir_parents ("$opacdir/htdocs", 0750);
unless ( -d $kohalogdir ) {
- mkdir_parents (dirname($kohalogdir), 0775) || print getmessage('DirFailed','parents of '.$kohalogdir);
- mkdir ($kohalogdir, 0770) || print getmessage('DirFailed',$kohalogdir);
- chown (oct(0), (getgrnam($httpduser))[2,3], "$kohalogdir");
+ mkdir_parents (dirname($kohalogdir), 0775) || print getmessage('DirFailed',['parents of '.$kohalogdir]);
+ mkdir ($kohalogdir, 0770) || print getmessage('DirFailed',[$kohalogdir]);
+ if ($>==0) { chown (oct(0), (getgrnam($httpduser))[2,3], "$kohalogdir"); }
chmod (oct(770), "$kohalogdir");
}
}
$realhttpdconf=$confpossibilities[0];
}
unless (open (HTTPDCONF, "<$realhttpdconf")) {
- warn "Insufficient privileges to open $realhttpdconf for reading.\n";
+ warn RED."Insufficient privileges to open $realhttpdconf for reading.\n";
sleep 4;
}
}
close(HTTPDCONF);
-
-
-
- unless ($httpduser) {
+ unless (defined($httpduser)) {
my $message=getmessage('EnterApacheUser', [$etcdir]);
- until (length($httpduser) && getpwnam($httpduser)) {
+ until (defined($httpduser) && length($httpduser) && getpwnam($httpduser)) {
$httpduser=showmessage($message, "free", '');
if (length($httpduser)>0) {
unless (getpwnam($httpduser)) {
} else {
}
}
- print "AU: $httpduser\n";
}
}
will do this by using one ip address and two different ports
for the virtual hosts. There are other ways to set this up,
and the installer will leave comments in
-$etcdir/koha-httpd.conf detailing
+%s/koha-httpd.conf detailing
what these other options are.
NOTE: You will need to add lines to your main httpd.conf to
- Include $etcdir/koha-httpd.conf
+ Include %s/koha-httpd.conf
and to make sure it is listening on the right ports
(using the Listen directive).
$opacport=80;
$intranetport=8080;
- showmessage(getmessage('ApacheConfigIntroduction'), 'PressEnter');
+ showmessage(getmessage('ApacheConfigIntroduction',[$etcdir,$etcdir]), 'PressEnter');
$svr_admin=showmessage(getmessage('GetVirtualHostEmail', [$svr_admin]), 'email', $svr_admin);
$servername=showmessage(getmessage('GetServerName', [$servername]), 'free', $servername);
Press <ENTER> to continue: |;
sub updateapacheconf {
- my $logfiledir=`grep ^ErrorLog "$realhttpdconf"`;
- chomp $logfiledir;
-
+ my $logfiledir=$kohalogdir;
my $httpdconf = $etcdir."/koha-httpd.conf";
-
- if ($logfiledir) {
- $logfiledir=~m#ErrorLog (.*)/[^/]*$#
- or die "Can't parse ErrorLog directive\n";
- $logfiledir=$1;
- }
-
- unless ($logfiledir) {
- $logfiledir='logs';
- }
-
+
showmessage(getmessage('StartUpdateApache'), 'none');
# to be polite about it: I don't think this should touch the main httpd.conf
}
}
+ startsysout;
if (`grep 'VirtualHost $servername' "$httpdconf"`) {
showmessage(getmessage('ApacheAlreadyConfigured', [$httpdconf, $httpdconf]), 'PressEnter');
return;
print SITE <<EOP
# Ports to listen to for Koha
-$opaclisten
-$intranetlisten
+# uncomment these if they aren't already in main httpd.conf
+#$opaclisten
+#$intranetlisten
# NameVirtualHost is used by one of the optional configurations detailed below
ErrorLog $logfiledir/opac-error_log
TransferLog $logfiledir/opac-access_log
SetEnv PERL5LIB "$intranetdir/modules"
+ SetEnv KOHA_CONF "$etcdir/koha.conf"
$includesdirectives
</VirtualHost>
ErrorLog $logfiledir/koha-error_log
TransferLog $logfiledir/koha-access_log
SetEnv PERL5LIB "$intranetdir/modules"
+ SetEnv KOHA_CONF "$etcdir/koha.conf"
$includesdirectives
</VirtualHost>
sub installfiles {
+ #MJR: preserve old files, just in case
+ sub neatcopy {
+ my $desc = shift;
+ my $src = shift;
+ my $tgt = shift;
+
+ if (-d $tgt) {
+ print getmessage('CopyingFiles', ["old ".$desc,$tgt.".old"]);
+ startsysout;
+ system("mv ".$tgt." ".$tgt.".old");
+ }
+
+ print getmessage('CopyingFiles', [$desc,$tgt]);
+ startsysout;
+ system("cp -R ".$src." ".$tgt);
+ }
showmessage(getmessage('InstallFiles'),'none');
- print getmessage('CopyingFiles', ['intranet-html', "$intranetdir/htdocs" ]);
- system("cp -R intranet-html/* $intranetdir/htdocs/");
- print getmessage('CopyingFiles', ['intranet-cgi', "$intranetdir/cgi-bin" ]);
- system("cp -R intranet-cgi/* $intranetdir/cgi-bin/");
- print getmessage('CopyingFiles', ['stand-alone scripts', "$intranetdir/scripts" ]);
- system("cp -R scripts/* $intranetdir/scripts/");
- print getmessage('CopyingFiles', ['perl modules', "$intranetdir/modules" ]);
- system("cp -R modules/* $intranetdir/modules/");
- print getmessage('CopyingFiles', ['opac-html', "$opacdir/htdocs" ]);
- system("cp -R opac-html/* $opacdir/htdocs/");
- print getmessage('CopyingFiles', ['opac-cgi', "$opacdir/cgi-bin" ]);
- system("cp -R opac-cgi/* $opacdir/cgi-bin/");
+
+ neatcopy("admin templates", 'intranet-html', "$intranetdir/htdocs");
+ neatcopy("admin interface", 'intranet-cgi', "$intranetdir/cgi-bin");
+ neatcopy("main scripts", 'scripts', "$intranetdir/scripts");
+ neatcopy("perl modules", 'modules', "$intranetdir/modules");
+ neatcopy("OPAC templates", 'opac-html', "$opacdir/htdocs");
+ neatcopy("OPAC interface", 'opac-cgi', "$opacdir/cgi-bin");
+ startsysout();
system("touch $opacdir/cgi-bin/opac");
- system("chown -R $httpduser:$httpduser $opacdir");
- system("chown -R $httpduser:$httpduser $intranetdir");
+ #MJR: is this necessary?
+ if ($> == 0) {
+ system("chown -R $httpduser:$httpduser $opacdir $intranetdir");
+ }
+ system("chmod -R a+rx $opacdir $intranetdir");
# Create /etc/koha.conf
close(SITES);
umask($old_umask);
- chown((getpwnam($httpduser)) [2,3], "$etcdir/koha.conf.tmp") or warn "can't chown koha.conf: $!";
+ startsysout();
+ #MJR: can't help but this be broken, can we?
chmod 0440, "$etcdir/koha.conf.tmp";
-
- chmod 0750, "$intranetdir/scripts/z3950daemon/z3950-daemon-launch.sh";
- chmod 0750, "$intranetdir/scripts/z3950daemon/z3950-daemon-shell.sh";
- chmod 0750, "$intranetdir/scripts/z3950daemon/processz3950queue";
- chown(0, (getpwnam($httpduser)) [3], "$intranetdir/scripts/z3950daemon/z3950-daemon-shell.sh") or warn "can't chown $intranetdir/scripts/z3950daemon/z3950-daemon-shell.sh: $!";
- chown(0, (getpwnam($httpduser)) [3], "$intranetdir/scripts/z3950daemon/processz3950queue") or warn "can't chown $intranetdir/scripts/z3950daemon/processz3950queue: $!";
-
+
+ #MJR: does this contain any passwords?
+ chmod 0755, "$intranetdir/scripts/z3950daemon/z3950-daemon-launch.sh", "$intranetdir/scripts/z3950daemon/z3950-daemon-shell.sh", "$intranetdir/scripts/z3950daemon/processz3950queue";
+
+ if ($> == 0) {
+ chown((getpwnam($httpduser)) [2,3], "$etcdir/koha.conf.tmp") or warn "can't chown koha.conf: $!";
+ chown(0, (getpwnam($httpduser)) [3], "$intranetdir/scripts/z3950daemon/z3950-daemon-shell.sh") or warn "can't chown $intranetdir/scripts/z3950daemon/z3950-daemon-shell.sh: $!";
+ chown(0, (getpwnam($httpduser)) [3], "$intranetdir/scripts/z3950daemon/processz3950queue") or warn "can't chown $intranetdir/scripts/z3950daemon/processz3950queue: $!";
+ } #MJR: FIXME: Should report that we haven't chown()d.
}
}
}
# we must not put the mysql root password on the command line
- $mysqlpass= showmessage(getmessage('MysqlRootPassword'),'free');
+ $mysqlpass= showmessage(getmessage('MysqlRootPassword'),'silentfree');
showmessage(getmessage('CreatingDatabase'),'none');
# set the login up
setmysqlclipass($mysqlpass);
# Set up permissions
+ startsysout();
print system("$mysqldir/bin/mysql -u$mysqluser mysql -e \"insert into user (Host,User,Password) values ('$hostname','$user',password('$pass'))\"\;");
system("$mysqldir/bin/mysql -u$mysqluser mysql -e \"insert into db (Host,Db,User,Select_priv,Insert_priv,Update_priv,Delete_priv,Create_priv,Drop_priv, index_priv, alter_priv) values ('%','$dbname','$user','Y','Y','Y','Y','Y','Y','Y','Y')\"");
system("$mysqldir/bin/mysqladmin -u$mysqluser reload");
showmessage(getmessage('CreatingDatabaseError'),'PressEnter', '', 1);
} else {
# Create the database structure
+ startsysout();
system("$mysqldir/bin/mysql -u$user $dbname < koha.mysql");
}
sub updatedatabase {
# At this point, $etcdir/koha.conf must exist, for C4::Context
$ENV{"KOHA_CONF"}=$etcdir.'/koha.conf.tmp';
+ startsysout();
my $result=system ("perl -I $intranetdir/modules scripts/updater/updatedatabase");
if ($result) {
restoremycnf();
my $response=showmessage(getmessage('UpdateMarcTables'), 'restrictchar 12N', '1');
+ startsysout();
if ($response eq '1') {
system("cat scripts/misc/marc_datas/marc21_en/structure_def.sql | $mysqldir/bin/mysql -u$user $dbname");
}
}
delete($ENV{"KOHA_CONF"});
- print "\n\nFinished updating of database. Press <ENTER> to continue...";
+ print RESET."\n\nFinished updating of database. Press <ENTER> to continue...";
<STDIN>;
}
$branchcode=substr($branchcode,0,4);
$branchcode or $branchcode='DEF';
+ startsysout();
system("$mysqldir/bin/mysql -u$user $dbname -e \"insert into branches (branchcode,branchname,issuing) values ('$branchcode', '$branch', 1)\"");
system("$mysqldir/bin/mysql -u$user $dbname -e \"insert into branchrelations (branchcode,categorycode) values ('MAIN', 'IS')\"");
system("$mysqldir/bin/mysql -u$user $dbname -e \"insert into branchrelations (branchcode,categorycode) values ('MAIN', 'CU')\"");
my $printerqueue='lp';
$printerqueue=showmessage(getmessage('PrinterQueue', [$printerqueue]), 'free', $printerqueue, 1);
$printerqueue=~s/[^A-Za-z0-9]//g;
+ startsysout();
system("$mysqldir/bin/mysql -u$user $dbname -e \"insert into printers (printername,printqueue,printtype) values ('$printername', '$printerqueue', '')\"");
# }
my $language=showmessage(getmessage('Language'), 'free', 'en');
+ startsysout();
system("$mysqldir/bin/mysql -u$user $dbname -e \"update systempreferences set value='$language' where variable='opaclanguages'\"");
}
}
unless ($response=~/^n/i) {
+ startsysout();
# Need to support other init structures here?
if (-e "/etc/rc.d/init.d/httpd") {
system('su root -c /etc/rc.d/init.d/httpd restart');
} elsif (-e "/etc/init.d/apache") {
- system('su root -c /etc//init.d/apache restart');
+ system('su root -c /etc/init.d/apache restart');
} elsif (-e "/etc/init.d/apache-ssl") {
system('su root -c /etc/init.d/apache-ssl restart');
}
END { } # module clean-up code here (global destructor)
+### These things may move
+
+sub setecho {
+my $state=shift;
+my $t = POSIX::Termios->new;
+
+$t->getattr();
+if ($state) {
+ $t->setlflag(($t->getlflag) | &POSIX::ECHO);
+ }
+else {
+ $t->setlflag(($t->getlflag) & !(&POSIX::ECHO));
+ }
+$t->setattr();
+}
+
sub setmysqlclipass {
my $pass = shift;
open(MYCNF,">$mycnf");
projects / koha.git / blobdiff