Fix a bunch of unicode/memory allocation errors.
[wine/multimedia.git] / tools / winecheck
bloba6f433713b1d5b341e1185720cfcaaa3c5eea273
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 # Copyright (C) 2001 Andreas Mohr
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.
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.
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
21 # FIXME:
22 # - implement cmdline arguments e.g. for confirmation keypress
23 # in case of a problem
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
32 use Getopt::Long;
33 use strict;
35 my $hold = 0;
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;
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;
53 my $factor_suspect = 0.995;
54 my $factor_bad = 0.95;
55 my $factor_critical = 0.85;
56 my $factor_failed = 0.15;
58 my $correctness = 100.0;
60 my $indent = 0;
62 my ($level, $reason, $advice);
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";
68 my $dev_read = 1;
69 my $dev_write = 2;
70 my $dev_open = 4;
72 select(STDERR); $| = 1; # make unbuffered
73 select(STDOUT); $| = 1; # make unbuffered
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();
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;
92 print "\n";
93 for ($i = 0; $i < $num; $i++) {
94 print "-";
96 print " ".$str." ";
97 for ($i = 0; $i < $num; $i++) {
98 print "-";
100 if ($len % 2)
102 print "-";
104 print "\n";
107 sub Do_Check {
108 my ($text) = @_;
109 my $test_no;
110 my $indent_str = "";
112 $count_tests++;
113 $test_no = sprintf("%03d", $count_tests);
114 for (my $i = 0; $i < $indent; $i++)
116 $indent_str = $indent_str." ";
118 print sprintf("%.60s", $test_no.".".$indent_str." Checking ".$text."... ");
121 sub Do_PrintResult {
122 my($level, $str, $advice, $skip_score) = @_;
123 my $err;
124 my $key;
126 if ($level == $is_notchecked)
128 $err = "NOT CHECKED";
129 $str = "";
130 $advice = "";
132 elsif ($level == $is_ok)
134 $err = "OK";
135 $str = "";
136 $advice = "";
137 $count_ok++;
139 elsif ($level == $is_notice)
141 $err = "NOTICE";
142 $count_notice++;
144 elsif ($level == $is_suspect)
146 $err = "SUSPICIOUS";
147 $count_suspect++;
148 if (! $skip_score)
150 $correctness *= $factor_suspect;
153 elsif ($level == $is_bad)
155 $err = "BAD";
156 $count_bad++;
157 if (! $skip_score)
159 $correctness *= $factor_bad;
162 elsif ($level == $is_critical)
164 $err = "CRITICAL";
165 $count_critical++;
166 if (! $skip_score)
168 $correctness *= $factor_critical;
171 elsif ($level == $is_failed)
173 $err = "FAILED";
174 $count_failed++;
175 if (! $skip_score)
177 $correctness *= $factor_failed;
180 print $err;
181 if ($str)
183 print " (".$str.")";
185 print ".";
186 if ($hold)
188 print " Press Enter.";
189 $key = getc(STDIN);
191 else
193 print "\n";
195 if ($advice)
197 print "- ADVICE: ".$advice.".\n";
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)
216 my $key;
217 print "Press Enter to continue or Ctrl-C to exit.";
218 $key = getc(STDIN);
222 sub Check_Misc {
224 Do_PrintHeader("checking miscellaneous stuff");
226 Do_Check("for root user");
228 $level = $is_ok;
230 if (`whoami` =~ /^root$/)
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";
236 Do_PrintResult($level, $reason, $advice);
239 sub Check_BaseFiles {
240 my $line;
242 Do_PrintHeader("checking Wine base files");
244 $level = $is_ok;
245 Do_Check("for file \"wine\"");
246 $line = `which wine`;
247 if (!$line)
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)";
253 Do_PrintResult($level, $reason, $advice);
255 # check for config mess
256 $level = $is_ok;
257 my @output = ();
258 Do_Check("for correct .so lib config (please wait)");
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, $_; }
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; }
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; }
284 #print "DEBUG: found libwine: @output\n";
286 if (@output > 1)
288 $level = $is_suspect;
289 my $dirs = "";
290 foreach $line (@output) {
291 chomp $line;
292 $dirs = $dirs." ".$line;
294 $reason = "libwine.so found ".@output." times:".$dirs;
295 $advice = "check whether this is really ok";
297 Do_PrintResult($level, $reason, $advice);
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)";
314 print "\n>>> Checking drive ".$drive." settings:\n";
315 $reason = "";
316 while (@$entries[$index])
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];
328 $index++;
331 $indent++;
333 my $serious = ($drive =~ /^C$/i) || ($type =~ /^cdrom$/i);
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)
341 $level = $serious ? $is_failed : $is_bad;
342 $reason = "no Path option given in config file";
344 elsif ($path =~ /\\/)
346 $level = $serious ? $is_failed : $is_bad;
347 $reason = "wrong Path format ".$path;
349 elsif ($path =~ /\%(.*)\%$/)
351 # get path assigned to environment variable
352 my $envpath = $ENV{$1};
353 if (! $envpath)
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";
359 else
361 $path = $envpath;
362 goto PERMCHECK; # hmpf
365 else
367 PERMCHECK:
368 if (!-e $path)
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";
374 elsif (!-r $path)
376 $level = $serious ? $is_failed : $is_bad;
377 $reason = $path." is not readable for you";
378 $advice = $advice_chmod.". ".$my_advice_fat;
380 elsif ((! ($type =~ /^cdrom$/i)) && (!-w $path))
382 $level = ($drive =~ /^C$/i) ? $is_failed : $is_suspect;
383 $reason = $path." is not writable for you";
384 $advice = $advice_chmod.". ".$my_advice_fat;
386 else # check permissions of the drive's directories
388 my(@output) = ();
389 push (@output, `find $path 2>&1 1>/dev/null`);
390 foreach my $line (@output) {
391 if ($line =~ /find:\ (.*):\ Permission denied$/)
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;
401 Do_PrintResult($level, $reason, $advice);
403 ##### check Type #####
404 if ($type)
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)
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";
419 last;
421 /^ramdisk$/i && do { last; };
422 if ($type)
424 $level = $is_bad;
425 $reason = "invalid Type setting ".$type;
426 $advice = "use one of \"floppy\", \"hd\", \"network\" or \"cdrom\"";
429 Do_PrintResult($level, $reason, $advice);
432 ##### FIXME: check Label and Serial here #####
434 ##### check Device #####
435 if ($device)
437 my $mode = ($type =~ /^cdrom$/i) ? $dev_read : $dev_read|$dev_write;
438 &Do_CheckDevice("device", $device, 1, $mode);
441 ##### check Filesystem #####
442 if ($fs)
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)
452 $advice = "This should almost never be used";
454 else
456 $advice = "only use ".$fs." if you only have a crappy 8.3 filename (i.e.: non-LFN) DOS FAT kernel filesystem driver";
458 last;
460 /^vfat$/i && do { last; };
461 /^win95$/i && do { last; };
462 if ($fs)
464 $level = $is_bad;
465 $reason = "invalid Filesystem setting ".$type;
466 $advice = "use one of \"win95\", \"msdos\" or \"unix\"";
469 Do_PrintResult($level, $reason, $advice);
471 $indent--;
472 if ($reason) {
473 print "--> PROBLEM.\n";
475 else
477 print "--> OK.\n";
481 sub Do_Config_Main {
482 my ($file) = shift;
483 my ($config, $line);
484 my $section = "";
485 my (@entries, @values);
486 LINE: while (<$file>)
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 ?
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)
500 $found = 0;
503 $section = $found ? $nextsection : "";
504 @entries = (); @values = ();
505 next LINE;
507 if ($line =~ /^[\ \t]*\"(.*)\"[\ \t]*\=[\ \t]*\"(.*)\"/)
509 push(@entries, $1);
510 push(@values, $2);
515 sub Check_ConfigFile {
516 my $config = "$ENV{'HOME'}/.wine/config";
517 my $indrive = 0;
519 Do_PrintHeader("checking config file");
521 Do_Check("config file access");
522 open(CFGFILE, $config);
523 if (! <CFGFILE>)
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";
529 elsif (!-r $config) {
530 $reason = $config." not readable";
531 $advice = $advice_chmod;
533 Do_PrintResult($is_failed, $reason, $advice);
534 return;
536 if (!-w $config)
538 Do_PrintResult($is_failed, $config." not writable", "wineserver needs to be able to write to config file. ".$advice_chmod);
540 else
542 Do_PrintResult($is_ok);
544 Do_Config_Main(\*CFGFILE);
545 close(CFGFILE);
548 sub Do_CheckDevice {
549 my($descr, $dev, $output, $mode) = @_;
550 my $level = $is_ok;
551 my $errstr = "";
553 if (! $mode)
555 $mode = $dev_read|$dev_write|$dev_open;
557 ($output != -1) && Do_Check($descr." ".$dev);
559 my $err_level = ($output == 1) ? $is_critical : $is_bad;
561 if (!-e $dev)
563 $level = $err_level;
564 $reason = $dev." does not exist";
565 $advice = "use MAKEDEV script to create it";
566 goto FAILED;
568 if (($mode & $dev_read) && (!-r $dev))
570 $level = $err_level;
571 $reason = $dev." is not readable for you";
572 $advice = $advice_chmod;
573 goto FAILED;
575 if (($mode & $dev_write) && (!-w $dev))
577 $level = $err_level;
578 $reason = $dev." is not writable for you";
579 $advice = $advice_chmod;
580 goto FAILED;
582 if (($mode & $dev_open) && (!open(DEVICE, ">$dev")))
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;
590 FAILED:
591 close(DEVICE);
592 ($output != -1) && Do_PrintResult($level, $reason, $advice);
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";
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);
608 sub Check_Registry {
609 my(@entries) = ();
610 my $regfile = $ENV{'HOME'}."/.wine/system.reg";
612 Do_PrintHeader("checking registry configuration");
614 Do_Check("availability of winedefault.reg entries");
615 push (@entries, `grep "SHAREDMEMLOCATION" $regfile 2>/dev/null`);
616 if (@entries)
618 Do_PrintResult($is_ok);
620 else
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 regedit");
624 @entries = ();
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)
632 Do_PrintResult($is_ok);
634 else
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. Feel free to ignore this message in case you do use a Windows registry, but have the SaveOnlyUpdatedKeys config setting set to N.");
638 @entries = ();
641 sub Check_WindowsFiles {
644 sub Print_Score {
645 # my ($score_total, $score_reached, $score_percent);
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;
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;