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