App-phoebe
view release on metacpan or search on metacpan
t/oddmuse-wiki.pl view on Meta::CPAN
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 {
if ($UseConfig and $ModuleDir and IsDir($ModuleDir)) {
foreach my $lib (Glob("$ModuleDir/*.p[ml]")) {
if (not $MyInc{$lib}) {
$MyInc{$lib} = 1; # Cannot use %INC in mod_perl settings
my $file = encode_utf8($lib);
do $file;
$Message .= CGI::p("$lib: $@") if $@; # no $q exists, yet
}
}
}
}
sub InitConfig {
if ($UseConfig and $ConfigFile and not $INC{$ConfigFile} and IsFile($ConfigFile)) {
do $ConfigFile; # these options must be set in a wrapper script or via the environment
$Message .= CGI::p("$ConfigFile: $@") if $@; # remember, no $q exists, yet
}
if ($ConfigPage) { # $FS and $MaxPost must be set in config file!
my ($status, $data) = ReadFile(GetPageFile(FreeToNormal($ConfigPage)));
my $page = ParseData($data); # before InitVariables so GetPageContent won't work
eval $page->{text} if $page->{text}; # perlcritic dislikes the use of eval here but we really mean it
$Message .= CGI::p("$ConfigPage: $@") if $@;
}
}
sub InitDirConfig {
$PageDir = "$DataDir/page"; # Stores page data
$KeepDir = "$DataDir/keep"; # Stores kept (old) page data
$TempDir = "$DataDir/temp"; # Temporary files and locks
$LockDir = "$TempDir/lock"; # DB is locked if this exists
$NoEditFile = "$DataDir/noedit"; # Indicates that the site is read-only
$RcFile = "$DataDir/rc.log"; # New RecentChanges logfile
$RcOldFile = "$DataDir/oldrc.log"; # Old RecentChanges logfile
$IndexFile = "$DataDir/pageidx"; # List of all pages
$VisitorFile = "$DataDir/visitors.log"; # List of recent visitors
$DeleteFile = "$DataDir/delete.log"; # Deletion logfile
$RssDir = "$DataDir/rss"; # For rss feed cache
$ConfigFile ||= "$DataDir/config"; # Config file with Perl code to execute
$ModuleDir ||= "$DataDir/modules"; # For extensions (ending in .pm or .pl)
}
sub InitRequest { # set up $q
$CGI::POST_MAX = $MaxPost;
$q ||= new CGI;
}
sub InitVariables { # Init global session variables for mod_perl!
$WikiDescription = $q->p($q->a({-href=>'https://www.oddmuse.org/'}, 'Oddmuse'),
$Counter++ > 0 ? Ts('%s calls', $Counter) : '');
$WikiDescription .= $ModulesDescription if $ModulesDescription;
$HeaderIsPrinted = 0; # print HTTP headers only once
$ScriptName //= $q->url(); # URL used in links
$FullUrl ||= $ScriptName; # URL used in forms
%Locks = ();
@Blocks = ();
@Flags = ();
$Fragment = '';
%RecentVisitors = ();
$OpenPageName = ''; # Currently open page
my $add_space = $CommentsPrefix =~ /[ \t_]$/;
$$_ = FreeToNormal($$_) for # convert spaces to underscores on all configurable pagenames
(\$HomePage, \$RCName, \$BannedHosts, \$InterMap, \$StyleSheetPage, \$CommentsPrefix,
\$ConfigPage, \$NotFoundPg, \$RssInterwikiTranslate, \$BannedContent, \$RssExclude, );
$CommentsPrefix .= '_' if $add_space;
$CommentsPattern = "^$CommentsPrefix(.*)" unless defined $CommentsPattern or not $CommentsPrefix;
@UserGotoBarPages = ($HomePage, $RCName) unless @UserGotoBarPages;
my @pages = sort($BannedHosts, $StyleSheetPage, $ConfigPage, $InterMap,
$RssInterwikiTranslate, $BannedContent);
%AdminPages = map { $_ => 1} @pages, $RssExclude unless %AdminPages;
%LockOnCreation = map { $_ => 1} @pages unless %LockOnCreation;
%PlainTextPages = ($BannedHosts => 1, $BannedContent => 1,
$StyleSheetPage => 1, $ConfigPage => 1) unless %PlainTextPages;
delete $PlainTextPages{''}; # $ConfigPage and others might be empty.
CreateDir($DataDir); # Create directory if it doesn't exist
$Now = time; # Reset in case script is persistent
my $ts = Modified($IndexFile); # always stat for multiple server processes
ReInit() if not $ts or $LastUpdate != $ts; # reinit if another process changed files (requires $DataDir)
$LastUpdate = $ts;
unshift(@MyRules, \&MyRules) if defined(&MyRules) && (not @MyRules or $MyRules[0] != \&MyRules);
@MyRules = sort {$RuleOrder{$a} <=> $RuleOrder{$b}} @MyRules; # default is 0
ReportError(Ts('Cannot create %s', $DataDir) . ": $!", '500 INTERNAL SERVER ERROR') unless IsDir($DataDir);
@IndexOptions = (['pages', T('Include normal pages'), 1, \&AllPagesList]);
foreach my $sub (@MyInitVariables) {
my $result = $sub->();
$Message .= $q->p($@) if $@;
}
}
sub ReInit { # init everything we need if we want to link to stuff
my $id = shift; # when saving a page, what to do depends on the page being saved
t/oddmuse-wiki.pl view on Meta::CPAN
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;
my @letters = split(//, encode_utf8($str));
my %safe = map {$_ => 1} ('a' .. 'z', 'A' .. 'Z', '0' .. '9', '-', '_', '.', '!', '~', '*', "'", '(', ')', '#');
foreach my $letter (@letters) {
$letter = sprintf("%%%02x", ord($letter)) unless $safe{$letter};
}
return join('', @letters);
}
sub UrlDecode {
my $str = shift;
return decode_utf8($str) if $str =~ s/%([0-9a-f][0-9a-f])/chr(hex($1))/eig;
return $str;
}
sub QuoteRegexp {
my $re = shift;
$re =~ s/([\\\[\]\$()^.])/\\$1/g;
t/oddmuse-wiki.pl view on Meta::CPAN
if ($changed) {
my $cookie = join(UrlEncode($FS), %params); # no CTL in field values
return $q->cookie(-name=>$CookieName, -value=>$cookie, -expires=>'+2y', secure=>$ENV{'HTTPS'}, httponly=>1);
}
return '';
}
sub GetHtmlHeader { # always HTML!
my ($title, $id) = @_;
my $edit_link = $id ? '<link rel="alternate" type="application/wiki" title="'
. T('Edit this page') . '" href="' . ScriptUrl('action=edit;id=' . UrlEncode($id)) . '" />' : '';
my $theme = GetParam('theme', 'default');
return $DocumentHeader
. $q->head($q->title($title) . $edit_link
. GetCss() . GetRobots() . GetFeeds() . $HtmlHeaders
. '<meta http-equiv="Content-Type" content="text/html; charset=utf-8" />')
. qq{<body class="$theme" lang="$CurrentLanguage">};
}
sub GetRobots { # NOINDEX for non-browse pages.
if (GetParam('action', 'browse') eq 'browse' and not GetParam('revision', '')) {
return '<meta name="robots" content="INDEX,FOLLOW" />';
} else {
return '<meta name="robots" content="NOINDEX,FOLLOW" />';
}
}
sub GetFeeds { # default for $HtmlHeaders
my $html = '<link rel="alternate" type="application/rss+xml" title="'
. QuoteHtml($SiteName) . '" href="' . $ScriptName . '?action=rss" />';
my $id = GetId(); # runs during Init, not during DoBrowseRequest
$html .= '<link rel="alternate" type="application/rss+xml" title="'
. QuoteHtml("$SiteName: $id") . '" href="' . $ScriptName
. '?action=rss;rcidonly=' . UrlEncode(FreeToNormal($id)) . '" />' if $id;
my $username = GetParam('username', '');
$html .= '<link rel="alternate" type="application/rss+xml" '
. 'title="Follow-ups for ' . NormalToFree($username) . '" '
. 'href="' . ScriptUrl('action=rss;followup=' . UrlEncode($username))
. '" />' if $username;
return $html;
}
sub GetCss { # prevent javascript injection
my @css = map { my $x = $_; $x =~ s/\".*//; $x; } split(/\s+/, GetParam('css', ''));
push (@css, ref $StyleSheet ? @$StyleSheet : $StyleSheet) if $StyleSheet and not @css;
if ($IndexHash{$StyleSheetPage} and not @css) {
push (@css, "$ScriptName?action=browse;id=" . UrlEncode($StyleSheetPage) . ";raw=1;mime-type=text/css")
}
push (@css, 'https://oddmuse.org/default.css') unless @css;
return join('', map { qq(<link type="text/css" rel="stylesheet" href="$_" />) } @css);
}
sub PrintPageContent {
my ($text, $revision, $comment) = @_;
print $q->start_div({-class=>'content browse', -lang=>GetLanguage($text)});
# This is a lot like PrintPageHtml except that it also works for older revisions
if ($revision eq '' and $Page{blocks} and GetParam('cache', $UseCache) > 0) {
PrintCache();
} else {
my $savecache = ($Page{revision} > 0 and $revision eq ''); # new page not cached
PrintWikiToHTML($text, $savecache, $revision); # unlocked, with anchors, unlocked
}
if ($comment) {
print $q->start_div({-class=>'preview'}), $q->hr();
print $q->h2(T('Preview:'));
# no caching, current revision, unlocked
PrintWikiToHTML(AddComment('', $comment));
print $q->hr(), $q->h2(T('Preview only, not yet saved')), $q->end_div();
}
print $q->end_div();
}
sub PrintFooter {
my ($id, $rev, $comment, $page) = @_;
if (GetParam('embed', $EmbedWiki)) {
print $q->end_html, "\n";
return;
}
PrintMyContent($id) if defined(&PrintMyContent);
foreach my $sub (@MyFooters) {
print $sub->(@_);
}
print $q->end_html, "\n";
}
sub WrapperEnd { # called via @MyFooters
return $q->start_div({-class=>'wrapper close'}) . $q->end_div() . $q->end_div(); # closes content
}
sub DefaultFooter { # called via @MyFooters
my ($id, $rev, $comment, $page) = @_;
my $html = $q->hr();
$html .= GetGotoBar($id) if GetParam('toplinkbar', $TopLinkBar) != 1;
$html .= GetFooterLinks($id, $rev);
$html .= GetFooterTimestamp($id, $rev, $page);
$html .= GetSearchForm() if GetParam('topsearchform', $TopSearchForm) != 1;
if ($DataDir =~ m|/tmp/|) {
$html .= $q->p($q->strong(T('Warning') . ': ')
. Ts('Database is stored in temporary directory %s', $DataDir));
}
$html .= T($FooterNote) if $FooterNote;
$html .= $q->p(Ts('%s seconds', (time - $Now))) if GetParam('timing', 0);
return "<footer>$html</footer>";
}
sub GetFooterTimestamp {
my ($id, $rev, $page) = @_;
$page //= \%Page;
if ($id and $rev ne 'history' and $rev ne 'edit' and $page->{revision}) {
my @elements = (($rev eq '' ? T('Last edited') : T('Edited')), TimeToText($page->{ts}),
Ts('by %s', GetAuthorLink($page->{username})));
push(@elements, ScriptLinkDiff(2, $id, T('(diff)'), $rev)) if $UseDiff and $page->{revision} > 1;
return $q->div({-class=>'time'}, @elements);
}
return '';
}
sub GetFooterLinks {
my ($id, $rev) = @_;
my @elements;
if ($id and $rev ne 'history' and $rev ne 'edit') {
if ($CommentsPattern) {
if ($id =~ /$CommentsPattern/) {
push(@elements, GetPageLink($1, undef, 'original', T('a'))) if $1;
} else {
push(@elements, GetPageLink($CommentsPrefix . $id, undef, 'comment', T('c')));
t/oddmuse-wiki.pl view on Meta::CPAN
$id =~ s/ /_/g;
$id =~ s/__+/_/g;
$id =~ s/^_//;
$id =~ s/_$//;
return UnquoteHtml($id);
}
sub ItemName {
my $id = shift; # id
return NormalToFree($id) unless GetParam('short', 1) and $RssStrip;
my $comment = $id =~ s/^($CommentsPrefix)//; # strip first so that ^ works
$id =~ s/^$RssStrip//;
$id = $CommentsPrefix . $id if $comment;
return NormalToFree($id);
}
sub NormalToFree { # returns HTML quoted title with spaces
my $title = shift;
$title =~ s/_/ /g;
return QuoteHtml($title);
}
sub UnWiki {
my $str = shift;
return $str unless $WikiLinks and $str =~ /^$LinkPattern$/;
$str =~ s/([[:lower:]])([[:upper:]])/$1 $2/g;
return $str;
}
sub DoEdit {
my ($id, $newText, $preview) = @_;
UserCanEditOrDie($id);
my $upload = GetParam('upload', undef);
if ($upload and not $UploadAllowed and not UserIsAdmin()) {
ReportError(T('Only administrators can upload files.'), '403 FORBIDDEN');
}
OpenPage($id);
my ($revisionPage, $revision) = GetTextRevision(GetParam('revision', ''), 1); # maybe revision reset!
my $oldText = $preview ? $newText : $revisionPage->{text};
my $isFile = TextIsFile($oldText);
$upload //= $isFile;
if ($upload and not $UploadAllowed and not UserIsAdmin()) {
ReportError(T('Only administrators can upload files.'), '403 FORBIDDEN');
}
if ($upload) { # shortcut lots of code
$revision = '';
$preview = 0;
} elsif ($isFile) {
$oldText = '';
}
my $header;
if ($revision and not $upload) {
$header = Ts('Editing revision %s of', $revision) . ' ' . NormalToFree($id);
} else {
$header = Ts('Editing %s', NormalToFree($id));
}
print GetHeader('', $header), $q->start_div({-class=>'content edit'});
if ($preview and not $upload) {
print $q->start_div({-class=>'preview'});
print $q->h2(T('Preview:'));
PrintWikiToHTML($oldText); # no caching, current revision, unlocked
print $q->hr(), $q->h2(T('Preview only, not yet saved')), $q->end_div();
}
if ($revision) {
print $q->strong(Ts('Editing old revision %s.', $revision) . ' '
. T('Saving this page will replace the latest revision with this text.'))
}
print GetEditForm($id, $upload, $oldText, $revision), $q->end_div();
PrintFooter($id, 'edit');
}
sub GetEditForm {
my ($page_name, $upload, $oldText, $revision) = @_;
my $html = GetFormStart(undef, undef, $upload ? 'edit upload' : 'edit text') # protected by questionasker
.$q->p(GetHiddenValue("title", $page_name),
($revision ? GetHiddenValue('revision', $revision) : ''),
GetHiddenValue('oldtime', GetParam('oldtime', $Page{ts})), # prefer parameter over actual timestamp
($upload ? GetUpload() : GetTextArea('text', $oldText)));
my $summary = UnquoteHtml(GetParam('summary', ''))
|| ($Now - $Page{ts} < ($SummaryHours * 3600) ? $Page{summary} : '');
$html .= $q->p(T('Summary:').$q->br().GetTextArea('summary', $summary, 2))
.$q->p($q->checkbox(-name=>'recent_edit', -checked=>(GetParam('recent_edit', '') eq 'on'),
-label=>T('This change is a minor edit.')));
$html .= T($EditNote) if $EditNote; # Allow translation
my $username = GetParam('username', '');
$html .= $q->p($q->label({-for=>'username'}, T('Username:')).' '
.$q->textfield(-name=>'username', -id=>'username', -default=>$username,
-override=>1, -size=>20, -maxlength=>50))
.$q->p($q->submit(-name=>'Save', -accesskey=>T('s'), -value=>T('Save')),
($upload ? '' : ' ' . $q->submit(-name=>'Preview', -accesskey=>T('p'), -value=>T('Preview'))).
' '.$q->submit(-name=>'Cancel', -value=>T('Cancel')));
if ($upload) {
$html .= $q->p(ScriptLink('action=edit;upload=0;id=' . UrlEncode($page_name), T('Replace this file with text'), 'upload'));
} elsif ($UploadAllowed or UserIsAdmin()) {
$html .= $q->p(ScriptLink('action=edit;upload=1;id=' . UrlEncode($page_name), T('Replace this text with a file'), 'upload'));
}
$html .= $q->end_form();
foreach my $sub (@MyFormChanges) {
$html = $sub->($html, 'edit', $upload);
}
return $html;
}
sub GetTextArea {
my ($name, $text, $rows) = @_;
return $q->textarea(-id=>$name, -name=>$name, -default=>$text, -rows=>$rows || 25, -columns=>78, -override=>1);
}
sub GetUpload {
return T('File to upload:') . ' ' . $q->filefield(-name=>'file', -size=>50, -maxlength=>100);
}
sub DoDownload {
my $id = shift;
OpenPage($id) if ValidIdOrDie($id);
print $q->header(-status=>'304 NOT MODIFIED') and return if FileFresh(); # FileFresh needs an OpenPage!
my ($revisionPage, $revision) = GetTextRevision(GetParam('revision', '')); # maybe revision reset!
my $text = $revisionPage->{text};
if (my ($type, $encoding) = TextIsFile($text)) {
my ($data) = $text =~ /^[^\n]*\n(.*)/s;
my %allowed = map {$_ => 1} @UploadTypes;
t/oddmuse-wiki.pl view on Meta::CPAN
print MIME::Base64::decode($data);
} else {
print GetHttpHeader('text/plain', $Page{ts});
print $text;
}
}
sub DoPassword {
my $id = shift;
print GetHeader('', T('Password')), $q->start_div({-class=>'content password'});
print $q->p(T('Your password is saved in a cookie, if you have cookies enabled. Cookies may get lost if you connect from another machine, from another account, or using another software.'));
if (not $AdminPass and not $EditPass) {
print $q->p(T('This site does not use admin or editor passwords.'));
} else {
if (UserIsAdmin()) {
print $q->p(T('You are currently an administrator on this site.'));
} elsif (UserIsEditor()) {
print $q->p(T('You are currently an editor on this site.'));
} else {
print $q->p(T('You are a normal user on this site.'));
if (not GetParam('pwd')) {
print $q->p(T('You do not have a password set.'));
} else {
print $q->p(T('Your password does not match any of the administrator or editor passwords.'));
}
}
print GetFormStart(undef, undef, 'password'),
$q->p(GetHiddenValue('action', 'password'), T('Password:'), ' ',
$q->password_field(-name=>'pwd', -size=>20, -maxlength=>64),
$q->hidden(-name=>'id', -value=>$id),
$q->submit(-name=>'Save', -accesskey=>T('s'), -value=>T('Save'))),
$q->end_form;
}
if ($id) {
print $q->p(ScriptLink('action=browse;id=' . UrlEncode($id) . ';time=' . time,
Ts('Return to %s', NormalToFree($id))));
}
print $q->end_div();
PrintFooter();
}
sub UserIsEditorOrError {
UserIsEditor()
or ReportError(T('This operation is restricted to site editors only...'), '403 FORBIDDEN');
return 1;
}
sub UserIsAdminOrError {
UserIsAdmin()
or ReportError(T('This operation is restricted to administrators only...'), '403 FORBIDDEN');
return 1;
}
sub UserCanEditOrDie {
my $id = shift;
ValidIdOrDie($id);
if (not UserCanEdit($id, 1)) {
my $rule = UserIsBanned();
if ($rule) {
ReportError(T('Edit Denied'), '403 FORBIDDEN', undef,
$q->p(T('Editing not allowed: user, ip, or network is blocked.')),
$q->p(T('Contact the wiki administrator for more information.')),
$q->p(Ts('The rule %s matched for you.', $rule) . ' '
. Ts('See %s for more information.', GetPageLink($BannedHosts))));
} else {
ReportError(T('Edit Denied'), '403 FORBIDDEN', undef,
$q->p(Ts('Editing not allowed: %s is read-only.', NormalToFree($id))));
}
}
}
sub UserCanEdit {
my ($id, $editing, $comment) = @_;
return 0 if $id eq 'SampleUndefinedPage' or $id eq T('SampleUndefinedPage')
or $id eq 'Sample_Undefined_Page' or $id eq T('Sample_Undefined_Page');
return 1 if UserIsAdmin();
return 0 if $id ne '' and IsFile(GetLockedPageFile($id));
return 0 if $LockOnCreation{$id} and not IsFile(GetPageFile($id)); # new page
return 1 if UserIsEditor();
return 0 if not $EditAllowed or IsFile($NoEditFile);
return 0 if $editing and UserIsBanned(); # this call is more expensive
return 0 if $EditAllowed >= 2 and (not $CommentsPattern or $id !~ /$CommentsPattern/);
return 1 if $EditAllowed >= 3 and GetParam('recent_edit', '') ne 'on' # disallow minor comments
and ($comment or (GetParam('aftertext', '') and not GetParam('text', '')));
return 0 if $EditAllowed >= 3;
return 1;
}
sub UserIsBanned {
return 0 if GetParam('action', '') eq 'password'; # login is always ok
my $host = $q->remote_addr();
foreach (split(/\n/, GetPageContent($BannedHosts))) {
if (/^\s*([^#]\S+)/) { # all lines except empty lines and comments, trim whitespace
my $regexp = $1;
return $regexp if ($host =~ /$regexp/i);
}
}
return 0;
}
sub UserIsAdmin {
return UserHasPassword(GetParam('pwd', ''), $AdminPass);
}
sub UserIsEditor {
return 1 if UserIsAdmin(); # Admin includes editor
return UserHasPassword(GetParam('pwd', ''), $EditPass);
}
sub UserHasPassword {
my ($pwd, $pass) = @_;
return 0 unless $pass;
if ($PassHashFunction ne '') {
no strict 'refs'; # TODO this is kept for compatibility. Feel free to remove it later (comment written on 2015-07-14)
$pwd = $PassHashFunction->($pwd . $PassSalt);
}
foreach (split(/\s+/, $pass)) {
return 1 if $pwd eq $_;
}
return 0;
}
t/oddmuse-wiki.pl view on Meta::CPAN
print GetHeader('', T('Index of all pages'));
push(@menu, GetHiddenValue('manual', 1) . $q->submit(-value=>T('Go!')));
push(@menu, $q->b(Ts('(for %s)', GetParam('lang', '')))) if GetParam('lang', '');
print $q->start_div({-class=>'content index'}),
GetFormStart(undef, 'get', 'index'), GetHiddenValue('action', 'index'),
$q->p(join($q->br(), @menu)), $q->end_form(),
$q->h2(Ts('%s pages found.', ($#pages + 1))), $q->start_p();
}
PrintPage($_) foreach (@pages);
print $q->end_p(), $q->end_div() unless $raw;
PrintFooter() unless $raw;
}
sub PrintPage {
my $id = shift;
my $lang = GetParam('lang', 0);
if ($lang) {
OpenPage($id);
my @languages = split(/,/, $Page{languages});
next if (@languages and not grep(/$lang/, @languages));
}
if (GetParam('raw', 0)) {
if (GetParam('search', '') and GetParam('context', 1)) {
print "title: $id\n\n"; # for near links without full search
} else {
print $id, "\n";
}
} else {
print GetPageOrEditLink($id, NormalToFree($id)), $q->br();
}
}
sub AllPagesList {
my $refresh = GetParam('refresh', 0);
return @IndexList if @IndexList and not $refresh;
SetParam('refresh', 0) if $refresh;
return @IndexList if not $refresh and IsFile($IndexFile) and ReadIndex();
# If open fails just refresh the index
RefreshIndex();
return @IndexList;
}
sub ReadIndex {
my ($status, $rawIndex) = ReadFile($IndexFile); # not fatal
if ($status) {
@IndexList = split(/ /, $rawIndex);
%IndexHash = map {$_ => 1} @IndexList;
return @IndexList;
}
return;
}
sub WriteIndex {
WriteStringToFile($IndexFile, join(' ', @IndexList));
}
sub RefreshIndex {
@IndexList = ();
%IndexHash = ();
# If file exists and cannot be changed, error!
my $locked = RequestLockDir('index', undef, undef, IsFile($IndexFile));
foreach (Glob("$PageDir/*.pg"), Glob("$PageDir/.*.pg")) {
next unless m|/.*/(.+)\.pg$|;
my $id = $1;
push(@IndexList, $id);
$IndexHash{$id} = 1;
}
WriteIndex() if $locked;
ReleaseLockDir('index') if $locked;
}
sub AddToIndex {
my ($id) = @_;
$IndexHash{$id} = 1;
@IndexList = sort(keys %IndexHash);
WriteIndex();
}
sub DoSearch {
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;
t/oddmuse-wiki.pl view on Meta::CPAN
@tmp = ();
while ($line = shift(@rc)) {
my ($ts, $id, $minor, $summary, $host, @rest) = split(/$FS/, $line);
last if $ts >= $starttime;
push(@tmp, join($FS, $ts, $id, $minor, $summary, 'Anonymous', @rest));
$changed = 1;
}
unshift(@rc, $line) if $line; # this one ended the loop
unshift(@rc, @tmp) if @tmp;
print $q->p(Ts('Removing IP numbers from %s log entries.', scalar(@tmp)));
WriteStringToFile($RcFile, @rc ? join("\n", @rc) . "\n" : '') if $changed;
if (opendir(DIR, $RssDir)) { # cleanup if they should expire anyway
foreach (readdir(DIR)) {
Unlink("$RssDir/$_") if $Now - Modified($_) > $RssCacheHours * 3600;
}
closedir DIR;
}
foreach my $func (@MyMaintenance) {
$func->();
}
WriteStringToFile($fname, 'Maintenance done at ' . TimeToText($Now));
ReleaseLock();
print $q->p(T('Main lock released.')), $q->end_div();
PrintFooter();
}
sub PageDeletable {
return unless $KeepDays;
my $expirets = $Now - ($KeepDays * 86400); # 24*60*60
return 0 if $Page{ts} >= $expirets;
return PageMarkedForDeletion();
}
sub PageMarkedForDeletion {
# Only pages explicitly marked for deletion or whitespace-only pages
# are deleted; taking into account the very rare possiblity of a
# read error and the page text being undefined.
return 1 if defined $Page{text} and $Page{text} =~ /^\s*$/;
return $DeletedPage && substr($Page{text}, 0, length($DeletedPage)) eq $DeletedPage;
}
sub DeletePage { # Delete must be done inside locks.
my $id = shift;
ValidIdOrDie($id);
AppendStringToFile($DeleteFile, "$id\n");
foreach my $name (GetPageFile($id), GetKeepFiles($id), GetKeepDir($id), GetLockedPageFile($id), $IndexFile) {
Unlink($name) if IsFile($name);
RemoveDir($name) if IsDir($name);
}
ReInit($id);
delete $IndexHash{$id};
@IndexList = sort(keys %IndexHash);
return ''; # no error
}
sub DoEditLock {
return unless UserIsAdminOrError();
print GetHeader('', T('Set or Remove global edit lock'));
my $fname = "$NoEditFile";
if (GetParam("set", 1)) {
WriteStringToFile($fname, 'editing locked.');
} else {
Unlink($fname);
}
utime time, time, $IndexFile; # touch index file
print $q->p(IsFile($fname) ? T('Edit lock created.') : T('Edit lock removed.'));
PrintFooter();
}
sub DoPageLock {
return unless UserIsAdminOrError();
print GetHeader('', T('Set or Remove page edit lock'));
my $id = GetParam('id', '');
ValidIdOrDie($id);
my $fname = GetLockedPageFile($id);
if (GetParam('set', 1)) {
WriteStringToFile($fname, 'editing locked.');
} else {
Unlink($fname);
}
utime time, time, $IndexFile; # touch index file
print $q->p(IsFile($fname) ? Ts('Lock for %s created.', GetPageLink($id))
: Ts('Lock for %s removed.', GetPageLink($id)));
PrintFooter();
}
sub DoShowVersion {
print GetHeader('', T('Displaying Wiki Version')), $q->start_div({-class=>'content version'});
print $WikiDescription, $q->p($q->server_software()),
$q->p(sprintf('Perl v%vd', $^V)),
$q->p($ENV{MOD_PERL} ? $ENV{MOD_PERL} : "no mod_perl"), $q->p('CGI: ', $CGI::VERSION),
$q->p('LWP::UserAgent ', eval { local $SIG{__DIE__}; require LWP::UserAgent; $LWP::UserAgent::VERSION; }),
$q->p('XML::RSS: ', eval { local $SIG{__DIE__}; require XML::RSS; $XML::RSS::VERSION; }),
$q->p('XML::Parser: ', eval { local $SIG{__DIE__}; $XML::Parser::VERSION; });
print $q->p('diff: ' . (`diff --version` || $!)), $q->p('diff3: ' . (`diff3 --version` || $!)) if $UseDiff;
print $q->end_div();
PrintFooter();
}
sub DoDebug {
print GetHeader('', T('Debugging Information')),
$q->start_div({-class=>'content debug'});
foreach my $func (@Debugging) { $func->() }
print $q->end_div();
PrintFooter();
}
sub DoSurgeProtection {
return unless $SurgeProtection;
my $name = GetParam('username', $q->remote_addr());
return unless $name;
ReadRecentVisitors();
AddRecentVisitor($name);
if (RequestLockDir('visitors')) { # not fatal
WriteRecentVisitors();
ReleaseLockDir('visitors');
if (DelayRequired($name)) {
ReportError(Ts('Too many connections by %s', $name)
. ': ' . Tss('Please do not fetch more than %1 pages in %2 seconds.',
$SurgeProtectionViews, $SurgeProtectionTime),
'503 SERVICE UNAVAILABLE');
}
} elsif (GetParam('action', '') ne 'unlock') {
ReportError(Ts('Could not get %s lock', 'visitors') . ': ' . Ts('Check whether the web server can create the directory %s and whether it can create files in it.', $TempDir), '503 SERVICE UNAVAILABLE');
}
}
sub DelayRequired {
my $name = shift;
my @entries = @{$RecentVisitors{$name}};
my $ts = $entries[$SurgeProtectionViews];
return ($Now - $ts) < $SurgeProtectionTime;
}
sub AddRecentVisitor {
my $name = shift;
my $value = $RecentVisitors{$name};
( run in 0.574 second using v1.01-cache-2.11-cpan-8f98c5d2c55 )