pjs/webtools/doctor/doctor.cgi

652 строки
20 KiB
Perl
Executable File

#!/export2/gnu/files/perl-5.6.0/bin/perl -w
# -*- Mode: perl; indent-tabs-mode: nil -*-
#
# The contents of this file are subject to the Mozilla Public
# License Version 1.1 (the "License"); you may not use this file
# except in compliance with the License. You may obtain a copy of
# the License at http://www.mozilla.org/MPL/
#
# Software distributed under the License is distributed on an "AS
# IS" basis, WITHOUT WARRANTY OF ANY KIND, either express or
# implied. See the License for the specific language governing
# rights and limitations under the License.
#
# The Original Code is Doctor.
#
# The Initial Developer of the Original Code is Netscape
# Communications Corporation. Portions created by Netscape
# are Copyright (C) 2002 Netscape Communications Corporation.
# All Rights Reserved.
#
# Contributor(s): Myk Melez <myk@mozilla.org>
################################################################################
# Script Initialization
################################################################################
# Make it harder to do dangerous things in Perl.
use diagnostics;
use strict;
# Make it easier to access Perl's built-in variables by turning on the option
# of referencing them by sensible name instead of punctuation mark.
use English;
# Include the standard Perl CGI library and create a new request object
# to handle this CGI request.
use CGI;
my $request = new CGI;
# Use a useful library for capturing filehandle output into a variable.
# http://groups.google.com/groups?selm=yr0e8.12924%24ZC3.1033373%40newsread2.prod.itd.earthlink.net
use IO::Capture;
# Include the Perl library for creating and deleting directory hierarchies.
use File::Path;
# Use the Template Toolkit (http://www.template-toolkit.org/) to generate
# the user interface using templates in the "template/" subdirectory.
use Template;
# Create the global template object that processes templates and specify
# configuration parameters that apply to templates processed in this script.
my $template = Template->new(
{
# Colon-separated list of directories containing templates.
INCLUDE_PATH => "templates" ,
FILTERS =>
{
linebreak => sub
{
my ($var) = @_;
$var =~ s/\\/\\\\/g;
$var =~ s/\n/\\n/g;
$var =~ s/\r/\\r/g;
return $var;
}
}
}
);
# Define the global variables and functions that will be passed to the UI
# template. Individual functions add their own values to this hash before
# sending them to the templates they process.
my $vars = {};
################################################################################
# Script Configuration
################################################################################
# Note: Look in the configuration file for descriptions of each parameter.
# Use the AppConfig module for handling script configuration.
use AppConfig qw(:expand :argcount);
# Create an AppConfig object and populate it with parameters defined
# in the configuration file.
my $config = AppConfig->new(
{
CREATE => 1 ,
GLOBAL => {
ARGCOUNT => ARGCOUNT_ONE ,
}
}
);
$config->file("doctor.conf");
# Write parameters into global variables.
my $TEMP_DIR = $config->get('TEMP_DIR');
my $READ_CVS_SERVER = $config->get('READ_CVS_SERVER');
my $READ_CVS_USERNAME = $config->get('READ_CVS_USERNAME');
my $READ_CVS_PASSWORD = $config->get('READ_CVS_PASSWORD');
my $WRITE_CVS_SERVER = $config->get('WRITE_CVS_SERVER');
my $WEB_BASE_URI = $config->get('WEB_BASE_URI');
my $WEB_BASE_URI_PATTERN = $config->get('WEB_BASE_URI_PATTERN');
my $WEB_BASE_PATH = $config->get('WEB_BASE_PATH');
# Store the home directory so we can get back to it after changing directories
# in certain places in the code.
use Cwd;
my $HOME = cwd;
################################################################################
# Main Body Execution
################################################################################
# Note: All calls to this script should contain an "action" variable
# whose value determines what the user wants to do. The code below
# checks the value of that variable and runs the appropriate code.
# Determine whether to use the action specified by the user or the default.
my $action = lc($request->param('action')) || "edit";
# If the user wants to edit a file, but they haven't specified the name
# of the file, prompt them for it.
if ($action eq "edit" && !$request->param('file')) { $action = "select" }
if ($action eq "select")
{
print $request->header;
$template->process("select.tmpl", $vars)
|| DisplayError("Template Process Failed", $template->error())
&& exit;
}
elsif ($action eq "edit")
{
ValidateFile();
$vars->{'file'} = $request->param('file');
if ($request->param('content'))
{
ValidateContent();
$vars->{'content'} = $request->param('content');
$vars->{'version'} = $request->param('version');
$vars->{'line_endings'} = $request->param('line_endings');
}
else
{
($vars->{'content'}, $vars->{'version'}, $vars->{'line_endings'})
= RetrieveFile($request->param('file'));
}
print $request->header;
$template->process("edit.tmpl", $vars)
|| DisplayError("Template Process Failed", $template->error())
&& exit;
}
elsif ($action eq "review")
{
ValidateFile();
ReviewChanges();
}
elsif ($action eq "commit")
{
ValidateContent();
ValidateUsername();
ValidatePassword();
ValidateComment();
CommitFile();
}
else
{
DisplayError("I could not figure out what you wanted to do.", "Unknown action");
}
exit;
################################################################################
# Input Validation
################################################################################
sub ValidateFile
{
# Make sure a path was entered.
my $file = $request->param("file");
$file
|| DisplayError("You must include the name of the file.")
&& exit;
# URL -> Path Conversion
# Remove the absolute URI for files on the web site (if any)
# from the beginning of the path.
if ($WEB_BASE_URI_PATTERN) { $file =~ s/^$WEB_BASE_URI_PATTERN//i }
else { $file =~ s/^\Q$WEB_BASE_URI\E//i }
# Entire Path Issues
# Collapse multiple consecutive slashes (i.e. dir//file.txt) into a single slash.
$file =~ s:/{2,}:/:;
# Beginning of Path Issues
# Remove a preceding slash.
$file =~ s:^/::;
# Add the base path of the file in the cvs repository if necessary.
# (i.e. if the user entered a URL or a path based on the URL).
if ($file !~ /^\Q$WEB_BASE_PATH\E/) { $file = $WEB_BASE_PATH . $file }
# End of Path Issues
# If the filename (the last name in the path) contains no period,
# it is probably a directory, so add a slash.
if ($file =~ m:^[^\./]+$: || $file =~ m:/[^\./]+$:) { $file .= "/" }
# If the file ends with a forward slash, it is a directory,
# so add the name of the default file.
if ($file =~ m:/$:) { $file .= "index.html" }
# Set the file path.
$request->param("file", $file);
# Note: we don't need to make sure the file exists at this point
# because CVS will tell us that.
# Construct a URL to the file if possible.
my $url = $file;
if ($url =~ s/^\Q$WEB_BASE_PATH\E(.*)$/$1/i) { $vars->{'file_url'} = $WEB_BASE_URI . $url }
}
sub ValidateUsername
{
$request->param('username')
|| DisplayError("You must enter a username.")
&& exit;
my $username = $request->param('username');
# If the username has an at sign in it, convert it to a percentage sign,
# since that is probably what the user meant (CVS usernames are often
# email addresses in which the at sign has been converted to a percentage sign.
$username =~ s/@/%/;
$request->param('username', $username);
}
sub ValidatePassword
{
$request->param('password')
|| DisplayError("You must enter a password.")
&& exit;
}
sub ValidateComment
{
$request->param('comment')
|| DisplayError("You must enter a check-in comment.")
&& exit;
}
sub ValidateContent
{
my $content = $request->param('content');
# The HTML spec tells browsers to remove line breaks (carriage return
# and newline characters) from form values in some cases. This happens
# even if those characters are encoded into entities (&#10; and &#13;).
# To prevent corruption of file content in this case, we have to escape
# those characters as \r and \n, so here we convert them back.
#
# An escaped line break is the literal string "\r" or "\n" with zero
# or an even number of slashes before it, because if there are an odd
# number of slashes before it, then the total number of slashes is even,
# so the slashes are actually escaped slashes followed by a literal
# "r" or "n" character, rather than an escaped line break character.
# In other words, "\n" and "\\\n" are a line break and a slash followed
# by a line break, respectively, but "\\n" is a slash followed by
# a literal "n".
#
$content =~ s/(^|[^\\])((\\\\)*)\\r/$1$2\r/g;
$content =~ s/(^|[^\\])((\\\\)*)\\n/$1$2\n/g;
$content =~ s/\\\\/\\/g;
$request->param('content', $content);
}
################################################################################
# Utility Functions
################################################################################
sub RetrieveFile
{
my ($name) = @_;
my @args = ("-d",
":pserver:$READ_CVS_USERNAME:$READ_CVS_PASSWORD\@$READ_CVS_SERVER",
"checkout",
"-p", # write to STDOUT
$name);
# Check out the file from the CVS repository, capturing the file content
# and any errors/notices.
my $CAPTURE_ERR = IO::Capture->new(\*STDERR);
my $CAPTURE_OUT = IO::Capture->new(\*STDOUT);
my $error_code = system("cvs", @args);
my $output = $CAPTURE_OUT->capture;
my $errors = $CAPTURE_ERR->capture;
if ($error_code != 0)
{
# Include the command in the error message (but hide the username/password).
my $command = join(" ", "cvs", @args);
$command =~ s/\Q$READ_CVS_PASSWORD\E/[password]/g;
$errors =~ s/\Q$READ_CVS_PASSWORD\E/[password]/g;
DisplayError("I could not check the file out from the repository.<br>
<strong>Command:</strong> <em>$command</em><br>
<strong>Error Code:</strong> <em>$error_code</em><br>
<strong>Error Message:</strong><b><pre>$errors</pre>");
exit;
}
# Extract the file version from the errors/notices.
my $version = "";
if ($errors =~ /VERS:\s([0-9.]+)\s/) { $version = $1 }
# Figure out the line-ending style by examining the content of the file.
my $line_endings = "unix";
if ($output =~ /\r\n/s) { $line_endings = "windows" }
elsif ($output =~ /\r[^\n]/s) { $line_endings = "mac" }
return ($output, $version, $line_endings);
}
sub ReviewChanges
{
# Displays a diff between the version of a file in the repository
# and the version submitted by the user so the user can review the
# changes they are making to the file. Offers the user the option
# to either commit their changes or edit the file some more.
# Create and change to a temporary sub-directory into which
# we will check out the file being reviewed.
CreateTempDir();
# Check out the file from the repository.
my $file = $request->param('file');
my $oldversion = $request->param('version');
my $newversion = CheckOutFile($file);
# Throw an error if the version of the file that was edited
# does not match the version in the repository. In the future
# we should try to merge the user's changes if possible.
if ($oldversion && $newversion && $oldversion != $newversion)
{
DisplayError("You edited version <em>$oldversion</em> of the file,
but version <em>$newversion</em> is in the repository.
Reload the edit page and make your changes again
(and bother the authors of this script to implement
change merging).");
DeleteTempDir();
exit;
}
# Replace the checked out file with the edited version, generate
# a diff between the edited file, and display it to the user.
ReplaceFile($file);
$vars->{'diff'} = DiffFile($file);
# Delete the temporary directory into which we checked out the file.
DeleteTempDir();
$vars->{'file'} = $file;
$vars->{'content'} = $request->param('content');
$vars->{'version'} = $request->param('version');
$vars->{'line_endings'} = $request->param('line_endings');
print $request->header;
$template->process("review.tmpl", $vars)
|| DisplayError("Template Process Failed", $template->error())
&& exit;
}
sub CommitFile
{
# Commit a file to the repository. Checks out the file via cvs,
# applies the changes, generates a diff, and then checks the file
# back in. It would be easier if we could commit a file by piping
# it into standard input, but cvs does not provide for this.
# Create and change to a temporary sub-directory into which
# we will check out the file being committed.
CreateTempDir();
# Check out the file from the repository.
my $file = $request->param('file');
my $oldversion = $request->param('version');
my $newversion = CheckOutFile($file);
# Throw an error if the version of the file that was edited
# does not match the version in the repository. In the future
# we should try to merge the user's changes if possible.
if ($oldversion && $newversion && $oldversion != $newversion)
{
DisplayError("You edited version <em>$oldversion</em> of the file,
but version <em>$newversion</em> is in the repository.
Reload the edit page and make your changes again
(and bother the authors of this script to implement
change merging).");
DeleteTempDir();
exit;
}
# Replace the checked out file with the edited version, generate
# a diff between the edited file and the version in the repository,
# and check in the edited file.
ReplaceFile($file);
$vars->{'diff'} = DiffFile($file);
$vars->{'checkin_results'} = CheckInFile($file);
# Delete the temporary directory into which we checked out the file.
DeleteTempDir();
$vars->{'file'} = $file;
$vars->{'at_sign'} = $at_sign;
print $request->header;
$template->process("committed.tmpl", $vars)
|| DisplayError("Template Process Failed", $template->error())
&& exit;
}
sub CheckOutFile
{
# Checks out a file from the repository.
my ($file) = @_;
my @args = ("-t", # debugging messages from which to extract the version
"-d",
":pserver:$READ_CVS_USERNAME:$READ_CVS_PASSWORD\@$READ_CVS_SERVER",
"checkout",
$file);
# Check out the file from the repository, capturing the output of the
# command and any error messages/notices.
my $CAPTURE_ERR = IO::Capture->new(\*STDERR);
my $CAPTURE_OUT = IO::Capture->new(\*STDOUT);
my $error_code = system("cvs", @args);
my $output = $CAPTURE_OUT->capture;
my $errors = $CAPTURE_ERR->capture;
if ($error_code != 0)
{
# Include the command in the error message (but hide the password).
my $command = join(" ", "cvs", @args);
$command =~ s/\Q$READ_CVS_PASSWORD\E/[password]/g;
$errors =~ s/\Q$READ_CVS_PASSWORD\E/[password]/g;
DisplayError("I could not check the file out from the repository.<br>
<strong>Command:</strong> <em>$command</em><br>
<strong>Error Message:</strong><b><pre>$errors</pre>");
DeleteTempDir();
exit;
}
# Extract the file version from the errors/notices.
my $version = "";
if ($errors =~ /\Q$file\E,v,\s([0-9.]+),/) { $version = $1 }
return $version;
}
sub ReplaceFile
{
# Replaces the file checked out from the repository with the edited version.
my ($file) = @_;
my $content = $request->param('content');
my $line_endings = $request->param('line_endings');
# Replace the Windows-style line endings in which browsers send content
# with line endings appropriate to the file being replaced if the file
# has Unix- or Mac-style line endings.
if ($line_endings eq "unix") { $content =~ s/\r\n/\n/g }
if ($line_endings eq "mac") { $content =~ s/\r\n/\r/g }
if (!open(DOC, ">$file"))
{
DisplayError("I could not open the temporary file <em>$file</em>
for writing: $!");
DeleteTempDir();
exit;
}
print DOC $content;
close(DOC);
}
sub DiffFile
{
# Returns the results of diffing a file against the version in the repository.
my ($file) = @_;
my @args = ("-d",
":pserver:$READ_CVS_USERNAME:$READ_CVS_PASSWORD\@$READ_CVS_SERVER",
"diff",
"-u",
$file);
# Diff the file against the version in the repository, capturing the diff
# and any error messages/notices.
my $CAPTURE_ERR = IO::Capture->new(\*STDERR);
my $CAPTURE_OUT = IO::Capture->new(\*STDOUT);
my $error_code = system("cvs", @args);
my $output = $CAPTURE_OUT->capture;
my $errors = $CAPTURE_ERR->capture;
# Check the error messages/notices in addition to the error code
# returned by the system call, because for some reason the call
# sometimes returns a non-zero error code (256) upon success.
if ($error_code && $errors)
{
# Include the command in the error message (but hide the password).
my $command = join(" ", "cvs", @args);
$command =~ s/\Q$READ_CVS_PASSWORD\E/[password]/g;
$errors =~ s/\Q$READ_CVS_PASSWORD\E/[password]/g;
DisplayError("I could not diff your version of the file against
the version in the repository.<br>
<strong>Command:</strong> <em>$command</em><br>
<strong>Error Message:</strong><b><pre>$errors</pre>");
DeleteTempDir();
exit;
}
if (!$output)
{
DisplayError("You didn't change anything!");
DeleteTempDir();
exit;
}
return $output;
}
sub CheckInFile
{
# Checks a file into the repository.
my ($file) = @_;
my $username = $request->param('username');
my $password = $request->param('password');
my $comment = $request->param('comment');
my @args = ("-d" ,
":pserver:$username:$password\@$WRITE_CVS_SERVER" ,
"commit" ,
"-m" ,
$comment ,
$file);
# Check the file into the repository and capture the results.
my $CAPTURE_ERR = IO::Capture->new(\*STDERR);
my $CAPTURE_OUT = IO::Capture->new(\*STDOUT);
my $error_code = system("cvs", @args);
my $output = $CAPTURE_OUT->capture;
my $errors = $CAPTURE_ERR->capture;
if ($error_code != 0)
{
# Include the command in the error message (but hide the password).
my $command = join(" ", "cvs", @args);
$command =~ s/\Q$password\E/[password]/g;
$errors =~ s/\Q$password\E/[password]/g;
DisplayError("I could not check your version of the file
into the repository.<br>
<strong>Command:</strong> <em>$command</em><br>
<strong>Error Message:</strong><br><pre>$errors</pre>");
DeleteTempDir();
exit;
}
return $output;
}
sub DisplayError
{
($vars->{'message'}, $vars->{'title'}) = @_;
chdir($HOME)
|| die("Could not change back to original working directory
to deliver error message <strong>$vars->{'title'}</strong>:
<em>$vars->{'message'}</em>.");
print $request->header;
$template->process("error.tmpl", $vars)
|| die("<strong>Template Error</strong>: <em>" . $template->error() . "</em>
while trying to deliver error message <strong>$vars->{'title'}</strong>:
<em>$vars->{'message'}</em>.");
}
sub CreateTempDir
{
# Creates and changes to a temporary sub-directory unique to this process
# that can be used for CVS activities requiring the checking out of files.
if (!-e $TEMP_DIR and !mkdir($TEMP_DIR))
{
DisplayError("I could not create the temporary directory <em>$TEMP_DIR</em>: $!");
exit;
}
elsif (!-d $TEMP_DIR)
{
DisplayError("I could not use the temporary directory <em>$TEMP_DIR</em>
because it is not a directory.");
exit;
}
# Create and change to a unique sub-directory in the temporary directory.
mkdir("$TEMP_DIR/$PID")
|| DisplayError("I could not create a temporary sub-directory <em>$TEMP_DIR/$PID</em>: $!")
&& exit;
chdir("$TEMP_DIR/$PID")
|| DisplayError("I could not change to the temporary sub-directory <em>$TEMP_DIR/$PID</em>: $!")
&& exit;
}
sub DeleteTempDir
{
# Changes back to the home directory and deletes the temporary directory.
chdir($HOME);
rmtree("$TEMP_DIR/$PID", 0, 1)
|| DisplayError("I could not delete the temporary sub-directory <em>$TEMP_DIR/$PID</em>: $!")
&& exit;
}