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