installer/install.pl

   1 #!/usr/bin/perl -w # please develop with -w
   2
   3 #use diagnostics;
   4
   5 # use Install;
   6 use InstallAuth;
   7 use C4::Context;
   8 use C4::Interface::CGI::Output;
   9 use C4::Languages;
  10
  11 use strict; # please develop with the strict pragma
  12
  13 use CGI;
  14
  15 my $query=new CGI;
  16 my $step=$query->param('step');
  17
  18 my $language=$query->param('language');
  19 my ($template, $loggedinuser, $cookie);
  20
  21
  22 my $all_languages=getAllLanguages();
  23
  24 if (defined($language) ){
  25   setlanguagecookie($query,$language,"install.pl?step=1");
  26 }
  27 ($template, $loggedinuser, $cookie)
  28         = get_template_and_user({template_name => "installer/step".($step?$step:1).".tmpl",
  29                 query => $query,
  30                 type => "intranet",
  31                 authnotrequired => 0,
  32                 debug => 1,
  33                 });
  34
  35 if ($step && $step==1){
  36   #First Step
  37   #Checking ALL perl Modules and services needed are installed.
  38   #Whenever there is an error, adding a report to the page
  39   # I suppose here that Apache user can access /usr/bin/
  40   # If mysql or zebra are in some fancy directory not in PATH
  41   # Performing a disk search.
  42   $template->param(language=>1);
  43   my $problem;
  44
  45   unless ($] >= 5.006001) {                     # Bug 179
  46       $template->param("problems"=>1,"perlversion"=>1);
  47       $problem=1;
  48   }
  49   unless (-x "/usr/bin/perl") {
  50     my $realperl=`which perl`;
  51     $realperl=`find / -name perl` unless ($realperl);
  52     chomp $realperl;
  53     $template->param("problems"=>1,'perllocation'=>1) unless ($realperl);
  54     $problem=1 unless($realperl);
  55   }
  56   unless (-x "/usr/local/bin/mysql") {
  57     my $mysql=`which mysql`;
  58     $mysql=`find / -name mysql` unless ($mysql);
  59     chomp $mysql;
  60     $template->param("problems"=>1,'mysql'=>1) unless ($mysql);
  61     $problem=1 unless($mysql);
  62   }
  63   unless (-x "/usr/local/bin/zebraidx" ||-x "/usr/local/bin/zebraidx-2.0") {
  64     my $zebra=`which zebraidx`;
  65     $zebra=`which zebraidx-2.0` unless ($zebra);
  66     $zebra=`find / -name "zebraidx*"` unless ($zebra);
  67     chomp $zebra;
  68     $template->param("problems"=>1,'zebra'=>1) unless ($zebra);
  69     $problem=1 unless ($zebra);
  70   }
  71   unless (-x "/usr/local/bin/zebrasrv" ||-x "/usr/local/bin/zebrasrv-2.0") {
  72     my $zebra=`which zebrasrv`;
  73     $zebra=`which zebrasrv-2.0` unless ($zebra);
  74     $zebra=`find / -name "zebrasrv*"` unless ($zebra);
  75     chomp $zebra;
  76     $template->param("problems"=>1,'zebra'=>1) unless ($zebra);
  77     $problem=1 unless ($zebra);
  78   }
  79   unless (-x "/usr/local/bin/yaz-client") {
  80     my $yaz=`which yaz-client`;
  81     $yaz=`find / -name "yaz-client*"` unless ($yaz);
  82     chomp $yaz;
  83     $template->param("problems"=>1,'yaz'=>1) unless ($yaz);
  84     $problem=1 unless ($yaz);
  85   }
  86   # We could here use a special find
  87   my @missing = ();
  88   unless (eval {require ZOOM})       {
  89           push @missing, {name=>"ZOOM"};
  90   }
  91   unless (eval {require LWP::Simple})       {
  92           push @missing, {name=>"LWP::Simple"};
  93   }
  94   unless (eval {require XML::Simple})       {
  95           push @missing, {name=>"XML::Simple"};
  96   }
  97   unless (eval {require MARC::File::XML})       {
  98           push @missing, {name=>"MARC::File::XML"};
  99   }
 100   unless (eval {require MARC::File::USMARC})       {
 101           push @missing, {name=>"MARC::File::USMARC"};
 102   }
 103   unless (eval {require DBI})              { push @missing,{name=>"DBI"} };
 104   unless (eval {require Date::Manip})      { push @missing,{name=>"Date::Manip"} };
 105   unless (eval {require DBD::mysql})       { push @missing,{name=>"DBD::mysql"} };
 106   unless (eval {require HTML::Template})   { push @missing,{name=>"HTML::Template::Pro"} };
 107   unless (eval {require HTML::Template})   { push @missing,{name=>"Date::Calc"} };
 108   unless (eval {require Digest::MD5})      { push @missing,{name=>"Digest::MD5"} };
 109   unless (eval {require MARC::Record})     { push @missing,{name=>"MARC::Record"} };
 110   unless (eval {require Mail::Sendmail})   { push @missing,{name=>"Mail::Sendmail",usagemail=>1} };
 111 # The following modules are not mandatory, depends on how the library want to use Koha
 112   unless (eval {require PDF::API2})   {
 113           if ($#missing>=0) { # only when $#missing >= 0 so this isn't fatal
 114               push @missing,{name=>"PDF::API2",usagebarcode=>1};
 115           }
 116   }
 117   unless (eval {require GD::Barcorde})   {
 118     if ($#missing>=0) { # only when $#missing >= 0 so this isn't fatal
 119       push @missing,{name=>"GD::Barcode",usagebarcode=>1,usagespine=>1};
 120     }
 121   }
 122   unless (eval {require Data::Random})   {
 123     if ($#missing>=0) { # only when $#missing >= 0 so this isn't fatal
 124       push @missing,{name=>"Data::Random",usagebarcode=>1};
 125     }
 126   }
 127   unless (eval {require PDF::Reuse::Barcode})   {
 128     if ($#missing>=0) { # only when $#missing >= 0 so this isn't fatal
 129       push @missing,{name=>"PDF::Reuse::Barcode",usagebarcode=>1};
 130     }
 131   }
 132   unless (eval {require PDF::Report})   {
 133     if ($#missing>=0) { # only when $#missing >= 0 so this isn't fatal
 134       push @missing,{name=>"PDF::Report",usagebarcode=>1};
 135     }
 136   }
 137   unless (eval {require GD::Barcode::UPCE})   {
 138     if ($#missing>=0) { # only when $#missing >= 0 so this isn't fatal
 139       push @missing,{name=>"GD::Barcode::UPCE",usagepine=>1};
 140     }
 141   }
 142   unless (eval {require Net::LDAP})       {
 143     if ($#missing>=0) { # only when $#missing >= 0 so this isn't fatal
 144       push @missing,{name=>"Net::LDAP",usageLDAP=>1};
 145     }
 146   }
 147
 148   $template->param(missings=>\@missing) if (scalar(@missing)>0);
 149   $template->param('checkmodule'=>1) unless (scalar(@missing) && $problem);
 150
 151 } elsif ($step && $step==2){
 152   # Check Database connection and access
 153   my %info;
 154   $info{'dbname'}=C4::Context->config("database");
 155   $info{'dbms'}=(C4::Context->config("db_scheme")?C4::Context->config("db_scheme"):"mysql");
 156   $info{'hostname'}=C4::Context->config("hostname");
 157   ($info{'hostname'},$info{'port'})=($1,$2) if $info{'hostname'}=~/([^:]*):([0-9]+)/;
 158   $info{'user'}=C4::Context->config("user");
 159   $info{'password'}=C4::Context->config("pass");
 160   $template->param(%info);
 161   my $checkmysql=$query->param("checkmysql");
 162   $template->param('mysqlconnection'=>$checkmysql);
 163   if ($checkmysql){
 164     my $dbh= DBI->connect("DBI:$info{dbms}:$info{dbname}:$info{hostname}".($info{port}?":$info{port}":""),$info{'user'}, $info{'password'});
 165     if ($dbh){
 166       # Can connect to the mysql
 167       $template->param("checkdatabaseaccess"=>1);
 168       if ($info{dbms} eq "mysql"){
 169         #Check if database created
 170         my $rv=$dbh->do("SHOW DATABASES LIKE \'$info{dbname}\'");
 171         if ($rv==1){$template->param('checkdatabasecreated'=>1);}
 172         #Check if user have all necessary grants on this database.
 173         my $rq=$dbh->prepare("SHOW GRANTS FOR \'$info{user}\'\@'$info{hostname}'");
 174         $rq->execute;
 175         my $grantaccess;
 176         while (my ($line)=$rq->fetchrow){
 177           my $dbname=$info{dbname};
 178           if ($line=~m/$dbname/ || index($line,'*.*')>0){
 179             $grantaccess=1 if (index($line,'ALL PRIVILEGES')>0 ||
 180             ((index($line,'SELECT')>0)&&(index($line,'INSERT')>0)&&(index($line,'UPDATE')>0)&&(index($line,'DELETE')>0)&&(index($line,'CREATE')>0)&&(index($line,'DROP')>0)));
 181           }
 182         }
 183         unless ($grantaccess){
 184           $rq=$dbh->prepare("SHOW GRANTS FOR \'$info{user}\'\@'\%'");
 185           $rq->execute;
 186           while (my ($line)=$rq->fetchrow){
 187             my $dbname=$info{dbname};
 188             if ($line=~m/$dbname/ || index($line,'*.*')>0){
 189               $grantaccess=1 if (index($line,'ALL PRIVILEGES')>0 ||
 190               ((index($line,'SELECT')>0)&&(index($line,'INSERT')>0)&&(index($line,'UPDATE')>0)&&(index($line,'DELETE')>0)&&(index($line,'CREATE')>0)&&(index($line,'DROP')>0)));
 191             }
 192           }
 193         }
 194         $template->param("checkgrantaccess"=>$grantaccess);
 195       }
 196     } else {
 197       $template->param("error"=>DBI::err,"message"=>DBI::errstr);
 198     }
 199   }
 200 } elsif ($step && $step==3){
 201   my %info;
 202   $info{'dbname'}=C4::Context->config("database");
 203   $info{'dbms'}=(C4::Context->config("db_scheme")?C4::Context->config("db_scheme"):"mysql");
 204   $info{'hostname'}=C4::Context->config("hostname");
 205   ($info{'hostname'},$info{'port'})=($1,$2) if $info{'hostname'}=~/([^:]*):([0-9]+)/;
 206   $info{port} = 3306 unless ($info{port});
 207   $info{'user'}=C4::Context->config("user");
 208   $info{'password'}=C4::Context->config("pass");
 209   my $op=$query->param('op');
 210   if ($op && $op eq 'finish'){
 211     # Installation is finished.
 212     # We just deny anybody acess to install
 213     # And we redirect people to mainpage.
 214     # The installer wil have to relogin since we donot pass cookie to redirection.
 215     my $dir=C4::Context->config('intranetdir');
 216     qx(chmod -R uog-xw $dir/installer);
 217     print $query->redirect("/cgi-bin/koha/mainpage.pl");
 218     exit 1;
 219   } elsif ($op && $op eq 'addframeworks'){
 220     #Framework importing and reports
 221     my $lang;
 222     my %hashlevel;
 223    # sort by filename -> prepend with numbers to specify order of insertion.
 224
 225         my @fnames = sort { my @aa = split /\/|\\/, ($a); my @bb = split /\/|\\/, ($b); $aa[-1] <=> $bb[-1] } $query->param('framework')  ;
 226
 227         foreach my $file (@fnames){
 228      warn $file;
 229          undef $/;
 230       my $strcmd="mysql ".($info{hostname}?"-h $info{hostname} ":"").($info{port}?"-P $info{port} ":"").($info{user}?"-u $info{user} ":"").($info{password}?"-p$info{password}":"")." $info{dbname} ";
 231       my $str = qx($strcmd < $file 2>&1);
 232       my @file = split qr(\/|\\),$file;
 233       $lang=$file[scalar(@file)-3] unless ($lang);
 234       my $level=$file[scalar(@file)-2];
 235       #Bulding here a hierarchy to display files by level.
 236       push @{$hashlevel{$level}},{"fwkname"=>$file[scalar(@file)-1],"error"=>$str};
 237     }
 238     my @list;
 239     map {push @list,{"level"=>$_,"fwklist"=>$hashlevel{$_}}} keys %hashlevel;
 240     my $fwk_language;
 241     for my $each_language(@$all_languages) {
 242                 warn "CODE".$each_language->{'language_code'};
 243                 warn "LANG:".$lang;
 244                 if ($lang eq $each_language->{'language_code'}) {
 245                         $fwk_language = $each_language->{language_locale_name};
 246                 }
 247     }
 248     $template->param("fwklanguage"=>$fwk_language,
 249                      "list"=>\@list);
 250     $template->param("$op"=>1);
 251   } elsif ( $op && $op eq 'selectframeworks'){
 252     #Framework Selection
 253     #sql data for import are supposed to be located in misc/sql-datas/<language>/<level>
 254     # Where <language> is en|fr or any international abbreviation (provided language hash is updated... This will be a problem with internationlisation.)
 255     # Where <level> is a category of requirement : required, recommended optional
 256     # level should contain :
 257     #   SQL File for import With a readable name.
 258     #   txt File taht explains what this SQL File is meant for.
 259     # Could be VERY useful to have A Big file for a kind of library.
 260     # But could also be useful to have some Authorised values data set prepared here.
 261     # Framework Selection is achieved through checking boxes.
 262     my $langchoice=$query->param('fwklanguage') ;
 263     $langchoice=$query->cookie('KohaOpacLanguage') unless ($langchoice);
 264         my $dir=C4::Context->config('intranetdir')."/misc/sql-datas/";
 265     opendir (MYDIR,$dir);
 266     my @listdir= grep { !/^\.|CVS/ && -d "$dir/$_"} readdir(MYDIR);
 267     closedir MYDIR;
 268         my $frmwklangs = getFrameworkLanguages();
 269     my @languages;
 270     map{
 271       push @languages,{'dirname'=>$_->{'language_code'}, 'languagedescription'=>$_->{'language_name'},'checked'=>($_->{'language_code'} eq $langchoice) } if ($_->{'language_code'});
 272     } @$frmwklangs;
 273     $template->param("languagelist"=>\@languages);
 274     undef $/;
 275     $dir=C4::Context->config('intranetdir')."/misc/sql-datas/$langchoice";
 276     opendir (MYDIR,$dir) || warn "no open $dir";
 277     @listdir= grep { !/^\.|CVS/ && -d "$dir/$_"} readdir(MYDIR);
 278     closedir MYDIR;
 279     my @levellist;
 280         foreach my $requirelevel (@listdir){
 281       $dir =C4::Context->config('intranetdir')."/misc/sql-datas/$langchoice/$requirelevel";
 282       opendir (MYDIR,$dir);
 283       my @listname = grep { !/^\.|CVS/ && -f "$dir/$_" && $_=~m/\.sql$/} readdir(MYDIR);
 284       closedir MYDIR;
 285       my %cell;
 286       my @frameworklist;
 287       map{
 288         my $name=substr($_,0,-4);
 289         open FILE, "< $dir/$name.txt";
 290         my $lines = <FILE>;
 291         $lines=~s/\n|\r/<br \/>/g;
 292         use utf8;
 293         utf8::encode($lines) unless (utf8::is_utf8($lines));
 294         push @frameworklist,{'fwkname'=>$name, 'fwkfile'=>"$dir/$_",'fwkdescription'=>$lines};
 295       } @listname;
 296           my @fwks = sort { $a->{'fwkname'} <=> $b->{'fwkname'} } @frameworklist;
 297       $cell{"mandatory"}=($requirelevel=~/(mandatory|requi|oblig|necess)/i);
 298       $cell{"frameworks"}=\@fwks;
 299       $cell{"label"}=ucfirst($requirelevel);
 300       $cell{"code"}=lc($requirelevel);
 301       push @levellist,\%cell;
 302     }
 303     $template->param("levelloop"=>\@levellist);
 304     $template->param("$op"=>1);
 305   } elsif ($op && $op eq 'updatestructure'){
 306     #Do updatedatabase And report
 307     my $execstring=C4::Context->config("intranetdir")."/updater/updatedatabase";
 308     undef $/;
 309     my $string= qx|$execstring 2>&1|;
 310     if ($string){
 311       $string=~s/\n|\r/<br \/>/g;
 312       $string=~s/(DBD::mysql.*? failed: .*? line [0-9]*.|=================.*?====================)/<font color=red>$1<\/font>/g;
 313       $template->param("updatereport"=>$string) ;
 314     }
 315     $template->param($op=>1)
 316   }elsif ($op && $op eq 'importdatastructure'){
 317     #Import data structure and show errors if any
 318     my $filename="kohastructure.sql";
 319     undef $/;
 320         my $str = qx(mysql -h $info{hostname} -P $info{port} -u $info{user} -p$info{password} $info{dbname} <$filename 2>&1);
 321         $str=~s/\n|\r/<br \/>/g;
 322         $template->param("error"=>$str ,
 323                                         importdatastructure => 1, );
 324   } else {
 325     #Check if there are enough tables.
 326     # Version 2_2 was 74 tables, so we check if there is more than 75
 327     # Maybe could be in step 2
 328     #I put it there because it implied a data import if condition was not satisfied.
 329     my $dbh= DBI->connect("DBI:$info{dbms}:$info{dbname}:$info{hostname}".($info{port}?":$info{port}":""),$info{'user'}, $info{'password'});
 330     my $rq=$dbh->prepare("SHOW TABLES FROM ".$info{'dbname'});
 331     $rq->execute;
 332     my $data=$rq->fetchall_arrayref({});
 333     my $count=scalar(@$data);
 334     if ($count < 75){
 335       $template->param("count"=>$count,"proposeimport"=>1);
 336     } else {
 337       $template->param("count"=>$count,"default"=>1);
 338     }
 339     $dbh->disconnect;
 340   }
 341 }else {
 342   # LANGUAGE SELECTION page by default
 343   # using opendir + language Hash
 344
 345   my $langavail = getTranslatedLanguages();
 346   my @languages;
 347   foreach (@$langavail){
 348         push @languages,{'value'=>$_->{'language_code'}, 'description'=>$_->{'language_name'} } if ($_->{'language_code'});
 349   }
 350   $template->param(languages=>\@languages);
 351 }
 352 output_html_with_http_headers $query, $cookie, $template->output;