App-phoebe
view release on metacpan or search on metacpan
t/oddmuse-wiki.pl view on Meta::CPAN
#! /usr/bin/env perl
# Copyright (C) 2001-2020
# Alex Schroeder <alex@gnu.org>
# Copyright (C) 2014-2015
# Alex Jakimenko <alex.jakimenko@gmail.com>
# Copyleft 2008 Brian Curry <http://www.raiazome.com>
# ... including lots of patches from the UseModWiki site
# Copyright (C) 2001, 2002 various authors
# ... which was based on UseModWiki version 0.92 (April 21, 2001)
# Copyright (C) 2000, 2001 Clifford A. Adams
# <caadams@frontiernet.net> or <usemod@usemod.com>
# ... which was based on the GPLed AtisWiki 0.3
# Copyright (C) 1998 Markus Denker <marcus@ira.uka.de>
# ... which was based on the LGPLed CVWiki CVS-patches
# Copyright (C) 1997 Peter Merel
# ... and The Original WikiWikiWeb
# Copyright (C) 1996, 1997 Ward Cunningham <ward@c2.com>
# (code reused with permission)
# 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 3 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.
#
# You should have received a copy of the GNU General Public License along with
# this program. If not, see <http://www.gnu.org/licenses/>.
package OddMuse;
use strict;
use warnings;
no warnings 'numeric';
no warnings 'uninitialized';
use utf8; # in case anybody ever adds UTF8 characters to the source
use B;
use CGI qw/-utf8/;
use CGI::Carp qw(fatalsToBrowser);
use File::Glob ':glob';
use Encode qw(encode_utf8 decode_utf8);
use sigtrap 'handler' => \&HandleSignals, 'normal-signals', 'error-signals';
local $| = 1; # Do not buffer output (localized for mod_perl)
# Options:
our ($ScriptName, $FullUrl, $PageDir, $TempDir, $LockDir, $KeepDir, $RssDir,
$RcFile, $RcOldFile, $IndexFile, $NoEditFile, $VisitorFile, $DeleteFile, $RssLicense,
$FreeLinkPattern, $LinkPattern, $FreeInterLinkPattern, $InterLinkPattern,
$UrlPattern, $FullUrlPattern, $InterSitePattern,
$UrlProtocols, $ImageExtensions, $LastUpdate,
%LockOnCreation, %PlainTextPages, %AdminPages,
@MyAdminCode, @MyFormChanges, @MyInitVariables, @MyMacros, @MyMaintenance,
$DocumentHeader, %HtmlEnvironmentContainers, $FS, $Counter, @Debugging);
# Internal variables:
our ($q, $bol, $OpenPageName, %Page, %Translate, %IndexHash, @IndexList,
@HtmlStack, @HtmlAttrStack, @Blocks, @Flags,
%Includes, $FootnoteNumber, $CollectingJournal, $HeaderIsPrinted,
%Locks, $Fragment, $Today, $ModulesDescription, %RssInterwikiTranslate,
$Message, $Now, %RecentVisitors, %MyInc, $WikiDescription, %InterSite, %OldCookie);
# Can be set outside the script: $DataDir, $UseConfig, $ConfigFile, $ModuleDir,
# $ConfigPage, $AdminPass, $EditPass, $ScriptName, $FullUrl, $RunCGI.
# 1 = load config file in the data directory
our $UseConfig //= 1;
# Main wiki directory
our $DataDir;
$DataDir ||= decode_utf8($ENV{WikiDataDir}) if $UseConfig;
$DataDir ||= '/tmp/oddmuse'; # FIXME: /var/opt/oddmuse/wiki ?
$DataDir = "./$DataDir" unless $DataDir =~ m!^(/|\./)!;
our $ConfigFile;
$ConfigFile ||= $ENV{WikiConfigFile} if $UseConfig;
our $ModuleDir;
$ModuleDir ||= $ENV{WikiModuleDir} if $UseConfig;
our $ConfigPage ||= '';
# 1 = Run script as CGI instead of loading as module
our $RunCGI //= 1;
# 1 = allow page views using wiki.pl/PageName
our $UsePathInfo = 1;
# -1 = disabled, 0 = 10s; 1 = partial HTML cache; 2 = HTTP/1.1 caching
our $UseCache = 2;
our $SiteName = 'Wiki'; # Name of site (used for titles)
our $HomePage = 'HomePage'; # Home page
our $CookieName = 'Wiki'; # Name for this wiki (for multi-wiki sites)
our $MaxPost = 1024 * 210; # Maximum 210K posts (about 200K for pages)
our $StyleSheet = ''; # URL for CSS stylesheet (like '/wiki.css')
our $StyleSheetPage = ''; # Page for CSS sheet
our $LogoUrl = ''; # URL for site logo ('' for no logo)
our $NotFoundPg = ''; # Page for not-found links ('' for blank pg)
our $EditAllowed = 1; # 0 = no, 1 = yes, 2 = comments pages only, 3 = comments only
our $AdminPass //= ''; # Whitespace separated passwords.
our $EditPass //= ''; # Whitespace separated passwords.
our $PassHashFunction //= ''; # Name of the function to create hashes
our $PassSalt //= ''; # Salt will be added to any password before hashing
our $BannedHosts = 'BannedHosts'; # Page for banned hosts
our $BannedCanRead = 1; # 1 = banned cannot edit, 0 = banned cannot read
our $BannedContent = 'BannedContent'; # Page for banned content (usually for link-ban)
our $WikiLinks = ''; # 1 = LinkPattern is a link
our $FreeLinks = 1; # 1 = [[some text]] is a link
our $UseQuestionmark = 1; # 1 = append questionmark to links to nonexisting pages
our $BracketText = 1; # 1 = [URL desc] uses a description for the URL
t/oddmuse-wiki.pl view on Meta::CPAN
unshift(@HtmlStack, $html_tag);
unshift(@HtmlAttrStack, $html_tag_attr);
$html .= $html_tag_attr ? "<$html_tag $html_tag_attr>" : "<$html_tag>";
}
return $html;
}
sub CloseHtmlEnvironments { # close all -- remember to use AddHtmlEnvironment('p') if required!
return CloseHtmlEnvironmentUntil() if pos($_) == length($_); # close all HTML environments if we're are at the end of this page
my $html = '';
while (@HtmlStack) {
defined $HtmlEnvironmentContainers{$HtmlStack[0]} and # avoid closing block level elements
($HtmlEnvironmentContainers{$HtmlStack[0]} ? $HtmlAttrStack[0] =~
m/$HtmlEnvironmentContainers{$HtmlStack[0]}/ : 1) and return $html;
shift(@HtmlAttrStack);
$html .= '</' . shift(@HtmlStack) . '>';
}
return $html;
}
sub CloseHtmlEnvironment { # close environments up to and including $html_tag
my $html = (@_ and InElement(@_)) ? CloseHtmlEnvironmentUntil(@_) : undef;
if (@HtmlStack and (not(@_) or defined $html)) {
shift(@HtmlAttrStack);
$html .= '</' . shift(@HtmlStack) . '>';
}
return $html || ''; # avoid returning undefined
}
sub CloseHtmlEnvironmentUntil { # close environments up to but not including $html_tag
my ($html_tag, $html_tag_attr) = @_;
my $html = '';
while (@HtmlStack && (pos($_) == length($_) || # while there is an HTML tag-stack and we are at the end of this page or...
!($html_tag ? $HtmlStack[0] eq $html_tag && # the top tag is not the desired tag and...
($html_tag_attr ? $HtmlAttrStack[0] =~ # its attributes do not match,
m/$html_tag_attr/ : 1) : ''))) { # then...
shift(@HtmlAttrStack); # shift off the top tag and
$html .= '</' . shift(@HtmlStack) . '>'; # append it to our HTML string.
}
return $html;
}
sub SmileyReplace {
foreach my $regexp (keys %Smilies) {
if (m/\G($regexp)/cg) {
return $q->img({-src=>$Smilies{$regexp}, -alt=>UnquoteHtml($1), -class=>'smiley'});
}
}
}
sub RunMyRules {
my ($locallinks, $withanchors) = @_;
foreach my $sub (@MyRules) {
my $result = $sub->($locallinks, $withanchors);
SetParam('msg', $@) if $@;
return $result if defined($result);
}
return;
}
sub RunMyMacros {
$_ = shift;
foreach my $macro (@MyMacros) { $macro->() };
return $_;
}
sub PrintWikiToHTML {
my ($markup, $is_saving_cache, $revision, $is_locked) = @_;
my ($blocks, $flags);
$FootnoteNumber = 0;
$markup =~ s/$FS//g if $markup; # Remove separators (paranoia)
$markup = QuoteHtml($markup);
($blocks, $flags) = ApplyRules($markup, 1, $is_saving_cache, $revision, 'p');
if ($is_saving_cache and not $revision and $Page{revision} # don't save revision 0 pages
and $Page{blocks} ne $blocks and $Page{flags} ne $flags) {
$Page{blocks} = $blocks;
$Page{flags} = $flags;
if ($is_locked or RequestLockDir('main')) { # not fatal!
SavePage();
ReleaseLock() unless $is_locked;
}
}
}
sub DoClearCache {
return unless UserIsAdminOrError();
RequestLockOrError();
print GetHeader('', T('Clear Cache')), $q->start_div({-class=>'content clear'}),
$q->p(T('Main lock obtained.')), '<p>';
foreach my $id (AllPagesList()) {
OpenPage($id);
delete @Page{qw(blocks flags languages)};
$Page{languages} = GetLanguages($Page{blocks}) unless TextIsFile($Page{blocks});
SavePage();
print $q->br(), GetPageLink($id);
}
print '</p>', $q->p(T('Main lock released.')), $q->end_div();
utime time, time, $IndexFile; # touch index file
ReleaseLock();
PrintFooter();
}
sub QuoteHtml {
my $html = shift;
$html =~ s/&/&/g;
$html =~ s/</</g;
$html =~ s/>/>/g;
$html =~ s/[\x00-\x08\x0b\x0c\x0e-\x1f]/ /g; # legal xml: #x9 | #xA | #xD | [#x20-#xD7FF] | [#xE000-#xFFFD] | [#x10000-#x10FFFF]
return $html;
}
sub UnquoteHtml {
my $html = shift;
$html =~ s/</</g;
$html =~ s/>/>/g;
$html =~ s/&/&/g;
$html =~ s/%26/&/g;
return $html;
}
sub UrlEncode {
my $str = shift;
return '' unless $str;
t/oddmuse-wiki.pl view on Meta::CPAN
foreach my $id (AllPagesList()) {
OpenPage($id);
if ($lang) {
my @languages = split(/,/, $Page{languages});
next if (@languages and not grep(/$lang/, @languages));
}
$_ = $Page{text};
my $replacement = sub {
my ($o1, $o2, $o3, $o4, $o5, $o6, $o7, $o8, $o9) = ($1, $2, $3, $4, $5, $6, $7, $8, $9);
my $str = $to;
$str =~ s/\$([1-9])/'$o' . $1/eeg;
$str
};
if (s/$from/$replacement->()/egi) { # allows use of backreferences
push (@result, $id);
$func->($id, $_) if $all or @result > $offset and @result <= $offset + $num;
}
}
return @result;
}
sub DoPost {
my $id = FreeToNormal(shift);
UserCanEditOrDie($id);
# Lock before getting old page to prevent races
RequestLockOrError(); # fatal
OpenPage($id);
my $old = $Page{text};
my $string = UnquoteHtml(GetParam('text', undef));
$string =~ s/(\r|$FS)//g;
my ($type) = TextIsFile($string); # MIME type if an uploaded file
my $filename = GetParam('file', undef);
if (($filename or $type) and not $UploadAllowed and not UserIsAdmin()) {
ReportError(T('Only administrators can upload files.'), '403 FORBIDDEN');
}
my $comment = UnquoteHtml(GetParam('aftertext', undef));
$comment =~ s/(\r|$FS)//g;
if (defined $comment and $comment eq '') {
ReleaseLock();
return ReBrowsePage($id);
}
if ($filename) { # upload file
my $file = $q->upload('file');
if (not $file and $q->cgi_error) {
ReportError(Ts('Transfer Error: %s', $q->cgi_error), '500 INTERNAL SERVER ERROR');
}
ReportError(T('Browser reports no file info.'), '500 INTERNAL SERVER ERROR') unless $q->uploadInfo($filename);
$type = $q->uploadInfo($filename)->{'Content-Type'};
ReportError(T('Browser reports no file type.'), '415 UNSUPPORTED MEDIA TYPE') unless $type;
local $/ = undef; # Read complete files
my $content = <$file>; # Apparently we cannot count on <$file> to always work within the eval!?
my $encoding = substr($content, 0, 2) eq "\x1f\x8b" ? 'gzip' : '';
eval { require MIME::Base64; $_ = MIME::Base64::encode($content) };
$string = "#FILE $type $encoding\n" . $_;
} else { # ordinary text edit
$string = AddComment($old, $comment) if defined $comment;
if ($comment and substr($string, 0, length($DeletedPage)) eq $DeletedPage) { # look ma, no regexp!
$string = substr($string, length($DeletedPage)); # undelete pages when adding a comment
}
$string .= "\n" if ($string !~ /\n$/); # add trailing newline
$string = RunMyMacros($string); # run macros on text pages only
}
my %allowed = map {$_ => 1} @UploadTypes;
if (@UploadTypes and $type and not $allowed{$type}) {
ReportError(Ts('Files of type %s are not allowed.', $type), '415 UNSUPPORTED MEDIA TYPE');
}
# Banned Content
my $summary = GetSummary();
if (not UserIsEditor()) {
my $rule = BannedContent(NormalToFree($id)) || BannedContent($string) || BannedContent($summary);
ReportError(T('Edit Denied'), '403 FORBIDDEN', undef, $q->p(T('The page contains banned text.')),
$q->p(T('Contact the wiki administrator for more information.')), $q->p($rule)) if $rule;
}
# rebrowse if no changes
my $oldrev = $Page{revision};
if (GetParam('Preview', '')) { # Preview button was used
ReleaseLock();
if (defined $comment) {
BrowsePage($id, 0, RunMyMacros($comment)); # show macros in preview
} else {
DoEdit($id, $string, 1);
}
return;
} elsif ($old eq $string) {
ReleaseLock(); # No changes -- just show the same page again
return ReBrowsePage($id);
} elsif ($oldrev == 0 and $string eq "\n") {
ReportError(T('No changes to be saved.'), '400 BAD REQUEST'); # don't fake page creation because of webdav
}
my $newAuthor = 0;
if ($oldrev) { # the first author (no old revision) is not considered to be "new"
$newAuthor = 1 if not $Page{username} or $Page{username} ne GetParam('username', '');
}
my $oldtime = $Page{ts};
my $myoldtime = GetParam('oldtime', ''); # maybe empty!
# Handle raw edits with the meta info on the first line
if (GetParam('raw', 0) == 2 and $string =~ /^([0-9]+).*\n((.*\n)*.*)/) {
$myoldtime = $1;
$string = $2;
}
my $generalwarning = 0;
if ($newAuthor and $oldtime ne $myoldtime and not defined $comment) {
if ($myoldtime) {
my ($ancestor) = GetTextAtTime($myoldtime);
if ($ancestor and $old ne $ancestor) {
my $new = MergeRevisions($string, $ancestor, $old);
if ($new) {
$string = $new;
if ($new =~ /^<<<<<<</m and $new =~ /^>>>>>>>/m) {
SetParam('msg', Ts('This page was changed by somebody else %s.',
CalcTimeSince($Now - $Page{ts}))
. ' ' . T('The changes conflict. Please check the page again.'));
} # else no conflict
} else {
$generalwarning = 1;
} # else merge revision didn't work
} # else nobody changed the page in the mean time (same text)
} else {
$generalwarning = 1;
} # no way to be sure since myoldtime is missing
} # same author or nobody changed the page in the mean time (same timestamp)
if ($generalwarning and ($Now - $Page{ts}) < 600) {
SetParam('msg', Ts('This page was changed by somebody else %s.',
CalcTimeSince($Now - $Page{ts}))
. ' ' . T('Please check whether you overwrote those changes.'));
}
Save($id, $string, $summary, (GetParam('recent_edit', '') eq 'on'), $filename);
ReleaseLock();
ReBrowsePage($id);
}
sub GetSummary {
my $text = GetParam('aftertext', '') || ($Page{revision} > 0 ? '' : GetParam('text', ''));
return '' if $text =~ /^#FILE /;
if ($SummaryDefaultLength and length($text) > $SummaryDefaultLength) {
$text = substr($text, 0, $SummaryDefaultLength);
$text =~ s/\s*\S*$/ . . ./;
}
my $summary = GetParam('summary', '') || $text; # not GetParam('summary', $text) work because '' is defined
( run in 0.725 second using v1.01-cache-2.11-cpan-f56aa216473 )