lib/TWiki/Configure/Checkers/CGISetup.pm
author Colas Nahaboo <colas@nahaboo.net>
Sat, 26 Jan 2008 15:50:53 +0100
changeset 0 414e01d06fd5
permissions -rw-r--r--
RELEASE 4.2.0 freetown
colas@0
     1
#
colas@0
     2
# TWiki Enterprise Collaboration Platform, http://TWiki.org/
colas@0
     3
#
colas@0
     4
# Copyright (C) 2000-2006 TWiki Contributors.
colas@0
     5
#
colas@0
     6
# This program is free software; you can redistribute it and/or
colas@0
     7
# modify it under the terms of the GNU General Public License
colas@0
     8
# as published by the Free Software Foundation; either version 2
colas@0
     9
# of the License, or (at your option) any later version. For
colas@0
    10
# more details read LICENSE in the root of this distribution.
colas@0
    11
#
colas@0
    12
# This program is distributed in the hope that it will be useful,
colas@0
    13
# but WITHOUT ANY WARRANTY; without even the implied warranty of
colas@0
    14
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
colas@0
    15
#
colas@0
    16
# As per the GPL, removal of this notice is prohibited.
colas@0
    17
#
colas@0
    18
package TWiki::Configure::Checkers::CGISetup;
colas@0
    19
colas@0
    20
use strict;
colas@0
    21
colas@0
    22
use base 'TWiki::Configure::Checker';
colas@0
    23
colas@0
    24
use File::Spec;
colas@0
    25
colas@0
    26
sub ui {
colas@0
    27
    my $this = shift;
colas@0
    28
    my $block = '';
colas@0
    29
colas@0
    30
    # Detect whether mod_perl was loaded into Apache
colas@0
    31
    $TWiki::cfg{DETECTED}{ModPerlLoaded} =
colas@0
    32
      ( exists $ENV{SERVER_SOFTWARE} &&
colas@0
    33
          ( $ENV{SERVER_SOFTWARE} =~ /mod_perl/ ));
colas@0
    34
colas@0
    35
    # Detect whether we are actually running under mod_perl
colas@0
    36
    # - test for MOD_PERL alone, which is enough.
colas@0
    37
    $TWiki::cfg{DETECTED}{UsingModPerl} = ( exists $ENV{MOD_PERL} );
colas@0
    38
colas@0
    39
    $TWiki::cfg{DETECTED}{ModPerlVersion} =
colas@0
    40
      eval 'use mod_perl; return $mod_perl::VERSION';
colas@0
    41
colas@0
    42
    # Get the version of mod_perl if it's being used
colas@0
    43
    if ( $TWiki::cfg{DETECTED}{UsingModPerl} ) {
colas@0
    44
        $block .= $this->setting(
colas@0
    45
            '', $this->WARN(<<HERE));
colas@0
    46
You are running <tt>configure</tt> with <tt>mod_perl</tt>. This
colas@0
    47
is risky because mod_perl will remember old values of configuration
colas@0
    48
variables. You are *highly* recommended not to run configure under
colas@0
    49
mod_perl (though the rest of TWiki can be run with mod_perl, of course)
colas@0
    50
HERE
colas@0
    51
    }
colas@0
    52
colas@0
    53
    # Check for potential CGI.pm module upgrade
colas@0
    54
    # CGI.pm version, on some platforms - actually need CGI 2.93 for
colas@0
    55
    # mod_perl 2.0 and CGI 2.90 for Cygwin Perl 5.8.0.  See 
colas@0
    56
    # http://perl.apache.org/products/apache-modules.html#Porting_CPAN_modules_to_mod_perl_2_0_Status
colas@0
    57
    if( $CGI::VERSION < 2.93 ) {
colas@0
    58
        if ( $Config::Config{osname} eq 'cygwin' && $] >= 5.008 ) {
colas@0
    59
            # Recommend CGI.pm upgrade if using Cygwin Perl 5.8.0
colas@0
    60
            $block .= $this->setting(
colas@0
    61
                '', $this->WARN( <<HERE ));
colas@0
    62
Perl CGI version 3.11 or higher is recommended to avoid problems with
colas@0
    63
attachment uploads on Cygwin Perl.
colas@0
    64
HERE
colas@0
    65
        } elsif( $TWiki::cfg{DETECTED}{ModPerlVersion} &&
colas@0
    66
                   $TWiki::cfg{DETECTED}{ModPerlVersion} >= 1.99 ) {
colas@0
    67
            # Recommend CGI.pm upgrade if using mod_perl 2.0, which
colas@0
    68
            # is reported as version 1.99 and implies Apache 2.0
colas@0
    69
            $block .= $this->setting(
colas@0
    70
                '', $this->WARN( <<HERE ));
colas@0
    71
Perl CGI version 3.11 or higher is recommended to avoid problems with
colas@0
    72
mod_perl.
colas@0
    73
HERE
colas@0
    74
        }
colas@0
    75
    }
