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