Remove the no longer used winewrap utility.
[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                         else
420                         {
421                           my $fs_line = `grep $device /etc/fstab`;
422                           my @entry = split /\s+/, $fs_line;
423                           if (! ($entry[3] =~ /unhide/)) 
424                           {
425                             $level = $is_suspect;
426                             $reason = "no unhide option found";
427                             $advice = "add unhide option to fstab, check http://www.winehq.org/site/docs/wine-user/config-drive-main"
428                           }
429                         }
430                         last;
431                          };
432         /^ramdisk$/i && do { last; };
433         if ($type)
434         {
435           $level = $is_bad;
436           $reason = "invalid Type setting ".$type;
437           $advice = "use one of \"floppy\", \"hd\", \"network\" or \"cdrom\"";
438         }
439     }
440     Do_PrintResult($level, $reason, $advice);
441   }
442
443   ##### FIXME: check Label and Serial here #####
444
445   ##### check Device #####
446   if ($device)
447   {
448     my $mode = ($type =~ /^cdrom$/i) ? $dev_read : $dev_read|$dev_write;
449     &Do_CheckDevice("device", $device, 1, $mode);
450   }
451
452   ##### check Filesystem #####
453   if ($fs)
454   {
455     Do_Check("Filesystem option");
456     $level = $is_ok;
457     SWITCH: for ($fs) {
458         /^(dos|fat|msdos|unix)$/i && do {
459                          $level = $is_bad;
460                          $reason = "You probably don't want to use \"".$fs."\". ".$advice_fs;
461                          if ($fs =~ /^unix$/i)
462                          {
463                            $advice = "This should almost never be used";
464                          }
465                          else
466                          {
467                            $advice = "only use ".$fs." if you only have a crappy 8.3 filename (i.e.: non-LFN) DOS FAT kernel filesystem driver";
468                          }
469                          last;
470                            };
471         /^vfat$/i && do { last; };
472         /^win95$/i && do { last; };
473         if ($fs)
474         {
475           $level = $is_bad;
476           $reason = "invalid Filesystem setting ".$type;
477           $advice = "use one of \"win95\", \"msdos\" or \"unix\"";
478         }
479     }
480     Do_PrintResult($level, $reason, $advice);
481   }
482   $indent--;
483   if ($reason) {
484     print "--> PROBLEM.\n";
485   }
486   else
487   {
488     print "--> OK.\n";
489   }
490 }
491
492 sub Do_Config_Main {
493   my ($file) = shift;
494   my ($config, $line);
495   my $section = "";
496   my (@entries, @values);
497   LINE: while (<$file>)
498   {
499     $line = $_;
500     next LINE if ($line =~ /[\ ]*[;#]/);        # skip comments
501     chomp $line;
502     #print "line: ".$line."\n";
503     if ($line =~ /\[(.*)\]/) # end of section/next section ?
504     {
505       my $nextsection = $1;
506       my $found = 1;
507       SWITCH: for ($section) {
508         /Drive\ (.)/i   && do { &Do_Config_Drive($1, \@entries, \@values); last; };
509         if ($section)
510         {
511           $found = 0;
512         }
513       }
514       $section = $found ? $nextsection : "";
515       @entries = (); @values = ();
516       next LINE;
517     }
518     if ($line =~ /^[\ \t]*\"(.*)\"[\ \t]*\=[\ \t]*\"(.*)\"/)
519     {
520       push(@entries, $1);
521       push(@values, $2);
522     }
523   }
524 }
525
526 sub Check_ConfigFile {
527   my $config = "$ENV{'HOME'}/.wine/config";
528   my $indrive = 0;
529
530   Do_PrintHeader("checking config file");
531
532   Do_Check("config file access");
533   open(CFGFILE, $config);
534   if (! <CFGFILE>)
535   {
536     if (!-e $config) {
537       $reason = $config." does not exist";
538       $advice = "it is ok in case you have ~/.winerc. If you don\'t, then you\'re in trouble";
539     }
540     elsif (!-r $config) {
541       $reason = $config." not readable";
542       $advice = $advice_chmod;
543     }
544     Do_PrintResult($is_failed, $reason, $advice);
545     return;
546   }
547   if (!-w $config)
548   {
549     Do_PrintResult($is_failed, $config." not writable", "wineserver needs to be able to write to config file. ".$advice_chmod);
550   }
551   else
552   {
553     Do_PrintResult($is_ok);
554   }
555   Do_Config_Main(\*CFGFILE);
556   close(CFGFILE);
557 }
558
559 sub Do_CheckDevice {
560   my($descr, $dev, $output, $mode) = @_;
561   my $level = $is_ok;
562   my $errstr = "";
563
564   if (! $mode)
565   {
566     $mode = $dev_read|$dev_write|$dev_open;
567   }
568   ($output != -1) && Do_Check($descr." ".$dev);
569
570   my $err_level = ($output == 1) ? $is_critical : $is_bad;
571
572   if (!-e $dev)
573   {
574     $level = $err_level;
575     $reason = $dev." does not exist";
576     $advice = "use MAKEDEV script to create it";
577     goto FAILED;
578   }
579   if (($mode & $dev_read) && (!-r $dev))
580   {
581     $level = $err_level;
582     $reason = $dev." is not readable for you";
583     $advice = $advice_chmod;
584     goto FAILED;
585   }
586   if (($mode & $dev_write) && (!-w $dev))
587   {
588     $level = $err_level;
589     $reason = $dev." is not writable for you";
590     $advice = $advice_chmod;
591     goto FAILED;
592   }
593   if (($mode & $dev_open) && (!open(DEVICE, ">$dev")))
594   {
595     $level = $err_level;
596     $reason = "no kernel driver for ".$dev."or used by other program?";
597     $advice = "module loading problems ? Read /usr/src/linux/Documentation/modules.txt";
598     goto FAILED;
599   }
600
601 FAILED:
602   close(DEVICE);
603   ($output != -1) && Do_PrintResult($level, $reason, $advice);
604 }
605
606 sub Check_Devices {
607 # FIXME: check joystick and scsi devices !
608   my $dev_sound = "/dev/dsp";
609   my $dev_mixer = "/dev/mixer";
610   my $dev_sequencer = "/dev/sequencer";
611   my $dev_mem = "/dev/mem";
612
613   Do_PrintHeader("checking system devices used by Wine");
614   &Do_CheckDevice("sound device", $dev_sound, 1);
615   &Do_CheckDevice("audio mixer device", $dev_mixer, 1);
616   &Do_CheckDevice("MIDI sequencer device", $dev_sequencer, 0);
617 }
618
619 sub Check_Registry {
620   my(@entries) = ();
621   my $regfile = $ENV{'HOME'}."/.wine/system.reg";
622
623   Do_PrintHeader("checking registry configuration");
624
625   Do_Check("availability of winedefault.reg entries");
626   push (@entries, `grep "SHAREDMEMLOCATION" $regfile 2>/dev/null`);
627   if (@entries)
628   {
629     Do_PrintResult($is_ok);
630   }
631   else
632   {
633     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 regedit");
634   }
635   @entries = ();
636
637   Do_Check("availability of windows registry entries");
638 # FIXME: use a different key for check if Wine adds this one to its
639 #        default registry.
640   push (@entries, `grep "Default Taskbar" $regfile 2>/dev/null`);
641   if (@entries)
642   {
643     Do_PrintResult($is_ok);
644   }
645   else
646   {
647     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. Feel free to ignore this message in case you do use a Windows registry, but have the SaveOnlyUpdatedKeys config setting set to N.");
648   }
649   @entries = ();
650 }
651
652 sub Check_WindowsFiles {
653 }
654
655 sub Print_Score {
656 #  my ($score_total, $score_reached, $score_percent);
657
658 #  $score_total   =     $count_tests * 20;
659 #  $score_reached =     $count_ok * 20 +
660 #                       $count_bad * 15 +
661 #                       $count_critical * 5 +
662 #                       $count_failed * 0;
663 #  $score_percent =     $score_reached * 100 / $score_total;
664
665   print "\n";
666   print $count_tests." tests. ".$count_suspect." suspicious, ".$count_bad." bad, ".$count_critical." critical, ".$count_failed." failed.\n";
667   print sprintf "Wine configuration correctness score: %2.2f%%\n", $correctness;
668 }