colas@0
    76
colas@0
    77
    #OS
colas@0
    78
    my $n = ucfirst(lc($Config::Config{osname})).' '.
colas@0
    79
      $Config::Config{osvers}.' ('.
colas@0
    80
        $Config::Config{archname}.')';
colas@0
    81
    $block .= $this->setting("Operating system", $n);
colas@0
    82
colas@0
    83
    # Perl version and type
colas@0
    84
    $n = $];
colas@0
    85
    $n .= " ($Config::Config{osname})";
colas@0
    86
    $n .= $this->NOTE(<<HERE);
colas@0
    87
Note that by convention "Perl version 5.008" is referred to as "Perl version 5.8" and "Perl 5.008004" as "Perl 5.8.4" (i.e. ignore the leading zeros after the .)
colas@0
    88
HERE
colas@0
    89
colas@0
    90
    if ( $] < 5.006 ) {
colas@0
    91
        $n .= $this->WARN(<<HERE);
colas@0
    92
Perl version is older than 5.6.0.
colas@0
    93
TWiki has only been successfully tested on Perl 5.6.X and 5.8.X,
colas@0
    94
and there have been reports that it does not run on 5.5.
colas@0
    95
You will need to upgrade Perl libraries and tweak the TWiki
colas@0
    96
code to make TWiki work on older versions of Perl
colas@0
    97
HERE
colas@0
    98
    }
colas@0
    99
colas@0
   100
    $block .= $this->setting('Perl version', $n);
colas@0
   101
colas@0
   102
    # Perl @INC (lib path)
colas@0
   103
    $block .= $this->setting(
colas@0
   104
        '@INC library path', join(CGI::br(), @INC ).
colas@0
   105
          $this->NOTE(<<HERE));
colas@0
   106
This is the Perl library path, used to load TWiki modules,
colas@0
   107
third-party modules used by some plugins, and Perl built-in modules.
colas@0
   108
HERE
colas@0
   109
colas@0
   110
colas@0
   111
colas@0
   112
    $block .= $this->setting(
colas@0
   113
        'CGI bin directory', $this->_checkBinDir());
colas@0
   114
colas@0
   115
    # Turn off fatalsToBrowser while checking module loads, to avoid
colas@0
   116
    # load errors in browser in some environments.
colas@0
   117
    $CGI::Carp::WRAP = 0;    # Avoid warnings...
colas@0
   118
colas@0
   119
    # Check that the TWiki.pm module can be found, but don't croak on
colas@0
   120
    # bogus configuration settings
colas@0
   121
    $TWiki::cfg{ConfigurationFinished}  =  1;
colas@0
   122
    eval 'require TWiki';
colas@0
   123
    my $mess = '';
colas@0
   124
    if ($@) {
colas@0
   125
        $mess = $@;
colas@0
   126
        $mess = $this->ERROR(
colas@0
   127
            'TWiki.pm could not be loaded. The error was:').
colas@0
   128
              CGI::pre($mess).
colas@0
   129
                  $this->ERROR(<<HERE);
colas@0
   130
Check path to <code>twiki/lib</code> and check that LocalSite.cfg is
colas@0
   131
present and readable
colas@0
   132
HERE
colas@0
   133
    } else {
colas@0
   134
        $mess = 'TWiki.pm (Version: <strong>'.$TWiki::VERSION.'</strong>) found';
colas@0
   135
    }
colas@0
   136
    $block .= $this->setting(
colas@0
   137
        'TWiki module in @INC path', $mess);
colas@0
   138
colas@0
   139
    # Check that each of the required Perl modules can be loaded, and
