installer/install.pl

   1 #!/usr/bin/perl
   2
   3 # This file is part of Koha.
   4 #
   5 # Copyright (C) YEAR  YOURNAME-OR-YOUREMPLOYER
   6 #
   7 # Koha is free software; you can redistribute it and/or modify it
   8 # under the terms of the GNU General Public License as published by
   9 # the Free Software Foundation; either version 3 of the License, or
  10 # (at your option) any later version.
  11 #
  12 # Koha is distributed in the hope that it will be useful, but
  13 # WITHOUT ANY WARRANTY; without even the implied warranty of
  14 # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
  15 # GNU General Public License for more details.
  16 #
  17 # You should have received a copy of the GNU General Public License
  18 # along with Koha; if not, see <http://www.gnu.org/licenses>.
  19
  20 use Modern::Perl;
  21 use diagnostics;
  22
  23 use C4::InstallAuth qw( get_template_and_user );
  24 use CGI qw ( -utf8 );
  25 use POSIX;
  26 use HTML::FromANSI::Tiny::Bootstrap;
  27
  28 use C4::Context;
  29 use C4::Output qw( output_html_with_http_headers );
  30 use C4::Templates;
  31 use C4::Languages qw( getAllLanguages getTranslatedLanguages );
  32 use C4::Installer;
  33 use C4::Installer::PerlModules;
  34
  35 use Koha;
  36 use Koha::Caches;
  37
  38 my $query = CGI->new;
  39 my $step  = $query->param('step');
  40
  41 # Flush memcached before we begin
  42 Koha::Caches->get_instance('config')->flush_all;
  43 Koha::Caches->get_instance('sysprefs')->flush_all;
  44
  45 my $language = $query->param('language');
  46 my ( $template, $loggedinuser, $cookie );
  47
  48 my $all_languages = getAllLanguages();
  49
  50 if ( defined($language) ) {
  51     C4::Templates::setlanguagecookie( $query, $language, "install.pl?step=1" );
  52 }
  53 ( $template, $loggedinuser, $cookie ) = get_template_and_user(
  54     {
  55         template_name => "installer/step" . ( $step ? $step : 1 ) . ".tt",
  56         query         => $query,
  57         type          => "intranet",
  58     }
  59 );
  60
  61 my $installer = C4::Installer->new();
  62 my %info;
  63 $info{'dbname'} = C4::Context->config("database_test") || C4::Context->config("database");
  64 $info{'dbms'}   = (
  65       C4::Context->config("db_scheme")
  66     ? C4::Context->config("db_scheme")
  67     : "mysql"
  68 );
  69 $info{'hostname'} = C4::Context->config("hostname");
  70 $info{'port'}     = C4::Context->config("port");
  71 $info{'user'}     = C4::Context->config("user");
  72 $info{'password'} = C4::Context->config("pass");
  73 $info{'tls'} = C4::Context->config("tls");
  74     if ($info{'tls'} && $info{'tls'} eq 'yes'){
  75         $info{'ca'} = C4::Context->config('ca');
  76         $info{'cert'} = C4::Context->config('cert');
  77         $info{'key'} = C4::Context->config('key');
  78         $info{'tlsoptions'} = ";mysql_ssl=1;mysql_ssl_client_key=".$info{key}.";mysql_ssl_client_cert=".$info{cert}.";mysql_ssl_ca_file=".$info{ca};
  79         $info{'tlscmdline'} =  " --ssl-cert ". $info{cert} . " --ssl-key " . $info{key} . " --ssl-ca ".$info{ca}." "
  80     }
  81
  82 my $dbh = DBI->connect(
  83     "DBI:$info{dbms}:dbname=$info{dbname};host=$info{hostname}"
  84       . ( $info{port} ? ";port=$info{port}" : "" )
  85       . ( $info{tlsoptions} ? $info{tlsoptions} : "" ),
  86     $info{'user'}, $info{'password'}
  87 );
  88
  89 my $op = $query->param('op') || q{};
  90 if ( $step && $step == 1 ) {
  91
  92     #First Step (for both fresh installations and upgrades)
  93     #Checking ALL perl Modules and services needed are installed.
  94     #Whenever there is an error, adding a report to the page
  95     $template->param( language      => 1 );
  96     my $checkmodule = 1;
  97     $template->param( 'checkmodule' => 1 )
  98       ; # we start with the assumption that there are no problems and set this to 0 if there are
  99
 100     unless ( $] >= 5.010000 ) {    # Bug 7375
 101         $template->param( problems => 1, perlversion => 1, checkmodule => 0 );
 102         $checkmodule = 0;
 103     }
 104
 105     my $perl_modules = C4::Installer::PerlModules->new;
 106     $perl_modules->versions_info;
 107
 108     my $missing_modules = $perl_modules->get_attr('missing_pm');
 109     my $upgrade_modules = $perl_modules->get_attr('upgrade_pm');
 110     if ( scalar(@$missing_modules) || scalar(@$upgrade_modules) ) {
 111         my @missing  = ();
 112         my @upgrade = ();
 113         foreach (@$missing_modules) {
 114             my ( $module, $stats ) = each %$_;
 115             $checkmodule = 0 if $stats->{'required'};
 116             push(
 117                 @missing,
 118                 {
 119                     name    => $module,
 120                     min_version => $stats->{'min_ver'},
 121                     max_version => $stats->{'max_ver'},
 122                     require => $stats->{'required'}
 123                 }
 124             );
 125         }
 126         foreach (@$upgrade_modules) {
 127             my ( $module, $stats ) = each %$_;
 128             $checkmodule = 0 if $stats->{'required'};
 129             push(
 130                 @upgrade,
 131                 {
 132                     name    => $module,
 133                     min_version => $stats->{'min_ver'},
 134                     max_version => $stats->{'max_ver'},
 135                     require => $stats->{'required'}
 136                 }
 137             );
 138         }
 139         @missing = sort { $a->{'name'} cmp $b->{'name'} } @missing;
 140         @upgrade = sort { $a->{'name'} cmp $b->{'name'} } @upgrade;
 141         $template->param(
 142             missing_modules => \@missing,
 143             upgrade_modules => \@upgrade,
 144             checkmodule     => $checkmodule,
 145         );
 146     }
 147 }
 148 elsif ( $step && $step == 2 ) {
 149
 150     #STEP 2 Check Database connection and access
 151
 152     $template->param(%info);
 153     my $checkdb = $query->param("checkdb");
 154     $template->param( 'dbconnection' => $checkdb );
 155     if ($checkdb) {
 156         if ($dbh) {
 157
 158             # Can connect to the mysql
 159             $template->param( "checkdatabaseaccess" => 1 );
 160             if ( $info{dbms} eq "mysql" ) {
 161
 162                 #Check if database created
 163                 my $rv = $dbh->do("SHOW DATABASES LIKE \'$info{dbname}\'");
 164                 if ( $rv == 1 ) {
 165                     $template->param( 'checkdatabasecreated' => 1 );
 166                 }
 167
 168                 # Check if user have all necessary grants on this database.
 169                 # CURRENT_USER is ANSI SQL, and doesn't require mysql table
 170                 # privileges, making the % check pointless, since they
 171                 # couldn't even check GRANTS if they couldn't connect.
 172                 my $rq = $dbh->prepare('SHOW GRANTS FOR CURRENT_USER');
 173                 $rq->execute;
 174                 my $grantaccess;
 175                 while ( my ($line) = $rq->fetchrow ) {
 176                     my $dbname = $info{dbname};
 177                     if ( $line =~ m/^GRANT (.*?) ON `$dbname`\.\*/
 178                         || index( $line, '*.*' ) > 0 )
 179                     {
 180                         $grantaccess = 1
 181                           if (
 182                             index( $line, 'ALL PRIVILEGES' ) > 0
 183                             || (   ( index( $line, 'SELECT' ) > 0 )
 184                                 && ( index( $line, 'INSERT' ) > 0 )
 185                                 && ( index( $line, 'UPDATE' ) > 0 )
 186                                 && ( index( $line, 'DELETE' ) > 0 )
 187                                 && ( index( $line, 'CREATE' ) > 0 )
 188                                 && ( index( $line, 'DROP' ) > 0 ) )
 189                           );
 190                     }
 191                 }
 192                 $template->param( "checkgrantaccess" => $grantaccess );
 193
 194                 if ( my $count = $installer->has_non_dynamic_row_format ) {
 195                     $template->param( warnDbRowFormat => $count );
 196                     $template->param( error => "InnoDB row format" );
 197                 }
 198
 199             }    # End mysql connect check...
 200
 201             elsif ( $info{dbms} eq "Pg" ) {
 202
 203                 # Check if database has been created...
 204                 my $rv = $dbh->do(
 205 "SELECT * FROM pg_catalog.pg_database WHERE datname = \'$info{dbname}\';"
 206                 );
 207                 if ( $rv == 1 ) {
 208                     $template->param( 'checkdatabasecreated' => 1 );
 209                 }
 210
 211                 # Check if user has all necessary grants on this database...
 212                 my $rq = $dbh->do(
 213                     "SELECT u.usesuper
 214             FROM pg_catalog.pg_user as u
 215             WHERE u.usename = \'$info{user}\';"
 216                 );
 217                 if ( $rq == 1 ) {
 218                     $template->param( "checkgrantaccess" => 1 );
 219                 }
 220             }    # End Pg connect check...
 221         }
 222         else {
 223             $template->param( "error" => DBI::err, "message" => DBI::errstr );
 224         }
 225     }
 226 }
 227 elsif ( $step && $step == 3 ) {
 228
 229     # STEP 3 : database setup
 230
 231     if ( $op eq 'finished' ) {
 232         # Remove the HandleError set at the beginning of the installer process
 233         C4::Context->dbh->disconnect;
 234
 235         my $cookie_mgr = Koha::CookieManager->new;
 236         # Remove cookie of the installer session
 237         my $cookies = [];
 238         if ( !ref $cookie ) {
 239             push( @$cookies, $cookie );
 240         }
 241         $cookies = $cookie_mgr->replace_in_list( $cookies, $query->cookie(
 242             -name     => 'CGISESSID',
 243             -value    => '',
 244             -HttpOnly => 1,
 245             -secure => ( C4::Context->https_enabled() ? 1 : 0 ),
 246             -sameSite => 'Lax',
 247         ));
 248
 249         # we have finished, just redirect to mainpage.
 250         print $query->redirect( -uri => "/cgi-bin/koha/mainpage.pl", -cookie => $cookies );
 251         exit;
 252     }
 253     elsif ( $op eq 'cud-finish' ) {
 254         $installer->set_version_syspref();
 255
 256         my $langchoice = $query->param('fwklanguage');
 257         $langchoice = $query->cookie('KohaOpacLanguage') unless ($langchoice);
 258         $langchoice =~ s/[^a-zA-Z_-]*//g;
 259         $installer->set_languages_syspref($langchoice);
 260
 261 # Installation is finished.
 262 # We just deny anybody access to install
 263 # And we redirect people to mainpage.
 264 # The installer will have to relogin since we do not pass cookie to redirection.
 265     }
 266
 267     elsif ( $op eq 'cud-addframeworks' ) {
 268
 269         # 1ST install, 3rd sub-step : insert the SQL files the user has selected
 270         my $langchoice = $query->param('fwklanguage');
 271         $langchoice = $query->cookie('KohaOpacLanguage') unless ($langchoice);
 272         $langchoice =~ s/[^a-zA-Z_-]*//g;
 273
 274         my ( $fwk_language, $list ) =
 275           $installer->load_sql_in_order( $langchoice, $all_languages,
 276             $query->multi_param('framework') );
 277         $template->param(
 278             "fwklanguage" => $fwk_language,
 279             "list"        => $list
 280         );
 281         use Koha::SearchEngine::Elasticsearch;
 282         Koha::SearchEngine::Elasticsearch->reset_elasticsearch_mappings;
 283     }
 284     elsif ( $op eq 'cud-selectframeworks' ) {
 285 #
 286 #
 287 # 1ST install, 2nd sub-step : show the user the sql datas they can insert in the database.
 288 #
 289 #
 290 # (note that the term "selectframeworks is not correct. The user can select various files, not only frameworks)
 291
 292 #Framework Selection
 293 #sql data for import are supposed to be located in installer/data/<language>/<level>
 294 # Where <language> is en|fr or any international abbreviation (provided language hash is updated... This will be a problem with internationlisation.)
 295 # Where <level> is a category of requirement : required, recommended optional
 296 # level should contain :
 297 #   SQL File for import With a readable name.
 298 #   txt File that explains what this SQL File is meant for.
 299 # Could be VERY useful to have A Big file for a kind of library.
 300 # But could also be useful to have some Authorised values data set prepared here.
 301 # Framework Selection is achieved through checking boxes.
 302         my $langchoice = $query->param('fwklanguage');
 303         $langchoice = $query->cookie('KohaOpacLanguage') unless ($langchoice);
 304         $langchoice =~ s/[^a-zA-Z_-]*//g;
 305         my $marcflavour = $query->param('marcflavour');
 306         if ($marcflavour) {
 307             $installer->set_marcflavour_syspref($marcflavour);
 308         }
 309         $marcflavour = C4::Context->preference('marcflavour')
 310           unless ($marcflavour);
 311
 312         #Insert into database the selected marcflavour
 313         undef $/;
 314         my ( $marc_defaulted_to_en, $fwklist ) =
 315           $installer->marc_framework_sql_list( $langchoice, $marcflavour );
 316         $template->param( 'en_marc_frameworks' => $marc_defaulted_to_en );
 317         $template->param( "frameworksloop"     => $fwklist );
 318         $template->param( "marcflavour"        => ucfirst($marcflavour) );
 319
 320         my ( $sample_defaulted_to_en, $levellist ) =
 321           $installer->sample_data_sql_list($langchoice);
 322         $template->param( "en_sample_data" => $sample_defaulted_to_en );
 323         $template->param( "levelloop"      => $levellist );
 324
 325     }
 326     elsif ( $op eq 'cud-choosemarc' ) {
 327         #
 328         #
 329         # 1ST install, 2nd sub-step : show the user the marcflavour available.
 330         #
 331         #
 332
 333 #Choose Marc Flavour
 334 #sql data are supposed to be located in installer/data/<dbms>/<language>/marcflavour/marcflavourname
 335 # Where <dbms> is database type according to DBD syntax
 336 # Where <language> is en|fr or any international abbreviation (provided language hash is updated... This will be a problem with internationlisation.)
 337 # Where <level> is a category of requirement : required, recommended optional
 338 # level should contain :
 339 #   SQL File for import With a readable name.
 340 #   txt File that explains what this SQL File is meant for.
 341 # Could be VERY useful to have A Big file for a kind of library.
 342 # But could also be useful to have some Authorised values data set prepared here.
 343 # Marcflavour Selection is achieved through radiobuttons.
 344         my $langchoice = $query->param('fwklanguage');
 345
 346         $langchoice = $query->cookie('KohaOpacLanguage') unless ($langchoice);
 347         $langchoice =~ s/[^a-zA-Z_-]*//g;
 348         my $dir =
 349           C4::Context->config('intranetdir')
 350           . "/installer/data/$info{dbms}/$langchoice/marcflavour";
 351         my $dir_h;
 352         unless ( opendir( $dir_h, $dir ) ) {
 353             if ( $langchoice eq 'en' ) {
 354                 warn "cannot open MARC frameworks directory $dir";
 355             }
 356             else {
 357                 # if no translated MARC framework is available,
 358                 # default to English
 359                 $dir = C4::Context->config('intranetdir')
 360                   . "/installer/data/$info{dbms}/en/marcflavour";
 361                 opendir( $dir_h, $dir )
 362                   or warn "cannot open English MARC frameworks directory $dir";
 363             }
 364         }
 365         my @listdir = grep { !/^\./ && -d "$dir/$_" } readdir($dir_h);
 366         closedir $dir_h;
 367         my $marcflavour = C4::Context->preference("marcflavour");
 368         my @flavourlist;
 369         foreach my $marc (@listdir) {
 370              my %cell=(
 371                  "label"=> ucfirst($marc),
 372                   "code"=>uc($marc),
 373                "checked"=> defined($marcflavour) ? uc($marc) eq $marcflavour : 0);
 374 #             $cell{"description"}= do { local $/ = undef; open INPUT "<$dir/$marc.txt"||"";<INPUT> };
 375              push @flavourlist, \%cell;
 376         }
 377         $template->param( "flavourloop" => \@flavourlist );
 378     }
 379     elsif ( $op eq 'cud-importdatastructure' ) {
 380         #
 381         #
 382         # 1st install, 1st "sub-step" : import kohastructure
 383         #
 384         #
 385         my $error = $installer->load_db_schema();
 386         $template->param(
 387             "error" => $error,
 388         );
 389     }
 390     elsif ( $op eq 'cud-updatestructure' ) {
 391         #
 392         # Not 1st install, the only sub-step : update database
 393         #
 394         #Do updatedatabase And report
 395
 396         if ( !defined $ENV{PERL5LIB} ) {
 397             my $find = "C4/Context.pm";
 398             my $path = $INC{$find};
 399             $path =~ s/\Q$find\E//;
 400             $ENV{PERL5LIB} = "$path:$path/installer";
 401             warn "# plack? inserted PERL5LIB $ENV{PERL5LIB}\n";
 402         }
 403
 404         my $now         = POSIX::strftime( "%Y-%m-%dT%H:%M:%S", localtime() );
 405         my $logdir      = C4::Context->config('logdir');
 406         my $dbversion   = C4::Context->preference('Version');
 407         my $kohaversion = Koha::version;
 408         $kohaversion =~ s/(.*\..*)\.(.*)\.(.*)/$1$2$3/;
 409
 410         my $filename_suffix = join '_', $now, $dbversion, $kohaversion;
 411         my ( $logfilepath, $logfilepath_errors ) = (
 412             chk_log( $logdir, "updatedatabase_$filename_suffix" ),
 413             chk_log( $logdir, "updatedatabase-error_$filename_suffix" )
 414         );
 415
 416         my $cmd = C4::Context->config("intranetdir")
 417           . "/installer/data/$info{dbms}/updatedatabase.pl >> $logfilepath 2>> $logfilepath_errors";
 418
 419         system( $cmd );
 420
 421         my $fh;
 422         open( $fh, "<:encoding(utf-8)", $logfilepath )
 423           or die "Cannot open log file $logfilepath: $!";
 424
 425         my @report = <$fh>;
 426         close $fh;
 427         if (@report) {
 428             $template->param( update_report =>
 429                   [ map { { line => $_ =~ s/\t/&emsp;&emsp;/gr } } split( /\n/, join( '', @report ) ) ]
 430             );
 431             $template->param( has_update_succeeds => 1 );
 432         }
 433         else {
 434             eval { `rm $logfilepath` };
 435         }
 436         open( $fh, "<:encoding(utf-8)", $logfilepath_errors )
 437           or die "Cannot open log file $logfilepath_errors: $!";
 438         @report = <$fh>;
 439         close $fh;
 440         my $update_errors;
 441         if (@report) {
 442             $template->param( update_errors =>
 443                   [ map { { line => $_ } } split( /\n/, join( '', @report ) ) ]
 444             );
 445             $update_errors = 1;
 446             $template->param( has_update_errors => 1 );
 447             warn
 448 "The following errors were returned while attempting to run the updatedatabase.pl script:\n";
 449             foreach my $line (@report) { warn "$line\n"; }
 450         }
 451         else {
 452             eval { `rm $logfilepath_errors` };
 453         }
 454
 455         unless ( $update_errors ) {
 456             my $db_entries = get_db_entries();
 457             my $report = update( $db_entries );
 458             my $atomic_update_files = get_atomic_updates;
 459             my $atomic_update_report = run_atomic_updates( $atomic_update_files );
 460
 461             colorize($report);
 462             colorize($atomic_update_report);
 463             $template->param(
 464                 success        => $report->{success},
 465                 error          => $report->{error},
 466                 atomic_updates => {
 467                     success => $atomic_update_report->{success},
 468                     error   => $atomic_update_report->{error}
 469                 }
 470             );
 471         }
 472     }
 473     else {
 474 #
 475 # check whether it's a 1st install or an update
 476 #
 477 #Check if there are enough tables.
 478 # Paul has cleaned up tables so reduced the count
 479 #I put it there because it implied a data import if condition was not satisfied.
 480         my $dbh = DBI->connect(
 481                 "DBI:$info{dbms}:dbname=$info{dbname};host=$info{hostname}"
 482                 . ( $info{port} ? ";port=$info{port}" : "" )
 483                 . ( $info{tlsoptions} ? $info{tlsoptions} : "" ),
 484                 $info{'user'}, $info{'password'}
 485         );
 486         my $rq;
 487         if ( $info{dbms} eq 'mysql' ) { $rq = $dbh->prepare("SHOW TABLES"); }
 488         elsif ( $info{dbms} eq 'Pg' ) {
 489             $rq = $dbh->prepare(
 490                 "SELECT *
 491                 FROM information_schema.tables
 492                 WHERE table_schema='public' and table_type='BASE TABLE';"
 493             );
 494         }
 495         $rq->execute;
 496         my $data = $rq->fetchall_arrayref( {} );
 497         my $count = scalar(@$data);
 498         #
 499         # we don't have tables, propose DB import
 500         #
 501         if ( $count < 70 ) {
 502             $template->param( "count" => $count, "proposeimport" => 1 );
 503         }
 504         else {
 505            #
 506            # we have tables, propose to select files to upload or updatedatabase
 507            #
 508             $template->param( "count" => $count, "default" => 1 );
 509      #
 510      # 1st part of step 3 : check if there is a databaseversion systempreference
 511      # if there is, then we just need to upgrade
 512      # if there is none, then we need to install the database
 513      #
 514             if ( C4::Context->preference('Version') ) {
 515                 my $dbversion = C4::Context->preference('Version');
 516                 $dbversion =~ /(.*)\.(..)(..)(...)/;
 517                 $dbversion = "$1.$2.$3.$4";
 518                 $template->param(
 519                     "upgrading"   => 1,
 520                     "dbversion"   => $dbversion,
 521                     "kohaversion" => Koha::version(),
 522                 );
 523             }
 524         }
 525     }
 526 }
 527 else {
 528
 529     # LANGUAGE SELECTION page by default
 530     # using opendir + language Hash
 531     my $languages_loop = getTranslatedLanguages('intranet');
 532     $template->param( installer_languages_loop => $languages_loop );
 533     if ($dbh) {
 534         my $rq =
 535           $dbh->prepare(
 536             "SELECT * from systempreferences WHERE variable='Version'");
 537         if ( $rq->execute ) {
 538             my ($version) = $rq->fetchrow;
 539             if ($version) {
 540                 print $query->redirect(
 541                     "/cgi-bin/koha/installer/install.pl?step=3");
 542                 exit;
 543             }
 544         }
 545     }
 546 }
 547
 548 if ($op) {
 549     $op =~ s/cud-//;
 550     $template->param( op => $op, $op => 1 );
 551 }
 552
 553 output_html_with_http_headers $query, $cookie, $template->output;
 554
 555 sub chk_log {    #returns a logfile in $dir or - if that failed - in temp dir
 556     my ( $dir, $name ) = @_;
 557     my $fn = $dir . '/' . $name . '.log';
 558     if ( !open my $fh, '>', $fn ) {
 559         $name .= '_XXXX';
 560         require File::Temp;
 561         ( $fh, $fn ) =
 562           File::Temp::tempfile( $name, TMPDIR => 1, SUFFIX => '.log' );
 563
 564         #if this should not work, let croak take over
 565     }
 566     return $fn;
 567 }
 568
 569 sub colorize {
 570     my ($report) = @_;
 571     my $h = HTML::FromANSI::Tiny::Bootstrap->new(
 572         auto_reverse  => 0,
 573         background    => 'white',
 574         foreground    => 'black',
 575         no_plain_tags => 1
 576     );
 577
 578     my @states = ( 'success', 'error' );
 579     for my $state (@states) {
 580         for my $result ( @{ $report->{$state} } ) {
 581
 582             #@{ $result->{output} } = map { s/^\t+//; $h->html($_) } @{ $result->{output} };
 583             for my $output ( @{ $result->{output} } ) {
 584                 $output = $h->html($output);
 585             }
 586         }
 587     }
 588 }