Added first version of the Perl regression testing framework.
[wine/multimedia.git] / tools / winecheck
blobed4176eee07f79a666b002cde3312091e60c59cf
1 #!/usr/bin/perl -w
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 # (C) 2001 Andreas Mohr
6 # Redistributable under Wine License
8 # FIXME:
9 # - implement cmdline arguments e.g. for confirmation keypress
10 # in case of a problem
12 # TODO:
13 # - implement it in a much more systematic way. This is a quick hack for now
14 # (like every Perl program ;-)
15 # And much more so since I'm NOT a Perl hacker
16 # - test/tweak on non-Linux systems
19 use Getopt::Long;
20 use strict;
22 my $hold = 0;
24 my $count_tests = 0;
25 my $count_ok = 0;
26 my $count_suspect = 0;
27 my $count_bad = 0;
28 my $count_critical = 0;
29 my $count_failed = 0;
31 my $is_notchecked = 0;
32 my $is_ok = 1;
33 my $is_suspect = 2;
34 my $is_bad = 3;
35 my $is_critical = 4;
36 my $is_failed = 5;
38 my $factor_suspect = 0.995;
39 my $factor_bad = 0.95;
40 my $factor_critical = 0.85;
41 my $factor_failed = 0.15;
43 my $correctness = 100.0;
45 my $indent = 0;
47 my ($level, $reason, $advice);
49 my $advice_chmod = "Use chmod as root to fix it (\"man chmod\")";
50 my $advice_fs = "The Filesystem option indicates the filesystem behaviour Wine is supposed to *emulate*, not the filesystem which is there";
52 my $dev_read = 1;
53 my $dev_write = 2;
54 my $dev_open = 4;
56 select(STDERR); $| = 1; # make unbuffered
57 select(STDOUT); $| = 1; # make unbuffered
59 #--------------------------------- main program --------------------------------
60 &Introduction();
61 &Check_BaseFiles();
62 &Check_ConfigFile();
63 &Check_Devices();
64 &Check_Registry();
65 &Check_WindowsFiles();
66 &Print_Score();
68 #------------------------------- support functions -----------------------------
69 sub Do_PrintHeader {
70 my ($str) = @_;
71 my $len = length($str);
72 my $num = int((80 - $len - 2)/2);
73 my $i;
75 print "\n";
76 for ($i = 0; $i < $num; $i++) {
77 print "-";
79 print " ".$str." ";
80 for ($i = 0; $i < $num; $i++) {
81 print "-";
83 if ($len % 2)
85 print "-";
87 print "\n";
90 sub Do_Check {
91 my ($text) = @_;
92 my $test_no;
93 my $indent_str = "";
95 $count_tests++;
96 $test_no = sprintf("%03d", $count_tests);
97 for (my $i = 0; $i < $indent; $i++)
99 $indent_str = $indent_str." ";
101 print sprintf("%.60s", $test_no.".".$indent_str." Checking ".$text."... ");
104 sub Do_PrintResult {
105 my($level, $str, $advice, $skip_score) = @_;
106 my $err;
107 my $key;
109 if ($level == $is_notchecked)
111 $err = "NOT CHECKED";
112 $str = "";
113 $advice = "";
115 elsif ($level == $is_ok)
117 $err = "OK";
118 $str = "";
119 $advice = "";
120 $count_ok++;
122 elsif ($level == $is_suspect)
124 $err = "SUSPICIOUS";
125 $count_suspect++;
126 if (! $skip_score)
128 $correctness *= $factor_suspect;
131 elsif ($level == $is_bad)
133 $err = "BAD";
134 $count_bad++;
135 if (! $skip_score)
137 $correctness *= $factor_bad;
140 elsif ($level == $is_critical)
142 $err = "CRITICAL";
143 $count_critical++;
144 if (! $skip_score)
146 $correctness *= $factor_critical;
149 elsif ($level == $is_failed)
151 $err = "FAILED";
152 $count_failed++;
153 if (! $skip_score)
155 $correctness *= $factor_failed;
158 print $err;
159 if ($str)
161 print " (".$str.")";
163 print ".";
164 if ($hold)
166 print " Press Enter.";
167 $key = getc(STDIN);
169 else
171 print "\n";
173 if ($advice)
175 print "- ADVICE: ".$advice.".\n";
179 #-------------------------------- main functions ------------------------------
180 sub Introduction {
181 print "This script verifies the configuration of the whole Wine environment.\n";
182 print "Note that this is an ALPHA version, and thus it doesn't catch all problems !\n";
183 print "The results of the checks are printed on the right side:\n";
184 print "OK - test passed without problems.\n";
185 print "SUSPICIOUS - potentially problematic. You might want to look into that.\n";
186 print "BAD - This is a problem, and it leads to configuration score penalty.\n";
187 print "CRITICAL - A critical problem which can easily lead to malfunction.\n";
188 print "FAILED - This problem leads to Wine failure almost certainly.\n";
189 print "\nThe result will be printed as a percentage score indicating config completeness.\n";
190 print "\n";
191 if ($hold)
193 my $key;
194 print "Press Enter to continue or Ctrl-C to exit.";
195 $key = getc(STDIN);
199 sub Check_BaseFiles {
200 my $line;
202 Do_PrintHeader("checking Wine base files");
204 $level = $is_ok;
205 Do_Check("for file \"wine\"");
206 $line = `which wine`;
207 if (!$line)
209 $level = $is_failed;
210 $reason = "file not found";
211 $advice = "Make sure the \"wine\" command is in your PATH (echo \$PATH; export PATH=xxx)";
213 Do_PrintResult($level, $reason, $advice);
215 # check for config mess
216 $level = $is_ok;
217 my @output = ();
218 Do_Check("for correct .so lib config (please wait)");
219 push (@output, `find / -name libwine.so 2>/dev/null`);
220 if (@output > 1)
222 $level = $is_suspect;
223 my $dirs = "";
224 foreach $line (@output) {
225 chomp $line;
226 $dirs = $dirs." ".$line;
228 $reason = "libwine.so found ".@output." times:".$dirs;
229 $advice = "check whether this is really ok";
231 Do_PrintResult($level, $reason, $advice);
234 sub Do_Config_Drive {
235 my ($drive, $entries, $values) = @_;
236 my $index = 0;
237 my $arg;
238 my $path = "";
239 my $type = "";
240 my $label = "";
241 my $serial = "";
242 my $device = "";
243 my $fs = "";
244 my $unknown = "";
245 my $level;
246 my $my_advice_fat = "If that doesn't help, change mount options in case of VFAT (\"umask\" option)";
248 print "\n>>> Checking drive ".$drive." settings:\n";
249 $reason = "";
250 while (@$entries[$index])
252 $arg = @$values[$index];
253 SWITCH: for (@$entries[$index]) {
254 /^path$/i && do { $path = $arg; last; };
255 /^type$/i && do { $type = $arg; last; };
256 /^label$/i && do { $label = $arg; last; };
257 /^serial$/i && do { $serial = $arg; last; };
258 /^device$/i && do { $device = $arg; last; };
259 /^filesystem$/i && do { $fs = $arg; last; };
260 $unknown = @$entries[$index];
262 $index++;
265 $indent++;
267 my $serious = ($drive =~ /^C$/i) || ($type =~ /^cdrom$/i);
269 ##### check Path #####
270 Do_Check("Path option");
271 $level = $is_ok;
272 $advice = "The syntax of the Path option has to be something like /my/mount/point";
273 if (! $path)
275 $level = $serious ? $is_failed : $is_bad;
276 $reason = "no Path option given in config file";
278 elsif ($path =~ /\\/)
280 $level = $serious ? $is_failed : $is_bad;
281 $reason = "wrong Path format ".$path;
283 elsif ($path =~ /\$\{(.*)\}$/)
285 # get path assigned to environment variable
286 my $envpath = $ENV{$1};
287 if (! $envpath)
289 $level = $serious ? $is_failed : $is_critical;
290 $reason = "Path \"".$path."\" references environment variable \"".$1."\" which is undefined";
291 $advice = "set environment variable before starting Wine or give a \"real\" directory instead";
293 else
295 $path = $envpath;
296 goto PERMCHECK; # hmpf
299 else
301 PERMCHECK:
302 if (!-e $path)
304 $level = $serious ? $is_failed : $is_suspect;
305 $reason = $path." does not exist !";
306 $advice = "create this directory or point Path to a real directory";
308 elsif (!-r $path)
310 $level = $serious ? $is_failed : $is_bad;
311 $reason = $path." is not readable for you";
312 $advice = $advice_chmod.". ".$my_advice_fat;
314 elsif ((! ($type =~ /^cdrom$/i)) && (!-w $path))
316 $level = ($drive =~ /^C$/i) ? $is_failed : $is_suspect;
317 $reason = $path." is not writable for you";
318 $advice = $advice_chmod.". ".$my_advice_fat;
320 else # check permissions of the drive's directories
322 my(@output) = ();
323 push (@output, `find $path 2>&1 1>/dev/null`);
324 foreach my $line (@output) {
325 if ($line =~ /find:\ (.*):\ Permission denied$/)
327 $level = ($drive =~ /^C$/i) ? $is_critical : $is_suspect;
328 $reason = "directory $1 is not accessible for you";
329 $advice = $advice_chmod.". ".$my_advice_fat;
330 last;
335 Do_PrintResult($level, $reason, $advice);
337 ##### check Type #####
338 if ($type)
340 Do_Check("Type option");
341 $level = $is_ok;
342 SWITCH: for ($type) {
343 /^floppy$/i && do { last; };
344 /^hd$/i && do { last; };
345 /^network$/i && do { last; };
346 /^cdrom$/i && do {
347 if (! $device)
349 $level = $is_critical;
350 $reason = "no Device option found -> CD-ROM labels can''t be read";
351 $advice = "add Device option and make sure the device given is accessible by you";
353 last;
355 /^ramdisk$/i && do { last; };
356 if ($type)
358 $level = $is_bad;
359 $reason = "invalid Type setting ".$type;
360 $advice = "use one of \"floppy\", \"hd\", \"network\" or \"cdrom\"";
363 Do_PrintResult($level, $reason, $advice);
366 ##### FIXME: check Label and Serial here #####
368 ##### check Device #####
369 if ($device)
371 my $mode = ($type =~ /^cdrom$/i) ? $dev_read : $dev_read|$dev_write;
372 &Do_CheckDevice("device", $device, 1, $mode);
375 ##### check Filesystem #####
376 if ($fs)
378 Do_Check("Filesystem option");
379 $level = $is_ok;
380 SWITCH: for ($fs) {
381 /^(dos|fat|msdos|unix)$/i && do {
382 $level = $is_bad;
383 $reason = "You probably don't want to use \"".$fs."\". ".$advice_fs;
384 if ($fs =~ /^unix$/i)
386 $advice = "This should almost never be used";
388 else
390 $advice = "only use ".$fs." if you only have a crappy 8.3 filename (i.e.: non-LFN) DOS FAT kernel filesystem driver";
392 last;
394 /^vfat$/i && do { last; };
395 /^win95$/i && do { last; };
396 if ($fs)
398 $level = $is_bad;
399 $reason = "invalid Filesystem setting ".$type;
400 $advice = "use one of \"win95\", \"msdos\" or \"unix\"";
403 Do_PrintResult($level, $reason, $advice);
405 $indent--;
406 if ($reason) {
407 print "--> PROBLEM.\n";
409 else
411 print "--> OK.\n";
415 sub Do_Config_Main {
416 my ($file) = shift;
417 my ($config, $line);
418 my $section = "";
419 my (@entries, @values);
420 LINE: while (<$file>)
422 $line = $_;
423 next LINE if ($line =~ /[\ ]*[;#]/); # skip comments
424 chomp $line;
425 #print "line: ".$line."\n";
426 if ($line =~ /\[(.*)\]/) # end of section/next section ?
428 my $nextsection = $1;
429 my $found = 1;
430 SWITCH: for ($section) {
431 /Drive\ (.)/i && do { &Do_Config_Drive($1, \@entries, \@values); last; };
432 if ($section)
434 $found = 0;
437 $section = $found ? $nextsection : "";
438 @entries = (); @values = ();
439 next LINE;
441 if ($line =~ /^[\ \t]*\"(.*)\"[\ \t]*\=[\ \t]*\"(.*)\"/)
443 push(@entries, $1);
444 push(@values, $2);
449 sub Check_ConfigFile {
450 my $config = "$ENV{'HOME'}/.wine/config";
451 my $indrive = 0;
453 Do_PrintHeader("checking config file");
455 Do_Check("config file access");
456 open(CFGFILE, $config);
457 if (! <CFGFILE>)
459 if (!-e $config) {
460 $reason = $config." does not exist";
461 $advice = "it is ok in case you have ~/.winerc. If you don''t, then you''re in trouble !";
463 elsif (!-r $config) {
464 $reason = $config." not readable";
465 $advice = $advice_chmod;
467 Do_PrintResult($is_failed, $reason, $advice);
468 return;
470 if (!-w $config)
472 Do_PrintResult($is_failed, $config." not writable", "wineserver needs to be able to write to config file. ".$advice_chmod);
474 else
476 Do_PrintResult($is_ok);
478 Do_Config_Main(\*CFGFILE);
479 close(CFGFILE);
482 sub Do_CheckDevice {
483 my($descr, $dev, $output, $mode) = @_;
484 my $level = $is_ok;
485 my $errstr = "";
487 if (! $mode)
489 $mode = $dev_read|$dev_write|$dev_open;
491 ($output != -1) && Do_Check($descr." ".$dev);
493 my $err_level = ($output == 1) ? $is_critical : $is_bad;
495 if (!-e $dev)
497 $level = $err_level;
498 $reason = $dev." does not exist";
499 $advice = "use MAKEDEV script to create it";
500 goto FAILED;
502 if (($mode & $dev_read) && (!-r $dev))
504 $level = $err_level;
505 $reason = $dev." is not readable for you";
506 $advice = $advice_chmod;
507 goto FAILED;
509 if (($mode & $dev_write) && (!-w $dev))
511 $level = $err_level;
512 $reason = $dev." is not writable for you";
513 $advice = $advice_chmod;
514 goto FAILED;
516 if (($mode & $dev_open) && (!open(DEVICE, ">$dev")))
518 $level = $err_level;
519 $reason = "no kernel driver for ".$dev."?";
520 $advice = "module loading problems ? Read /usr/src/linux/Documentation/modules.txt";
521 goto FAILED;
524 FAILED:
525 close(DEVICE);
526 ($output != -1) && Do_PrintResult($level, $reason, $advice);
529 sub Check_Devices {
530 # FIXME: check joystick and scsi devices !
531 my $dev_sound = "/dev/dsp";
532 my $dev_mixer = "/dev/mixer";
533 my $dev_sequencer = "/dev/sequencer";
534 my $dev_mem = "/dev/mem";
536 Do_PrintHeader("checking system devices used by Wine");
537 &Do_CheckDevice("sound device", $dev_sound, 1);
538 &Do_CheckDevice("audio mixer device", $dev_mixer, 1);
539 &Do_CheckDevice("MIDI sequencer device", $dev_sequencer, 0);
540 &Do_CheckDevice("device needed for DGA (option \"UseDGA\"):", $dev_mem, 0);
543 sub Check_Registry {
544 my(@entries) = ();
545 my $regfile = $ENV{'HOME'}."/.wine/system.reg";
547 Do_PrintHeader("checking registry configuration");
549 Do_Check("availability of winedefault.reg entries");
550 push (@entries, `grep "SHAREDMEMLOCATION" $regfile`);
551 if (@entries)
553 Do_PrintResult($is_ok);
555 else
557 Do_PrintResult($is_critical, "entry \"SHAREDMEMLOCATION\" not found", "file winedefault.reg doesn't seem to have been applied using regapi");
559 @entries = ();
561 Do_Check("availability of windows registry entries");
562 # FIXME: use a different key for check if Wine adds this one to its
563 # default registry.
564 push (@entries, `grep "Default Taskbar" $regfile`);
565 if (@entries)
567 Do_PrintResult($is_ok);
569 else
571 Do_PrintResult($is_critical, "entry \"Default Taskbar\" not found", "Windows registry does not seem to be added to Wine. This can affect many newer programs");
573 @entries = ();
576 sub Check_WindowsFiles {
579 sub Print_Score {
580 # my ($score_total, $score_reached, $score_percent);
582 # $score_total = $count_tests * 20;
583 # $score_reached = $count_ok * 20 +
584 # $count_bad * 15 +
585 # $count_critical * 5 +
586 # $count_failed * 0;
587 # $score_percent = $score_reached * 100 / $score_total;
589 print "\n";
590 print $count_tests." tests. ".$count_suspect." suspicious, ".$count_bad." bad, ".$count_critical." critical, ".$count_failed." failed.\n";
591 print sprintf "Wine configuration correctness score: %2.2f%%\n", $correctness;