mirror of
https://github.com/mozilla/gecko-dev.git
synced 2024-11-05 08:35:26 +00:00
721 lines
24 KiB
Perl
Executable File
721 lines
24 KiB
Perl
Executable File
#!/usr/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;
|
|
|
|
# Include the Perl library for creating and deleting directory hierarchies
|
|
# and the one for creating temporary files and directories.
|
|
use File::Path;
|
|
use File::Temp qw(tempfile tempdir);
|
|
|
|
use Doctor qw($template $vars %CONFIG);
|
|
|
|
use Doctor::File;
|
|
|
|
################################################################################
|
|
# Script Configuration
|
|
################################################################################
|
|
|
|
# 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
|
|
################################################################################
|
|
|
|
# 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.
|
|
|
|
my $action = lc($request->param('action'));
|
|
if (!$action) {
|
|
$action = $request->param('file') ? "edit" : "choose";
|
|
}
|
|
|
|
# Displays a form for choosing the page you want to edit.
|
|
if ($action eq "choose") { choose() }
|
|
|
|
# Displays a page with UI for editing the page online, downloading it
|
|
# for local editing, viewing the original and the user's modified versions,
|
|
# getting a diff of the user's changes, and committing the user's changes
|
|
# or submitting them to the editors for review. This is the principle
|
|
# interface to Doctor functionality, and many other actions are called
|
|
# from links, forms, and JavaScript on this page.
|
|
elsif ($action eq "edit") { edit() }
|
|
|
|
# Retrieves a page from CVS and returns it. Called by the "download the page"
|
|
# link on the Edit page for users who want to download and edit pages locally
|
|
# instead of via the embedded textarea. Also called by the View Original panel
|
|
# of the Edit page to show the original version of the page being edited.
|
|
elsif ($action eq "download" || $action eq "display")
|
|
{ retrieve() }
|
|
|
|
# Generates and returns a diff of changes between the submitted version
|
|
# of a page and the version in CVS. Called by the Show Diff panel of the Edit page.
|
|
elsif ($action eq "diff") { diff() }
|
|
|
|
# Returns the content that was submitted to it. Useful for displaying
|
|
# the modified version of a page the user downloaded and edited locally,
|
|
# since for security reasons there's no way to get access to a file
|
|
# in a file upload control on the client side. Called by JavaScript
|
|
# when the user focuses the View Edited panel on the Edit page after entering
|
|
# a filename into the file upload control.
|
|
elsif ($action eq "regurgitate") { regurgitate() }
|
|
|
|
# Submits a change to the editors for review. Requires the EDITOR_EMAIL config
|
|
# parameter to be set to the editors' email addresses.
|
|
elsif ($action eq "queue") { queue() }
|
|
|
|
# Adds and commits a new page to the repository.
|
|
elsif ($action eq "create") { create() }
|
|
|
|
# Commits changes to an existing page to the repository.
|
|
elsif ($action eq "commit") { commit() }
|
|
|
|
else
|
|
{
|
|
ThrowCodeError("couldn't recognize the value of the action parameter", "Unknown Action");
|
|
}
|
|
|
|
exit;
|
|
|
|
################################################################################
|
|
# Main Execution Functions
|
|
################################################################################
|
|
|
|
sub choose
|
|
{
|
|
print $request->header;
|
|
$template->process("select.tmpl", $vars)
|
|
|| ThrowCodeError($template->error(), "Template Processing Failed");
|
|
}
|
|
|
|
sub edit {
|
|
my $file = Doctor::File->new($request->param('file'));
|
|
|
|
$file->retrieve();
|
|
$vars->{file} = $file;
|
|
|
|
print $request->header;
|
|
$template->process("edit.tmpl", $vars)
|
|
|| ThrowCodeError($template->error(), "Template Processing Failed");
|
|
}
|
|
|
|
sub retrieve {
|
|
my $file = Doctor::File->new($request->param('file'));
|
|
|
|
$file->retrieve();
|
|
|
|
my $disposition = $action eq "download" ? "attachment" : "inline";
|
|
|
|
my $length = length($file->content);
|
|
|
|
print $request->header(
|
|
-type => qq|text/html; name="$file->name"|,
|
|
-content_disposition => qq|$disposition; filename="$file->name"|,
|
|
-content_length => $length );
|
|
|
|
print $file->content;
|
|
}
|
|
|
|
sub diff {
|
|
my $file = Doctor::File->new($request->param('file'));
|
|
ValidateVersions($request->param('version'), $file->version);
|
|
my $diff = $file->diff($request->param('content'))
|
|
|| "There are no differences between the version in CVS and your revision.";
|
|
|
|
print $request->header(-type=>"text/plain");
|
|
print $diff;
|
|
}
|
|
|
|
sub regurgitate {
|
|
# Returns the content that was submitted to it. Useful for displaying
|
|
# the modified version of a document the user downloaded and edited locally
|
|
# in the "View Edited" tab, since for security reasons there's no way
|
|
# to get access to a file being uploaded on the client side. When the user
|
|
# clicks on the "View Edited" tab, client-side JS checks to see if there is
|
|
# a value in the file upload control, and if so it adds an iframe
|
|
# to the "View Edited" panel and posts the file to it with action=regurgitate.
|
|
|
|
my $content = GetContent();
|
|
my $filename = $request->param('content_file')
|
|
|| $request->param('file')
|
|
|| "modified.html";
|
|
$filename =~ s/^(.*[\/\\])?([^\/\\]+)$/$2/;
|
|
|
|
print $request->header(
|
|
-type => qq|text/html; name="$filename"|,
|
|
-content_disposition => qq|inline; filename="$filename"|,
|
|
-content_length => length($content));
|
|
print $content;
|
|
}
|
|
|
|
sub queue {
|
|
# Sends the diff or new file to an editors mailing list for review.
|
|
|
|
if (!$CONFIG{EDITOR_EMAIL}) {
|
|
ThrowCodeError("The administrator has not enabled submission of patches
|
|
for review.", "Review Not Enabled");
|
|
}
|
|
|
|
my $file = Doctor::File->new($request->param('file'));
|
|
my $comment = $request->param('comment') || "No comment.";
|
|
my $content = GetContent() || "";
|
|
|
|
my $email;
|
|
use Email::Valid;
|
|
if (!($email = Email::Valid->address($request->param('email')))) {
|
|
ThrowUserError("address $email invalid: $Email::Valid::Details");
|
|
}
|
|
|
|
# Prefer the name of the file being uploaded, if any; otherwise append
|
|
# ".diff" to the name of the file in CVS.
|
|
my $filename = $request->param('content_file') || $file->name . ".diff";
|
|
$filename =~ s/^(.*[\/\\])?([^\/\\]+)$/$2/;
|
|
|
|
my ($patch, $version);
|
|
if ($file->version eq "new") {
|
|
$patch = $content;
|
|
$version = "(new file)";
|
|
}
|
|
else {
|
|
ValidateVersions($request->param('version'), $file->version);
|
|
$patch = $file->diff($content);
|
|
if (!$patch) {
|
|
ThrowUserError("There are no differences between the version
|
|
in CVS and your revision.", "No Differences Found");
|
|
}
|
|
$version = "v" . $file->version;
|
|
}
|
|
|
|
my $subject = "patch: " . $file->spec . " $version";
|
|
|
|
eval {
|
|
use MIME::Entity;
|
|
my $mail = MIME::Entity->build(Type =>"multipart/mixed",
|
|
From => $email,
|
|
To => $CONFIG{EDITOR_EMAIL},
|
|
Subject => $subject);
|
|
$mail->attach(Data => \$comment,
|
|
Encoding => "quoted-printable");
|
|
$mail->attach(Data => \$patch,
|
|
Encoding => "quoted-printable",
|
|
Disposition => "inline",
|
|
Filename => $filename);
|
|
# Set the record separator because otherwise MIME::Entity seems
|
|
# to get stuck in an infinite loop.
|
|
$/ = "\n";
|
|
$mail->send();
|
|
};
|
|
if ($@) {
|
|
ThrowCodeError($@, "Mail Failure");
|
|
}
|
|
|
|
print $request->header;
|
|
$template->process("queued.tmpl", $vars)
|
|
|| ThrowCodeError($template->error(), "Template Processing Failed");
|
|
}
|
|
|
|
sub create
|
|
{
|
|
# Creates a new file in the repository.
|
|
|
|
ValidateFile();
|
|
ValidateContent();
|
|
ValidateUsername();
|
|
ValidatePassword();
|
|
ValidateComment();
|
|
|
|
ChangeToTempDir();
|
|
|
|
# Separate the name of the file from its path.
|
|
$request->param('file') =~ /^(.*)\/([^\/]+)$/;
|
|
my $filename = $2;
|
|
my $path = $1;
|
|
|
|
# Write the file to the temporary directory. "ReplaceFile" is an unfortunate
|
|
# name. !!! Replace it with a new fortunate name!
|
|
ReplaceFile($filename);
|
|
|
|
# Create a fake CVS directory that makes the temporary directory look like
|
|
# a local working copy of the directory in the repository where this file
|
|
# will be created. This way we just have to commit the file to create it;
|
|
# we avoid having to first check out the directory and then add the file.
|
|
|
|
# Make the CVS directory and change to it.
|
|
mkdir("CVS") || ThrowCodeError("couldn't create directory 'CVS': $!");
|
|
chdir("CVS");
|
|
|
|
# Make the Entries file and add an entry for the new file.
|
|
open(FILE, ">Entries") || ThrowCodeError("couldn't create file 'Entries': $!");
|
|
print FILE "/$filename/0/Initial $filename//\nD\n";
|
|
close(FILE);
|
|
|
|
# Make an empty file named after the new file but with a ",t" appended
|
|
# to the name. I don't know what this is for, but the CVS client creates it,
|
|
# so I figure I should too.
|
|
#
|
|
# UPDATE: Commenting out this code didn't make it fail, so I'm leaving it
|
|
# commented out--less code means less things to break.
|
|
#
|
|
#open(FILE, ">${filename},t")
|
|
# || ThrowCodeError("couldn't create file '${filename},t': $!");
|
|
#close(FILE);
|
|
|
|
# Make the Repository file, which contains the path to the directory
|
|
# in the CVS repository.
|
|
open(FILE, ">Repository")
|
|
|| ThrowCodeError("couldn't create file 'Repository': $!");
|
|
print FILE "$path\n";
|
|
close(FILE);
|
|
|
|
# Note that we don't have to create a Root file with information about
|
|
# the repository (authentication type, server address, root path, etc.)
|
|
# since we add that information to the command line.
|
|
|
|
# Change back to the directory containing the file and check it in.
|
|
chdir("..");
|
|
$vars->{'checkin_results'} = CheckInFile($filename);
|
|
|
|
$vars->{'file'} = $request->param('file');
|
|
|
|
print $request->header;
|
|
$template->process("created.tmpl", $vars)
|
|
|| ThrowCodeError($template->error(), "Template Processing Failed");
|
|
}
|
|
|
|
sub commit
|
|
{
|
|
# 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.
|
|
|
|
ValidateFile();
|
|
ValidateContent();
|
|
ValidateUsername();
|
|
ValidatePassword();
|
|
ValidateComment();
|
|
my $patch_id;
|
|
if ($request->param('patch_id')) {
|
|
$patch_id = ValidateID($request->param('patch_id'));
|
|
}
|
|
|
|
ChangeToTempDir();
|
|
|
|
# Check out the file from the repository.
|
|
my $file = $request->param('file');
|
|
my $oldversion = $request->param('version');
|
|
my $newversion = CheckOutFile($file);
|
|
|
|
ValidateVersions();
|
|
|
|
# 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);
|
|
|
|
$vars->{'file'} = $file;
|
|
|
|
print $request->header;
|
|
$template->process("committed.tmpl", $vars)
|
|
|| ThrowCodeError($template->error(), "Template Processing Failed");
|
|
}
|
|
|
|
################################################################################
|
|
# Input Validation
|
|
################################################################################
|
|
|
|
sub ValidateFile
|
|
{
|
|
# Make sure a path was entered.
|
|
my $file = $request->param("file");
|
|
$file
|
|
|| ThrowUserError("You must include the name/path or the URL of the file.");
|
|
|
|
|
|
# URL -> Path Conversion
|
|
|
|
# Remove the absolute URI for files on the web site (if any)
|
|
# from the beginning of the path.
|
|
if ($CONFIG{WEB_BASE_URI_PATTERN}) { $file =~ s/^$CONFIG{WEB_BASE_URI_PATTERN}//i }
|
|
else { $file =~ s/^\Q$CONFIG{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$CONFIG{WEB_BASE_PATH}\E/) { $file = $CONFIG{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$CONFIG{WEB_BASE_PATH}\E(.*)$/$1/i) { $vars->{'file_url'} = $CONFIG{WEB_BASE_URI} . $url }
|
|
|
|
}
|
|
|
|
sub ValidateUsername
|
|
{
|
|
$request->param('username')
|
|
|| ThrowUserError("You must enter your username.");
|
|
|
|
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')
|
|
|| ThrowUserError("You must enter your password.");
|
|
}
|
|
|
|
sub ValidateComment
|
|
{
|
|
$request->param('comment')
|
|
|| ThrowUserError("You must enter a check-in comment describing your changes.");
|
|
}
|
|
|
|
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 ( and ).
|
|
# 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);
|
|
}
|
|
|
|
sub ValidateID()
|
|
{
|
|
my ($id) = @_;
|
|
$id =~ m/(\d+)/;
|
|
$id = $1;
|
|
$id || ThrowCodeError("$id is not a valid patch ID");
|
|
return $id;
|
|
}
|
|
|
|
sub ValidateVersions()
|
|
{
|
|
# Throws 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.
|
|
|
|
my ($oldversion, $newversion) = @_;
|
|
|
|
if ($oldversion && $newversion && $oldversion != $newversion) {
|
|
ThrowCodeError("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
|
|
(<a href=\"http://bugzilla.mozilla.org/show_bug.cgi?id=164342\">bug 164342</a>).");
|
|
}
|
|
}
|
|
|
|
|
|
################################################################################
|
|
# CVS Glue
|
|
################################################################################
|
|
|
|
sub CheckOutFile
|
|
{
|
|
# Checks out a file from the repository.
|
|
|
|
my ($file) = @_;
|
|
|
|
my @args = ("-t", # debugging messages from which to extract the version
|
|
"-d",
|
|
":pserver:$CONFIG{READ_CVS_USERNAME}:$CONFIG{READ_CVS_PASSWORD}\@$CONFIG{READ_CVS_SERVER}",
|
|
"checkout",
|
|
$file);
|
|
|
|
# Check out the file from the repository, capturing the output of the
|
|
# command and any error messages.
|
|
my ($error_code, $output, $errors) = system_capture("cvs", @args);
|
|
|
|
if ($error_code != 0)
|
|
{
|
|
# Include the command in the error message (but hide the password).
|
|
my $command = join(" ", "cvs", @args);
|
|
$command =~ s/\Q$CONFIG{READ_CVS_PASSWORD}\E/[password]/g;
|
|
$errors =~ s/\Q$CONFIG{READ_CVS_PASSWORD}\E/[password]/g;
|
|
|
|
ThrowUserError("Doctor could not check out the file from the repository.",
|
|
undef,
|
|
$command,
|
|
undef,
|
|
$errors);
|
|
}
|
|
|
|
# Extract the file version from the errors/notices.
|
|
my $version = "";
|
|
if ($errors =~ /\Q$file\E,v,\s([0-9.]+),/) { $version = $1 }
|
|
|
|
return $version;
|
|
}
|
|
|
|
sub DiffFile
|
|
{
|
|
# Returns the results of diffing a file against the version in the repository.
|
|
|
|
my ($file) = @_;
|
|
|
|
my @args = ("-d",
|
|
":pserver:$CONFIG{READ_CVS_USERNAME}:$CONFIG{READ_CVS_PASSWORD}\@$CONFIG{READ_CVS_SERVER}",
|
|
"diff",
|
|
"-u",
|
|
$file);
|
|
|
|
# Diff the file against the version in the repository, capturing the diff
|
|
# and any error messages/notices.
|
|
my ($error_code, $output, $errors) = system_capture("cvs", @args);
|
|
|
|
# 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$CONFIG{READ_CVS_PASSWORD}\E/[password]/g;
|
|
$errors =~ s/\Q$CONFIG{READ_CVS_PASSWORD}\E/[password]/g;
|
|
|
|
ThrowUserError("Doctor could not diff your version of the file
|
|
against the version in the repository.",
|
|
undef,
|
|
$command,
|
|
undef,
|
|
$errors);
|
|
}
|
|
|
|
$output || ThrowUserError("You didn't change anything!");
|
|
|
|
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\@$CONFIG{WRITE_CVS_SERVER}" ,
|
|
"commit" ,
|
|
"-m" ,
|
|
$comment ,
|
|
$file);
|
|
|
|
# Check the file into the repository and capture the results.
|
|
my ($error_code, $output, $errors) = system_capture("cvs", @args);
|
|
|
|
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;
|
|
|
|
ThrowUserError("Doctor could not check the file into the repository.",
|
|
undef,
|
|
$command,
|
|
$error_code,
|
|
$errors);
|
|
}
|
|
|
|
return $output;
|
|
}
|
|
|
|
################################################################################
|
|
# Error Handling
|
|
################################################################################
|
|
|
|
sub ThrowUserError
|
|
{
|
|
# Throw an error about a problem with the user's request. This function
|
|
# should avoid mentioning system problems displaying the error message, since
|
|
# the user isn't going to care about them and probably doesn't need to deal
|
|
# with them after fixing their own mistake. Errors should be gentle on
|
|
# the user, since many "user" errors are caused by bad UI that trip them up.
|
|
|
|
# !!! Mail code errors to the system administrator!
|
|
|
|
($vars->{'message'},
|
|
$vars->{'title'},
|
|
$vars->{'cvs_command'},
|
|
$vars->{'cvs_error_code'},
|
|
$vars->{'cvs_error_message'}) = @_;
|
|
|
|
chdir($HOME);
|
|
print $request->header;
|
|
$template->process("user-error.tmpl", $vars)
|
|
|| print( ($vars->{'title'} ? "<h1>$vars->{'title'}</h1>" : "") .
|
|
"<p>$vars->{'message'}</p><p>Please go back and try again.</p>" );
|
|
exit;
|
|
}
|
|
|
|
sub ThrowCodeError
|
|
{
|
|
# Throw error about a problem with the code. This function should be
|
|
# apologetic and deferent to the user, since it isn't the user's fault
|
|
# the code didn't work.
|
|
|
|
# !!! Mail code errors to the system administrator!
|
|
|
|
($vars->{'message'}, $vars->{'title'}) = @_;
|
|
|
|
chdir($HOME);
|
|
print $request->header;
|
|
$template->process("code-error.tmpl", $vars)
|
|
|| print("
|
|
<p>
|
|
Unfortunately Doctor has experienced an internal error from which
|
|
it was unable to recover. More information about the error is
|
|
provided below. Please forward this information along with any
|
|
other information that would help diagnose and fix this problem
|
|
to the system administrator at
|
|
<a href=\"mailto:$CONFIG{ADMIN_EMAIL}\">$CONFIG{ADMIN_EMAIL}</a>.
|
|
</p>
|
|
<p>
|
|
couldn't process error.tmpl template: " . $template->error() .
|
|
"; error occurred while trying to display error message: " .
|
|
($vars->{'title'} ? "$vars->{'title'}: ": "") . $vars->{'message'} .
|
|
"</p>");
|
|
exit;
|
|
}
|
|
|
|
################################################################################
|
|
# File and Directory Manipulation
|
|
################################################################################
|
|
|
|
sub ReplaceFile
|
|
{
|
|
# Replaces the file checked out from the repository with the edited version.
|
|
|
|
my ($file) = @_;
|
|
|
|
my $content = GetContent();
|
|
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 }
|
|
|
|
open(DOC, ">$file")
|
|
|| ThrowCodeError("I could not open the temporary file <em>$file</em>
|
|
for writing: $!");
|
|
print DOC $content;
|
|
close(DOC);
|
|
}
|
|
|
|
sub GetContent {
|
|
my $fh = $request->upload('content_file');
|
|
my $content;
|
|
if ($fh) {
|
|
local $/; # enable 'slurp' mode
|
|
$content = <$fh>;
|
|
}
|
|
if (!$content) {
|
|
$content = $request->param('content');
|
|
}
|
|
return $content;
|
|
}
|
|
|
|
sub ChangeToTempDir
|
|
{
|
|
my $dir = tempdir("doctor-XXXXXXXX", TMPDIR => 1, CLEANUP => 1);
|
|
chdir $dir;
|
|
}
|
|
|