colas@0
   140
    # print its version number.
colas@0
   141
    my $set;
colas@0
   142
    my $perlModules = $this->_loadDEPENDENCIES();
colas@0
   143
    if (ref($perlModules)) {
colas@0
   144
        $set = $this->checkPerlModules( $perlModules );
colas@0
   145
    } else {
colas@0
   146
        $set = $this->ERROR($perlModules);
colas@0
   147
    }
colas@0
   148
colas@0
   149
    $block .= $this->setting("Perl modules",
colas@0
   150
                       CGI::start_table({width=>'100%'}).
colas@0
   151
                       $set.CGI::end_table());
colas@0
   152
colas@0
   153
    # All module checks done, OK to enable fatalsToBrowser
colas@0
   154
    import CGI::Carp qw( fatalsToBrowser );
colas@0
   155
colas@0
   156
    # PATH_INFO
colas@0
   157
    my $url = $TWiki::query->url();
colas@0
   158
    $block .= $this->setting(CGI::a({name=>'PATH_INFO'},'PATH_INFO'),
colas@0
   159
                             $TWiki::query->path_info().
colas@0
   160
              $this->NOTE(<<HERE
colas@0
   161
For a URL such as <strong>$url/foo/bar</strong>,
colas@0
   162
the correct PATH_INFO is <strong>/foo/bar</strong>, without any prefixed path
colas@0
   163
components. <a rel="nofollow" href="$url/foo/bar#PATH_INFO">
colas@0
   164
<strong>Test PATH_INFO now</strong></a>
colas@0
   165
- particularly if you are using mod_perl, Apache or IIS, or are using
colas@0
   166
a web hosting provider.
colas@0
   167
Look at the new path info here. It should be <strong>/foo/bar</strong>.
colas@0
   168
HERE
colas@0
   169
                  ));
colas@0
   170
colas@0
   171
    # mod_perl
colas@0
   172
    if( $TWiki::cfg{DETECTED}{UsingModPerl} ) {
colas@0
   173
        $n = "Used for this script";
colas@0
   174
    } else {
colas@0
   175
        $n = "Not used for this script";
colas@0
   176
    }
colas@0
   177
    $n .= $this->NOTE(
colas@0
   178
        'mod_perl is ', $TWiki::cfg{DETECTED}{ModPerlLoaded} ? '' : 'not',
colas@0
   179
        ' loaded into Apache' );
colas@0
   180
    if ( $TWiki::cfg{DETECTED}{ModPerlVersion} ) {
colas@0
   181
        $n .= $this->NOTE( 'mod_perl version ', $TWiki::cfg{DETECTED}{ModPerlVersion} );
colas@0
   182
    }
colas@0
   183
colas@0
   184
    # Check for a broken version of mod_perl 2.0
colas@0
   185
    if ( $TWiki::cfg{DETECTED}{UsingModPerl} && $TWiki::cfg{DETECTED}{ModPerlVersion} =~ /1\.99_?11/ ) {
colas@0
   186
        # Recommend mod_perl upgrade if using a mod_perl 2.0 version
colas@0
   187
        # with PATH_INFO bug (see Support.RegistryCookerBadFileDescriptor
colas@0
   188
        # and Bugs:Item82)
colas@0
   189
        $n .= $this->ERROR(<<HERE);
colas@0
   190
Version $TWiki::cfg{DETECTED}{ModPerlVersion} of mod_perl is known to have major bugs that prevent
colas@0
   191
its use with TWiki. 1.99_12 or higher is recommended.
colas@0
   192
HERE
colas@0
   193
    }
colas@0
   194
    $block .= $this->setting('mod_perl', $n);
colas@0
   195
colas@0
   196
    $block .= $this->setting(
colas@0
   197
        'CGI user', 'userid = <strong>'.$::WebServer_uid.'</strong> groups = <strong>'.
colas@0
   198
          $::WebServer_gid.'</strong>'.
colas@0
   199
            $this->NOTE(
colas@0
   200
                'Your CGI scripts are executing as this user.'));
colas@0
   201
colas@0
   202
    $block .= $this->setting(
colas@0
   203
        'Original PATH', $TWiki::cfg{DETECTED}{originalPath}.
colas@0
   204
          $this->NOTE(<<HERE));
colas@0
   205
