App-Phoebe
view release on metacpan or search on metacpan
t/oddmuse-wiki.pl view on Meta::CPAN
# -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
our $BracketWiki = 1; # 1 = [WikiLink desc] uses a desc for the local link
our $NetworkFile = 1; # 1 = file: is a valid protocol for URLs
our $AllNetworkFiles = 0; # 1 = file:///foo is allowed -- the default allows only file://foo
our $InterMap = 'InterMap'; # name of the intermap page, '' = disable
our $RssInterwikiTranslate = 'RssInterwikiTranslate'; # name of RSS interwiki translation page, '' = disable
$ENV{PATH} = '/bin:/usr/bin'; # Path used to find 'diff' and 'grep'
our $UseDiff = 1; # 1 = use diff
our $SurgeProtection = 1; # 1 = protect against leeches
our $SurgeProtectionTime = 20; # Size of the protected window in seconds
our $SurgeProtectionViews = 20; # How many page views to allow in this window
our $DeletedPage = 'DeletedPage'; # Pages starting with this can be deleted
our $RCName = 'RecentChanges'; # Name of changes page
our @RcDays = qw(1 3 7 30 90); # Days for links on RecentChanges
our $RcDefault = 30; # Default number of RecentChanges days
our $KeepHostDays = 4; # Days to keep IP numbers for
our $KeepDays = 0; # Days to keep old revisions (0 means keep forever)
our $KeepMajor = 1; # 1 = keep at least one major rev when expiring pages
our $SummaryHours = 4; # Hours to offer the old subject when editing a page
our $SummaryDefaultLength = 150; # Length of default text for summary (0 to disable)
our $ShowEdits = 0; # 1 = major and show minor edits in recent changes
our $ShowAll = 0; # 1 = show multiple edits per page in recent changes
our $ShowRollbacks = 0; # 1 = show rollbacks in recent changes
our $RecentLink = 1; # 1 = link to usernames
our $PageCluster = ''; # name of cluster page, eg. 'Cluster' to enable
our $InterWikiMoniker = ''; # InterWiki prefix for this wiki for RSS
our $SiteDescription = ''; # RSS Description of this wiki
our $RssStrip = '^\d\d\d\d-\d\d-\d\d_'; # Regexp to strip from feed item titles
our $RssImageUrl = $LogoUrl; # URL to image to associate with your RSS feed
our $RssRights = ''; # Copyright notice for RSS, usually an URL to the appropriate text
our $RssExclude = 'RssExclude'; # name of the page that lists pages to be excluded from the feed
our $RssCacheHours = 1; # How many hours to cache remote RSS files
our $RssStyleSheet = ''; # External style sheet for RSS files
our $UploadAllowed = 0; # 1 = yes, 0 = administrators only
our @UploadTypes = ('image/jpeg', 'image/png'); # MIME types allowed, all allowed if empty list
our $EmbedWiki = 0; # 1 = no headers/footers
our $FooterNote = ''; # HTML for bottom of every page
our $EditNote = ''; # HTML notice above buttons on edit page
our $TopLinkBar = 1; # 0 = goto bar both at the top and bottom; 1 = top, 2 = bottom
our $TopSearchForm = 1; # 0 = search form both at the top and bottom; 1 = top, 2 = bottom
our $MatchingPages = 0; # 1 = search page content and page titles
our @UserGotoBarPages = (); # List of pagenames
our $UserGotoBar = ''; # HTML added to end of goto bar
our $CommentsPrefix = ''; # prefix for comment pages, eg. 'Comments_on_' to enable
our $CommentsPattern = undef; # regex used to match comment pages
our $HtmlHeaders = ''; # Additional stuff to put in the HTML <head> section
our $IndentLimit = 20; # Maximum depth of nested lists
our $CurrentLanguage = 'en'; # Language of error messages etc
our $LanguageLimit = 3; # Number of matches req. for each language
our $JournalLimit = 200; # how many pages can be collected in one go?
our $PageNameLimit = 120; # max length of page name in bytes
$DocumentHeader = "<!DOCTYPE html>\n<html>";
our @MyFooters = (\&GetCommentForm, \&WrapperEnd, \&DefaultFooter);
# Checkboxes at the end of the index.
our @IndexOptions = ();
# Display short comments below the GotoBar for special days
# Example: %SpecialDays = ('1-1' => 'New Year', '1-2' => 'Next Day');
our %SpecialDays = ();
# Replace regular expressions with inlined images
# Example: %Smilies = (":-?D(?=\\W)" => '/pics/grin.png');
our %Smilies = ();
# Detect page languages when saving edits
# Example: %Languages = ('de' => '\b(der|die|das|und|oder)\b');
our %Languages = ();
our @KnownLocks = qw(main diff index merge visitors); # locks to remove
our $LockExpiration = 60; # How long before expirable locks are expired
our %LockExpires = (diff=>1, index=>1, merge=>1, visitors=>1); # locks to expire after some time
our %LockCleaners = (); # What to do if a job under a lock gets a signal like SIGINT. e.g. 'diff' => \&CleanDiff
our %CookieParameters = (username=>'', pwd=>'', homepage=>'', theme=>'', css=>'', msg=>'', lang=>'', embed=>$EmbedWiki,
toplinkbar=>$TopLinkBar, topsearchform=>$TopSearchForm, matchingpages=>$MatchingPages, );
our %Action = (rc => \&BrowseRc, rollback => \&DoRollback,
browse => \&BrowseResolvedPage, maintain => \&DoMaintain,
random => \&DoRandom, pagelock => \&DoPageLock,
history => \&DoHistory, editlock => \&DoEditLock,
edit => \&DoEdit, version => \&DoShowVersion,
download => \&DoDownload, rss => \&DoRss,
unlock => \&DoUnlock, password => \&DoPassword,
index => \&DoIndex, admin => \&DoAdminPage,
clear => \&DoClearCache, debug => \&DoDebug,
contrib => \&DoContributors, more => \&DoJournal);
our @MyRules = (\&LinkRules, \&ListRule); # don't set this variable, add to it!
our %RuleOrder = (\&LinkRules => 0, \&ListRule => 0);
# The 'main' program, called at the end of this script file (aka. as handler)
sub DoWikiRequest {
Init();
DoSurgeProtection();
if (not $BannedCanRead and UserIsBanned() and not UserIsEditor()) {
ReportError(T('Reading not allowed: user, ip, or network is blocked.'), '403 FORBIDDEN',
0, $q->p(ScriptLink('action=password', T('Login'), 'password')));
}
DoBrowseRequest();
}
sub ReportError { # fatal!
my ($errmsg, $status, $log, @html) = @_;
InitRequest(); # make sure we can report errors before InitRequest
print GetHttpHeader('text/html', 'nocache', $status), GetHtmlHeader(T('Error')),
$q->start_div({class=>'error'}), $q->h1(QuoteHtml($errmsg)), @html, $q->end_div,
$q->end_html, "\n\n"; # newlines for FCGI because of exit()
WriteStringToFile("$TempDir/error", '<body>' . $q->h1("$status $errmsg") . $q->Dump) if $log;
map { ReleaseLockDir($_); } keys %Locks;
exit 2;
}
sub Init {
binmode(STDOUT, ':encoding(UTF-8)'); # this is where the HTML gets printed
binmode(STDERR, ':encoding(UTF-8)'); # just in case somebody prints debug info to stderr
InitDirConfig();
$FS = "\x1e"; # The FS character is the RECORD SEPARATOR control char in ASCII
$Message = ''; # Warnings and non-fatal errors.
InitLinkPatterns(); # Link pattern can be changed in config files
InitModules(); # Modules come first so that users can change module variables in config
InitConfig(); # Config comes as early as possible; remember $q is not available here
InitRequest(); # get $q with $MaxPost; set these in the config file
InitCookie(); # After InitRequest, because $q is used
InitVariables(); # After config, to change variables, after InitCookie for GetParam
}
sub InitModules {
t/oddmuse-wiki.pl view on Meta::CPAN
SetParam($key, $OldCookie{$key}) unless $provided{$key};
}
CookieUsernameFix();
CookieRollbackFix();
}
sub CookieUsernameFix {
# Only valid usernames get stored in the new cookie.
my $name = GetParam('username', '');
$q->delete('username');
if (not $name) {
# do nothing
} elsif ($WikiLinks and not $FreeLinks and $name !~ /^$LinkPattern$/) {
$Message .= $q->p(Ts('Invalid UserName %s: not saved.', $name));
} elsif ($FreeLinks and $name !~ /^$FreeLinkPattern$/) {
$Message .= $q->p(Ts('Invalid UserName %s: not saved.', $name));
} elsif (length($name) > 50) { # Too long
$Message .= $q->p(T('UserName must be 50 characters or less: not saved'));
} else {
SetParam('username', $name);
}
}
sub CookieRollbackFix {
my @rollback = grep(/rollback-(\d+)/, $q->param);
if (@rollback and $rollback[0] =~ /(\d+)/) {
SetParam('to', $1);
$q->delete('action');
SetParam('action', 'rollback');
}
}
sub GetParam {
my ($name, $default) = @_;
my $result = $q->param(encode_utf8($name));
$result //= $default;
return QuoteHtml($result); # you need to unquote anything that can have <tags>
}
sub SetParam {
my ($name, $val) = @_;
$q->param($name, $val);
}
sub InitLinkPatterns {
my ($WikiWord, $QDelim);
$QDelim = '(?:"")?'; # Optional quote delimiter (removed from the output)
$WikiWord = '\p{Uppercase}+\p{Lowercase}+\p{Uppercase}\p{Alphabetic}*';
$LinkPattern = "($WikiWord)$QDelim";
$FreeLinkPattern = "([-,.()'%&!?;<> _1-9A-Za-z\x{0080}-\x{fffd}]|[-,.()'%&!?;<> _0-9A-Za-z\x{0080}-\x{fffd}][-,.()'%&!?;<> _0-9A-Za-z\x{0080}-\x{fffd}]+)"; # disallow "0" and must match HTML and plain text (ie. > and >)
# Intersites must start with uppercase letter to avoid confusion with URLs.
$InterSitePattern = '[A-Z\x{0080}-\x{fffd}]+[A-Za-z\x{0080}-\x{fffd}]+';
$InterLinkPattern = "($InterSitePattern:[-a-zA-Z0-9\x{0080}-\x{fffd}_=!?#\$\@~`\%&*+\\/:;.,]*[-a-zA-Z0-9\x{0080}-\x{fffd}_=#\$\@~`\%&*+\\/])$QDelim";
$FreeInterLinkPattern = "($InterSitePattern:[-a-zA-Z0-9\x{0080}-\x{fffd}_=!?#\$\@~`\%&*+\\/:;.,()' ]+)"; # plus space and other characters, and no restrictions on the end of the pattern
$UrlProtocols = 'https?|ftp|afs|news|nntp|mid|cid|mailto|wais|prospero|telnet|gophers?|irc|feed';
$UrlProtocols .= '|file' if $NetworkFile;
my $UrlChars = '[-a-zA-Z0-9/@=+$_~*.,;:?!\'"()&#%]'; # see RFC 2396
my $EndChars = '[-a-zA-Z0-9/@=+$_~*]'; # no punctuation at the end of the url.
$UrlPattern = "((?:$UrlProtocols):$UrlChars+$EndChars)";
$FullUrlPattern="((?:$UrlProtocols):$UrlChars+)"; # when used in square brackets
$ImageExtensions = '(gif|jpg|jpeg|png|bmp|svg)';
}
sub Clean {
my $block = shift;
return 0 unless defined($block); # "0" must print
return 1 if $block eq ''; # '' is the result of a dirty rule
$Fragment .= $block;
return 1;
}
sub Dirty { # arg 1 is the raw text; the real output must be printed instead
if ($Fragment ne '') {
$Fragment =~ s|<p>\s*</p>||g; # clean up extra paragraphs (see end of ApplyRules)
print $Fragment;
push(@Blocks, $Fragment);
push(@Flags, 0);
}
push(@Blocks, shift);
push(@Flags, 1);
$Fragment = '';
}
sub ApplyRules {
# locallinks: apply rules that create links depending on local config (incl. interlink!)
my ($text, $locallinks, $withanchors, $revision, @tags) = @_; # $revision is used for images
$text =~ s/\r\n/\n/g; # DOS to Unix
$text =~ s/\n+$//g; # No trailing paragraphs
return if $text eq ''; # allow the text '0'
local $Fragment = ''; # the clean HTML fragment not yet on @Blocks
local @Blocks = (); # the list of cached HTML blocks
local @Flags = (); # a list for each block, 1 = dirty, 0 = clean
Clean(join('', map { AddHtmlEnvironment($_) } @tags));
if ($OpenPageName and $PlainTextPages{$OpenPageName}) { # there should be no $PlainTextPages{''}
Clean(CloseHtmlEnvironments() . $q->pre($text));
} elsif (my ($type) = TextIsFile($text)) { # TODO? $type defined here??
Clean(CloseHtmlEnvironments() . $q->p(T('This page contains an uploaded file:'))
. $q->p(GetDownloadLink($OpenPageName, (substr($type, 0, 6) eq 'image/'), $revision))
. (length $Page{summary} > 0 ? $q->blockquote(QuoteHtml($Page{summary})) : $q->p(T('No summary was provided for this file.'))));
} else {
my $smileyregex = join "|", keys %Smilies;
$smileyregex = qr/(?=$smileyregex)/;
local $_ = $text;
local $bol = 1;
while (1) {
# Block level elements should eat trailing empty lines to prevent empty p elements.
if ($bol and m/\G(\s*\n)+/cg) {
Clean(CloseHtmlEnvironments() . AddHtmlEnvironment('p'));
} elsif ($bol and m/\G(\<include(\s+(text|with-anchors))?\s+"(.*)"\>[ \t]*\n?)/cgi) {
# <include "uri..."> includes the text of the given URI verbatim
Clean(CloseHtmlEnvironments());
Dirty($1);
my ($oldpos, $old_, $type, $uri) = ((pos), $_, $3, UnquoteHtml($4)); # remember, page content is quoted!
if ($uri =~ /^($UrlProtocols):/) {
if ($type eq 'text') {
print $q->pre({class=>"include $uri"}, QuoteHtml(GetRaw($uri)));
} else { # never use local links for remote pages, with a starting tag
print $q->start_div({class=>'include'});
ApplyRules(QuoteHtml(GetRaw($uri)), 0, ($type eq 'with-anchors'), undef, 'p');
print $q->end_div();
}
t/oddmuse-wiki.pl view on Meta::CPAN
my $string = shift || GetParam('search', '');
my $re = UnquoteHtml($string);
return DoIndex() if $string eq '';
eval { qr/$re/ } or $re = quotemeta($re);
my $replacement = GetParam('replace', undef);
my $raw = GetParam('raw', '');
my @results;
if ($replacement or GetParam('delete', 0)) {
return unless UserIsAdminOrError();
if (GetParam('preview', '')) { # Preview button was used
print GetHeader('', Ts('Preview: %s', $string . " → " . $replacement));
print $q->start_div({-class=>'content replacement'});
print GetFormStart(undef, 'post', 'replace');
print GetHiddenValue('search', $string);
print GetHiddenValue('replace', $replacement);
print GetHiddenValue('delete', GetParam('delete', 0));
print $q->submit(-value=>T('Go!')) . $q->end_form();
@results = ReplaceAndDiff($re, UnquoteHtml($replacement));
} else {
print GetHeader('', Ts('Replaced: %s', $string . " → " . $replacement));
print $q->start_div({-class=>'content replacement'});
@results = ReplaceAndSave($re, UnquoteHtml($replacement));
foreach (@results) {
PrintSearchResult($_, quotemeta($replacement || $re)); # the replacement is not a valid regex
}
}
} else {
if ($raw) {
print GetHttpHeader('text/plain');
print RcTextItem('title', Ts('Search for: %s', $string)), RcTextItem('date', TimeToText($Now)),
RcTextItem('link', $q->url(-path_info=>1, -query=>1)), "\n" if GetParam('context', 1);
} else {
print GetHeader('', Ts('Search for: %s', $string)), $q->start_div({-class=>'content search'});
print $q->p({-class=>'links'}, SearchMenu($string));
}
@results = SearchTitleAndBody($re, \&PrintSearchResult, SearchRegexp($re));
}
print SearchResultCount($#results + 1), $q->end_div() unless $raw;
PrintFooter() unless $raw;
}
sub SearchMenu {
return ScriptLink('action=rc;rcfilteronly=' . UrlEncode(shift),
T('View changes for these pages'));
}
sub SearchResultCount { $q->p({-class=>'result'}, Ts('%s pages found.', (shift))); }
sub PageIsUploadedFile {
my $id = shift;
return if $OpenPageName eq $id;
if ($IndexHash{$id}) {
my $file = GetPageFile($id);
open(my $FILE, '<:encoding(UTF-8)', encode_utf8($file))
or ReportError(Ts('Cannot open %s', GetPageFile($id))
. ": $!", '500 INTERNAL SERVER ERROR');
while (defined($_ = <$FILE>) and $_ !~ /^text: /) {
} # read lines until we get to the text key
close $FILE;
return unless length($_) > 6;
return TextIsFile(substr($_, 6)); # pass "#FILE image/png\n" to the test
}
}
sub SearchTitleAndBody {
my ($regex, $func, @args) = @_;
my @found;
my $lang = GetParam('lang', '');
foreach my $id (Filtered($regex, AllPagesList())) {
my $name = NormalToFree($id);
my ($text) = PageIsUploadedFile($id); # set to mime-type if this is an uploaded file
local ($OpenPageName, %Page); # this is local!
if (not $text) { # not uploaded file, therefore allow searching of page body
OpenPage($id); # this opens a page twice if it is not uploaded, but that's ok
if ($lang) {
my @languages = split(/,/, $Page{languages});
next if (@languages and not grep(/$lang/, @languages));
}
$text = $Page{text};
}
if (SearchString($regex, $name . "\n" . $text)) { # the real search code
push(@found, $id);
$func->($id, @args) if $func;
}
}
return @found;
}
sub Filtered { # this is overwriten in extensions such as tags.pl
my ($string, @pages) = @_;
my $match = GetParam('match', '');
@pages = grep /$match/i, @pages if $match;
return @pages;
}
sub SearchString {
my ($string, $data) = @_;
my @strings = grep /./, $string =~ /\"([^\"]+)\"|(\S+)/g; # skip null entries
foreach my $str (@strings) {
return 0 unless ($data =~ /$str/i);
}
return 1;
}
sub SearchRegexp {
my $regexp = join '|', map { index($_, '|') == -1 ? $_ : "($_)" }
grep /./, shift =~ /\"([^\"]+)\"|(\S+)/g; # this acts as OR
$regexp =~ s/\\s/[[:space:]]/g;
return $regexp;
}
sub PrintSearchResult {
my ($name, $regex) = @_;
return PrintPage($name) if not GetParam('context', 1);
OpenPage($name); # should be open already, just making sure!
my $text = $Page{text};
my ($type) = TextIsFile($text); # MIME type if an uploaded file
my %entry;
# get the page, filter it, remove all tags
$text =~ s/$FS//g; # Remove separators (paranoia)
$text =~ s/[\s]+/ /g; # Shrink whitespace
( run in 2.915 seconds using v1.01-cache-2.11-cpan-b9db842bd85 )