Moved all references to file descriptors out of the generic object
[wine] / tools / winecheck
1 #!/usr/bin/perl -w
2
3 # This program checks the whole Wine environment configuration.
4 # (or that's at least what it's supposed to do once it's finished)
5 # Copyright (C) 2001 Andreas Mohr
6 #
7 # This library is free software; you can redistribute it and/or
8 # modify it under the terms of the GNU Lesser General Public
9 # License as published by the Free Software Foundation; either
10 # version 2.1 of the License, or (at your option) any later version.
11 #
12 # This library is distributed in the hope that it will be useful,
13 # but WITHOUT ANY WARRANTY; without even the implied warranty of
14 # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
15 # Lesser General Public License for more details.
16 #
17 # You should have received a copy of the GNU Lesser General Public
18 # License along with this library; if not, write to the Free Software
19 # Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
20 #
21 # FIXME:
22 # - implement cmdline arguments e.g. for confirmation keypress
23 #   in case of a problem
24 #
25 # TODO:
26 # - implement it in a much more systematic way. This is a quick hack for now
27 #   (like every Perl program ;-)
28 #   And much more so since I'm NOT a Perl hacker
29 # - test/tweak on non-Linux systems
30 #
31
32 use Getopt::Long;
33 use strict;
34
35 my $hold = 0;
36
37 my $count_tests = 0;
38 my $count_ok = 0;
39 my $count_notice = 0;
40 my $count_suspect = 0;
41 my $count_bad = 0;
42 my $count_critical = 0;
43 my $count_failed = 0;
44
45 my $is_notchecked = 0;
46 my $is_ok = 1;
47 my $is_notice = 2;
48 my $is_suspect = 3;
49 my $is_bad = 4;
50 my $is_critical = 5;
51 my $is_failed = 6;
52
53 my $factor_suspect = 0.995;
54 my $factor_bad = 0.95;
55 my $factor_critical = 0.85;
56 my $factor_failed = 0.15;
57
58 my $correctness = 100.0;
59
60 my $indent = 0;
61
62 my ($level, $reason, $advice);
63
64 my $advice_chmod = "If your user account is supposed to be able to access
65 it properly, use chmod as root to fix it (\"man chmod\")";
66 my $advice_fs = "The Filesystem option indicates the filesystem behaviour Wine is supposed to *emulate*, not the filesystem which is there";
67
68 my $dev_read = 1;
69 my $dev_write = 2;
70 my $dev_open = 4;
71
72 select(STDERR); $| = 1;     # make unbuffered
73 select(STDOUT); $| = 1;     # make unbuffered
74
75 #--------------------------------- main program --------------------------------
76 &Introduction();
77 &Check_Misc();
78 &Check_BaseFiles();
79 &Check_ConfigFile();
80 &Check_Devices();
81 &Check_Registry();
82 &Check_WindowsFiles();
83 &Print_Score();
84
85 #------------------------------- support functions -----------------------------
86 sub Do_PrintHeader {
87   my ($str) = @_;
88   my $len = length($str);
89   my $num = int((80 - $len - 2)/2);
90   my $i;
91
92   print "\n";
93   for ($i = 0; $i < $num; $i++) {
94     print "-";
95   }
96   print " ".$str." ";
97   for ($i = 0; $i < $num; $i++) {
98     print "-";
99   }
100   if ($len % 2)
101   {
102     print "-";
103   }
104   print "\n";
105 }
106
107 sub Do_Check {
108   my ($text) = @_;
109   my $test_no;
110   my $indent_str = "";
111
112   $count_tests++;
113   $test_no = sprintf("%03d", $count_tests);
114   for (my $i = 0; $i < $indent; $i++)
115   {
116     $indent_str = $indent_str." ";
117   }
118   print sprintf("%.60s", $test_no.".".$indent_str." Checking ".$text."...                                           ");
119 }
120
121 sub Do_PrintResult {
122   my($level, $str, $advice, $skip_score) = @_;
123   my $err;
124   my $key;
125
126   if ($level == $is_notchecked)
127   {
128     $err = "NOT CHECKED";
129     $str = "";
130     $advice = "";
131   }
132   elsif ($level == $is_ok)
133   {
134     $err = "OK";
135     $str = "";
136     $advice = "";
137     $count_ok++;
138   }
139   elsif ($level == $is_notice)
140   {
141     $err = "NOTICE";
142     $count_notice++;
143   }
144   elsif ($level == $is_suspect)
145   {
146     $err = "SUSPICIOUS";
147     $count_suspect++;
148     if (! $skip_score)
149     {
150       $correctness *= $factor_suspect;
151     }
152   }
153   elsif ($level == $is_bad)
154   {
155     $err = "BAD";
156     $count_bad++;
157     if (! $skip_score)
158     {
159       $correctness *= $factor_bad;
160     }
161   }
162   elsif ($level == $is_critical)
163   {
164     $err = "CRITICAL";
165     $count_critical++;
166     if (! $skip_score)
167     {
168       $correctness *= $factor_critical;
169     }
170   }
171   elsif ($level == $is_failed)
172   {
173     $err = "FAILED";
174     $count_failed++;
175     if (! $skip_score)
176     {
177       $correctness *= $factor_failed;
178     }
179   }
180   print $err;
181   if ($str)
182   {
183     print " (".$str.")";
184   }
185   print ".";
186   if ($hold)
187   {
188     print " Press Enter.";
189     $key = getc(STDIN);
190   }
191   else
192   {
193     print "\n";
194   }
195   if ($advice)
196   {
197     print "- ADVICE: ".$advice.".\n";
198   }
199 }
200
201 #-------------------------------- main functions ------------------------------
202 sub Introduction {
203   print "This script verifies the configuration of the whole Wine environment.\n";
204   print "Note that this is an ALPHA version, and thus it doesn't catch all problems !\n";
205   print "The results of the checks are printed on the right side:\n";
206   print "OK         - test passed without problems.\n";
207   print "NOTICE     - Not a problem but something for the user to be aware of.\n"; 
208   print "SUSPICIOUS - potentially problematic. You might want to look into that.\n";
209   print "BAD        - This is a problem, and it leads to configuration score penalty.\n";
210   print "CRITICAL   - A critical problem which can easily lead to malfunction.\n";
211   print "FAILED     - This problem leads to Wine failure almost certainly.\n";
212   print "\nThe result will be printed as a percentage score indicating config completeness.\n";
213   print "\n";
214   if ($hold)
215   {
216     my $key;
217     print "Press Enter to continue or Ctrl-C to exit.";
218     $key = getc(STDIN);
219   }
220 }
221
222 sub Check_Misc {
223
224   Do_PrintHeader("checking miscellaneous stuff");
225
226   Do_Check("for root user");
227   
228   $level = $is_ok;
229
230   if (`whoami` =~ /^root$/)
231   {
232     $level = $is_bad;
233     $reason = "running as root might be insecure/problematic.";
234     $advice = "don\'t run Wine as root unless you know what you\'re doing";
235   }
236   Do_PrintResult($level, $reason, $advice);
237 }
238
239 sub Check_BaseFiles {
240   my $line;
241
242   Do_PrintHeader("checking Wine base files");
243
244   $level = $is_ok;
245   Do_Check("for file \"wine\"");
246   $line = `which wine`;
247   if (!$line)
248   {
249     $level = $is_failed;
250     $reason = "file not found";
251     $advice = "Make sure the \"wine\" command is in your PATH (echo \$PATH; export PATH=xxx)";
252   }
253   Do_PrintResult($level, $reason, $advice);
254
255   # check for config mess
256   $level = $is_ok;
257   my @output = ();
258   Do_Check("for correct .so lib config (please wait)");
259
260   # Build list of library directories.
261   # First parse ld.so.conf to find system-wide lib directories.
262   my @dirlist = ();
263   open (LDCONF, "</etc/ld.so.conf");
264   while (<LDCONF>) {
265     s/\#.*//; # eliminate comments
266     chomp;
267     if (-d $_) { push @dirlist, $_; }
268   }
269   close (LDCONF);
270   # Next parse LD_LIBRARY_PATH to find user-specific lib dirs.
271   my ($dir);
272   if ($ENV{'LD_LIBRARY_PATH'}) {
273     my (@ld_dirs) = split (/:/, $ENV{'LD_LIBRARY_PATH'});
274     foreach $dir (@ld_dirs) {
275       if (-d $dir) { push @dirlist, $dir; }
276     }
277   }
278
279   # Now check for a libwine.so in each directory
280   foreach $dir (@dirlist) {
281     my ($target) = $dir . "/libwine.so";
282     if (-f $target) { push @output, $target; }
283   }
284   #print "DEBUG: found libwine: @output\n";
285
286   if (@output > 1)
287   {
288     $level = $is_suspect;
289     my $dirs = "";
290     foreach $line (@output) {
291       chomp $line;
292       $dirs = $dirs." ".$line;
293     }
294     $reason = "libwine.so found ".@output." times:".$dirs;
295     $advice = "check whether this is really ok";
296   }
297   Do_PrintResult($level, $reason, $advice);
298 }
299
300 sub Do_Config_Drive {
301   my ($drive, $entries, $values) = @_;
302   my $index = 0;
303   my $arg;
304   my $path = "";
305   my $type = "";
306   my $label = "";
307   my $serial = "";
308   my $device = "";
309   my $fs = "";
310   my $unknown = "";
311   my $level;
312   my $my_advice_fat = "If that doesn't help, change mount options in case of VFAT (\"umask\" option)";
313
314   print "\n>>> Checking drive ".$drive." settings:\n";
315   $reason = "";
316   while (@$entries[$index])
317   {
318     $arg = @$values[$index];
319     SWITCH: for (@$entries[$index]) {
320         /^path$/i       && do { $path = $arg; last; };
321         /^type$/i && do { $type = $arg; last; };
322         /^label$/i && do { $label = $arg; last; };
323         /^serial$/i && do { $serial = $arg; last; };
324         /^device$/i && do { $device = $arg; last; };
325         /^filesystem$/i && do { $fs = $arg; last; };
326         $unknown = @$entries[$index];
327     }
328     $index++;
329   }
330
331   $indent++;
332
333   my $serious = ($drive =~ /^C$/i) || ($type =~ /^cdrom$/i);
334
335   ##### check Path #####
336   Do_Check("Path option");
337   $level = $is_ok;
338   $advice = "The syntax of the Path option has to be something like /my/mount/point";
339   if (! $path)
340   {
341     $level = $serious ? $is_failed : $is_bad;
342     $reason = "no Path option given in config file";
343   }
344   elsif ($path =~ /\\/)
345   {
346     $level = $serious ? $is_failed : $is_bad;
347     $reason = "wrong Path format ".$path;
348   }
349   elsif ($path =~ /\$\{(.*)\}$/)
350   {
351     # get path assigned to environment variable
352     my $envpath = $ENV{$1};
353     if (! $envpath)
354     {
355       $level = $serious ? $is_failed : $is_critical;
356       $reason = "Path \"".$path."\" references environment variable \"".$1."\" which is undefined";
357       $advice = "set environment variable before starting Wine or give a \"real\" directory instead";
358     }
359     else
360     {
361       $path = $envpath;
362       goto PERMCHECK; # hmpf
363     }
364   }
365   else
366   {
367 PERMCHECK:
368     if (!-e $path)
369     {
370       $level = $serious ? $is_failed : $is_suspect;
371       $reason = $path." does not exist !";
372       $advice = "create this directory or point Path to a real directory";
373     }
374     elsif (!-r $path)
375     {
376       $level = $serious ? $is_failed : $is_bad;
377       $reason = $path." is not readable for you";
378       $advice = $advice_chmod.". ".$my_advice_fat;
379     }
380     elsif ((! ($type =~ /^cdrom$/i)) && (!-w $path))
381     {
382       $level = ($drive =~ /^C$/i) ? $is_failed : $is_suspect;
383       $reason = $path." is not writable for you";
384       $advice = $advice_chmod.". ".$my_advice_fat;
385     }
386     else # check permissions of the drive's directories
387     {
388         my(@output) = ();
389         push (@output, `find $path 2>&1 1>/dev/null`);
390         foreach my $line (@output) {
391             if ($line =~ /find:\ (.*):\ Permission denied$/)
392             {
393                 $level = ($drive =~ /^C$/i) ? $is_critical : $is_suspect;
394                 $reason = "directory $1 is not accessible for you";
395                 $advice = $advice_chmod.". ".$my_advice_fat;
396                 last;
397             }
398         }
399     }
400   }
401   Do_PrintResult($level, $reason, $advice);
402
403   ##### check Type #####
404   if ($type)
405   {
406     Do_Check("Type option");
407     $level = $is_ok;
408     SWITCH: for ($type) {
409         /^floppy$/i && do { last; };
410         /^hd$/i && do { last; };
411         /^network$/i && do { last; };
412         /^cdrom$/i && do {
413                         if (! $device)
414                         {
415                           $level = $is_critical;
416                           $reason = "no Device option found -> CD-ROM labels can\'t be read";
417                           $advice = "add Device option and make sure the device given is accessible by you";
418                         }
419                         last;
420                          };
421         /^ramdisk$/i && do { last; };
422         if ($type)
423         {
424           $level = $is_bad;
425           $reason = "invalid Type setting ".$type;
426           $advice = "use one of \"floppy\", \"hd\", \"network\" or \"cdrom\"";
427         }
428     }
429     Do_PrintResult($level, $reason, $advice);
430   }
431
432   ##### FIXME: check Label and Serial here #####
433
434   ##### check Device #####
435   if ($device)
436   {
437     my $mode = ($type =~ /^cdrom$/i) ? $dev_read : $dev_read|$dev_write;
438     &Do_CheckDevice("device", $device, 1, $mode);
439   }
440
441   ##### check Filesystem #####
442   if ($fs)
443   {
444     Do_Check("Filesystem option");
445     $level = $is_ok;
446     SWITCH: for ($fs) {
447         /^(dos|fat|msdos|unix)$/i && do {
448                          $level = $is_bad;
449                          $reason = "You probably don't want to use \"".$fs."\". ".$advice_fs;
450                          if ($fs =~ /^unix$/i)
451                          {
452                            $advice = "This should almost never be used";
453                          }
454                          else
455                          {
456                            $advice = "only use ".$fs." if you only have a crappy 8.3 filename (i.e.: non-LFN) DOS FAT kernel filesystem driver";
457                          }
458                          last;
459                            };
460         /^vfat$/i && do { last; };
461         /^win95$/i && do { last; };
462         if ($fs)
463         {
464           $level = $is_bad;
465           $reason = "invalid Filesystem setting ".$type;
466           $advice = "use one of \"win95\", \"msdos\" or \"unix\"";
467         }
468     }
469     Do_PrintResult($level, $reason, $advice);
470   }
471   $indent--;
472   if ($reason) {
473     print "--> PROBLEM.\n";
474   }
475   else
476   {
477     print "--> OK.\n";
478   }
479 }
480
481 sub Do_Config_Main {
482   my ($file) = shift;
483   my ($config, $line);
484   my $section = "";
485   my (@entries, @values);
486   LINE: while (<$file>)
487   {
488     $line = $_;
489     next LINE if ($line =~ /[\ ]*[;#]/);        # skip comments
490     chomp $line;
491     #print "line: ".$line."\n";
492     if ($line =~ /\[(.*)\]/) # end of section/next section ?
493     {
494       my $nextsection = $1;
495       my $found = 1;
496       SWITCH: for ($section) {
497         /Drive\ (.)/i   && do { &Do_Config_Drive($1, \@entries, \@values); last; };
498         if ($section)
499         {
500           $found = 0;
501         }
502       }
503       $section = $found ? $nextsection : "";
504       @entries = (); @values = ();
505       next LINE;
506     }
507     if ($line =~ /^[\ \t]*\"(.*)\"[\ \t]*\=[\ \t]*\"(.*)\"/)
508     {
509       push(@entries, $1);
510       push(@values, $2);
511     }
512   }
513 }
514
515 sub Check_ConfigFile {
516   my $config = "$ENV{'HOME'}/.wine/config";
517   my $indrive = 0;
518
519   Do_PrintHeader("checking config file");
520
521   Do_Check("config file access");
522   open(CFGFILE, $config);
523   if (! <CFGFILE>)
524   {
525     if (!-e $config) {
526       $reason = $config." does not exist";
527       $advice = "it is ok in case you have ~/.winerc. If you don\'t, then you\'re in trouble";
528     }
529     elsif (!-r $config) {
530       $reason = $config." not readable";
531       $advice = $advice_chmod;
532     }
533     Do_PrintResult($is_failed, $reason, $advice);
534     return;
535   }
536   if (!-w $config)
537   {
538     Do_PrintResult($is_failed, $config." not writable", "wineserver needs to be able to write to config file. ".$advice_chmod);
539   }
540   else
541   {
542     Do_PrintResult($is_ok);
543   }
544   Do_Config_Main(\*CFGFILE);
545   close(CFGFILE);
546 }
547
548 sub Do_CheckDevice {
549   my($descr, $dev, $output, $mode) = @_;
550   my $level = $is_ok;
551   my $errstr = "";
552
553   if (! $mode)
554   {
555     $mode = $dev_read|$dev_write|$dev_open;
556   }
557   ($output != -1) && Do_Check($descr." ".$dev);
558
559   my $err_level = ($output == 1) ? $is_critical : $is_bad;
560
561   if (!-e $dev)
562   {
563     $level = $err_level;
564     $reason = $dev." does not exist";
565     $advice = "use MAKEDEV script to create it";
566     goto FAILED;
567   }
568   if (($mode & $dev_read) && (!-r $dev))
569   {
570     $level = $err_level;
571     $reason = $dev." is not readable for you";
572     $advice = $advice_chmod;
573     goto FAILED;
574   }
575   if (($mode & $dev_write) && (!-w $dev))
576   {
577     $level = $err_level;
578     $reason = $dev." is not writable for you";
579     $advice = $advice_chmod;
580     goto FAILED;
581   }
582   if (($mode & $dev_open) && (!open(DEVICE, ">$dev")))
583   {
584     $level = $err_level;
585     $reason = "no kernel driver for ".$dev."or used by other program?";
586     $advice = "module loading problems ? Read /usr/src/linux/Documentation/modules.txt";
587     goto FAILED;
588   }
589
590 FAILED:
591   close(DEVICE);
592   ($output != -1) && Do_PrintResult($level, $reason, $advice);
593 }
594
595 sub Check_Devices {
596 # FIXME: check joystick and scsi devices !
597   my $dev_sound = "/dev/dsp";
598   my $dev_mixer = "/dev/mixer";
599   my $dev_sequencer = "/dev/sequencer";
600   my $dev_mem = "/dev/mem";
601
602   Do_PrintHeader("checking system devices used by Wine");
603   &Do_CheckDevice("sound device", $dev_sound, 1);
604   &Do_CheckDevice("audio mixer device", $dev_mixer, 1);
605   &Do_CheckDevice("MIDI sequencer device", $dev_sequencer, 0);
606 }
607
608 sub Check_Registry {
609   my(@entries) = ();
610   my $regfile = $ENV{'HOME'}."/.wine/system.reg";
611
612   Do_PrintHeader("checking registry configuration");
613
614   Do_Check("availability of winedefault.reg entries");
615   push (@entries, `grep "SHAREDMEMLOCATION" $regfile 2>/dev/null`);
616   if (@entries)
617   {
618     Do_PrintResult($is_ok);
619   }
620   else
621   {
622     Do_PrintResult($is_critical, "entry \"SHAREDMEMLOCATION\" not found in system.reg registry file", "file winedefault.reg, the most basic wine registry environment, doesn't seem to have been applied using regapi");
623   }
624   @entries = ();
625
626   Do_Check("availability of windows registry entries");
627 # FIXME: use a different key for check if Wine adds this one to its
628 #        default registry.
629   push (@entries, `grep "Default Taskbar" $regfile 2>/dev/null`);
630   if (@entries)
631   {
632     Do_PrintResult($is_ok);
633   }
634   else
635   {
636     Do_PrintResult($is_notice, "entry \"Default Taskbar\" not found", "A Windows registry does not seem to have been added to Wine as this typical Windows registry entry does not exist in Wine's registry.  A complete original Windows registry entry set will *not* be available with a no-windows install. Usually this will present no problem in running applications although this can affect newer programs");
637   }
638   @entries = ();
639 }
640
641 sub Check_WindowsFiles {
642 }
643
644 sub Print_Score {
645 #  my ($score_total, $score_reached, $score_percent);
646
647 #  $score_total   =     $count_tests * 20;
648 #  $score_reached =     $count_ok * 20 +
649 #                       $count_bad * 15 +
650 #                       $count_critical * 5 +
651 #                       $count_failed * 0;
652 #  $score_percent =     $score_reached * 100 / $score_total;
653
654   print "\n";
655   print $count_tests." tests. ".$count_suspect." suspicious, ".$count_bad." bad, ".$count_critical." critical, ".$count_failed." failed.\n";
656   print sprintf "Wine configuration correctness score: %2.2f%%\n", $correctness;
657 }