#!c:/cygwin/bin/perl -wTI. # # TWiki WikiClone (see wiki.pm for $wikiversion and other info) # # Copyright (C) 2000 Peter Thoeny, peter@thoeny.com # # This program is free software; you can redistribute it and/or # modify it under the terms of the GNU General Public License # as published by the Free Software Foundation; either version 2 # of the License, or (at your option) any later version. # # This program is distributed in the hope that it will be useful, # but WITHOUT ANY WARRANTY; without even the implied warranty of # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the # GNU General Public License for more details, published at # http://www.gnu.org/copyleft/gpl.html # # DESCRIPTION: Test utility to see if CGI is running and enabled # for the bin directory use lib ( '.' ); use lib ( '../lib' ); open(STDERR,'>&STDOUT'); # redirect error to browser $| = 1; # no buffering print "Content-type: text/html\n\n"; print < Test the CGI environment

Test the CGI environment for TWiki

Read the TWikiInstallationNotes.

Environment variables:

EOM for $key ( sort keys %ENV ) { print "\n"; } print <

CGI User and Group:

$key$ENV{$key}
EOM my $usr = getpwuid( $< ); print "\n"; print "\n"; if( $usr ne "nobody" ) { print "\n"; } print "
User:$usr
Note: "; print "This is the user your cgi-bin scripts are executing."; print "
Warning: "; print "Since your CGI script is not running as user nobody"; print "you need to change the locks in the *,v RCS files of the TWiki "; print "distribution from nobody to $usr.\n"; print "
Member of groups:"; foreach( split( " ", $( ) ) { $grp = getgrgid( $_ ); print "$grp "; } print "
\n"; print "

Test of TWiki.cfg Configuration:

\n"; # read the TWiki configuration do "TWiki.cfg"; print "\n"; print "\n"; print "\n"; print "\n"; print "\n"; my $val = $ENV{"HTTP_HOST"}; if( ! ( $defaultUrlHost =~ /$val/ ) ) { print "\n"; } print "\n"; print "\n"; $val = $ENV{"REQUEST_URI"}; if( ! ( $val =~ /^$scriptUrlPath/ ) ) { print "\n"; } print "\n"; print "\n"; print "\n"; print "\n"; if( ! ( -e "$pubDir/wikiHome.gif" ) ) { print "\n"; } elsif( ! ( testFileIsWritable( "$pubDir/testenv.test" ) ) ) { # directory is not writable print "\n"; } print "\n"; print "\n"; if( ! ( -e "$templateDir/view.tmpl" ) ) { print "\n"; } elsif( testFileIsWritable( "$templateDir/testenv.test" ) ) { # directory is writable print "\n"; } print "\n"; print "\n"; if( ! ( -e "$dataDir" ) ) { print "\n"; } elsif( ! ( testFileIsWritable( "$dataDir/testenv.test" ) ) ) { # directory is not writable print "\n"; } print "\n"; print "\n"; $val = $mailProgram; $val =~ s/([^\s]*).*/$1/go; if( ! ( -e $val ) ) { print "\n"; } print "\n"; print "\n"; # FIXME should look for ci.exe in Windows if( ! ( -e "$rcsDir/ci" ) ) { print "\n"; } # FIXME check that diff command is in path, required by ci print "\n"; print "\n"; $val = $lsCmd; $val =~ s/([^\s]*).*/$1/go; if( ! ( -e $val ) ) { print "\n"; } print "\n"; print "\n"; $val = $egrepCmd; $val =~ s/([^\s]*).*/$1/go; if( ! ( -e $val ) ) { print "\n"; } print "\n"; print "\n"; $val = $fgrepCmd; $val =~ s/([^\s]*).*/$1/go; if( ! ( -e $val ) ) { print "\n"; } print "
\$wikiHomeUrl:$wikiHomeUrl
Note: "; print "This is the link of the TWiki icon in the upper left corner."; print "
\$defaultUrlHost:$defaultUrlHost
Note: "; print "This must be the protocol and host part (with optional port number) of "; print "the TWiki URL."; print "
Warning: "; print "It does not match with HTTP_HOST"; print "
\$scriptUrlPath:$scriptUrlPath
Note: "; print "This must be the URI of the TWiki cgi-bin directory."; print "
Warning: "; print "It does not match with REQUEST_URI"; print "
\$pubUrlPath:$pubUrlPath
Note: "; print "This must be the URI of the public directory."; print "This is not set correctly if below "; print "$pubUrlPath/wikiHome.gif image is broken:
"; print ""; print "
\$pubDir:$pubDir
Note: "; print "This is the public directory, as seen from the file system. "; print "It must correspond to \$pubUrlPath."; print "
Error: "; print "Directory does not exist or file wikiHome.gif does not exist in this directory."; print "
Error: "; print "This directory is not writable by $usr user."; print "
\$templateDir:$templateDir
Note: "; print "This is the TWiki template directory, as seen from the file system. "; print "
Error: "; print "Directory does not exist or file view.tmpl does not exist in this directory."; print "
Warning: "; print "Security issue: This directory should not be writable by $usr user."; print "
\$dataDir:$dataDir
Note: "; print "This is the data directory where TWiki stores all topics."; print "
Error: "; print "Directory does not exist."; print "
Error: "; print "This directory must be writable by $usr user."; print "
\$mailProgram:$mailProgram
Note: "; print "This is the mail program TWiki uses to send mail."; print "
Warning: "; print "Mail program $val not found. Check the path."; print "
\$rcsDir:$rcsDir
Note: "; print "This is the directory where RCS is located."; print "
Warning: "; print "RCS program $rcsDir/ci not found. Check the path."; print "
\$lsCmd:$lsCmd
Note: "; print "This is the file list program TWiki uses to list topics."; print "
Warning: "; print "List program $val not found. Check the path."; print "
\$egrepCmd:$egrepCmd
Note: "; print "This is a program TWiki uses for search."; print "
Warning: "; print "Search program $val not found. Check the path."; print "
\$fgrepCmd:$fgrepCmd
Note: "; print "This is a program TWiki uses for search."; print "
Warning: "; print "Search program $val not found. Check the path."; print "
\n"; print < EOM exit; # ========================= sub testFileIsWritable { my( $name ) = @_; my $txt1 = "test 1 2 3"; deleteTestFile( $name ); writeTestFile( $name, $txt1 ); my $txt2 = readTestFile( $name ); deleteTestFile( $name ); my $identical = ( $txt2 eq $txt1 ); return $identical; } # ========================= sub readTestFile { my( $name ) = @_; my $data = ""; undef $/; # set to read to EOF open( IN_FILE, "<$name" ) || return ""; $data = ; $/ = "\n"; close( IN_FILE ); return $data; } # ========================= sub writeTestFile { my( $name, $text ) = @_; if( open( FILE, ">$name" ) ) { print FILE $text; close( FILE); } } # ========================= sub deleteTestFile { my( $name ) = @_; if( -e $name ) { unlink $name; } }