git.oblomov.eu Git - wine/blob - 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 (@ld_dirs) = split (/:/, $ENV{'LD_LIBRARY_PATH'});
 246   my ($dir);
 247   foreach $dir (@ld_dirs) {
 248     if (-d $dir) { push @dirlist, $dir; }
 249   }
 250
 251   # Now check for a libwine.so in each directory
 252   foreach $dir (@dirlist) {
 253     my ($target) = $dir . "/libwine.so";
 254     if (-f $target) { push @output, $target; }
 255   }
 256   print "DEBUG: found libwine: @output\n";
 257
 258   if (@output > 1)
 259   {
 260     $level = $is_suspect;
 261     my $dirs = "";
 262     foreach $line (@output) {
 263       chomp $line;
 264       $dirs = $dirs." ".$line;
 265     }
 266     $reason = "libwine.so found ".@output." times:".$dirs;
 267     $advice = "check whether this is really ok";
 268   }
 269   Do_PrintResult($level, $reason, $advice);
 270 }
 271
 272 sub Do_Config_Drive {
 273   my ($drive, $entries, $values) = @_;
 274   my $index = 0;
 275   my $arg;
 276   my $path = "";
 277   my $type = "";
 278   my $label = "";
 279   my $serial = "";
 280   my $device = "";
 281   my $fs = "";
 282   my $unknown = "";
 283   my $level;
 284   my $my_advice_fat = "If that doesn't help, change mount options in case of VFAT (\"umask\" option)";
 285
 286   print "\n>>> Checking drive ".$drive." settings:\n";
 287   $reason = "";
 288   while (@$entries[$index])
 289   {
 290     $arg = @$values[$index];
 291     SWITCH: for (@$entries[$index]) {
 292         /^path$/i       && do { $path = $arg; last; };
 293         /^type$/i && do { $type = $arg; last; };
 294         /^label$/i && do { $label = $arg; last; };
 295         /^serial$/i && do { $serial = $arg; last; };
 296         /^device$/i && do { $device = $arg; last; };
 297         /^filesystem$/i && do { $fs = $arg; last; };
 298         $unknown = @$entries[$index];
 299     }
 300     $index++;
 301   }
 302
 303   $indent++;
 304
 305   my $serious = ($drive =~ /^C$/i) || ($type =~ /^cdrom$/i);
 306
 307   ##### check Path #####
 308   Do_Check("Path option");
 309   $level = $is_ok;
 310   $advice = "The syntax of the Path option has to be something like /my/mount/point";
 311   if (! $path)
 312   {
 313     $level = $serious ? $is_failed : $is_bad;
 314     $reason = "no Path option given in config file";
 315   }
 316   elsif ($path =~ /\\/)
 317   {
 318     $level = $serious ? $is_failed : $is_bad;
 319     $reason = "wrong Path format ".$path;
 320   }
 321   elsif ($path =~ /\$\{(.*)\}$/)
 322   {
 323     # get path assigned to environment variable
 324     my $envpath = $ENV{$1};
 325     if (! $envpath)
 326     {
 327       $level = $serious ? $is_failed : $is_critical;
 328       $reason = "Path \"".$path."\" references environment variable \"".$1."\" which is undefined";
 329       $advice = "set environment variable before starting Wine or give a \"real\" directory instead";
 330     }
 331     else
 332     {
 333       $path = $envpath;
 334       goto PERMCHECK; # hmpf
 335     }
 336   }
 337   else
 338   {
 339 PERMCHECK:
 340     if (!-e $path)
 341     {
 342       $level = $serious ? $is_failed : $is_suspect;
 343       $reason = $path." does not exist !";
 344       $advice = "create this directory or point Path to a real directory";
 345     }
 346     elsif (!-r $path)
 347     {
 348       $level = $serious ? $is_failed : $is_bad;
 349       $reason = $path." is not readable for you";
 350       $advice = $advice_chmod.". ".$my_advice_fat;
 351     }
 352     elsif ((! ($type =~ /^cdrom$/i)) && (!-w $path))
 353     {
 354       $level = ($drive =~ /^C$/i) ? $is_failed : $is_suspect;
 355       $reason = $path." is not writable for you";
 356       $advice = $advice_chmod.". ".$my_advice_fat;
 357     }
 358     else # check permissions of the drive's directories
 359     {
 360         my(@output) = ();
 361         push (@output, `find $path 2>&1 1>/dev/null`);
 362         foreach my $line (@output) {
 363             if ($line =~ /find:\ (.*):\ Permission denied$/)
 364             {
 365                 $level = ($drive =~ /^C$/i) ? $is_critical : $is_suspect;
 366                 $reason = "directory $1 is not accessible for you";
 367                 $advice = $advice_chmod.". ".$my_advice_fat;
 368                 last;
 369             }
 370         }
 371     }
 372   }
 373   Do_PrintResult($level, $reason, $advice);
 374
 375   ##### check Type #####
 376   if ($type)
 377   {
 378     Do_Check("Type option");
 379     $level = $is_ok;
 380     SWITCH: for ($type) {
 381         /^floppy$/i && do { last; };
 382         /^hd$/i && do { last; };
 383         /^network$/i && do { last; };
 384         /^cdrom$/i && do {
 385                         if (! $device)
 386                         {
 387                           $level = $is_critical;
 388                           $reason = "no Device option found -> CD-ROM labels can''t be read";
 389                           $advice = "add Device option and make sure the device given is accessible by you";
 390                         }
 391                         last;
 392                          };
 393         /^ramdisk$/i && do { last; };
 394         if ($type)
 395         {
 396           $level = $is_bad;
 397           $reason = "invalid Type setting ".$type;
 398           $advice = "use one of \"floppy\", \"hd\", \"network\" or \"cdrom\"";
 399         }
 400     }
 401     Do_PrintResult($level, $reason, $advice);
 402   }
 403
 404   ##### FIXME: check Label and Serial here #####
 405
 406   ##### check Device #####
 407   if ($device)
 408   {
 409     my $mode = ($type =~ /^cdrom$/i) ? $dev_read : $dev_read|$dev_write;
 410     &Do_CheckDevice("device", $device, 1, $mode);
 411   }
 412
 413   ##### check Filesystem #####
 414   if ($fs)
 415   {
 416     Do_Check("Filesystem option");
 417     $level = $is_ok;
 418     SWITCH: for ($fs) {
 419         /^(dos|fat|msdos|unix)$/i && do {
 420                          $level = $is_bad;
 421                          $reason = "You probably don't want to use \"".$fs."\". ".$advice_fs;
 422                          if ($fs =~ /^unix$/i)
 423                          {
 424                            $advice = "This should almost never be used";
 425                          }
 426                          else
 427                          {
 428                            $advice = "only use ".$fs." if you only have a crappy 8.3 filename (i.e.: non-LFN) DOS FAT kernel filesystem driver";
 429                          }
 430                          last;
 431                            };
 432         /^vfat$/i && do { last; };
 433         /^win95$/i && do { last; };
 434         if ($fs)
 435         {
 436           $level = $is_bad;
 437           $reason = "invalid Filesystem setting ".$type;
 438           $advice = "use one of \"win95\", \"msdos\" or \"unix\"";
 439         }
 440     }
 441     Do_PrintResult($level, $reason, $advice);
 442   }
 443   $indent--;
 444   if ($reason) {
 445     print "--> PROBLEM.\n";
 446   }
 447   else
 448   {
 449     print "--> OK.\n";
 450   }
 451 }
 452
 453 sub Do_Config_Main {
 454   my ($file) = shift;
 455   my ($config, $line);
 456   my $section = "";
 457   my (@entries, @values);
 458   LINE: while (<$file>)
 459   {
 460     $line = $_;
 461     next LINE if ($line =~ /[\ ]*[;#]/);        # skip comments
 462     chomp $line;
 463     #print "line: ".$line."\n";
 464     if ($line =~ /\[(.*)\]/) # end of section/next section ?
 465     {
 466       my $nextsection = $1;
 467       my $found = 1;
 468       SWITCH: for ($section) {
 469         /Drive\ (.)/i   && do { &Do_Config_Drive($1, \@entries, \@values); last; };
 470         if ($section)
 471         {
 472           $found = 0;
 473         }
 474       }
 475       $section = $found ? $nextsection : "";
 476       @entries = (); @values = ();
 477       next LINE;
 478     }
 479     if ($line =~ /^[\ \t]*\"(.*)\"[\ \t]*\=[\ \t]*\"(.*)\"/)
 480     {
 481       push(@entries, $1);
 482       push(@values, $2);
 483     }
 484   }
 485 }
 486
 487 sub Check_ConfigFile {
 488   my $config = "$ENV{'HOME'}/.wine/config";
 489   my $indrive = 0;
 490
 491   Do_PrintHeader("checking config file");
 492
 493   Do_Check("config file access");
 494   open(CFGFILE, $config);
 495   if (! <CFGFILE>)
 496   {
 497     if (!-e $config) {
 498       $reason = $config." does not exist";
 499       $advice = "it is ok in case you have ~/.winerc. If you don''t, then you''re in trouble !";
 500     }
 501     elsif (!-r $config) {
 502       $reason = $config." not readable";
 503       $advice = $advice_chmod;
 504     }
 505     Do_PrintResult($is_failed, $reason, $advice);
 506     return;
 507   }
 508   if (!-w $config)
 509   {
 510     Do_PrintResult($is_failed, $config." not writable", "wineserver needs to be able to write to config file. ".$advice_chmod);
 511   }
 512   else
 513   {
 514     Do_PrintResult($is_ok);
 515   }
 516   Do_Config_Main(\*CFGFILE);
 517   close(CFGFILE);
 518 }
 519
 520 sub Do_CheckDevice {
 521   my($descr, $dev, $output, $mode) = @_;
 522   my $level = $is_ok;
 523   my $errstr = "";
 524
 525   if (! $mode)
 526   {
 527     $mode = $dev_read|$dev_write|$dev_open;
 528   }
 529   ($output != -1) && Do_Check($descr." ".$dev);
 530
 531   my $err_level = ($output == 1) ? $is_critical : $is_bad;
 532
 533   if (!-e $dev)
 534   {
 535     $level = $err_level;
 536     $reason = $dev." does not exist";
 537     $advice = "use MAKEDEV script to create it";
 538     goto FAILED;
 539   }
 540   if (($mode & $dev_read) && (!-r $dev))
 541   {
 542     $level = $err_level;
 543     $reason = $dev." is not readable for you";
 544     $advice = $advice_chmod;
 545     goto FAILED;
 546   }
 547   if (($mode & $dev_write) && (!-w $dev))
 548   {
 549     $level = $err_level;
 550     $reason = $dev." is not writable for you";
 551     $advice = $advice_chmod;
 552     goto FAILED;
 553   }
 554   if (($mode & $dev_open) && (!open(DEVICE, ">$dev")))
 555   {
 556     $level = $err_level;
 557     $reason = "no kernel driver for ".$dev."?";
 558     $advice = "module loading problems ? Read /usr/src/linux/Documentation/modules.txt";
 559     goto FAILED;
 560   }
 561
 562 FAILED:
 563   close(DEVICE);
 564   ($output != -1) && Do_PrintResult($level, $reason, $advice);
 565 }
 566
 567 sub Check_Devices {
 568 # FIXME: check joystick and scsi devices !
 569   my $dev_sound = "/dev/dsp";
 570   my $dev_mixer = "/dev/mixer";
 571   my $dev_sequencer = "/dev/sequencer";
 572   my $dev_mem = "/dev/mem";
 573
 574   Do_PrintHeader("checking system devices used by Wine");
 575   &Do_CheckDevice("sound device", $dev_sound, 1);
 576   &Do_CheckDevice("audio mixer device", $dev_mixer, 1);
 577   &Do_CheckDevice("MIDI sequencer device", $dev_sequencer, 0);
 578 }
 579
 580 sub Check_Registry {
 581   my(@entries) = ();
 582   my $regfile = $ENV{'HOME'}."/.wine/system.reg";
 583
 584   Do_PrintHeader("checking registry configuration");
 585
 586   Do_Check("availability of winedefault.reg entries");
 587   push (@entries, `grep "SHAREDMEMLOCATION" $regfile`);
 588   if (@entries)
 589   {
 590     Do_PrintResult($is_ok);
 591   }
 592   else
 593   {
 594     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");
 595   }
 596   @entries = ();
 597
 598   Do_Check("availability of windows registry entries");
 599 # FIXME: use a different key for check if Wine adds this one to its
 600 #        default registry.
 601   push (@entries, `grep "Default Taskbar" $regfile`);
 602   if (@entries)
 603   {
 604     Do_PrintResult($is_ok);
 605   }
 606   else
 607   {
 608     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.");
 609   }
 610   @entries = ();
 611 }
 612
 613 sub Check_WindowsFiles {
 614 }
 615
 616 sub Print_Score {
 617 #  my ($score_total, $score_reached, $score_percent);
 618
 619 #  $score_total   =     $count_tests * 20;
 620 #  $score_reached =     $count_ok * 20 +
 621 #                       $count_bad * 15 +
 622 #                       $count_critical * 5 +
 623 #                       $count_failed * 0;
 624 #  $score_percent =     $score_reached * 100 / $score_total;
 625
 626   print "\n";
 627   print $count_tests." tests. ".$count_suspect." suspicious, ".$count_bad." bad, ".$count_critical." critical, ".$count_failed." failed.\n";
 628   print sprintf "Wine configuration correctness score: %2.2f%%\n", $correctness;
 629 }