This is the PATH value passed in from the web server to this
colas@0
   206
script - it is reset by TWiki scripts to the PATH below, and
colas@0
   207
is provided here for comparison purposes only.
colas@0
   208
HERE
colas@0
   209
colas@0
   210
    my $currentPath = $ENV{PATH} || '';     # As re-set earlier in this routine
colas@0
   211
    $block .= $this->setting("Current PATH", $currentPath,
colas@0
   212
              $this->NOTE(<<HERE
colas@0
   213
This is the actual PATH setting that will be used by Perl to run
colas@0
   214
programs. It is normally identical to {SafeEnvPath}, unless
colas@0
   215
that variable is empty, in which case this will be the webserver user's
colas@0
   216
standard path..
colas@0
   217
HERE
colas@0
   218
                  ));
colas@0
   219
colas@0
   220
    return $this->foldableBlock(
colas@0
   221
        CGI::em( 'CGI Setup' ), '(read only) ',
colas@0
   222
        $block);
colas@0
   223
};
colas@0
   224
colas@0
   225
sub _checkBinDir {
colas@0
   226
    my $this = shift;
colas@0
   227
    my $dir = $ENV{SCRIPT_FILENAME} || '.';
colas@0
   228
    $dir =~ s(/+configure[^/]*$)();
colas@0
   229
    my $ext = $TWiki::cfg{ScriptSuffix} || '';
colas@0
   230
    my $errs = '';
colas@0
   231
    opendir(D, $dir) ||
colas@0
   232
      return $this->ERROR(<<HERE);
colas@0
   233
Cannot open '$dir' for read ($!) - check it exists, and that permissions are correct.
colas@0
   234
HERE
colas@0
   235
    foreach my $script (grep { -f "$dir/$_" && /^\w+(\.\w+)?$/ } readdir D) {
colas@0
   236
        next if( $ext && $script !~ /\.$ext$/ );
colas@0
   237
        if( $TWiki::cfg{OS} !~ /^Windows$/i &&
colas@0
   238
              $script !~ /\.cfg$/ &&
colas@0
   239
                !-x "$dir/$script" ) {
colas@0
   240
            $errs .= $this->WARN(<<HERE);
colas@0
   241
$script might not be an executable script - please check it (and its
colas@0
   242
permissions) manually.
colas@0
   243
HERE
colas@0
   244
        }
colas@0
   245
    }
colas@0
   246
    closedir(D);
colas@0
   247
    return $dir.CGI::br().$errs;
colas@0
   248
}
colas@0
   249
colas@0
   250
# The perl modules that are required by TWiki.
colas@0
   251
sub _loadDEPENDENCIES {
colas@0
   252
    my $this = shift;
colas@0
   253
    
colas@0
   254
    # File DEPENDENCIES is in the lib dir (Item3478)
colas@0
   255
    my $from = TWiki::findFileOnPath('TWiki.spec');
colas@0
   256
    my @dir = File::Spec->splitdir( $from );
colas@0
   257
    pop(@dir); # Cutting off trailing TWiki.spec gives us lib dir
colas@0
   258
    $from = File::Spec->catfile(@dir, 'DEPENDENCIES');
colas@0
   259
    my $d;
colas@0
   260
    open($d, '<'.$from) || return 'Failed to load DEPENDENCIES: '.$!;
colas@0
   261
    my @perlModules;
colas@0
   262
    foreach my $line ( <$d> ) {
colas@0
   263
        next unless $line;
colas@0
   264
        my @row = split(/,\s*/, $line, 4);
colas@0
   265
        next unless (scalar(@row) == 4 && $row[2] eq 'cpan');
colas@0
   266
        my $ver = $row[1];
colas@0
   267
        $ver =~ s/[<>=]//g;
colas@0
   268
        my ($dispo,$usage) = $row[3] =~ /^\s*(\w+).?(.*)$/;
colas@0
   269
        push(@perlModules, {
colas@0
   270
            name => $row[0],
colas@0
   271
            usage => $usage,
colas@0
   272
            minimumVersion => $ver,
colas@0
   273
            disposition => lc($dispo)
colas@0
   274
           });
colas@0
   275
    }
colas@0
   276
    close($d);
colas@0
   277
    return \@perlModules;
colas@0
   278
}
colas@0
   279
colas@0
   280
1;