mirror of
https://codeberg.org/usemod/usemod
synced 2026-04-05 02:50:11 +09:00
5245 lines
158 KiB
Perl
Executable File
5245 lines
158 KiB
Perl
Executable File
#!/usr/bin/perl -wT
|
|
# UseModWiki version 1.0.6 (November 05, 2016)
|
|
# Copyright (C) 2000-2003 Clifford A. Adams <caadams@usemod.com>
|
|
# Copyright (C) 2002-2003 Sunir Shah <sunir@sunir.org>
|
|
# Based on the GPLed AtisWiki 0.3 (C) 1998 Markus Denker
|
|
# <marcus@ira.uka.de>
|
|
# ...which was based on
|
|
# the LGPLed CVWiki CVS-patches (C) 1997 Peter Merel
|
|
# and The Original WikiWikiWeb (C) Ward Cunningham
|
|
# <ward@c2.com> (code reused with permission)
|
|
# Email and ThinLine options by Jim Mahoney <mahoney@marlboro.edu>
|
|
#
|
|
# 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 2 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, write to the
|
|
# Free Software Foundation, Inc.
|
|
# 59 Temple Place, Suite 330
|
|
# Boston, MA 02111-1307 USA
|
|
|
|
package UseModWiki;
|
|
use strict;
|
|
local $| = 1; # Do not buffer output (localized for mod_perl)
|
|
|
|
# Configuration/constant variables:
|
|
use vars qw(@RcDays @HtmlPairs @HtmlSingle
|
|
$TempDir $LockDir $DataDir $HtmlDir $UserDir $KeepDir $PageDir
|
|
$InterFile $RcFile $RcOldFile $IndexFile $FullUrl $SiteName $HomePage
|
|
$LogoUrl $RcDefault $IndentLimit $RecentTop $EditAllowed $UseDiff
|
|
$UseSubpage $UseCache $RawHtml $SimpleLinks $NonEnglish $LogoLeft
|
|
$KeepDays $HtmlTags $HtmlLinks $UseDiffLog $KeepMajor $KeepAuthor
|
|
$FreeUpper $EmailNotify $SendMail $EmailFrom $FastGlob $EmbedWiki
|
|
$ScriptTZ $BracketText $UseAmPm $UseConfig $UseIndex $UseLookup
|
|
$RedirType $AdminPass $EditPass $UseHeadings $NetworkFile $BracketWiki
|
|
$FreeLinks $WikiLinks $AdminDelete $FreeLinkPattern $RCName $RunCGI
|
|
$ShowEdits $ThinLine $LinkPattern $InterLinkPattern $InterSitePattern
|
|
$UrlProtocols $UrlPattern $ImageExtensions $RFCPattern $ISBNPattern
|
|
$FS $FS1 $FS2 $FS3 $CookieName $SiteBase $StyleSheet $NotFoundPg
|
|
$FooterNote $EditNote $MaxPost $NewText $NotifyDefault $HttpCharset
|
|
$UserGotoBar $DeletedPage $ReplaceFile @ReplaceableFiles $TableSyntax
|
|
$MetaKeywords $NamedAnchors $InterWikiMoniker $SiteDescription $RssLogoUrl
|
|
$NumberDates $EarlyRules $LateRules $NewFS $KeepSize $SlashLinks $BGColor
|
|
$UpperFirst $AdminBar $RepInterMap $DiffColor1 $DiffColor2 $ConfirmDel
|
|
$MaskHosts $LockCrash $ConfigFile $HistoryEdit $OldThinLine
|
|
@IsbnNames @IsbnPre @IsbnPost $EmailFile $FavIcon $RssDays $UserHeader
|
|
$UserBody $StartUID $ParseParas $AuthorFooter $UseUpload $AllUpload
|
|
$UploadDir $UploadUrl $LimitFileUrl $MaintTrimRc $SearchButton
|
|
$EditNameLink $UseMetaWiki @ImageSites $BracketImg );
|
|
# Note: $NotifyDefault is kept because it was a config variable in 0.90
|
|
# Other global variables:
|
|
use vars qw(%Page %Section %Text %InterSite %SaveUrl %SaveNumUrl
|
|
%KeptRevisions %UserCookie %SetCookie %UserData %IndexHash %Translate
|
|
%LinkIndex $InterSiteInit $SaveUrlIndex $SaveNumUrlIndex $MainPage
|
|
$OpenPageName @KeptList @IndexList $IndexInit $TableMode
|
|
$q $Now $UserID $TimeZoneOffset $ScriptName $BrowseCode $OtherCode
|
|
$AnchoredLinkPattern @HeadingNumbers $TableOfContents $QuotedFullUrl
|
|
$ConfigError $UploadPattern );
|
|
|
|
# == Configuration =====================================================
|
|
$DataDir = "/tmp/mywikidb"; # Main wiki directory
|
|
$UseConfig = 1; # 1 = use config file, 0 = do not look for config
|
|
$ConfigFile = "$DataDir/config"; # Configuration file
|
|
|
|
# Default configuration (used if UseConfig is 0)
|
|
$CookieName = "Wiki"; # Name for this wiki (for multi-wiki sites)
|
|
$SiteName = "Wiki"; # Name of site (used for titles)
|
|
$HomePage = "HomePage"; # Home page (change space to _)
|
|
$RCName = "RecentChanges"; # Name of changes page (change space to _)
|
|
$LogoUrl = "/wiki.gif"; # URL for site logo ("" for no logo)
|
|
$ENV{PATH} = "/usr/bin/"; # Path used to find "diff"
|
|
$ScriptTZ = ""; # Local time zone ("" means do not print)
|
|
$RcDefault = 30; # Default number of RecentChanges days
|
|
@RcDays = qw(1 3 7 30 90); # Days for links on RecentChanges
|
|
$KeepDays = 14; # Days to keep old revisions
|
|
$SiteBase = ""; # Full URL for <BASE> header
|
|
$FullUrl = ""; # Set if the auto-detected URL is wrong
|
|
$RedirType = 1; # 1 = CGI.pm, 2 = script, 3 = no redirect
|
|
$AdminPass = ""; # Set to non-blank to enable password(s)
|
|
$EditPass = ""; # Like AdminPass, but for editing only
|
|
$StyleSheet = ""; # URL for CSS stylesheet (like "/wiki.css")
|
|
$NotFoundPg = ""; # Page for not-found links ("" for blank pg)
|
|
$EmailFrom = "Wiki"; # Text for "From: " field of email notes.
|
|
$SendMail = "/usr/sbin/sendmail"; # Full path to sendmail executable
|
|
$FooterNote = ""; # HTML for bottom of every page
|
|
$EditNote = ""; # HTML notice above buttons on edit page
|
|
$MaxPost = 1024 * 210; # Maximum 210K posts (about 200K for pages)
|
|
$NewText = ""; # New page text ("" for default message)
|
|
$HttpCharset = ""; # Charset for pages, like "iso-8859-2"
|
|
$UserGotoBar = ""; # HTML added to end of goto bar
|
|
$InterWikiMoniker = ''; # InterWiki moniker for this wiki. (for RSS)
|
|
$SiteDescription = $SiteName; # Description of this wiki. (for RSS)
|
|
$RssLogoUrl = ''; # Optional image for RSS feed
|
|
$EarlyRules = ''; # Local syntax rules for wiki->html (evaled)
|
|
$LateRules = ''; # Local syntax rules for wiki->html (evaled)
|
|
$KeepSize = 0; # If non-zero, maximum size of keep file
|
|
$BGColor = 'white'; # Background color ('' to disable)
|
|
$DiffColor1 = '#ffffaf'; # Background color of old/deleted text
|
|
$DiffColor2 = '#cfffcf'; # Background color of new/added text
|
|
$FavIcon = ''; # URL of bookmark/favorites icon, or ''
|
|
$RssDays = 7; # Default number of days in RSS feed
|
|
$UserHeader = ''; # Optional HTML header additional content
|
|
$UserBody = ''; # Optional <BODY> tag additional content
|
|
$StartUID = 1001; # Starting number for user IDs
|
|
$UploadDir = ''; # Full path (like /foo/www/uploads) for files
|
|
$UploadUrl = ''; # Full URL (like http://foo.com/uploads)
|
|
@ImageSites = qw(); # Url prefixes of good image sites: ()=all
|
|
|
|
# Major options:
|
|
$UseSubpage = 1; # 1 = use subpages, 0 = do not use subpages
|
|
$UseCache = 0; # 1 = cache HTML pages, 0 = generate every page
|
|
$EditAllowed = 1; # 1 = editing allowed, 0 = read-only
|
|
$RawHtml = 0; # 1 = allow <HTML> tag, 0 = no raw HTML in pages
|
|
$HtmlTags = 0; # 1 = "unsafe" HTML tags, 0 = only minimal tags
|
|
$UseDiff = 1; # 1 = use diff features, 0 = do not use diff
|
|
$FreeLinks = 1; # 1 = use [[word]] links, 0 = LinkPattern only
|
|
$WikiLinks = 1; # 1 = use LinkPattern, 0 = use [[word]] only
|
|
$AdminDelete = 1; # 1 = Admin only deletes, 0 = Editor can delete
|
|
$RunCGI = 1; # 1 = Run script as CGI, 0 = Load but do not run
|
|
$EmailNotify = 0; # 1 = use email notices, 0 = no email on changes
|
|
$EmbedWiki = 0; # 1 = no headers/footers, 0 = normal wiki pages
|
|
$DeletedPage = 'DeletedPage'; # 0 = disable, 'PageName' = tag to delete page
|
|
$ReplaceFile = 'ReplaceFile'; # 0 = disable, 'PageName' = indicator tag
|
|
@ReplaceableFiles = (); # List of allowed server files to replace
|
|
$TableSyntax = 1; # 1 = wiki syntax tables, 0 = no table syntax
|
|
$NewFS = 0; # 1 = new multibyte $FS, 0 = old $FS
|
|
$UseUpload = 0; # 1 = allow uploads, 0 = no uploads
|
|
|
|
# Minor options:
|
|
$LogoLeft = 0; # 1 = logo on left, 0 = logo on right
|
|
$RecentTop = 1; # 1 = recent on top, 0 = recent on bottom
|
|
$UseDiffLog = 1; # 1 = save diffs to log, 0 = do not save diffs
|
|
$KeepMajor = 1; # 1 = keep major rev, 0 = expire all revisions
|
|
$KeepAuthor = 1; # 1 = keep author rev, 0 = expire all revisions
|
|
$ShowEdits = 0; # 1 = show minor edits, 0 = hide edits by default
|
|
$HtmlLinks = 0; # 1 = allow A HREF links, 0 = no raw HTML links
|
|
$SimpleLinks = 0; # 1 = only letters, 0 = allow _ and numbers
|
|
$NonEnglish = 0; # 1 = extra link chars, 0 = only A-Za-z chars
|
|
$ThinLine = 0; # 1 = fancy <hr> tags, 0 = classic wiki <hr>
|
|
$BracketText = 1; # 1 = allow [URL text], 0 = no link descriptions
|
|
$UseAmPm = 1; # 1 = use am/pm in times, 0 = use 24-hour times
|
|
$UseIndex = 0; # 1 = use index file, 0 = slow/reliable method
|
|
$UseHeadings = 1; # 1 = allow = h1 text =, 0 = no header formatting
|
|
$NetworkFile = 1; # 1 = allow remote file:, 0 = no file:// links
|
|
$BracketWiki = 0; # 1 = [WikiLnk txt] link, 0 = no local descriptions
|
|
$UseLookup = 1; # 1 = lookup host names, 0 = skip lookup (IP only)
|
|
$FreeUpper = 1; # 1 = force upper case, 0 = do not force case
|
|
$FastGlob = 1; # 1 = new faster code, 0 = old compatible code
|
|
$MetaKeywords = 1; # 1 = Google-friendly, 0 = search-engine averse
|
|
$NamedAnchors = 1; # 0 = no anchors, 1 = enable anchors,
|
|
# 2 = enable but suppress display
|
|
$SlashLinks = 0; # 1 = use script/action links, 0 = script?action
|
|
$UpperFirst = 1; # 1 = free links start uppercase, 0 = no ucfirst
|
|
$AdminBar = 1; # 1 = admins see admin links, 0 = no admin bar
|
|
$RepInterMap = 0; # 1 = intermap is replacable, 0 = not replacable
|
|
$ConfirmDel = 1; # 1 = delete link confirm page, 0 = immediate delete
|
|
$MaskHosts = 0; # 1 = mask hosts/IPs, 0 = no masking
|
|
$LockCrash = 0; # 1 = crash if lock stuck, 0 = auto clear locks
|
|
$HistoryEdit = 0; # 1 = edit links on history page, 0 = no edit links
|
|
$OldThinLine = 0; # 1 = old ==== thick line, 0 = ------ for thick line
|
|
$NumberDates = 0; # 1 = 2003-06-17 dates, 0 = June 17, 2003 dates
|
|
$ParseParas = 0; # 1 = new paragraph markup, 0 = old markup
|
|
$AuthorFooter = 1; # 1 = show last author in footer, 0 = do not show
|
|
$AllUpload = 0; # 1 = anyone can upload, 0 = only editor/admins
|
|
$LimitFileUrl = 1; # 1 = limited use of file: URLs, 0 = no limits
|
|
$MaintTrimRc = 0; # 1 = maintain action trims RC, 0 = only maintainrc
|
|
$SearchButton = 0; # 1 = search button on page, 0 = old behavior
|
|
$EditNameLink = 0; # 1 = edit links use name (CSS), 0 = '?' links
|
|
$UseMetaWiki = 0; # 1 = add MetaWiki search links, 0 = no MW links
|
|
$BracketImg = 1; # 1 = [url url.gif] becomes image link, 0 = no img
|
|
|
|
# Names of sites. (The first entry is used for the number link.)
|
|
@IsbnNames = ('bn.com', 'amazon.com', 'search');
|
|
# Full URL of each site before the ISBN
|
|
@IsbnPre = ('http://search.barnesandnoble.com/booksearch/isbninquiry.asp?isbn=',
|
|
'http://www.amazon.com/exec/obidos/ISBN=',
|
|
'http://www.pricescan.com/books/BookDetail.asp?isbn=');
|
|
# Rest of URL of each site after the ISBN (usually '')
|
|
@IsbnPost = ('', '', '');
|
|
|
|
# HTML tag lists, enabled if $HtmlTags is set.
|
|
# Scripting is currently possible with these tags,
|
|
# so they are *not* particularly "safe".
|
|
# Tags that must be in <tag> ... </tag> pairs:
|
|
@HtmlPairs = qw(b i u font big small sub sup h1 h2 h3 h4 h5 h6 cite code
|
|
em s strike strong tt var div center blockquote ol ul dl table caption);
|
|
# Single tags (that do not require a closing /tag)
|
|
@HtmlSingle = qw(br p hr li dt dd tr td th);
|
|
@HtmlPairs = (@HtmlPairs, @HtmlSingle); # All singles can also be pairs
|
|
|
|
# == You should not have to change anything below this line. =============
|
|
$IndentLimit = 20; # Maximum depth of nested lists
|
|
$PageDir = "$DataDir/page"; # Stores page data
|
|
$HtmlDir = "$DataDir/html"; # Stores HTML versions
|
|
$UserDir = "$DataDir/user"; # Stores user 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
|
|
$InterFile = "$DataDir/intermap"; # Interwiki site->url map
|
|
$RcFile = "$DataDir/rclog"; # New RecentChanges logfile
|
|
$RcOldFile = "$DataDir/oldrclog"; # Old RecentChanges logfile
|
|
$IndexFile = "$DataDir/pageidx"; # List of all pages
|
|
$EmailFile = "$DataDir/emails"; # Email notification lists
|
|
|
|
if ($RepInterMap) {
|
|
push @ReplaceableFiles, $InterFile;
|
|
}
|
|
|
|
# The "main" program, called at the end of this script file.
|
|
sub DoWikiRequest {
|
|
if ($UseConfig && (-f $ConfigFile)) {
|
|
$ConfigError = '';
|
|
if (!do $ConfigFile) { # Some error occurred
|
|
$ConfigError = $@;
|
|
if ($ConfigError eq '') {
|
|
# Unfortunately, if the last expr returns 0, one will get a false
|
|
# error above. To remain compatible with existing installs the
|
|
# wiki must not report an error unless there is error text in $@.
|
|
# (Errors in "use strict" may not have error text.)
|
|
# Uncomment the line below if you want to catch use strict errors.
|
|
# $ConfigError = T('Unknown Error (no error text)');
|
|
}
|
|
}
|
|
}
|
|
&InitLinkPatterns();
|
|
if (!&DoCacheBrowse()) {
|
|
eval $BrowseCode;
|
|
&InitRequest() or return;
|
|
if (!&DoBrowseRequest()) {
|
|
eval $OtherCode;
|
|
&DoOtherRequest();
|
|
}
|
|
}
|
|
}
|
|
|
|
# == Common and cache-browsing code ====================================
|
|
sub InitLinkPatterns {
|
|
my ($UpperLetter, $LowerLetter, $AnyLetter, $LpA, $LpB, $QDelim);
|
|
|
|
# Field separators are used in the URL-style patterns below.
|
|
if ($NewFS) {
|
|
$FS = "\x1e\xff\xfe\x1e"; # An unlikely sequence for any charset
|
|
} else {
|
|
$FS = "\xb3"; # The FS character is a superscript "3"
|
|
}
|
|
$FS1 = $FS . "1"; # The FS values are used to separate fields
|
|
$FS2 = $FS . "2"; # in stored hashtables and other data structures.
|
|
$FS3 = $FS . "3"; # The FS character is not allowed in user data.
|
|
$UpperLetter = "[A-Z";
|
|
$LowerLetter = "[a-z";
|
|
$AnyLetter = "[A-Za-z";
|
|
if ($NonEnglish) {
|
|
$UpperLetter .= "\xc0-\xde";
|
|
$LowerLetter .= "\xdf-\xff";
|
|
if ($NewFS) {
|
|
$AnyLetter .= "\x80-\xff";
|
|
} else {
|
|
$AnyLetter .= "\xc0-\xff";
|
|
}
|
|
}
|
|
if (!$SimpleLinks) {
|
|
$AnyLetter .= "_0-9";
|
|
}
|
|
$UpperLetter .= "]"; $LowerLetter .= "]"; $AnyLetter .= "]";
|
|
# Main link pattern: lowercase between uppercase, then anything
|
|
$LpA = $UpperLetter . "+" . $LowerLetter . "+" . $UpperLetter
|
|
. $AnyLetter . "*";
|
|
# Optional subpage link pattern: uppercase, lowercase, then anything
|
|
$LpB = $UpperLetter . "+" . $LowerLetter . "+" . $AnyLetter . "*";
|
|
if ($UseSubpage) {
|
|
# Loose pattern: If subpage is used, subpage may be simple name
|
|
$LinkPattern = "((?:(?:$LpA)?\\/$LpB)|$LpA)";
|
|
# Strict pattern: both sides must be the main LinkPattern
|
|
# $LinkPattern = "((?:(?:$LpA)?\\/)?$LpA)";
|
|
} else {
|
|
$LinkPattern = "($LpA)";
|
|
}
|
|
$QDelim = '(?:"")?'; # Optional quote delimiter (not in output)
|
|
$AnchoredLinkPattern = $LinkPattern . '#(\\w+)' . $QDelim if $NamedAnchors;
|
|
$LinkPattern .= $QDelim;
|
|
# Inter-site convention: sites must start with uppercase letter
|
|
# (Uppercase letter avoids confusion with URLs)
|
|
$InterSitePattern = $UpperLetter . $AnyLetter . "+";
|
|
$InterLinkPattern = "((?:$InterSitePattern:[^\\]\\s\"<>$FS]+)$QDelim)";
|
|
if ($FreeLinks) {
|
|
# Note: the - character must be first in $AnyLetter definition
|
|
if ($NonEnglish) {
|
|
if ($NewFS) {
|
|
$AnyLetter = "[-,.()' _0-9A-Za-z\x80-\xff]";
|
|
} else {
|
|
$AnyLetter = "[-,.()' _0-9A-Za-z\xc0-\xff]";
|
|
}
|
|
} else {
|
|
$AnyLetter = "[-,.()' _0-9A-Za-z]";
|
|
}
|
|
}
|
|
$FreeLinkPattern = "($AnyLetter+)";
|
|
if ($UseSubpage) {
|
|
$FreeLinkPattern = "((?:(?:$AnyLetter+)?\\/)?$AnyLetter+)";
|
|
}
|
|
$FreeLinkPattern .= $QDelim;
|
|
# Url-style links are delimited by one of:
|
|
# 1. Whitespace (kept in output)
|
|
# 2. Left or right angle-bracket (< or >) (kept in output)
|
|
# 3. Right square-bracket (]) (kept in output)
|
|
# 4. A single double-quote (") (kept in output)
|
|
# 5. A $FS (field separator) character (kept in output)
|
|
# 6. A double double-quote ("") (removed from output)
|
|
$UrlProtocols = "http|https|ftp|afs|news|nntp|mid|cid|mailto|wais|"
|
|
. "prospero|telnet|gopher";
|
|
$UrlProtocols .= '|file' if ($NetworkFile || !$LimitFileUrl);
|
|
$UrlPattern = "((?:(?:$UrlProtocols):[^\\]\\s\"<>$FS]+)$QDelim)";
|
|
$ImageExtensions = "(gif|jpg|png|bmp|jpeg|ico|tiff?)";
|
|
$RFCPattern = "RFC\\s?(\\d+)";
|
|
$ISBNPattern = "ISBN:?([0-9- xX]{10,})";
|
|
$UploadPattern = "upload:([^\\]\\s\"<>$FS]+)$QDelim";
|
|
}
|
|
|
|
# Simple HTML cache
|
|
sub DoCacheBrowse {
|
|
my ($query, $idFile, $text);
|
|
|
|
return 0 if (!$UseCache);
|
|
$query = $ENV{'QUERY_STRING'};
|
|
if (($query eq "") && ($ENV{'REQUEST_METHOD'} eq "GET")) {
|
|
$query = $HomePage; # Allow caching of home page.
|
|
}
|
|
if (!($query =~ /^$LinkPattern$/)) {
|
|
if (!($FreeLinks && ($query =~ /^$FreeLinkPattern$/))) {
|
|
return 0; # Only use cache for simple links
|
|
}
|
|
}
|
|
$idFile = &GetHtmlCacheFile($query);
|
|
if (-f $idFile) {
|
|
local $/ = undef; # Read complete files
|
|
open(INFILE, "<$idFile") or return 0;
|
|
$text = <INFILE>;
|
|
close INFILE;
|
|
print $text;
|
|
return 1;
|
|
}
|
|
return 0;
|
|
}
|
|
|
|
sub GetHtmlCacheFile {
|
|
my ($id) = @_;
|
|
|
|
return $HtmlDir . "/" . &GetPageDirectory($id) . "/$id.htm";
|
|
}
|
|
|
|
sub GetPageDirectory {
|
|
my ($id) = @_;
|
|
|
|
if ($id =~ /^([a-zA-Z])/) {
|
|
return uc($1);
|
|
}
|
|
return "other";
|
|
}
|
|
|
|
sub T {
|
|
my ($text) = @_;
|
|
|
|
if (defined($Translate{$text}) && ($Translate{$text} ne '')) {
|
|
return $Translate{$text};
|
|
}
|
|
return $text;
|
|
}
|
|
|
|
sub Ts {
|
|
my ($text, $string, $noquote) = @_;
|
|
|
|
$string = &QuoteHtml($string) unless $noquote;
|
|
$text = T($text);
|
|
$text =~ s/\%s/$string/;
|
|
return $text;
|
|
}
|
|
|
|
sub Tss {
|
|
my $text = $_[0];
|
|
my @args = @_;
|
|
|
|
@args = map {
|
|
$_ = &QuoteHtml($_);
|
|
} @args;
|
|
$text = T($text);
|
|
$text =~ s/\%([1-9])/$args[$1]/ge;
|
|
return $text;
|
|
}
|
|
|
|
sub QuoteHtml {
|
|
my ($html) = @_;
|
|
|
|
$html =~ s/&/&/g;
|
|
$html =~ s/</</g;
|
|
$html =~ s/>/>/g;
|
|
$html =~ s/&([#a-zA-Z0-9]+);/&$1;/g; # Allow character references
|
|
return $html;
|
|
}
|
|
|
|
# == Normal page-browsing and RecentChanges code =======================
|
|
$BrowseCode = ""; # Comment next line to always compile (slower)
|
|
#$BrowseCode = <<'#END_OF_BROWSE_CODE';
|
|
use CGI;
|
|
use CGI::Carp qw(fatalsToBrowser);
|
|
|
|
sub InitRequest {
|
|
my @ScriptPath = $ENV{SCRIPT_NAME} ? split('/', $ENV{SCRIPT_NAME}) : ();
|
|
|
|
$CGI::POST_MAX = $MaxPost;
|
|
if ($UseUpload) {
|
|
$CGI::DISABLE_UPLOADS = 0; # allow uploads
|
|
} else {
|
|
$CGI::DISABLE_UPLOADS = 1; # no uploads
|
|
}
|
|
$q = new CGI;
|
|
# Fix some issues with editing UTF8 pages (if charset specified)
|
|
if ($HttpCharset ne '') {
|
|
$q->charset($HttpCharset);
|
|
}
|
|
$Now = time; # Reset in case script is persistent
|
|
$ScriptName = pop(@ScriptPath) || ''; # Name used in links
|
|
$IndexInit = 0; # Must be reset for each request
|
|
$InterSiteInit = 0;
|
|
%InterSite = ();
|
|
$MainPage = "."; # For subpages only, the name of the top-level page
|
|
$OpenPageName = ""; # Currently open page
|
|
&CreateDir($DataDir); # Create directory if it doesn't exist
|
|
if (!-d $DataDir) {
|
|
&ReportError(Ts('Could not create %s', $DataDir) . ": $!");
|
|
return 0;
|
|
}
|
|
&InitCookie(); # Reads in user data
|
|
return 1;
|
|
}
|
|
|
|
sub InitCookie {
|
|
my $unsafe_uid;
|
|
|
|
%SetCookie = ();
|
|
$TimeZoneOffset = 0;
|
|
undef $q->{'.cookies'}; # Clear cache if it exists (for SpeedyCGI)
|
|
%UserData = (); # Fix for persistent environments.
|
|
%UserCookie = $q->cookie($CookieName);
|
|
$unsafe_uid = $UserCookie{'id'} || 0;
|
|
$UserID = &SanitizeUserID($unsafe_uid);
|
|
if ($UserID > 199) {
|
|
&LoadUserData($UserID);
|
|
if (($UserData{'id'} != $UserCookie{'id'}) ||
|
|
($UserData{'randkey'} != $UserCookie{'randkey'})) {
|
|
$UserID = 113;
|
|
%UserData = (); # Invalid. Consider warning message.
|
|
}
|
|
}
|
|
if ($UserData{'tzoffset'}) {
|
|
$TimeZoneOffset = $UserData{'tzoffset'} * (60 * 60);
|
|
}
|
|
}
|
|
|
|
sub DoBrowseRequest {
|
|
my ($id, $action);
|
|
|
|
if (!$q->param) { # No parameter
|
|
&BrowsePage($HomePage);
|
|
return 1;
|
|
}
|
|
$id = &GetParam('keywords', '');
|
|
if ($id ne '') { # Just script?PageName
|
|
if ($FreeLinks && (!-f &GetPageFile($id))) {
|
|
$id = &FreeToNormal($id);
|
|
}
|
|
if (($NotFoundPg ne '') && (!-f &GetPageFile($id))) {
|
|
$id = $NotFoundPg;
|
|
}
|
|
&BrowsePage($id) if &ValidIdOrDie($id);
|
|
return 1;
|
|
}
|
|
$action = lc(&GetParam('action', ''));
|
|
$id = &GetParam('id', '');
|
|
if ($action eq 'browse') {
|
|
if ($FreeLinks && (!-f &GetPageFile($id))) {
|
|
$id = &FreeToNormal($id);
|
|
}
|
|
if (($NotFoundPg ne '') && (!-f &GetPageFile($id))) {
|
|
$id = $NotFoundPg;
|
|
}
|
|
&BrowsePage($id) if &ValidIdOrDie($id);
|
|
return 1;
|
|
} elsif ($action eq 'rc') {
|
|
&BrowsePage($RCName);
|
|
return 1;
|
|
} elsif ($action eq 'random') {
|
|
&DoRandom();
|
|
return 1;
|
|
} elsif ($action eq 'history') {
|
|
&DoHistory($id) if &ValidIdOrDie($id);
|
|
return 1;
|
|
}
|
|
return 0; # Request not handled
|
|
}
|
|
|
|
sub BrowsePage {
|
|
my ($id) = @_;
|
|
my ($fullHtml, $oldId, $allDiff, $showDiff, $openKept);
|
|
my ($revision, $goodRevision, $diffRevision, $newText);
|
|
|
|
&OpenPage($id);
|
|
&OpenDefaultText();
|
|
$openKept = 0;
|
|
$revision = &GetParam('revision', '');
|
|
$revision =~ s/\D//g; # Remove non-numeric chars
|
|
$goodRevision = $revision; # Non-blank only if exists
|
|
if ($revision ne '') {
|
|
&OpenKeptRevisions('text_default');
|
|
$openKept = 1;
|
|
if (!defined($KeptRevisions{$revision})) {
|
|
$goodRevision = '';
|
|
} else {
|
|
&OpenKeptRevision($revision);
|
|
}
|
|
}
|
|
# Raw mode: just untranslated wiki text
|
|
if (&GetParam('raw', 0)) {
|
|
print &GetHttpHeader('text/plain');
|
|
print $Text{'text'};
|
|
return;
|
|
}
|
|
$newText = $Text{'text'}; # For differences
|
|
# Handle a single-level redirect
|
|
$oldId = &GetParam('oldid', '');
|
|
if (($oldId eq '') && (substr($Text{'text'}, 0, 10) eq '#REDIRECT ')) {
|
|
$oldId = $id;
|
|
if (($FreeLinks) && ($Text{'text'} =~ /\#REDIRECT\s+\[\[.+\]\]/)) {
|
|
($id) = ($Text{'text'} =~ /\#REDIRECT\s+\[\[(.+)\]\]/);
|
|
$id = &FreeToNormal($id);
|
|
} else {
|
|
($id) = ($Text{'text'} =~ /\#REDIRECT\s+(\S+)/);
|
|
}
|
|
if (&ValidId($id) eq '') {
|
|
# Consider revision in rebrowse?
|
|
&ReBrowsePage($id, $oldId, 0);
|
|
return;
|
|
} else { # Not a valid target, so continue as normal page
|
|
$id = $oldId;
|
|
$oldId = '';
|
|
}
|
|
}
|
|
$MainPage = $id;
|
|
$MainPage =~ s|/.*||; # Only the main page name (remove subpage)
|
|
$fullHtml = &GetHeader($id, &QuoteHtml($id), $oldId, 1);
|
|
if ($revision ne '') {
|
|
if (($revision eq $Page{'revision'}) || ($goodRevision ne '')) {
|
|
$fullHtml .= '<b>' . Ts('Showing revision %s', $revision) . "</b><br>";
|
|
} else {
|
|
$fullHtml .= '<b>' . Ts('Revision %s not available', $revision)
|
|
. ' (' . T('showing current revision instead')
|
|
. ')</b><br>';
|
|
}
|
|
}
|
|
$allDiff = &GetParam('alldiff', 0);
|
|
if ($allDiff != 0) {
|
|
$allDiff = &GetParam('defaultdiff', 1);
|
|
}
|
|
if ((($id eq $RCName) || (T($RCName) eq $id) || (T($id) eq $RCName))
|
|
&& &GetParam('norcdiff', 1)) {
|
|
$allDiff = 0; # Only show if specifically requested
|
|
}
|
|
$showDiff = &GetParam('diff', $allDiff);
|
|
if ($UseDiff && $showDiff) {
|
|
$diffRevision = $goodRevision;
|
|
$diffRevision = &GetParam('diffrevision', $diffRevision);
|
|
# Eventually try to avoid the following keep-loading if possible?
|
|
&OpenKeptRevisions('text_default') if (!$openKept);
|
|
$fullHtml .= &GetDiffHTML($showDiff, $id, $diffRevision,
|
|
$revision, $newText);
|
|
$fullHtml .= "<hr class=wikilinediff>\n";
|
|
}
|
|
$fullHtml .= '<div class=wikitext>';
|
|
$fullHtml .= &WikiToHTML($Text{'text'});
|
|
$fullHtml .= '</div>';
|
|
if (($id eq $RCName) || (T($RCName) eq $id) || (T($id) eq $RCName)) {
|
|
print $fullHtml;
|
|
print "<hr class=wikilinerc>\n";
|
|
print '<div class=wikirc>';
|
|
&DoRc(1);
|
|
print '</div>';
|
|
print &GetFooterText($id, $goodRevision);
|
|
return;
|
|
}
|
|
$fullHtml .= &GetFooterText($id, $goodRevision);
|
|
print $fullHtml;
|
|
return if ($showDiff || ($revision ne '')); # Don't cache special version
|
|
&UpdateHtmlCache($id, $fullHtml) if ($UseCache && ($oldId eq ''));
|
|
}
|
|
|
|
sub ReBrowsePage {
|
|
my ($id, $oldId, $isEdit) = @_;
|
|
|
|
if ($oldId ne "") { # Target of #REDIRECT (loop breaking)
|
|
print &GetRedirectPage("action=browse&id=$id&oldid=$oldId",
|
|
$id, $isEdit);
|
|
} else {
|
|
print &GetRedirectPage($id, $id, $isEdit);
|
|
}
|
|
}
|
|
|
|
sub DoRc {
|
|
my ($rcType) = @_; # 0 = RSS, 1 = HTML
|
|
my ($fileData, $rcline, $i, $daysago, $lastTs, $ts, $idOnly);
|
|
my (@fullrc, $status, $oldFileData, $firstTs, $errorText, $showHTML);
|
|
my $starttime = 0;
|
|
my $showbar = 0;
|
|
|
|
if (0 == $rcType) {
|
|
$showHTML = 0;
|
|
} else {
|
|
$showHTML = 1;
|
|
}
|
|
if (&GetParam("from", 0)) {
|
|
$starttime = &GetParam("from", 0);
|
|
if ($showHTML) {
|
|
print "<h2>" . Ts('Updates since %s', &TimeToText($starttime))
|
|
. "</h2>\n";
|
|
}
|
|
} else {
|
|
$daysago = &GetParam("days", 0);
|
|
$daysago = &GetParam("rcdays", 0) if ($daysago == 0);
|
|
if ($daysago) {
|
|
$starttime = $Now - ((24*60*60)*$daysago);
|
|
if ($showHTML) {
|
|
print "<h2>" . Ts('Updates in the last %s day'
|
|
. (($daysago != 1)?"s":""), $daysago) . "</h2>\n";
|
|
}
|
|
# Note: must have two translations (for "day" and "days")
|
|
# Following comment line is for translation helper script
|
|
# Ts('Updates in the last %s days', '');
|
|
}
|
|
}
|
|
if ($starttime == 0) {
|
|
if (0 == $rcType) {
|
|
$starttime = $Now - ((24*60*60)*$RssDays);
|
|
} else {
|
|
$starttime = $Now - ((24*60*60)*$RcDefault);
|
|
}
|
|
if ($showHTML) {
|
|
print "<h2>" . Ts('Updates in the last %s day'
|
|
. (($RcDefault != 1)?"s":""), $RcDefault) . "</h2>\n";
|
|
}
|
|
# Translation of above line is identical to previous version
|
|
}
|
|
# Read rclog data (and oldrclog data if needed)
|
|
($status, $fileData) = &ReadFile($RcFile);
|
|
$errorText = "";
|
|
if (!$status) {
|
|
# Save error text if needed.
|
|
$errorText = '<p><strong>' . Ts('Could not open %s log file', $RCName)
|
|
. ":</strong> $RcFile<p>"
|
|
. T('Error was') . ":\n<pre>$!</pre>\n" . '<p>'
|
|
. T('Note: This error is normal if no changes have been made.') . "\n";
|
|
}
|
|
@fullrc = split(/\n/, $fileData);
|
|
$firstTs = 0;
|
|
if (@fullrc > 0) { # Only false if no lines in file
|
|
($firstTs) = split(/$FS3/, $fullrc[0]);
|
|
}
|
|
if (($firstTs == 0) || ($starttime <= $firstTs)) {
|
|
($status, $oldFileData) = &ReadFile($RcOldFile);
|
|
if ($status) {
|
|
@fullrc = split(/\n/, $oldFileData . $fileData);
|
|
} else {
|
|
if ($errorText ne "") { # could not open either rclog file
|
|
print $errorText;
|
|
print "<p><strong>"
|
|
. Ts('Could not open old %s log file', $RCName)
|
|
. ":</strong> $RcOldFile<p>"
|
|
. T('Error was') . ":\n<pre>$!</pre>\n";
|
|
return;
|
|
}
|
|
}
|
|
}
|
|
$lastTs = 0;
|
|
if (@fullrc > 0) { # Only false if no lines in file
|
|
($lastTs) = split(/$FS3/, $fullrc[$#fullrc]);
|
|
}
|
|
$lastTs++ if (($Now - $lastTs) > 5); # Skip last unless very recent
|
|
|
|
$idOnly = &GetParam("rcidonly", "");
|
|
if ($idOnly && $showHTML) {
|
|
print '<b>(' . Ts('for %s only', &ScriptLink($idOnly, &QuoteHtml($idOnly)), 1)
|
|
. ')</b><br>';
|
|
}
|
|
if ($showHTML) {
|
|
foreach $i (@RcDays) {
|
|
print " | " if $showbar;
|
|
$showbar = 1;
|
|
print &ScriptLink("action=rc&days=$i",
|
|
Ts('%s day' . (($i != 1)?'s':''), $i));
|
|
# Note: must have two translations (for "day" and "days")
|
|
# Following comment line is for translation helper script
|
|
# Ts('%s days', '');
|
|
}
|
|
print "<br>" . &ScriptLink("action=rc&from=$lastTs",
|
|
T('List new changes starting from'));
|
|
print " " . &TimeToText($lastTs) . "<br>\n";
|
|
}
|
|
$i = 0;
|
|
while ($i < @fullrc) { # Optimization: skip old entries quickly
|
|
($ts) = split(/$FS3/, $fullrc[$i]);
|
|
if ($ts >= $starttime) {
|
|
$i -= 1000 if ($i > 0);
|
|
last;
|
|
}
|
|
$i += 1000;
|
|
}
|
|
$i -= 1000 if (($i > 0) && ($i >= @fullrc));
|
|
for (; $i < @fullrc ; $i++) {
|
|
($ts) = split(/$FS3/, $fullrc[$i]);
|
|
last if ($ts >= $starttime);
|
|
}
|
|
if ($i == @fullrc && $showHTML) {
|
|
print '<br><strong>' . Ts('No updates since %s',
|
|
&TimeToText($starttime)) . "</strong><br>\n";
|
|
} else {
|
|
splice(@fullrc, 0, $i); # Remove items before index $i
|
|
# Consider an end-time limit (items older than X)
|
|
if (0 == $rcType) {
|
|
print &GetRcRss(@fullrc);
|
|
} else {
|
|
print &GetRcHtml(@fullrc);
|
|
}
|
|
}
|
|
if ($showHTML) {
|
|
print '<p>' . Ts('Page generated %s', &TimeToText($Now)), "<br>\n";
|
|
}
|
|
}
|
|
|
|
sub GetRc {
|
|
my $rcType = shift;
|
|
my @outrc = @_;
|
|
my ($rcline, $date, $newtop, $author, $inlist, $result);
|
|
my ($showedit, $link, $all, $idOnly, $headItem, $item);
|
|
my ($ts, $pagename, $summary, $isEdit, $host, $kind, $extraTemp);
|
|
my ($rcchangehist, $tEdit, $tChanges, $tDiff);
|
|
my ($headList, $pagePrefix, $historyPrefix, $diffPrefix);
|
|
my %extra = ();
|
|
my %changetime = ();
|
|
my %pagecount = ();
|
|
|
|
# Slice minor edits
|
|
$showedit = &GetParam("rcshowedit", $ShowEdits);
|
|
$showedit = &GetParam("showedit", $showedit);
|
|
if ($showedit != 1) {
|
|
my @temprc = ();
|
|
foreach $rcline (@outrc) {
|
|
($ts, $pagename, $summary, $isEdit, $host) = split(/$FS3/, $rcline);
|
|
if ($showedit == 0) { # 0 = No edits
|
|
push(@temprc, $rcline) if (!$isEdit);
|
|
} else { # 2 = Only edits
|
|
push(@temprc, $rcline) if ($isEdit);
|
|
}
|
|
}
|
|
@outrc = @temprc;
|
|
}
|
|
# Optimize param fetches out of main loop
|
|
$rcchangehist = &GetParam("rcchangehist", 1);
|
|
# Optimize translations out of main loop
|
|
$tEdit = T('(edit)');
|
|
$tDiff = T('(diff)');
|
|
$tChanges = T('changes');
|
|
if (0 == $rcType) { # RSS
|
|
$pagePrefix = $QuotedFullUrl . &ScriptLinkChar();
|
|
$diffPrefix = $pagePrefix . &QuoteHtml("action=browse&diff=4&id=");
|
|
$historyPrefix = $pagePrefix . &QuoteHtml("action=history&id=");
|
|
}
|
|
foreach $rcline (@outrc) {
|
|
($ts, $pagename) = split(/$FS3/, $rcline);
|
|
$pagecount{$pagename}++;
|
|
$changetime{$pagename} = $ts;
|
|
}
|
|
$date = "";
|
|
$all = &GetParam("rcall", 0);
|
|
$all = &GetParam("all", $all);
|
|
$newtop = &GetParam("rcnewtop", $RecentTop);
|
|
$newtop = &GetParam("newtop", $newtop);
|
|
$idOnly = &GetParam("rcidonly", "");
|
|
$inlist = 0;
|
|
$headList = '';
|
|
$result = '';
|
|
@outrc = reverse @outrc if ($newtop);
|
|
foreach $rcline (@outrc) {
|
|
($ts, $pagename, $summary, $isEdit, $host, $kind, $extraTemp)
|
|
= split(/$FS3/, $rcline);
|
|
next if ((!$all) && ($ts < $changetime{$pagename}));
|
|
next if (($idOnly ne "") && ($idOnly ne $pagename));
|
|
%extra = split(/$FS2/, $extraTemp, -1);
|
|
if ($date ne &CalcDay($ts)) {
|
|
$date = &CalcDay($ts);
|
|
if (1 == $rcType) { # HTML
|
|
# add date, properly closing lists first
|
|
if ($inlist) {
|
|
$result .= "</UL>\n";
|
|
$inlist = 0;
|
|
}
|
|
$result .= "<p><strong>" . $date . "</strong></p>\n";
|
|
if (!$inlist) {
|
|
$result .= "<UL>\n";
|
|
$inlist = 1;
|
|
}
|
|
}
|
|
}
|
|
if (0 == $rcType) { # RSS
|
|
($headItem, $item) = &GetRssRcLine($pagename, $ts, $host,
|
|
$extra{'name'}, $extra{'id'}, $summary, $isEdit,
|
|
$pagecount{$pagename}, $extra{'revision'},
|
|
$diffPrefix, $historyPrefix, $pagePrefix);
|
|
$headList .= $headItem;
|
|
$result .= $item;
|
|
} else { # HTML
|
|
$result .= &GetHtmlRcLine($pagename, $ts, $host, $extra{'name'},
|
|
$extra{'id'}, $summary, $isEdit,
|
|
$pagecount{$pagename}, $extra{'revision'},
|
|
$tEdit, $tDiff, $tChanges, $all, $rcchangehist);
|
|
}
|
|
}
|
|
if (1 == $rcType) {
|
|
$result .= "</UL>\n" if ($inlist); # Close final tag
|
|
}
|
|
return ($headList, $result); # Just ignore headList for HTML
|
|
}
|
|
|
|
sub GetRcHtml {
|
|
my ($html, $extra);
|
|
|
|
($extra, $html) = &GetRc(1, @_);
|
|
return $html;
|
|
}
|
|
|
|
sub GetHtmlRcLine {
|
|
my ($pagename, $timestamp, $host, $userName, $userID, $summary,
|
|
$isEdit, $pagecount, $revision, $tEdit, $tDiff, $tChanges, $all,
|
|
$rcchangehist) = @_;
|
|
my ($author, $sum, $edit, $count, $link, $html);
|
|
|
|
$html = '';
|
|
$host = &QuoteHtml($host);
|
|
if (defined($userName) && defined($userID)) {
|
|
$author = &GetAuthorLink($host, $userName, $userID);
|
|
} else {
|
|
$author = &GetAuthorLink($host, "", 0);
|
|
}
|
|
$sum = "";
|
|
if (($summary ne "") && ($summary ne "*")) {
|
|
$summary = &QuoteHtml($summary);
|
|
$sum = "<strong>[$summary]</strong> ";
|
|
}
|
|
$edit = "";
|
|
$edit = "<em>$tEdit</em> " if ($isEdit);
|
|
$count = "";
|
|
if ((!$all) && ($pagecount > 1)) {
|
|
$count = "($pagecount ";
|
|
if ($rcchangehist) {
|
|
$count .= &GetHistoryLink($pagename, $tChanges);
|
|
} else {
|
|
$count .= $tChanges;
|
|
}
|
|
$count .= ") ";
|
|
}
|
|
$link = "";
|
|
if ($UseDiff && &GetParam("diffrclink", 1)) {
|
|
$link .= &ScriptLinkDiff(4, $pagename, $tDiff, "") . " ";
|
|
}
|
|
$link .= &GetPageLink($pagename);
|
|
$html .= "<li>$link ";
|
|
$html .= &CalcTime($timestamp) . " $count$edit" . " $sum";
|
|
$html .= ". . . . . $author\n";
|
|
return $html;
|
|
}
|
|
|
|
sub GetRcRss {
|
|
my ($rssHeader, $headList, $items);
|
|
|
|
# Normally get URL from script, but allow override
|
|
$FullUrl = $q->url(-full=>1) if ($FullUrl eq "");
|
|
$QuotedFullUrl = &QuoteHtml($FullUrl);
|
|
$SiteDescription = &QuoteHtml($SiteDescription);
|
|
|
|
my $ChannelAbout = &QuoteHtml($FullUrl . &ScriptLinkChar()
|
|
. $ENV{QUERY_STRING});
|
|
$rssHeader = <<RSS ;
|
|
<?xml version="1.0" encoding="@{[$HttpCharset or 'ISO-8859-1']}"?>
|
|
<rdf:RDF
|
|
xmlns:rdf="http://www.w3.org/1999/02/22-rdf-syntax-ns#"
|
|
xmlns="http://purl.org/rss/1.0/"
|
|
xmlns:dc="http://purl.org/dc/elements/1.1/"
|
|
xmlns:wiki="http://purl.org/rss/1.0/modules/wiki/"
|
|
>
|
|
<channel rdf:about="$ChannelAbout">
|
|
<title>${\(&QuoteHtml($SiteName))}</title>
|
|
<link>${\($QuotedFullUrl . &ScriptLinkChar() . &QuoteHtml(&UriEscape($RCName)))}</link>
|
|
<description>${\(&QuoteHtml($SiteDescription))}</description>
|
|
<wiki:interwiki>
|
|
<rdf:Description link="$QuotedFullUrl">
|
|
<rdf:value>$InterWikiMoniker</rdf:value>
|
|
</rdf:Description>
|
|
</wiki:interwiki>
|
|
<items>
|
|
<rdf:Seq>
|
|
RSS
|
|
($headList, $items) = &GetRc(0, @_);
|
|
$rssHeader .= $headList;
|
|
return <<RSS ;
|
|
$rssHeader
|
|
</rdf:Seq>
|
|
</items>
|
|
</channel>
|
|
<image rdf:about="${\(&QuoteHtml($RssLogoUrl))}">
|
|
<title>${\(&QuoteHtml($SiteName))}</title>
|
|
<url>$RssLogoUrl</url>
|
|
<link>$QuotedFullUrl</link>
|
|
</image>
|
|
$items
|
|
</rdf:RDF>
|
|
RSS
|
|
}
|
|
|
|
sub GetRssRcLine{
|
|
my ($pagename, $timestamp, $host, $userName, $userID, $summary, $isEdit,
|
|
$pagecount, $revision, $diffPrefix, $historyPrefix, $pagePrefix) = @_;
|
|
my ($pagenameEsc, $itemID, $description, $authorLink, $author, $status,
|
|
$importance, $date, $item, $headItem);
|
|
|
|
$pagenameEsc = &UriEscape($pagename);
|
|
# Add to list of items in the <channel/>
|
|
$itemID = $FullUrl . &ScriptLinkChar()
|
|
. &GetOldPageParameters('browse', $pagenameEsc, $revision);
|
|
$itemID = &QuoteHtml($itemID);
|
|
$headItem = " <rdf:li rdf:resource=\"$itemID\"/>\n";
|
|
# Add to list of items proper.
|
|
if (($summary ne "") && ($summary ne "*")) {
|
|
$description = &QuoteHtml($summary);
|
|
} else {
|
|
$description = '';
|
|
}
|
|
$host = &QuoteHtml($host);
|
|
if ($userName) {
|
|
$author = &QuoteHtml($userName);
|
|
$authorLink = 'link="' . $QuotedFullUrl . &ScriptLinkChar() . &UriEscape($author) . '"';
|
|
} else {
|
|
$author = $host;
|
|
$authorLink = '';
|
|
}
|
|
$status = (1 == $revision) ? 'new' : 'updated';
|
|
$importance = $isEdit ? 'minor' : 'major';
|
|
$timestamp += $TimeZoneOffset;
|
|
my ($sec, $min, $hour, $mday, $mon, $year) = localtime($timestamp);
|
|
$year += 1900;
|
|
$date = sprintf("%4d-%02d-%02dT%02d:%02d:%02d+%02d:00",
|
|
$year, $mon+1, $mday, $hour, $min, $sec, $TimeZoneOffset/(60*60));
|
|
$pagename = &QuoteHtml($pagename);
|
|
$pagename =~ tr/_/ /;
|
|
# Write it out longhand
|
|
$item = <<RSS ;
|
|
<item rdf:about="$itemID">
|
|
<title>$pagename</title>
|
|
<link>$pagePrefix$pagenameEsc</link>
|
|
<description>$description</description>
|
|
<dc:date>$date</dc:date>
|
|
<dc:contributor>
|
|
<rdf:Description wiki:host="$host" $authorLink>
|
|
<rdf:value>$author</rdf:value>
|
|
</rdf:Description>
|
|
</dc:contributor>
|
|
<wiki:status>$status</wiki:status>
|
|
<wiki:importance>$importance</wiki:importance>
|
|
<wiki:diff>$diffPrefix$pagenameEsc</wiki:diff>
|
|
<wiki:version>$revision</wiki:version>
|
|
<wiki:history>$historyPrefix$pagenameEsc</wiki:history>
|
|
</item>
|
|
RSS
|
|
return ($headItem, $item);
|
|
}
|
|
|
|
sub DoRss {
|
|
print "Content-type: text/xml", $HttpCharset ? "; charset=$HttpCharset" : "", "\n\n";
|
|
&DoRc(0);
|
|
}
|
|
|
|
sub DoRandom {
|
|
my ($id, @pageList);
|
|
|
|
@pageList = &AllPagesList(); # Optimize?
|
|
$id = $pageList[int(rand($#pageList + 1))];
|
|
&ReBrowsePage($id, "", 0);
|
|
}
|
|
|
|
sub DoHistory {
|
|
my ($id) = @_;
|
|
my ($html, $canEdit, $row, $newText);
|
|
|
|
print &GetHeader('', Ts('History of %s', $id), '');
|
|
&OpenPage($id);
|
|
&OpenDefaultText();
|
|
$newText = $Text{'text'};
|
|
$canEdit = 0;
|
|
$canEdit = &UserCanEdit($id) if ($HistoryEdit);
|
|
if ($UseDiff) {
|
|
print <<EOF ;
|
|
<form action="$ScriptName" METHOD="GET">
|
|
<input type="hidden" name="action" value="browse"/>
|
|
<input type="hidden" name="diff" value="1"/>
|
|
<input type="hidden" name="id" value="$id"/>
|
|
<table border="0" width="100%"><tr>
|
|
EOF
|
|
}
|
|
$html = &GetHistoryLine($id, $Page{'text_default'}, $canEdit, $row++);
|
|
&OpenKeptRevisions('text_default');
|
|
foreach (reverse sort {$a <=> $b} keys %KeptRevisions) {
|
|
next if ($_ eq ""); # (needed?)
|
|
$html .= &GetHistoryLine($id, $KeptRevisions{$_}, $canEdit, $row++);
|
|
}
|
|
print $html;
|
|
if ($UseDiff) {
|
|
my $label = T('Compare');
|
|
print "<tr><td align='center'><input type='submit' "
|
|
. "value='$label'/> </td></table></form>\n";
|
|
print "<hr class=wikilinediff>\n";
|
|
print &GetDiffHTML(&GetParam('defaultdiff', 1), $id, '', '', $newText);
|
|
}
|
|
print &GetCommonFooter();
|
|
}
|
|
|
|
sub GetMaskedHost {
|
|
my ($text) = @_;
|
|
my ($logText);
|
|
|
|
if (!$MaskHosts) {
|
|
return $text;
|
|
}
|
|
$logText = T('(logged)');
|
|
if (!($text =~ s/\d+$/$logText/)) { # IP address (ending numbers masked)
|
|
$text =~ s/^[^\.\(]+/$logText/; # Host name: mask until first .
|
|
}
|
|
return $text;
|
|
}
|
|
|
|
sub GetHistoryLine {
|
|
my ($id, $section, $canEdit, $row) = @_;
|
|
my ($html, $expirets, $rev, $summary, $host, $user, $uid, $ts, $minor);
|
|
my (%sect, %revtext);
|
|
|
|
%sect = split(/$FS2/, $section, -1);
|
|
%revtext = split(/$FS3/, $sect{'data'});
|
|
$rev = $sect{'revision'};
|
|
$summary = $revtext{'summary'};
|
|
if ((defined($sect{'host'})) && ($sect{'host'} ne '')) {
|
|
$host = $sect{'host'};
|
|
} else {
|
|
$host = $sect{'ip'};
|
|
}
|
|
$host = &GetMaskedHost($host);
|
|
$user = $sect{'username'};
|
|
$uid = $sect{'id'};
|
|
$ts = $sect{'ts'};
|
|
$minor = '';
|
|
$minor = '<i>' . T('(edit)') . '</i> ' if ($revtext{'minor'});
|
|
$expirets = $Now - ($KeepDays * 24 * 60 * 60);
|
|
$html = '';
|
|
if ($UseDiff) {
|
|
my ($c1, $c2) = ('', '');
|
|
$c1 = 'checked="checked"' if 1 == $row;
|
|
$c2 = 'checked="checked"' if 0 == $row;
|
|
$html .= "<tr><td align='center'><input type='radio' "
|
|
. "name='diffrevision' value='$rev' $c1/> ";
|
|
$html .= "<input type='radio' name='revision' value='$rev' $c2/></td><td>";
|
|
}
|
|
if (0 == $row) { # current revision
|
|
$html .= &GetPageLinkText($id, Ts('Revision %s', $rev)) . ' ';
|
|
if ($canEdit) {
|
|
$html .= &GetEditLink($id, T('Edit')) . ' ';
|
|
}
|
|
} else {
|
|
$html .= &GetOldPageLink('browse', $id, $rev,
|
|
Ts('Revision %s', $rev)) . ' ';
|
|
if ($canEdit) {
|
|
$html .= &GetOldPageLink('edit', $id, $rev, T('Edit')) . ' ';
|
|
}
|
|
}
|
|
$html .= ". . " . $minor . &TimeToText($ts) . " ";
|
|
$html .= T('by') . ' ' . &GetAuthorLink($host, $user, $uid) . " ";
|
|
if (defined($summary) && ($summary ne "") && ($summary ne "*")) {
|
|
$summary = &QuoteHtml($summary); # Thanks Sunir! :-)
|
|
$html .= "<b>[$summary]</b> ";
|
|
}
|
|
$html .= $UseDiff ? "</tr>\n" : "<br>\n";
|
|
return $html;
|
|
}
|
|
|
|
# ==== HTML and page-oriented functions ====
|
|
sub ScriptLinkChar {
|
|
if ($SlashLinks) {
|
|
return '/';
|
|
}
|
|
return '?';
|
|
}
|
|
|
|
sub ScriptLink {
|
|
my ($action, $text) = @_;
|
|
|
|
return '<a href="' . $ScriptName . &ScriptLinkChar() . &UriEscape($action)
|
|
. "\">$text</a>";
|
|
}
|
|
|
|
sub ScriptLinkClass {
|
|
my ($action, $text, $class) = @_;
|
|
|
|
return '<a href="' . $ScriptName . &ScriptLinkChar() . &UriEscape($action)
|
|
. '" class="' . $class . "\">$text</a>";
|
|
}
|
|
|
|
sub GetPageLinkText {
|
|
my ($id, $name) = @_;
|
|
|
|
$id =~ s|^/|$MainPage/|;
|
|
if ($FreeLinks) {
|
|
$id = &FreeToNormal($id);
|
|
$name =~ s/_/ /g;
|
|
}
|
|
return &ScriptLinkClass($id, $name, 'wikipagelink');
|
|
}
|
|
|
|
sub GetPageLink {
|
|
my ($id) = @_;
|
|
|
|
return &GetPageLinkText($id, $id);
|
|
}
|
|
|
|
sub GetEditLink {
|
|
my ($id, $name) = @_;
|
|
|
|
if ($FreeLinks) {
|
|
$id = &FreeToNormal($id);
|
|
$name =~ s/_/ /g;
|
|
}
|
|
return &ScriptLinkClass("action=edit&id=$id", $name, 'wikipageedit');
|
|
}
|
|
|
|
sub GetDeleteLink {
|
|
my ($id, $name, $confirm) = @_;
|
|
|
|
if ($FreeLinks) {
|
|
$id = &FreeToNormal($id);
|
|
$name =~ s/_/ /g;
|
|
}
|
|
return &ScriptLink("action=delete&id=$id&confirm=$confirm", $name);
|
|
}
|
|
|
|
sub GetOldPageParameters {
|
|
my ($kind, $id, $revision) = @_;
|
|
|
|
$id = &FreeToNormal($id) if $FreeLinks;
|
|
return "action=$kind&id=$id&revision=$revision";
|
|
}
|
|
|
|
sub GetOldPageLink {
|
|
my ($kind, $id, $revision, $name) = @_;
|
|
|
|
$name =~ s/_/ /g if $FreeLinks;
|
|
return &ScriptLink(&GetOldPageParameters($kind, $id, $revision), $name);
|
|
}
|
|
|
|
sub GetPageOrEditAnchoredLink {
|
|
my ($id, $anchor, $name) = @_;
|
|
my (@temp, $exists);
|
|
|
|
if ($name eq "") {
|
|
$name = $id;
|
|
if ($FreeLinks) {
|
|
$name =~ s/_/ /g;
|
|
}
|
|
}
|
|
$id =~ s|^/|$MainPage/|;
|
|
if ($FreeLinks) {
|
|
$id = &FreeToNormal($id);
|
|
}
|
|
$exists = 0;
|
|
if ($UseIndex) {
|
|
if (!$IndexInit) {
|
|
@temp = &AllPagesList(); # Also initializes hash
|
|
}
|
|
$exists = 1 if ($IndexHash{$id});
|
|
} elsif (-f &GetPageFile($id)) { # Page file exists
|
|
$exists = 1;
|
|
}
|
|
if ($exists) {
|
|
$id = "$id#$anchor" if $anchor;
|
|
$name = "$name#$anchor" if $anchor && $NamedAnchors != 2;
|
|
return &GetPageLinkText($id, $name);
|
|
}
|
|
if ($FreeLinks && !$EditNameLink) {
|
|
if ($name =~ m| |) { # Not a single word
|
|
$name = "[$name]"; # Add brackets so boundaries are obvious
|
|
}
|
|
}
|
|
if ($EditNameLink) {
|
|
return &GetEditLink($id, $name);
|
|
} else {
|
|
return $name . &GetEditLink($id, '?');
|
|
}
|
|
}
|
|
|
|
sub GetPageOrEditLink {
|
|
my ($id, $name) = @_;
|
|
return &GetPageOrEditAnchoredLink($id, "", $name);
|
|
}
|
|
|
|
sub GetBackLinksSearchLink {
|
|
my ($id) = @_;
|
|
my $name = $id;
|
|
|
|
$id =~ s|.+/|/|; # Subpage match: search for just /SubName
|
|
if ($FreeLinks) {
|
|
$name =~ s/_/ /g; # Display with spaces
|
|
$id =~ s/_/+/g; # Search for url-escaped spaces
|
|
}
|
|
return &ScriptLink("back=$id", $name);
|
|
}
|
|
|
|
sub GetPrefsLink {
|
|
return &ScriptLink("action=editprefs", T('Preferences'));
|
|
}
|
|
|
|
sub GetRandomLink {
|
|
return &ScriptLink("action=random", T('Random Page'));
|
|
}
|
|
|
|
sub ScriptLinkDiff {
|
|
my ($diff, $id, $text, $rev) = @_;
|
|
|
|
$rev = "&revision=$rev" if ($rev ne "");
|
|
$diff = &GetParam("defaultdiff", 1) if ($diff == 4);
|
|
return &ScriptLink("action=browse&diff=$diff&id=$id$rev", $text);
|
|
}
|
|
|
|
sub ScriptLinkDiffRevision {
|
|
my ($diff, $id, $rev, $text) = @_;
|
|
|
|
$rev = "&diffrevision=$rev" if ($rev ne "");
|
|
$diff = &GetParam("defaultdiff", 1) if ($diff == 4);
|
|
return &ScriptLink("action=browse&diff=$diff&id=$id$rev", $text);
|
|
}
|
|
|
|
sub GetUploadLink {
|
|
return &ScriptLink('action=upload', T('Upload'));
|
|
}
|
|
|
|
sub ScriptLinkTitle {
|
|
my ($action, $text, $title) = @_;
|
|
|
|
if ($FreeLinks) {
|
|
$action =~ s/ /_/g;
|
|
}
|
|
return '<a href="' . $ScriptName . &ScriptLinkChar() . &UriEscape($action)
|
|
. "\" title=\"$title\">$text</a>";
|
|
}
|
|
|
|
sub GetAuthorLink {
|
|
my ($host, $userName, $uid) = @_;
|
|
my ($html, $title, $userNameShow);
|
|
|
|
$userNameShow = $userName;
|
|
if ($FreeLinks) {
|
|
$userName =~ s/ /_/g;
|
|
$userNameShow =~ s/_/ /g;
|
|
}
|
|
if (&ValidId($userName) ne "") { # Invalid under current rules
|
|
$userName = ""; # Just pretend it isn't there.
|
|
}
|
|
if (($uid > 0) && ($userName ne "")) {
|
|
$html = &ScriptLinkTitle($userName, $userNameShow,
|
|
Ts('ID %s', $uid) . ' ' . Ts('from %s', $host));
|
|
} else {
|
|
$html = $host;
|
|
}
|
|
return $html;
|
|
}
|
|
|
|
sub GetHistoryLink {
|
|
my ($id, $text) = @_;
|
|
|
|
if ($FreeLinks) {
|
|
$id =~ s/ /_/g;
|
|
}
|
|
return &ScriptLink("action=history&id=$id", $text);
|
|
}
|
|
|
|
sub GetHeader {
|
|
my ($id, $title, $oldId, $backlinks) = @_;
|
|
my $header = "";
|
|
my $logoImage = "";
|
|
my $result = "";
|
|
my $embed = &GetParam('embed', $EmbedWiki);
|
|
my $altText = T('[Home]');
|
|
|
|
$result = &GetHttpHeader('');
|
|
if ($FreeLinks) {
|
|
$title =~ s/_/ /g; # Display as spaces
|
|
}
|
|
$result .= &GetHtmlHeader("$SiteName: $title", $id);
|
|
return $result if ($embed);
|
|
|
|
$result .= '<div class=wikiheader>';
|
|
if ($oldId ne '') {
|
|
$result .= $q->h3('(' . Ts('redirected from %s',
|
|
&GetEditLink($oldId, &QuoteHtml($oldId)), 1) . ')');
|
|
}
|
|
if ((!$embed) && ($LogoUrl ne "")) {
|
|
$logoImage = "img src=\"$LogoUrl\" alt=\"$altText\" border=0";
|
|
if (!$LogoLeft) {
|
|
$logoImage .= " align=\"right\"";
|
|
}
|
|
$header = &ScriptLink($HomePage, "<$logoImage>");
|
|
}
|
|
if (($id ne '') and $backlinks) {
|
|
$result .= $q->h1($header . &GetBackLinksSearchLink($id));
|
|
} else {
|
|
$result .= $q->h1($header . $title);
|
|
}
|
|
if (&GetParam("toplinkbar", 1)) {
|
|
$result .= &GetGotoBar($id) . "<hr class=wikilineheader>";
|
|
}
|
|
$result .= '</div>';
|
|
return $result;
|
|
}
|
|
|
|
sub GetHttpHeader {
|
|
my ($type) = @_;
|
|
my $cookie;
|
|
|
|
$type = 'text/html' if ($type eq '');
|
|
if (defined($SetCookie{'id'})) {
|
|
$cookie = $q->cookie(
|
|
-name => $CookieName,
|
|
-value => { rev => $SetCookie{'rev'},
|
|
id => $SetCookie{'id'},
|
|
randkey => $SetCookie{'randkey'} },
|
|
-expires => '+3y');
|
|
if ($HttpCharset ne '') {
|
|
return $q->header(-cookie=>$cookie,
|
|
-type=>"$type; charset=$HttpCharset");
|
|
}
|
|
return $q->header(-cookie=>$cookie);
|
|
}
|
|
if ($HttpCharset ne '') {
|
|
return $q->header(-type=>"$type; charset=$HttpCharset");
|
|
}
|
|
return $q->header(-type=>$type);
|
|
}
|
|
|
|
sub GetHtmlHeader {
|
|
my ($title, $id) = @_;
|
|
my ($dtd, $html, $bodyExtra, $stylesheet);
|
|
|
|
$html = '';
|
|
$dtd = '-//IETF//DTD HTML//EN';
|
|
$html = qq(<!DOCTYPE HTML PUBLIC "$dtd">\n);
|
|
$title = $q->escapeHTML($title);
|
|
$html .= "<HTML><HEAD><TITLE>$title</TITLE>\n";
|
|
if ($FavIcon ne '') {
|
|
$html .= '<LINK REL="SHORTCUT ICON" HREF="' . $FavIcon . '">'
|
|
}
|
|
if ($MetaKeywords) {
|
|
my $keywords = $OpenPageName;
|
|
$keywords =~ s/([a-z])([A-Z])/$1, $2/g;
|
|
$html .= "<META NAME='KEYWORDS' CONTENT='$keywords'/>\n" if $keywords;
|
|
}
|
|
# we don't want robots indexing our history or other admin pages
|
|
my $action = lc(&GetParam('action', ''));
|
|
unless (!$action or $action eq "rc" or $action eq "index") {
|
|
$html .= "<META NAME='robots' CONTENT='noindex,nofollow'>\n";
|
|
}
|
|
if ($SiteBase ne "") {
|
|
$html .= qq(<BASE HREF="$SiteBase">\n);
|
|
}
|
|
unless ($action) {
|
|
$html .= qq(<link rel="alternate" title="$SiteName RSS" href=")
|
|
. $ScriptName . &ScriptLinkChar() . &UriEscape("action=rss&days=$RssDays")
|
|
. qq(" type="application/rss+xml">\n);
|
|
}
|
|
$stylesheet = &GetParam('stylesheet', $StyleSheet);
|
|
$stylesheet = $StyleSheet if ($stylesheet eq '');
|
|
$stylesheet = '' if ($stylesheet eq '*'); # Allow removing override
|
|
if ($stylesheet ne '') {
|
|
$html .= qq(<LINK REL="stylesheet" HREF="$stylesheet">\n);
|
|
}
|
|
$html .= $UserHeader;
|
|
$bodyExtra = '';
|
|
if ($UserBody ne '') {
|
|
$bodyExtra = ' ' . $UserBody;
|
|
}
|
|
if ($BGColor ne '') {
|
|
$bodyExtra .= qq( BGCOLOR="$BGColor");
|
|
}
|
|
$html .= "</HEAD><BODY$bodyExtra>\n";
|
|
return $html;
|
|
}
|
|
|
|
sub GetFooterText {
|
|
my ($id, $rev) = @_;
|
|
my $result;
|
|
|
|
if (&GetParam('embed', $EmbedWiki)) {
|
|
return $q->end_html;
|
|
}
|
|
$result = '<div class=wikifooter>';
|
|
$result .= "<hr class=wikilinefooter>\n";
|
|
$result .= &GetFormStart();
|
|
$result .= &GetGotoBar($id);
|
|
if (&UserCanEdit($id, 0)) {
|
|
if ($rev ne '') {
|
|
$result .= &GetOldPageLink('edit', $id, $rev,
|
|
Ts('Edit revision %s of this page', $rev));
|
|
} else {
|
|
$result .= &GetEditLink($id, T('Edit text of this page'));
|
|
}
|
|
} else {
|
|
$result .= T('This page is read-only');
|
|
}
|
|
$result .= ' | ';
|
|
$result .= &GetHistoryLink($id, T('View other revisions'));
|
|
if ($rev ne '') {
|
|
$result .= ' | ';
|
|
$result .= &GetPageLinkText($id, T('View current revision'));
|
|
}
|
|
if ($UseMetaWiki) {
|
|
$result .= ' | <a href="http://sunir.org/apps/meta.pl?' . &UriEscape($id) . '">'
|
|
. T('Search MetaWiki') . '</a>';
|
|
}
|
|
if ($Section{'revision'} > 0) {
|
|
$result .= '<br>';
|
|
if ($rev eq '') { # Only for most current rev
|
|
$result .= T('Last edited');
|
|
} else {
|
|
$result .= T('Edited');
|
|
}
|
|
$result .= ' ' . &TimeToText($Section{ts});
|
|
if ($AuthorFooter) {
|
|
$result .= ' ' . Ts('by %s', &GetAuthorLink($Section{'host'},
|
|
$Section{'username'}, $Section{'id'}), 1);
|
|
}
|
|
}
|
|
if ($UseDiff) {
|
|
$result .= ' ' . &ScriptLinkDiff(4, $id, T('(diff)'), $rev);
|
|
}
|
|
$result .= '<br>' . &GetSearchForm();
|
|
if ($AdminBar && &UserIsAdmin()) {
|
|
$result .= '<br>' . &GetAdminBar($id);
|
|
}
|
|
if ($DataDir =~ m|/tmp/|) {
|
|
$result .= '<br><b>' . T('Warning') . ':</b> '
|
|
. Ts('Database is stored in temporary directory %s',
|
|
$DataDir) . '<br>';
|
|
}
|
|
if ($ConfigError) {
|
|
$result .= '<br><b>' . T('Config file error:') . '</b> '
|
|
. $ConfigError . '<br>';
|
|
}
|
|
$result .= $q->end_form;
|
|
if ($FooterNote ne '') {
|
|
$result .= T($FooterNote);
|
|
}
|
|
$result .= '</div>';
|
|
$result .= &GetMinimumFooter();
|
|
return $result;
|
|
}
|
|
|
|
sub GetCommonFooter {
|
|
my ($html);
|
|
|
|
$html = '<div class=wikifooter>' . '<hr class=wikilinefooter>'
|
|
. &GetFormStart() . &GetGotoBar('')
|
|
. &GetSearchForm() . $q->end_form;
|
|
if ($FooterNote ne '') {
|
|
$html .= T($FooterNote);
|
|
}
|
|
$html .= '</div>' . $q->end_html;
|
|
return $html;
|
|
}
|
|
|
|
sub GetMinimumFooter {
|
|
return $q->end_html;
|
|
}
|
|
|
|
sub GetFormStart {
|
|
return $q->start_form("POST", "$ScriptName",
|
|
"application/x-www-form-urlencoded");
|
|
}
|
|
|
|
sub GetGotoBar {
|
|
my ($id) = @_;
|
|
my ($main, $bartext);
|
|
|
|
$bartext = &GetPageLink($HomePage);
|
|
if ($id =~ m|/|) {
|
|
$main = $id;
|
|
$main =~ s|/.*||; # Only the main page name (remove subpage)
|
|
$bartext .= " | " . &GetPageLink($main);
|
|
}
|
|
$bartext .= " | " . &GetPageLink($RCName);
|
|
$bartext .= " | " . &GetPrefsLink();
|
|
if ($UseUpload && &UserCanUpload()) {
|
|
$bartext .= " | " . &GetUploadLink();
|
|
}
|
|
if (&GetParam("linkrandom", 0)) {
|
|
$bartext .= " | " . &GetRandomLink();
|
|
}
|
|
if ($UserGotoBar ne '') {
|
|
$bartext .= " | " . $UserGotoBar;
|
|
}
|
|
$bartext .= "<br>\n";
|
|
return $bartext;
|
|
}
|
|
|
|
# Admin bar contributed by ElMoro (with some changes)
|
|
sub GetPageLockLink {
|
|
my ($id, $status, $name) = @_;
|
|
|
|
if ($FreeLinks) {
|
|
$id = &FreeToNormal($id);
|
|
}
|
|
return &ScriptLink("action=pagelock&set=$status&id=$id", $name);
|
|
}
|
|
|
|
sub GetAdminBar {
|
|
my ($id) = @_;
|
|
my ($result);
|
|
|
|
$result = T('Administration') . ': ';
|
|
if (-f &GetLockedPageFile($id)) {
|
|
$result .= &GetPageLockLink($id, 0, T('Unlock page'));
|
|
}
|
|
else {
|
|
$result .= &GetPageLockLink($id, 1, T('Lock page'));
|
|
}
|
|
$result .= " | " . &GetDeleteLink($id, T('Delete this page'), 0);
|
|
$result .= " | " . &ScriptLink("action=editbanned", T("Edit Banned List"));
|
|
$result .= " | " . &ScriptLink("action=maintain", T("Run Maintenance"));
|
|
$result .= " | " . &ScriptLink("action=editlinks", T("Edit/Rename pages"));
|
|
if (-f "$DataDir/noedit") {
|
|
$result .= " | " . &ScriptLink("action=editlock&set=0", T("Unlock site"));
|
|
} else {
|
|
$result .= " | " . &ScriptLink("action=editlock&set=1", T("Lock site"));
|
|
}
|
|
return $result;
|
|
}
|
|
|
|
sub GetSearchForm {
|
|
my ($result);
|
|
|
|
$result = T('Search:') . ' ' . $q->textfield(-name=>'search', -size=>20);
|
|
if ($SearchButton) {
|
|
$result .= $q->submit('dosearch', T('Go!'));
|
|
} else {
|
|
$result .= &GetHiddenValue("dosearch", 1);
|
|
}
|
|
return $result;
|
|
}
|
|
|
|
sub GetRedirectPage {
|
|
my ($newid, $name, $isEdit) = @_;
|
|
my ($url, $html);
|
|
my ($nameLink);
|
|
|
|
# Normally get URL from script, but allow override.
|
|
$FullUrl = $q->url(-full=>1) if ($FullUrl eq "");
|
|
$url = $FullUrl . &ScriptLinkChar() . &UriEscape($newid);
|
|
$nameLink = "<a href=\"$url\">$name</a>";
|
|
if ($RedirType < 3) {
|
|
if ($RedirType == 1) { # Use CGI.pm
|
|
# NOTE: do NOT use -method (does not work with old CGI.pm versions)
|
|
# Thanks to Daniel Neri for fixing this problem.
|
|
$html = $q->redirect(-uri=>$url);
|
|
} else { # Minimal header
|
|
$html = "Status: 302 Moved\n";
|
|
$html .= "Location: $url\n";
|
|
$html .= "Content-Type: text/html\n"; # Needed for browser failure
|
|
$html .= "\n";
|
|
}
|
|
$html .= "\n" . Ts('Your browser should go to the %s page.', $newid);
|
|
$html .= ' ' . Ts('If it does not, click %s to continue.', $nameLink);
|
|
} else {
|
|
if ($isEdit) {
|
|
$html = &GetHeader('', T('Thanks for editing...'), '');
|
|
$html .= Ts('Thank you for editing %s.', $nameLink);
|
|
} else {
|
|
$html = &GetHeader('', T('Link to another page...'), '');
|
|
}
|
|
$html .= "\n<p>";
|
|
$html .= Ts('Follow the %s link to continue.', $nameLink);
|
|
$html .= &GetMinimumFooter();
|
|
}
|
|
return $html;
|
|
}
|
|
|
|
# ==== Common wiki markup ====
|
|
sub RestoreSavedText {
|
|
my ($text) = @_;
|
|
|
|
1 while $text =~ s/$FS(\d+)$FS/$SaveUrl{$1}/ge; # Restore saved text
|
|
return $text;
|
|
}
|
|
|
|
sub RemoveFS {
|
|
my ($text) = @_;
|
|
|
|
# Note: must remove all $FS, and $FS may be multi-byte/char separator
|
|
$text =~ s/($FS)+(\d)/$2/g;
|
|
return $text;
|
|
}
|
|
|
|
sub WikiToHTML {
|
|
my ($pageText) = @_;
|
|
$TableMode = 0;
|
|
|
|
%SaveUrl = ();
|
|
%SaveNumUrl = ();
|
|
$SaveUrlIndex = 0;
|
|
$SaveNumUrlIndex = 0;
|
|
$pageText = &RemoveFS($pageText);
|
|
if ($RawHtml) {
|
|
$pageText =~ s/<html>((.|\n)*?)<\/html>/&StoreRaw($1)/ige;
|
|
}
|
|
$pageText = &QuoteHtml($pageText);
|
|
$pageText =~ s/\\ *\r?\n/ /g; # Join lines with backslash at end
|
|
if ($ParseParas) {
|
|
# Note: The following 3 rules may span paragraphs, so they are
|
|
# copied from CommonMarkup
|
|
$pageText =~
|
|
s/\<nowiki\>((.|\n)*?)\<\/nowiki\>/&StoreRaw($1)/ige;
|
|
$pageText =~
|
|
s/\<pre\>((.|\n)*?)\<\/pre\>/&StorePre($1, "pre")/ige;
|
|
$pageText =~
|
|
s/\<code\>((.|\n)*?)\<\/code\>/&StorePre($1, "code")/ige;
|
|
$pageText =~ s/((.|\n)+?\n)\s*(\n|$)/&ParseParagraph($1)/geo;
|
|
$pageText =~ s/(.*)<\/p>(.+)$/$1.&ParseParagraph($2)/seo;
|
|
} else {
|
|
$pageText = &CommonMarkup($pageText, 1, 0); # Multi-line markup
|
|
$pageText = &WikiLinesToHtml($pageText); # Line-oriented markup
|
|
}
|
|
$TableOfContents ||= '';
|
|
while (@HeadingNumbers) {
|
|
pop @HeadingNumbers;
|
|
$TableOfContents .= "</dd></dl>\n\n";
|
|
}
|
|
$pageText =~ s/<toc>/$TableOfContents/gi;
|
|
if ($LateRules ne '') {
|
|
$pageText = &EvalLocalRules($LateRules, $pageText, 0);
|
|
}
|
|
return &RestoreSavedText($pageText);
|
|
}
|
|
|
|
sub CommonMarkup {
|
|
my ($text, $useImage, $doLines) = @_;
|
|
local $_ = $text;
|
|
|
|
if ($doLines < 2) { # 2 = do line-oriented only
|
|
# The <nowiki> tag stores text with no markup (except quoting HTML)
|
|
s/\<nowiki\>((.|\n)*?)\<\/nowiki\>/&StoreRaw($1)/ige;
|
|
# The <pre> tag wraps the stored text with the HTML <pre> tag
|
|
s/\<pre\>((.|\n)*?)\<\/pre\>/&StorePre($1, "pre")/ige;
|
|
s/\<code\>((.|\n)*?)\<\/code\>/&StorePre($1, "code")/ige;
|
|
if ($EarlyRules ne '') {
|
|
$_ = &EvalLocalRules($EarlyRules, $_, !$useImage);
|
|
}
|
|
s/\[\#(\w+)\]/&StoreHref(" name=\"$1\"")/ge if $NamedAnchors;
|
|
if ($HtmlTags) {
|
|
my ($t);
|
|
foreach $t (@HtmlPairs) {
|
|
s/\<$t(\s[^<>]+?)?\>(.*?)\<\/$t\>/<$t$1>$2<\/$t>/gis;
|
|
}
|
|
foreach $t (@HtmlSingle) {
|
|
s/\<$t(\s[^<>]+?)?\>/<$t$1>/gi;
|
|
}
|
|
} else {
|
|
# Note that these tags are restricted to a single line
|
|
s/\<b\>(.*?)\<\/b\>/<b>$1<\/b>/gi;
|
|
s/\<i\>(.*?)\<\/i\>/<i>$1<\/i>/gi;
|
|
s/\<strong\>(.*?)\<\/strong\>/<strong>$1<\/strong>/gi;
|
|
s/\<em\>(.*?)\<\/em\>/<em>$1<\/em>/gi;
|
|
}
|
|
s/\<tt\>(.*?)\<\/tt\>/<tt>$1<\/tt>/gis; # <tt> (MeatBall)
|
|
s/\<br\>/<br>/gi; # Allow simple line break anywhere
|
|
if ($HtmlLinks) {
|
|
s/\<A(\s[^<>]+?)\>(.*?)\<\/a\>/&StoreHref($1, $2)/gise;
|
|
}
|
|
if ($FreeLinks) {
|
|
# Consider: should local free-link descriptions be conditional?
|
|
# Also, consider that one could write [[Bad Page|Good Page]]?
|
|
s/\[\[$FreeLinkPattern\|([^\]]+)\]\]/&StorePageOrEditLink($1, $2)/geo;
|
|
s/\[\[$FreeLinkPattern\]\]/&StorePageOrEditLink($1, "")/geo;
|
|
}
|
|
if ($BracketText) { # Links like [URL text of link]
|
|
s/\[$UrlPattern\s+([^\]]+?)\]/&StoreBracketUrl($1, $2, $useImage)/geos;
|
|
s/\[$InterLinkPattern\s+([^\]]+?)\]/&StoreBracketInterPage($1, $2,
|
|
$useImage)/geos;
|
|
if ($WikiLinks && $BracketWiki) { # Local bracket-links
|
|
s/\[$LinkPattern\s+([^\]]+?)\]/&StoreBracketLink($1, $2)/geos;
|
|
s/\[$AnchoredLinkPattern\s+([^\]]+?)\]/&StoreBracketAnchoredLink($1,
|
|
$2, $3)/geos if $NamedAnchors;
|
|
}
|
|
}
|
|
s/\[$UrlPattern\]/&StoreBracketUrl($1, "", 0)/geo;
|
|
s/\[$InterLinkPattern\]/&StoreBracketInterPage($1, "", 0)/geo;
|
|
s/\b$UrlPattern/&StoreUrl($1, $useImage)/geo;
|
|
s/\b$InterLinkPattern/&StoreInterPage($1, $useImage)/geo;
|
|
if ($UseUpload) {
|
|
s/$UploadPattern/&StoreUpload($1)/geo;
|
|
}
|
|
if ($WikiLinks) {
|
|
s/$AnchoredLinkPattern/&StoreRaw(&GetPageOrEditAnchoredLink($1,
|
|
$2, ""))/geo if $NamedAnchors;
|
|
# CAA: Putting \b in front of $LinkPattern breaks /SubPage links
|
|
# (subpage links without the main page)
|
|
s/$LinkPattern/&GetPageOrEditLink($1, "")/geo;
|
|
}
|
|
s/\b$RFCPattern/&StoreRFC($1)/geo;
|
|
s/\b$ISBNPattern/&StoreISBN($1)/geo;
|
|
if ($ThinLine) {
|
|
if ($OldThinLine) { # Backwards compatible, conflicts with headers
|
|
s/====+/<hr noshade class=wikiline size=2>/g;
|
|
} else { # New behavior--no conflict
|
|
s/------+/<hr noshade class=wikiline size=2>/g;
|
|
}
|
|
s/----+/<hr noshade class=wikiline size=1>/g;
|
|
} else {
|
|
s/----+/<hr class=wikiline>/g;
|
|
}
|
|
}
|
|
if ($doLines) { # 0 = no line-oriented, 1 or 2 = do line-oriented
|
|
# The quote markup patterns avoid overlapping tags (with 5 quotes)
|
|
# by matching the inner quotes for the strong pattern.
|
|
s/('*)'''(.*?)'''/$1<strong>$2<\/strong>/g;
|
|
s/''(.*?)''/<em>$1<\/em>/g;
|
|
if ($UseHeadings) {
|
|
s/(^|\n)\s*(\=+)\s+([^\n]+)\s+\=+/&WikiHeading($1, $2, $3)/geo;
|
|
}
|
|
if ($TableMode) {
|
|
s/((\|\|)+)/"<\/TD><TD COLSPAN=\"" . (length($1)\/2) . "\">"/ge;
|
|
}
|
|
}
|
|
return $_;
|
|
}
|
|
|
|
sub EmptyCellsToNbsp {
|
|
my ($row) = @_;
|
|
|
|
$row =~ s/(?<=\|\|)\s+(?=\|\|)/ /g;
|
|
$row =~ s/^\s+(?=\|\|)/ /;
|
|
$row =~ s/(?<=\|\|)\s+$/ /;
|
|
return $row;
|
|
}
|
|
|
|
sub WikiLinesToHtml {
|
|
my ($pageText) = @_;
|
|
my ($pageHtml, @htmlStack, $code, $codeAttributes, $depth, $oldCode);
|
|
|
|
@htmlStack = ();
|
|
$depth = 0;
|
|
$pageHtml = "";
|
|
foreach (split(/\n/, $pageText)) { # Process lines one-at-a-time
|
|
$code = '';
|
|
$codeAttributes = '';
|
|
$TableMode = 0;
|
|
$_ .= "\n";
|
|
if (s/^(\;+)([^:]+\:?)\:/<dt>$2<dd>/) {
|
|
$code = "DL";
|
|
$depth = length $1;
|
|
} elsif (s/^(\:+)/<dt><dd>/) {
|
|
$code = "DL";
|
|
$depth = length $1;
|
|
} elsif (s/^(\*+)/<li>/) {
|
|
$code = "UL";
|
|
$depth = length $1;
|
|
} elsif (s/^(\#+)/<li>/) {
|
|
$code = "OL";
|
|
$depth = length $1;
|
|
} elsif ($TableSyntax &&
|
|
s/^((\|\|)+)(.*)\|\|\s*$/"<TR VALIGN='CENTER' "
|
|
. "ALIGN='CENTER'><TD colspan='"
|
|
. (length($1)\/2) . "'>" . EmptyCellsToNbsp($3) . "<\/TD><\/TR>\n"/e) {
|
|
$code = 'TABLE';
|
|
$codeAttributes = "BORDER='1'";
|
|
$TableMode = 1;
|
|
$depth = 1;
|
|
} elsif (/^[ \t].*\S/) {
|
|
$code = "PRE";
|
|
$depth = 1;
|
|
} else {
|
|
$depth = 0;
|
|
}
|
|
while (@htmlStack > $depth) { # Close tags as needed
|
|
$pageHtml .= "</" . pop(@htmlStack) . ">\n";
|
|
}
|
|
if ($depth > 0) {
|
|
$depth = $IndentLimit if ($depth > $IndentLimit);
|
|
if (@htmlStack) { # Non-empty stack
|
|
$oldCode = pop(@htmlStack);
|
|
if ($oldCode ne $code) {
|
|
$pageHtml .= "</$oldCode><$code>\n";
|
|
}
|
|
push(@htmlStack, $code);
|
|
}
|
|
while (@htmlStack < $depth) {
|
|
push(@htmlStack, $code);
|
|
$pageHtml .= "<$code $codeAttributes>\n";
|
|
}
|
|
}
|
|
if (!$ParseParas) {
|
|
s/^\s*$/<p>\n/; # Blank lines become <p> tags
|
|
}
|
|
$pageHtml .= &CommonMarkup($_, 1, 2); # Line-oriented common markup
|
|
}
|
|
while (@htmlStack > 0) { # Clear stack
|
|
$pageHtml .= "</" . pop(@htmlStack) . ">\n";
|
|
}
|
|
return $pageHtml;
|
|
}
|
|
|
|
sub EvalLocalRules {
|
|
my ($rules, $origText, $isDiff) = @_;
|
|
my ($text, $reportError, $errorText);
|
|
|
|
$text = $origText;
|
|
$reportError = 1;
|
|
# Basic idea: the $rules should change $text, possibly with different
|
|
# behavior if $isDiff is true (no images or color changes?)
|
|
# Note: for fun, the $rules could also change $reportError and $origText
|
|
if (!eval $rules) {
|
|
$errorText = $@;
|
|
if ($errorText eq '') {
|
|
# Search for "Unknown Error" for the reason the next line is commented
|
|
# $errorText = T('Unknown Error (no error text)');
|
|
}
|
|
if ($errorText ne '') {
|
|
$text = $origText; # Consider: should partial results be kept?
|
|
if ($reportError) {
|
|
$text .= '<hr><b>' . T('Local rule error:') . '</b><br>'
|
|
. &QuoteHtml($errorText);
|
|
}
|
|
}
|
|
}
|
|
return $text;
|
|
}
|
|
|
|
sub UriEscape {
|
|
my ($uri) = @_;
|
|
$uri =~ s/([^\w\-.!~*'()\/\&=#])/sprintf("%%%02X", ord($1))/ge;
|
|
$uri =~ s/\&/\&/g;
|
|
return $uri;
|
|
}
|
|
|
|
sub ParseParagraph {
|
|
my ($text) = @_;
|
|
|
|
$text = &CommonMarkup($text, 1, 0); # Multi-line markup
|
|
$text = &WikiLinesToHtml($text); # Line-oriented markup
|
|
return "<p>$text</p>\n";
|
|
}
|
|
|
|
sub StoreInterPage {
|
|
my ($id, $useImage) = @_;
|
|
my ($link, $extra);
|
|
|
|
($link, $extra) = &InterPageLink($id, $useImage);
|
|
# Next line ensures no empty links are stored
|
|
$link = &StoreRaw($link) if ($link ne "");
|
|
return $link . $extra;
|
|
}
|
|
|
|
sub InterPageLink {
|
|
my ($id, $useImage) = @_;
|
|
my ($name, $site, $remotePage, $url, $punct);
|
|
|
|
($id, $punct) = &SplitUrlPunct($id);
|
|
$name = $id;
|
|
($site, $remotePage) = split(/:/, $id, 2);
|
|
$url = &GetSiteUrl($site);
|
|
return ("", $id . $punct) if ($url eq "");
|
|
$remotePage =~ s/&/&/g; # Unquote common URL HTML
|
|
$url .= $remotePage;
|
|
return (&UrlLinkOrImage($url, $name, $useImage), $punct);
|
|
}
|
|
|
|
sub StoreBracketInterPage {
|
|
my ($id, $text, $useImage) = @_;
|
|
my ($site, $remotePage, $url, $index);
|
|
|
|
($site, $remotePage) = split(/:/, $id, 2);
|
|
$remotePage =~ s/&/&/g; # Unquote common URL HTML
|
|
$url = &GetSiteUrl($site);
|
|
if ($text ne "") {
|
|
return "[$id $text]" if ($url eq "");
|
|
} else {
|
|
return "[$id]" if ($url eq "");
|
|
$text = &GetBracketUrlIndex($id);
|
|
}
|
|
$url .= $remotePage;
|
|
if ($BracketImg && $useImage && &ImageAllowed($text)) {
|
|
$text = "<img src=\"$text\">";
|
|
} else {
|
|
$text = "[$text]";
|
|
}
|
|
return &StoreRaw("<a href=\"$url\">$text</a>");
|
|
}
|
|
|
|
sub GetBracketUrlIndex {
|
|
my ($id) = @_;
|
|
my ($index, $key);
|
|
|
|
# Consider plain array?
|
|
if ($SaveNumUrl{$id} > 0) {
|
|
return $SaveNumUrl{$id};
|
|
}
|
|
$SaveNumUrlIndex++; # Start with 1
|
|
$SaveNumUrl{$id} = $SaveNumUrlIndex;
|
|
return $SaveNumUrlIndex;
|
|
}
|
|
|
|
sub GetSiteUrl {
|
|
my ($site) = @_;
|
|
my ($data, $status);
|
|
|
|
if (!$InterSiteInit) {
|
|
($status, $data) = &ReadFile($InterFile);
|
|
if ($status) {
|
|
%InterSite = split(/\s+/, $data); # Consider defensive code
|
|
}
|
|
# Check for definitions to allow file to override automatic settings
|
|
if (!defined($InterSite{'LocalWiki'})) {
|
|
$InterSite{'LocalWiki'} = $ScriptName . &ScriptLinkChar();
|
|
}
|
|
if (!defined($InterSite{'Local'})) {
|
|
$InterSite{'Local'} = $ScriptName . &ScriptLinkChar();
|
|
}
|
|
$InterSiteInit = 1; # Init only once per request
|
|
}
|
|
return $InterSite{$site} if (defined($InterSite{$site}));
|
|
return '';
|
|
}
|
|
|
|
sub StoreRaw {
|
|
my ($html) = @_;
|
|
|
|
$SaveUrl{$SaveUrlIndex} = $html;
|
|
return $FS . $SaveUrlIndex++ . $FS;
|
|
}
|
|
|
|
sub StorePre {
|
|
my ($html, $tag) = @_;
|
|
|
|
return &StoreRaw("<$tag>" . $html . "</$tag>");
|
|
}
|
|
|
|
sub StoreHref {
|
|
my ($anchor, $text) = @_;
|
|
|
|
$text ||= '';
|
|
return "<a" . &StoreRaw($anchor) . ">$text</a>";
|
|
}
|
|
|
|
sub StoreUrl {
|
|
my ($name, $useImage) = @_;
|
|
my ($link, $extra);
|
|
|
|
($link, $extra) = &UrlLink($name, $useImage);
|
|
# Next line ensures no empty links are stored
|
|
$link = &StoreRaw($link) if ($link ne "");
|
|
return $link . $extra;
|
|
}
|
|
|
|
sub UrlLink {
|
|
my ($rawname, $useImage) = @_;
|
|
my ($name, $punct);
|
|
|
|
($name, $punct) = &SplitUrlPunct($rawname);
|
|
if ($LimitFileUrl && ($NetworkFile && $name =~ m|^file:|)) {
|
|
# Only do remote file:// links. No file:///c|/windows.
|
|
if ($name =~ m|^file://[^/]|) {
|
|
return ("<a href=\"$name\">$name</a>", $punct);
|
|
}
|
|
return ($rawname, '');
|
|
}
|
|
return (&UrlLinkOrImage($name, $name, $useImage), $punct);
|
|
}
|
|
|
|
sub UrlLinkOrImage {
|
|
my ($url, $name, $useImage) = @_;
|
|
|
|
# Restricted image URLs so that mailto:foo@bar.gif is not an image
|
|
if ($useImage && &ImageAllowed($url)) {
|
|
return "<img src=\"$url\">";
|
|
}
|
|
return "<a href=\"$url\">$name</a>";
|
|
}
|
|
|
|
sub ImageAllowed {
|
|
my ($url) = @_;
|
|
my ($site, $imagePrefixes);
|
|
|
|
$imagePrefixes = 'http:|https:|ftp:';
|
|
$imagePrefixes .= '|file:' if (!$LimitFileUrl);
|
|
return 0 unless ($url =~ /^($imagePrefixes).+\.$ImageExtensions$/i);
|
|
return 0 if ($url =~ /"/); # No HTML-breaking quotes allowed
|
|
return 1 if (@ImageSites < 1); # Most common case: () means all allowed
|
|
return 0 if ($ImageSites[0] eq 'none'); # Special case: none allowed
|
|
foreach $site (@ImageSites) {
|
|
return 1 if ($site eq substr($url, 0, length($site))); # Match prefix
|
|
}
|
|
return 0;
|
|
}
|
|
|
|
sub StoreBracketUrl {
|
|
my ($url, $text, $useImage) = @_;
|
|
|
|
if ($text eq "") {
|
|
$text = &GetBracketUrlIndex($url);
|
|
} elsif ($text =~ /^$InterLinkPattern$/) {
|
|
my @interlink = split(/:/, $text, 2);
|
|
$text = &GetSiteUrl($interlink[0]) . $interlink[1];
|
|
}
|
|
if ($BracketImg && $useImage && &ImageAllowed($text)) {
|
|
$text = "<img src=\"$text\">";
|
|
} else {
|
|
$text = "[$text]";
|
|
}
|
|
return &StoreRaw("<a href=\"$url\">$text</a>");
|
|
}
|
|
|
|
sub StoreBracketLink {
|
|
my ($name, $text) = @_;
|
|
|
|
return &StoreRaw(&GetPageLinkText($name, "[$text]"));
|
|
}
|
|
|
|
sub StoreBracketAnchoredLink {
|
|
my ($name, $anchor, $text) = @_;
|
|
|
|
return &StoreRaw(&GetPageLinkText("$name#$anchor", "[$text]"));
|
|
}
|
|
|
|
sub StorePageOrEditLink {
|
|
my ($page, $name) = @_;
|
|
|
|
if ($FreeLinks) {
|
|
$page =~ s/^\s+//; # Trim extra spaces
|
|
$page =~ s/\s+$//;
|
|
$page =~ s|\s*/\s*|/|; # ...also before/after subpages
|
|
}
|
|
$name =~ s/^\s+//;
|
|
$name =~ s/\s+$//;
|
|
return &StoreRaw(&GetPageOrEditLink($page, $name));
|
|
}
|
|
|
|
sub StoreRFC {
|
|
my ($num) = @_;
|
|
|
|
return &StoreRaw(&RFCLink($num));
|
|
}
|
|
|
|
sub RFCLink {
|
|
my ($num) = @_;
|
|
|
|
return "<a href=\"http://www.faqs.org/rfcs/rfc${num}.html\">RFC $num</a>";
|
|
}
|
|
|
|
sub StoreUpload {
|
|
my ($url) = @_;
|
|
|
|
return &StoreRaw(&UploadLink($url));
|
|
}
|
|
|
|
sub UploadLink {
|
|
my ($filename) = @_;
|
|
my ($html, $url);
|
|
|
|
return $filename if ($UploadUrl eq ''); # No bad links if misconfigured
|
|
$UploadUrl .= '/' if (substr($UploadUrl, -1, 1) ne '/'); # End with /
|
|
$url = $UploadUrl . $filename;
|
|
$html = '<a href="' . $url . '">';
|
|
if (&ImageAllowed($url)) {
|
|
$html .= '<img src="' . $url . '" alt="upload:' . $filename . '">';
|
|
} else {
|
|
$html .= 'upload:' . $filename;
|
|
}
|
|
$html .= '</a>';
|
|
return $html;
|
|
}
|
|
|
|
sub StoreISBN {
|
|
my ($num) = @_;
|
|
|
|
return &StoreRaw(&ISBNLink($num));
|
|
}
|
|
|
|
sub ISBNALink {
|
|
my ($num, $pre, $post, $text) = @_;
|
|
|
|
return '<a href="' . $pre . $num . $post . '">' . $text . '</a>';
|
|
}
|
|
|
|
sub ISBNLink {
|
|
my ($rawnum) = @_;
|
|
my ($rawprint, $html, $num, $numSites, $i);
|
|
|
|
$num = $rawnum;
|
|
$rawprint = $rawnum;
|
|
$rawprint =~ s/ +$//;
|
|
$num =~ s/[- ]//g;
|
|
$numSites = scalar @IsbnNames; # Number of entries
|
|
if ((length($num) != 10) || ($numSites < 1)) {
|
|
return "ISBN $rawnum";
|
|
}
|
|
$html = &ISBNALink($num, $IsbnPre[0], $IsbnPost[0], 'ISBN ' . $rawprint);
|
|
if ($numSites > 1) {
|
|
$html .= ' (';
|
|
$i = 1;
|
|
while ($i < $numSites) {
|
|
$html .= &ISBNALink($num, $IsbnPre[$i], $IsbnPost[$i], $IsbnNames[$i]);
|
|
if ($i < ($numSites - 1)) { # Not the last site
|
|
$html .= ', ';
|
|
}
|
|
$i++;
|
|
}
|
|
$html .= ')';
|
|
}
|
|
$html .= " " if ($rawnum =~ / $/); # Add space if old ISBN had space.
|
|
return $html;
|
|
}
|
|
|
|
sub SplitUrlPunct {
|
|
my ($url) = @_;
|
|
my ($punct);
|
|
|
|
if ($url =~ s/\"\"$//) {
|
|
return ($url, ""); # Delete double-quote delimiters here
|
|
}
|
|
$punct = "";
|
|
if ($NewFS) {
|
|
($punct) = ($url =~ /([^a-zA-Z0-9\/\x80-\xff]+)$/);
|
|
$url =~ s/([^a-zA-Z0-9\/\x80-\xff]+)$//;
|
|
} else {
|
|
($punct) = ($url =~ /([^a-zA-Z0-9\/\xc0-\xff]+)$/);
|
|
$url =~ s/([^a-zA-Z0-9\/\xc0-\xff]+)$//;
|
|
}
|
|
$punct ||= '';
|
|
return ($url, $punct);
|
|
}
|
|
|
|
sub StripUrlPunct {
|
|
my ($url) = @_;
|
|
my ($junk);
|
|
|
|
($url, $junk) = &SplitUrlPunct($url);
|
|
return $url;
|
|
}
|
|
|
|
sub WikiHeadingNumber {
|
|
my ($depth, $text) = @_;
|
|
my ($anchor, $number);
|
|
|
|
return '' unless --$depth > 0; # Don't number H1s because it looks stupid
|
|
while (scalar @HeadingNumbers < ($depth-1)) {
|
|
push @HeadingNumbers, 1;
|
|
$TableOfContents .= '<dl><dt> </dt><dd>';
|
|
}
|
|
if (scalar @HeadingNumbers < $depth) {
|
|
push @HeadingNumbers, 0;
|
|
$TableOfContents .= '<dl><dt> </dt><dd>';
|
|
}
|
|
while (scalar @HeadingNumbers > $depth) {
|
|
pop @HeadingNumbers;
|
|
$TableOfContents .= "</dd></dl>\n\n";
|
|
}
|
|
$HeadingNumbers[$#HeadingNumbers]++;
|
|
$number = (join '.', @HeadingNumbers) . '. ';
|
|
# Remove embedded links. THIS IS FRAGILE!
|
|
$text = &RestoreSavedText($text);
|
|
$text =~ s/\<a\s[^\>]*?\>\?\<\/a\>//si; # No such page syntax
|
|
$text =~ s/\<a\s[^\>]*?\>(.*?)\<\/a\>/$1/si;
|
|
# Cook anchor by canonicalizing $text.
|
|
$anchor = $text;
|
|
$anchor =~ s/\<.*?\>//g;
|
|
$anchor =~ s/\W/_/g;
|
|
$anchor =~ s/__+/_/g;
|
|
$anchor =~ s/^_//;
|
|
$anchor =~ s/_$//;
|
|
# Last ditch effort
|
|
$anchor = '_' . (join '_', @HeadingNumbers) unless $anchor;
|
|
$TableOfContents .= $number . &ScriptLink("$OpenPageName#$anchor",$text)
|
|
. "</dd>\n<dt> </dt><dd>";
|
|
return &StoreHref(" name=\"$anchor\"") . $number;
|
|
}
|
|
|
|
sub WikiHeading {
|
|
my ($pre, $depth, $text) = @_;
|
|
|
|
$depth = length($depth);
|
|
$depth = 6 if ($depth > 6);
|
|
$text =~ s/^\s*#\s+/&WikiHeadingNumber($depth,$')/e; # $' == $POSTMATCH
|
|
return $pre . "<H$depth>$text</H$depth>\n";
|
|
}
|
|
|
|
# ==== Difference markup and HTML ====
|
|
sub GetDiffHTML {
|
|
my ($diffType, $id, $revOld, $revNew, $newText) = @_;
|
|
my ($html, $diffText, $diffTextTwo, $priorName, $links, $usecomma);
|
|
my ($major, $minor, $author, $useMajor, $useMinor, $useAuthor, $cacheName);
|
|
|
|
$links = "(";
|
|
$usecomma = 0;
|
|
$major = &ScriptLinkDiff(1, $id, T('major diff'), "");
|
|
$minor = &ScriptLinkDiff(2, $id, T('minor diff'), "");
|
|
$author = &ScriptLinkDiff(3, $id, T('author diff'), "");
|
|
$useMajor = 1;
|
|
$useMinor = 1;
|
|
$useAuthor = 1;
|
|
$diffType = &GetParam("defaultdiff", 1) if ($diffType == 4);
|
|
if ($diffType == 1) {
|
|
$priorName = T('major');
|
|
$cacheName = 'major';
|
|
$useMajor = 0;
|
|
} elsif ($diffType == 2) {
|
|
$priorName = T('minor');
|
|
$cacheName = 'minor';
|
|
$useMinor = 0;
|
|
} elsif ($diffType == 3) {
|
|
$priorName = T('author');
|
|
$cacheName = 'author';
|
|
$useAuthor = 0;
|
|
}
|
|
if ($revOld ne "") {
|
|
# Note: OpenKeptRevisions must have been done by caller.
|
|
# Eventually optimize if same as cached revision
|
|
$diffText = &GetKeptDiff($newText, $revOld, 1); # 1 = get lock
|
|
if ($diffText eq "") {
|
|
$diffText = T('(The revisions are identical or unavailable.)');
|
|
}
|
|
} else {
|
|
$diffText = &GetCacheDiff($cacheName);
|
|
}
|
|
$useMajor = 0 if ($useMajor && ($diffText eq &GetCacheDiff("major")));
|
|
$useMinor = 0 if ($useMinor && ($diffText eq &GetCacheDiff("minor")));
|
|
$useAuthor = 0 if ($useAuthor && ($diffText eq &GetCacheDiff("author")));
|
|
$useMajor = 0 if ((!defined(&GetPageCache('oldmajor'))) ||
|
|
(&GetPageCache("oldmajor") < 1));
|
|
$useAuthor = 0 if ((!defined(&GetPageCache('oldauthor'))) ||
|
|
(&GetPageCache("oldauthor") < 1));
|
|
if ($useMajor) {
|
|
$links .= $major;
|
|
$usecomma = 1;
|
|
}
|
|
if ($useMinor) {
|
|
$links .= ", " if ($usecomma);
|
|
$links .= $minor;
|
|
$usecomma = 1;
|
|
}
|
|
if ($useAuthor) {
|
|
$links .= ", " if ($usecomma);
|
|
$links .= $author;
|
|
}
|
|
if (!($useMajor || $useMinor || $useAuthor)) {
|
|
$links .= T('no other diffs');
|
|
}
|
|
$links .= ")";
|
|
if ((!defined($diffText)) || ($diffText eq "")) {
|
|
$diffText = T('No diff available.');
|
|
}
|
|
if ($revOld ne "") {
|
|
my $currentRevision = T('current revision');
|
|
$currentRevision = Ts('revision %s', $revNew) if $revNew;
|
|
$html = '<b>'
|
|
. Tss("Difference (from revision %1 to %2)", $revOld, $currentRevision)
|
|
. "</b>\n" . "$links<br>" . &DiffToHTML($diffText);
|
|
} else {
|
|
if (($diffType != 2) &&
|
|
((!defined(&GetPageCache("old$cacheName"))) ||
|
|
(&GetPageCache("old$cacheName") < 1))) {
|
|
$html = '<b>'
|
|
. Ts('No diff available--this is the first %s revision.',
|
|
$priorName) . "</b>\n$links";
|
|
} else {
|
|
$html = '<b>'
|
|
. Ts('Difference (from prior %s revision)', $priorName)
|
|
. "</b>\n$links<br>" . &DiffToHTML($diffText);
|
|
}
|
|
}
|
|
@HeadingNumbers = ();
|
|
$TableOfContents = '';
|
|
return $html;
|
|
}
|
|
|
|
sub GetCacheDiff {
|
|
my ($type) = @_;
|
|
my ($diffText);
|
|
|
|
$diffText = &GetPageCache("diff_default_$type");
|
|
$diffText = &GetCacheDiff('minor') if ($diffText eq "1");
|
|
$diffText = &GetCacheDiff('major') if ($diffText eq "2");
|
|
return $diffText;
|
|
}
|
|
|
|
# Must be done after minor diff is set and OpenKeptRevisions called
|
|
sub GetKeptDiff {
|
|
my ($newText, $oldRevision, $lock) = @_;
|
|
my (%sect, %data, $oldText);
|
|
|
|
$oldText = "";
|
|
if (defined($KeptRevisions{$oldRevision})) {
|
|
%sect = split(/$FS2/, $KeptRevisions{$oldRevision}, -1);
|
|
%data = split(/$FS3/, $sect{'data'}, -1);
|
|
$oldText = $data{'text'};
|
|
}
|
|
return "" if ($oldText eq ""); # Old revision not found
|
|
return &GetDiff($oldText, $newText, $lock);
|
|
}
|
|
|
|
sub GetDiff {
|
|
my ($old, $new, $lock) = @_;
|
|
my ($diff_out, $oldName, $newName);
|
|
|
|
&CreateDir($TempDir);
|
|
$oldName = "$TempDir/old_diff";
|
|
$newName = "$TempDir/new_diff";
|
|
if ($lock) {
|
|
&RequestDiffLock() or return "";
|
|
$oldName .= "_locked";
|
|
$newName .= "_locked";
|
|
}
|
|
&WriteStringToFile($oldName, $old);
|
|
&WriteStringToFile($newName, $new);
|
|
$diff_out = `diff $oldName $newName`;
|
|
&ReleaseDiffLock() if ($lock);
|
|
$diff_out =~ s/\\ No newline.*\n//g; # Get rid of common complaint.
|
|
# No need to unlink temp files--next diff will just overwrite.
|
|
return $diff_out;
|
|
}
|
|
|
|
sub DiffToHTML {
|
|
my ($html) = @_;
|
|
my ($tChanged, $tRemoved, $tAdded);
|
|
|
|
$tChanged = T('Changed:');
|
|
$tRemoved = T('Removed:');
|
|
$tAdded = T('Added:');
|
|
$html =~ s/\n--+//g;
|
|
# Note: Need spaces before <br> to be different from diff section.
|
|
$html =~ s/(^|\n)(\d+.*c.*)/$1 <br><strong>$tChanged $2<\/strong><br>/g;
|
|
$html =~ s/(^|\n)(\d+.*d.*)/$1 <br><strong>$tRemoved $2<\/strong><br>/g;
|
|
$html =~ s/(^|\n)(\d+.*a.*)/$1 <br><strong>$tAdded $2<\/strong><br>/g;
|
|
$html =~ s/\n((<.*\n)+)/&ColorDiff($1, $DiffColor1, 0)/ge;
|
|
$html =~ s/\n((>.*\n)+)/&ColorDiff($1, $DiffColor2, 1)/ge;
|
|
return $html;
|
|
}
|
|
|
|
sub ColorDiff {
|
|
my ($diff, $color, $type) = @_;
|
|
my ($colorHtml, $classHtml);
|
|
|
|
$diff =~ s/(^|\n)[<>]/$1/g;
|
|
$diff = &QuoteHtml($diff);
|
|
# Do some of the Wiki markup rules:
|
|
%SaveUrl = ();
|
|
%SaveNumUrl = ();
|
|
$SaveUrlIndex = 0;
|
|
$SaveNumUrlIndex = 0;
|
|
$diff = &RemoveFS($diff);
|
|
$diff = &CommonMarkup($diff, 0, 1); # No images, all patterns
|
|
if ($LateRules ne '') {
|
|
$diff = &EvalLocalRules($LateRules, $diff, 1);
|
|
}
|
|
1 while $diff =~ s/$FS(\d+)$FS/$SaveUrl{$1}/ge; # Restore saved text
|
|
$diff =~ s/\r?\n/<br>/g;
|
|
$colorHtml = '';
|
|
if ($color ne '') {
|
|
$colorHtml = " bgcolor=$color";
|
|
}
|
|
if ($type) {
|
|
$classHtml = ' class=wikidiffnew';
|
|
} else {
|
|
$classHtml = ' class=wikidiffold';
|
|
}
|
|
return "<table width=\"95\%\"$colorHtml$classHtml><tr><td>\n" . $diff
|
|
. "</td></tr></table>\n";
|
|
}
|
|
|
|
# ==== Database (Page, Section, Text, Kept, User) functions ====
|
|
sub OpenNewPage {
|
|
my ($id) = @_;
|
|
|
|
%Page = ();
|
|
$Page{'version'} = 3; # Data format version
|
|
$Page{'revision'} = 0; # Number of edited times
|
|
$Page{'tscreate'} = $Now; # Set once at creation
|
|
$Page{'ts'} = $Now; # Updated every edit
|
|
}
|
|
|
|
sub OpenNewSection {
|
|
my ($name, $data) = @_;
|
|
|
|
%Section = ();
|
|
$Section{'name'} = $name;
|
|
$Section{'version'} = 1; # Data format version
|
|
$Section{'revision'} = 0; # Number of edited times
|
|
$Section{'tscreate'} = $Now; # Set once at creation
|
|
$Section{'ts'} = $Now; # Updated every edit
|
|
$Section{'ip'} = $ENV{REMOTE_ADDR};
|
|
$Section{'host'} = ''; # Updated only for real edits (can be slow)
|
|
$Section{'id'} = $UserID;
|
|
$Section{'username'} = &GetParam("username", "");
|
|
$Section{'data'} = $data;
|
|
$Page{$name} = join($FS2, %Section); # Replace with save?
|
|
}
|
|
|
|
sub OpenNewText {
|
|
my ($name) = @_; # Name of text (usually "default")
|
|
%Text = ();
|
|
if ($NewText ne '') {
|
|
$Text{'text'} = T($NewText);
|
|
} else {
|
|
$Text{'text'} = T('Describe the new page here.') . "\n";
|
|
}
|
|
$Text{'text'} .= "\n" if (substr($Text{'text'}, -1, 1) ne "\n");
|
|
$Text{'minor'} = 0; # Default as major edit
|
|
$Text{'newauthor'} = 1; # Default as new author
|
|
$Text{'summary'} = '';
|
|
&OpenNewSection("text_$name", join($FS3, %Text));
|
|
}
|
|
|
|
sub GetPageFile {
|
|
my ($id) = @_;
|
|
|
|
return $PageDir . "/" . &GetPageDirectory($id) . "/$id.db";
|
|
}
|
|
|
|
sub OpenPage {
|
|
my ($id) = @_;
|
|
my ($fname, $data);
|
|
|
|
if ($OpenPageName eq $id) {
|
|
return;
|
|
}
|
|
%Section = ();
|
|
%Text = ();
|
|
$fname = &GetPageFile($id);
|
|
if (-f $fname) {
|
|
$data = &ReadFileOrDie($fname);
|
|
%Page = split(/$FS1/, $data, -1); # -1 keeps trailing null fields
|
|
} else {
|
|
&OpenNewPage($id);
|
|
}
|
|
if ($Page{'version'} != 3) {
|
|
&UpdatePageVersion();
|
|
}
|
|
$OpenPageName = $id;
|
|
}
|
|
|
|
sub OpenSection {
|
|
my ($name) = @_;
|
|
|
|
if (!defined($Page{$name})) {
|
|
&OpenNewSection($name, "");
|
|
} else {
|
|
%Section = split(/$FS2/, $Page{$name}, -1);
|
|
}
|
|
}
|
|
|
|
sub OpenText {
|
|
my ($name) = @_;
|
|
|
|
if (!defined($Page{"text_$name"})) {
|
|
&OpenNewText($name);
|
|
} else {
|
|
&OpenSection("text_$name");
|
|
%Text = split(/$FS3/, $Section{'data'}, -1);
|
|
}
|
|
}
|
|
|
|
sub OpenDefaultText {
|
|
&OpenText('default');
|
|
}
|
|
|
|
# Called after OpenKeptRevisions
|
|
sub OpenKeptRevision {
|
|
my ($revision) = @_;
|
|
|
|
%Section = split(/$FS2/, $KeptRevisions{$revision}, -1);
|
|
%Text = split(/$FS3/, $Section{'data'}, -1);
|
|
}
|
|
|
|
sub GetPageCache {
|
|
my ($name) = @_;
|
|
|
|
return $Page{"cache_$name"};
|
|
}
|
|
|
|
# Always call SavePage within a lock.
|
|
sub SavePage {
|
|
my $file = &GetPageFile($OpenPageName);
|
|
|
|
$Page{'revision'} += 1; # Number of edited times
|
|
$Page{'ts'} = $Now; # Updated every edit
|
|
&CreatePageDir($PageDir, $OpenPageName);
|
|
&WriteStringToFile($file, join($FS1, %Page));
|
|
}
|
|
|
|
sub SaveSection {
|
|
my ($name, $data) = @_;
|
|
|
|
$Section{'revision'} += 1; # Number of edited times
|
|
$Section{'ts'} = $Now; # Updated every edit
|
|
$Section{'ip'} = $ENV{REMOTE_ADDR};
|
|
$Section{'id'} = $UserID;
|
|
$Section{'username'} = &GetParam("username", "");
|
|
$Section{'data'} = $data;
|
|
$Page{$name} = join($FS2, %Section);
|
|
}
|
|
|
|
sub SaveText {
|
|
my ($name) = @_;
|
|
|
|
&SaveSection("text_$name", join($FS3, %Text));
|
|
}
|
|
|
|
sub SaveDefaultText {
|
|
&SaveText('default');
|
|
}
|
|
|
|
sub SetPageCache {
|
|
my ($name, $data) = @_;
|
|
|
|
$Page{"cache_$name"} = $data;
|
|
}
|
|
|
|
sub UpdatePageVersion {
|
|
&ReportError(T('Bad page version (or corrupt page).'));
|
|
}
|
|
|
|
sub KeepFileName {
|
|
return $KeepDir . "/" . &GetPageDirectory($OpenPageName)
|
|
. "/$OpenPageName.kp";
|
|
}
|
|
|
|
sub SaveKeepSection {
|
|
my $file = &KeepFileName();
|
|
my $data;
|
|
|
|
return if ($Section{'revision'} < 1); # Don't keep "empty" revision
|
|
$Section{'keepts'} = $Now;
|
|
$data = $FS1 . join($FS2, %Section);
|
|
&CreatePageDir($KeepDir, $OpenPageName);
|
|
&AppendStringToFileLimited($file, $data, $KeepSize);
|
|
}
|
|
|
|
sub ExpireKeepFile {
|
|
my ($fname, $data, @kplist, %tempSection, $expirets);
|
|
my ($anyExpire, $anyKeep, $expire, %keepFlag, $sectName, $sectRev);
|
|
my ($oldMajor, $oldAuthor);
|
|
|
|
$fname = &KeepFileName();
|
|
return if (!(-f $fname));
|
|
$data = &ReadFileOrDie($fname);
|
|
@kplist = split(/$FS1/, $data, -1); # -1 keeps trailing null fields
|
|
return if (scalar(@kplist) < 1); # Also empty
|
|
shift(@kplist) if ($kplist[0] eq ""); # First can be empty
|
|
return if (scalar(@kplist) < 1); # Also empty
|
|
%tempSection = split(/$FS2/, $kplist[0], -1);
|
|
if (!defined($tempSection{'keepts'})) {
|
|
return; # Bad keep file
|
|
}
|
|
$expirets = $Now - ($KeepDays * 24 * 60 * 60);
|
|
return if ($tempSection{'keepts'} >= $expirets); # Nothing old enough
|
|
$anyExpire = 0;
|
|
$anyKeep = 0;
|
|
%keepFlag = ();
|
|
$oldMajor = &GetPageCache('oldmajor');
|
|
$oldAuthor = &GetPageCache('oldauthor');
|
|
foreach (reverse @kplist) {
|
|
%tempSection = split(/$FS2/, $_, -1);
|
|
$sectName = $tempSection{'name'};
|
|
$sectRev = $tempSection{'revision'};
|
|
$expire = 0;
|
|
if ($sectName eq "text_default") {
|
|
if (($KeepMajor && ($sectRev == $oldMajor)) ||
|
|
($KeepAuthor && ($sectRev == $oldAuthor))) {
|
|
$expire = 0;
|
|
} elsif ($tempSection{'keepts'} < $expirets) {
|
|
$expire = 1;
|
|
}
|
|
} else {
|
|
if ($tempSection{'keepts'} < $expirets) {
|
|
$expire = 1;
|
|
}
|
|
}
|
|
if (!$expire) {
|
|
$keepFlag{$sectRev . "," . $sectName} = 1;
|
|
$anyKeep = 1;
|
|
} else {
|
|
$anyExpire = 1;
|
|
}
|
|
}
|
|
if (!$anyKeep) { # Empty, so remove file
|
|
unlink($fname);
|
|
return;
|
|
}
|
|
return if (!$anyExpire); # No sections expired
|
|
open (OUT, ">$fname") or die (Ts('cant write %s', $fname) . ": $!");
|
|
foreach (@kplist) {
|
|
%tempSection = split(/$FS2/, $_, -1);
|
|
$sectName = $tempSection{'name'};
|
|
$sectRev = $tempSection{'revision'};
|
|
if ($keepFlag{$sectRev . "," . $sectName}) {
|
|
print OUT $FS1, $_;
|
|
}
|
|
}
|
|
close(OUT);
|
|
}
|
|
|
|
sub OpenKeptList {
|
|
my ($fname, $data);
|
|
|
|
@KeptList = ();
|
|
$fname = &KeepFileName();
|
|
return if (!(-f $fname));
|
|
$data = &ReadFileOrDie($fname);
|
|
@KeptList = split(/$FS1/, $data, -1); # -1 keeps trailing null fields
|
|
}
|
|
|
|
sub OpenKeptRevisions {
|
|
my ($name) = @_; # Name of section
|
|
my ($fname, $data, %tempSection);
|
|
|
|
%KeptRevisions = ();
|
|
&OpenKeptList();
|
|
foreach (@KeptList) {
|
|
%tempSection = split(/$FS2/, $_, -1);
|
|
next unless ($tempSection{'name'});
|
|
next if ($tempSection{'name'} ne $name);
|
|
$KeptRevisions{$tempSection{'revision'}} = $_;
|
|
}
|
|
}
|
|
|
|
sub LoadUserData {
|
|
my ($data, $status);
|
|
|
|
%UserData = ();
|
|
($status, $data) = &ReadFile(&UserDataFilename($UserID));
|
|
if (!$status) {
|
|
$UserID = 112; # Could not open file. Consider warning message?
|
|
return;
|
|
}
|
|
%UserData = split(/$FS1/, $data, -1); # -1 keeps trailing null fields
|
|
}
|
|
|
|
sub UserDataFilename {
|
|
my ($id) = @_;
|
|
|
|
return "" if ($id < 1);
|
|
return $UserDir . "/" . ($id % 10) . "/$id.db";
|
|
}
|
|
|
|
# ==== Misc. functions ====
|
|
sub ReportError {
|
|
my ($errmsg) = @_;
|
|
|
|
print $q->header, $q->start_html, "<H2>", &QuoteHtml($errmsg), "</H2>", $q->end_html;
|
|
}
|
|
|
|
sub ValidId {
|
|
my ($id) = @_;
|
|
|
|
if (length($id) > 120) {
|
|
return Ts('Page name is too long: %s', $id);
|
|
}
|
|
if ($id =~ m| |) {
|
|
return Ts('Page name may not contain space characters: %s', $id);
|
|
}
|
|
if ($UseSubpage) {
|
|
if ($id =~ m|.*/.*/|) {
|
|
return Ts('Too many / characters in page %s', $id);
|
|
}
|
|
if ($id =~ /^\//) {
|
|
return Ts('Invalid Page %s (subpage without main page)', $id);
|
|
}
|
|
if ($id =~ /\/$/) {
|
|
return Ts('Invalid Page %s (missing subpage name)', $id);
|
|
}
|
|
}
|
|
if ($FreeLinks) {
|
|
$id =~ s/ /_/g;
|
|
if (!$UseSubpage) {
|
|
if ($id =~ /\//) {
|
|
return Ts('Invalid Page %s (/ not allowed)', $id);
|
|
}
|
|
}
|
|
if (!($id =~ m|^$FreeLinkPattern$|)) {
|
|
return Ts('Invalid Page %s', $id);
|
|
}
|
|
if ($id =~ m|\.db$|) {
|
|
return Ts('Invalid Page %s (must not end with .db)', $id);
|
|
}
|
|
if ($id =~ m|\.lck$|) {
|
|
return Ts('Invalid Page %s (must not end with .lck)', $id);
|
|
}
|
|
return "";
|
|
} else {
|
|
if (!($id =~ /^$LinkPattern$/)) {
|
|
return Ts('Invalid Page %s', $id);
|
|
}
|
|
}
|
|
return "";
|
|
}
|
|
|
|
sub ValidIdOrDie {
|
|
my ($id) = @_;
|
|
my $error;
|
|
|
|
$error = &ValidId($id);
|
|
if ($error ne "") {
|
|
&ReportError($error);
|
|
return 0;
|
|
}
|
|
return 1;
|
|
}
|
|
|
|
sub SanitizePageName {
|
|
my ($unsafe_id) = @_;
|
|
my $id = '';
|
|
|
|
if ($FreeLinks) {
|
|
if ($unsafe_id =~ /^($FreeLinkPattern)$/) {
|
|
$id = $1; # untaint
|
|
}
|
|
} else {
|
|
if ($unsafe_id =~ /^($LinkPattern)$/) {
|
|
$id = $1; # untaint
|
|
}
|
|
}
|
|
return $id;
|
|
}
|
|
|
|
sub SanitizeUserID {
|
|
my ($unsafe_uid) = @_;
|
|
my $uid = 111;
|
|
|
|
if ($unsafe_uid =~ /^(\d+)$/) {
|
|
$uid = $1; # untaint
|
|
if ($uid < 200) {
|
|
$uid = 111;
|
|
}
|
|
}
|
|
return $uid;
|
|
}
|
|
|
|
sub UserCanEdit {
|
|
my ($id, $deepCheck) = @_;
|
|
|
|
# Optimized for the "everyone can edit" case (don't check passwords)
|
|
if (($id ne "") && (-f &GetLockedPageFile($id))) {
|
|
return 1 if (&UserIsAdmin()); # Requires more privledges
|
|
# Consider option for editor-level to edit these pages?
|
|
return 0;
|
|
}
|
|
if (!$EditAllowed) {
|
|
return 1 if (&UserIsEditor());
|
|
return 0;
|
|
}
|
|
if (-f "$DataDir/noedit") {
|
|
return 1 if (&UserIsEditor());
|
|
return 0;
|
|
}
|
|
if ($deepCheck) { # Deeper but slower checks (not every page)
|
|
return 1 if (&UserIsEditor());
|
|
return 0 if (&UserIsBanned());
|
|
}
|
|
return 1;
|
|
}
|
|
|
|
sub UserIsBanned {
|
|
my ($host, $ip, $data, $status);
|
|
|
|
($status, $data) = &ReadFile("$DataDir/banlist");
|
|
return 0 if (!$status); # No file exists, so no ban
|
|
$data =~ s/\r//g;
|
|
$ip = $ENV{'REMOTE_ADDR'};
|
|
$host = &GetRemoteHost(0);
|
|
foreach (split(/\n/, $data)) {
|
|
next if ((/^\s*$/) || (/^#/)); # Skip empty, spaces, or comments
|
|
return 1 if ($ip =~ /$_/i);
|
|
return 1 if ($host =~ /$_/i);
|
|
}
|
|
return 0;
|
|
}
|
|
|
|
sub UserIsAdmin {
|
|
my ($userPassword);
|
|
|
|
return 0 if ($AdminPass eq "");
|
|
$userPassword = &GetParam("adminpw", "");
|
|
return 0 if ($userPassword eq "");
|
|
foreach (split(/\s+/, $AdminPass)) {
|
|
next if ($_ eq "");
|
|
return 1 if ($userPassword eq $_);
|
|
}
|
|
return 0;
|
|
}
|
|
|
|
sub UserIsEditor {
|
|
my ($userPassword);
|
|
|
|
return 1 if (&UserIsAdmin()); # Admin includes editor
|
|
return 0 if ($EditPass eq "");
|
|
$userPassword = &GetParam("adminpw", ""); # Used for both
|
|
return 0 if ($userPassword eq "");
|
|
foreach (split(/\s+/, $EditPass)) {
|
|
next if ($_ eq "");
|
|
return 1 if ($userPassword eq $_);
|
|
}
|
|
return 0;
|
|
}
|
|
|
|
sub UserCanUpload {
|
|
return 1 if (&UserIsEditor());
|
|
return $AllUpload;
|
|
}
|
|
|
|
sub GetLockedPageFile {
|
|
my ($id) = @_;
|
|
|
|
return $PageDir . "/" . &GetPageDirectory($id) . "/$id.lck";
|
|
}
|
|
|
|
sub RequestLockDir {
|
|
my ($name, $tries, $wait, $errorDie) = @_;
|
|
my ($lockName, $n);
|
|
|
|
&CreateDir($TempDir);
|
|
$lockName = $LockDir . $name;
|
|
$n = 0;
|
|
while (mkdir($lockName, 0555) == 0) {
|
|
if ($! != 17) {
|
|
die(Ts('can not make %s', $LockDir) . ": $!\n") if $errorDie;
|
|
return 0;
|
|
}
|
|
return 0 if ($n++ >= $tries);
|
|
sleep($wait);
|
|
}
|
|
return 1;
|
|
}
|
|
|
|
sub ReleaseLockDir {
|
|
my ($name) = @_;
|
|
|
|
rmdir($LockDir . $name);
|
|
}
|
|
|
|
sub RequestLock {
|
|
# 10 tries, 3 second wait, possibly die on error
|
|
return &RequestLockDir("main", 10, 3, $LockCrash);
|
|
}
|
|
|
|
sub ReleaseLock {
|
|
&ReleaseLockDir('main');
|
|
}
|
|
|
|
sub ForceReleaseLock {
|
|
my ($name) = @_;
|
|
my $forced;
|
|
|
|
# First try to obtain lock (in case of normal edit lock)
|
|
# 5 tries, 3 second wait, do not die on error
|
|
$forced = !&RequestLockDir($name, 5, 3, 0);
|
|
&ReleaseLockDir($name); # Release the lock, even if we didn't get it.
|
|
return $forced;
|
|
}
|
|
|
|
sub RequestCacheLock {
|
|
# 4 tries, 2 second wait, do not die on error
|
|
return &RequestLockDir('cache', 4, 2, 0);
|
|
}
|
|
|
|
sub ReleaseCacheLock {
|
|
&ReleaseLockDir('cache');
|
|
}
|
|
|
|
sub RequestDiffLock {
|
|
# 4 tries, 2 second wait, do not die on error
|
|
return &RequestLockDir('diff', 4, 2, 0);
|
|
}
|
|
|
|
sub ReleaseDiffLock {
|
|
&ReleaseLockDir('diff');
|
|
}
|
|
|
|
# Index lock is not very important--just return error if not available
|
|
sub RequestIndexLock {
|
|
# 1 try, 2 second wait, do not die on error
|
|
return &RequestLockDir('index', 1, 2, 0);
|
|
}
|
|
|
|
sub ReleaseIndexLock {
|
|
&ReleaseLockDir('index');
|
|
}
|
|
|
|
sub ReadFile {
|
|
my ($fileName) = @_;
|
|
my ($data);
|
|
local $/ = undef; # Read complete files
|
|
|
|
if (open(IN, "<$fileName")) {
|
|
$data=<IN>;
|
|
close IN;
|
|
return (1, $data);
|
|
}
|
|
return (0, "");
|
|
}
|
|
|
|
sub ReadFileOrDie {
|
|
my ($fileName) = @_;
|
|
my ($status, $data);
|
|
|
|
($status, $data) = &ReadFile($fileName);
|
|
if (!$status) {
|
|
die(Ts('Can not open %s', $fileName) . ": $!");
|
|
}
|
|
return $data;
|
|
}
|
|
|
|
sub WriteStringToFile {
|
|
my ($file, $string) = @_;
|
|
|
|
open (OUT, ">$file") or die(Ts('cant write %s', $file) . ": $!");
|
|
print OUT $string;
|
|
close(OUT);
|
|
}
|
|
|
|
sub AppendStringToFile {
|
|
my ($file, $string) = @_;
|
|
|
|
open (OUT, ">>$file") or die(Ts('cant write %s', $file) . ": $!");
|
|
print OUT $string;
|
|
close(OUT);
|
|
}
|
|
|
|
sub AppendStringToFileLimited {
|
|
my ($file, $string, $limit) = @_;
|
|
|
|
if (($limit < 1) || (((-s $file) + length($string)) <= $limit)) {
|
|
&AppendStringToFile($file, $string);
|
|
}
|
|
}
|
|
|
|
sub CreateDir {
|
|
my ($newdir) = @_;
|
|
|
|
mkdir($newdir, 0775) if (!(-d $newdir));
|
|
}
|
|
|
|
sub CreatePageDir {
|
|
my ($dir, $id) = @_;
|
|
my $subdir;
|
|
|
|
&CreateDir($dir); # Make sure main page exists
|
|
$subdir = $dir . "/" . &GetPageDirectory($id);
|
|
&CreateDir($subdir);
|
|
if ($id =~ m|([^/]+)/|) {
|
|
$subdir = $subdir . "/" . $1;
|
|
&CreateDir($subdir);
|
|
}
|
|
}
|
|
|
|
sub UpdateHtmlCache {
|
|
my ($id, $html) = @_;
|
|
my $idFile;
|
|
|
|
$idFile = &GetHtmlCacheFile($id);
|
|
&CreatePageDir($HtmlDir, $id);
|
|
if (&RequestCacheLock()) {
|
|
&WriteStringToFile($idFile, $html);
|
|
&ReleaseCacheLock();
|
|
}
|
|
}
|
|
|
|
sub GenerateAllPagesList {
|
|
my (@pages, @dirs, $id, $dir, @pageFiles, @subpageFiles, $subId);
|
|
|
|
@pages = ();
|
|
if ($FastGlob) {
|
|
# The following was inspired by the FastGlob code by Marc W. Mengel.
|
|
# Thanks to Bob Showalter for pointing out the improvement.
|
|
opendir(PAGELIST, $PageDir);
|
|
@dirs = readdir(PAGELIST);
|
|
closedir(PAGELIST);
|
|
@dirs = sort(@dirs);
|
|
foreach $dir (@dirs) {
|
|
next if (substr($dir, 0, 1) eq '.'); # No ., .., or .dirs or files
|
|
opendir(PAGELIST, "$PageDir/$dir");
|
|
@pageFiles = readdir(PAGELIST);
|
|
closedir(PAGELIST);
|
|
foreach $id (@pageFiles) {
|
|
next if (($id eq '.') || ($id eq '..'));
|
|
if (substr($id, -3) eq '.db') {
|
|
push(@pages, substr($id, 0, -3));
|
|
} elsif (substr($id, -4) ne '.lck') {
|
|
opendir(PAGELIST, "$PageDir/$dir/$id");
|
|
@subpageFiles = readdir(PAGELIST);
|
|
closedir(PAGELIST);
|
|
foreach $subId (@subpageFiles) {
|
|
if (substr($subId, -3) eq '.db') {
|
|
push(@pages, "$id/" . substr($subId, 0, -3));
|
|
}
|
|
}
|
|
}
|
|
}
|
|
}
|
|
} else {
|
|
# Old slow/compatible method.
|
|
@dirs = qw(A B C D E F G H I J K L M N O P Q R S T U V W X Y Z other);
|
|
foreach $dir (@dirs) {
|
|
if (-e "$PageDir/$dir") { # Thanks to Tim Holt
|
|
while (<$PageDir/$dir/*.db $PageDir/$dir/*/*.db>) {
|
|
s|^$PageDir/||;
|
|
m|^[^/]+/(\S*).db|;
|
|
$id = $1;
|
|
push(@pages, $id);
|
|
}
|
|
}
|
|
}
|
|
}
|
|
return sort(@pages);
|
|
}
|
|
|
|
sub AllPagesList {
|
|
my ($rawIndex, $refresh, $status);
|
|
|
|
if (!$UseIndex) {
|
|
return &GenerateAllPagesList();
|
|
}
|
|
$refresh = &GetParam("refresh", 0);
|
|
if ($IndexInit && !$refresh) {
|
|
# Note for mod_perl: $IndexInit is reset for each query
|
|
# Eventually consider some timestamp-solution to keep cache?
|
|
return @IndexList;
|
|
}
|
|
if ((!$refresh) && (-f $IndexFile)) {
|
|
($status, $rawIndex) = &ReadFile($IndexFile);
|
|
if ($status) {
|
|
%IndexHash = split(/\s+/, $rawIndex);
|
|
@IndexList = sort(keys %IndexHash);
|
|
$IndexInit = 1;
|
|
return @IndexList;
|
|
}
|
|
# If open fails just refresh the index
|
|
}
|
|
@IndexList = ();
|
|
%IndexHash = ();
|
|
@IndexList = &GenerateAllPagesList();
|
|
foreach (@IndexList) {
|
|
$IndexHash{$_} = 1;
|
|
}
|
|
$IndexInit = 1; # Initialized for this run of the script
|
|
# Try to write out the list for future runs
|
|
&RequestIndexLock() or return @IndexList;
|
|
&WriteStringToFile($IndexFile, join(" ", %IndexHash));
|
|
&ReleaseIndexLock();
|
|
return @IndexList;
|
|
}
|
|
|
|
sub CalcDay {
|
|
my ($ts) = @_;
|
|
|
|
$ts += $TimeZoneOffset;
|
|
my ($sec, $min, $hour, $mday, $mon, $year) = localtime($ts);
|
|
if ($NumberDates) {
|
|
return sprintf("%d-%02d-%02d", $year+1900, $mon+1, $mday);
|
|
}
|
|
return ("January", "February", "March", "April", "May", "June",
|
|
"July", "August", "September", "October", "November",
|
|
"December")[$mon]. " " . $mday . ", " . ($year+1900);
|
|
}
|
|
|
|
sub CalcTime {
|
|
my ($ts) = @_;
|
|
my ($ampm, $mytz);
|
|
|
|
$ts += $TimeZoneOffset;
|
|
my ($sec, $min, $hour, $mday, $mon, $year) = localtime($ts);
|
|
$mytz = "";
|
|
if (($TimeZoneOffset == 0) && ($ScriptTZ ne "")) {
|
|
$mytz = " " . $ScriptTZ;
|
|
}
|
|
unless ($UseAmPm) {
|
|
return sprintf("%02d:%02d$mytz", $hour, $min);
|
|
}
|
|
$ampm = " am";
|
|
if ($hour > 11) {
|
|
$ampm = " pm";
|
|
$hour = $hour - 12;
|
|
}
|
|
$hour = 12 if ($hour == 0);
|
|
$min = "0" . $min if ($min<10);
|
|
return $hour . ":" . $min . $ampm . $mytz;
|
|
}
|
|
|
|
sub TimeToText {
|
|
my ($t) = @_;
|
|
|
|
return &CalcDay($t) . " " . &CalcTime($t);
|
|
}
|
|
|
|
sub GetParam {
|
|
my ($name, $default) = @_;
|
|
my $result;
|
|
|
|
$result = $q->param($name);
|
|
if (!defined($result)) {
|
|
if (defined($UserData{$name})) {
|
|
$result = $UserData{$name};
|
|
} else {
|
|
$result = $default;
|
|
}
|
|
}
|
|
return $result;
|
|
}
|
|
|
|
sub GetHiddenValue {
|
|
my ($name, $value) = @_;
|
|
|
|
$q->param($name, $value);
|
|
return $q->hidden($name);
|
|
}
|
|
|
|
sub GetRemoteHost {
|
|
my ($doMask) = @_;
|
|
my ($rhost, $iaddr);
|
|
|
|
$rhost = $ENV{REMOTE_HOST} || '';
|
|
if ($UseLookup && ($rhost eq "")) {
|
|
# Catch errors (including bad input) without aborting the script
|
|
eval 'use Socket; $iaddr = inet_aton($ENV{REMOTE_ADDR});'
|
|
. '$rhost = gethostbyaddr($iaddr, AF_INET)';
|
|
}
|
|
if ($rhost eq "") {
|
|
$rhost = $ENV{REMOTE_ADDR};
|
|
}
|
|
$rhost = &GetMaskedHost($rhost) if ($doMask);
|
|
return $rhost;
|
|
}
|
|
|
|
sub FreeToNormal {
|
|
my ($id) = @_;
|
|
|
|
$id =~ s/ /_/g;
|
|
$id = ucfirst($id) if ($UpperFirst || $FreeUpper);
|
|
if (index($id, '_') > -1) { # Quick check for any space/underscores
|
|
$id =~ s/__+/_/g;
|
|
$id =~ s/^_//;
|
|
$id =~ s/_$//;
|
|
if ($UseSubpage) {
|
|
$id =~ s|_/|/|g;
|
|
$id =~ s|/_|/|g;
|
|
}
|
|
}
|
|
if ($FreeUpper) {
|
|
# Note that letters after ' are *not* capitalized
|
|
if ($id =~ m|[-_.,\(\)/][a-z]|) { # Quick check for non-canonical case
|
|
$id =~ s|([-_.,\(\)/])([a-z])|$1 . uc($2)|ge;
|
|
}
|
|
}
|
|
return $id;
|
|
}
|
|
#END_OF_BROWSE_CODE
|
|
|
|
# == Page-editing and other special-action code ========================
|
|
$OtherCode = ""; # Comment next line to always compile (slower)
|
|
#$OtherCode = <<'#END_OF_OTHER_CODE';
|
|
|
|
sub DoOtherRequest {
|
|
my ($id, $action, $search);
|
|
|
|
$action = &GetParam("action", "");
|
|
$id = &GetParam("id", "");
|
|
if ($action ne "") {
|
|
$action = lc($action);
|
|
if ($action eq "edit") {
|
|
&DoEdit($id, 0, 0, "", 0) if &ValidIdOrDie($id);
|
|
} elsif ($action eq "unlock") {
|
|
&DoUnlock();
|
|
} elsif ($action eq "index") {
|
|
&DoIndex();
|
|
} elsif ($action eq "links") {
|
|
&DoLinks();
|
|
} elsif ($action eq "maintain") {
|
|
&DoMaintain();
|
|
} elsif ($action eq "pagelock") {
|
|
&DoPageLock();
|
|
} elsif ($action eq "editlock") {
|
|
&DoEditLock();
|
|
} elsif ($action eq "editprefs") {
|
|
&DoEditPrefs();
|
|
} elsif ($action eq "editbanned") {
|
|
&DoEditBanned();
|
|
} elsif ($action eq "editlinks") {
|
|
&DoEditLinks();
|
|
} elsif ($action eq "login") {
|
|
&DoEnterLogin();
|
|
} elsif ($action eq "newlogin") {
|
|
$UserID = 0;
|
|
&DoEditPrefs(); # Also creates new ID
|
|
} elsif ($action eq "version") {
|
|
&DoShowVersion();
|
|
} elsif ($action eq "rss") {
|
|
&DoRss();
|
|
} elsif ($action eq "delete") {
|
|
&DoDeletePage($id);
|
|
} elsif ($UseUpload && ($action eq "upload")) {
|
|
&DoUpload();
|
|
} elsif ($action eq "maintainrc") {
|
|
&DoMaintainRc();
|
|
} elsif ($action eq "convert") {
|
|
&DoConvert();
|
|
} elsif ($action eq "trimusers") {
|
|
&DoTrimUsers();
|
|
} else {
|
|
&ReportError(Ts('Invalid action parameter %s', $action));
|
|
}
|
|
return;
|
|
}
|
|
if (&GetParam("edit_prefs", 0)) {
|
|
&DoUpdatePrefs();
|
|
return;
|
|
}
|
|
if (&GetParam("edit_ban", 0)) {
|
|
&DoUpdateBanned();
|
|
return;
|
|
}
|
|
if (&GetParam("enter_login", 0)) {
|
|
&DoLogin();
|
|
return;
|
|
}
|
|
if (&GetParam("edit_links", 0)) {
|
|
&DoUpdateLinks();
|
|
return;
|
|
}
|
|
if ($UseUpload && (&GetParam("upload", 0))) {
|
|
&SaveUpload();
|
|
return;
|
|
}
|
|
$search = &GetParam("search", "");
|
|
if (($search ne "") || (&GetParam("dosearch", "") ne "")) {
|
|
&DoSearch($search);
|
|
return;
|
|
} else {
|
|
$search = &GetParam("back","");
|
|
if ($search ne "") {
|
|
&DoBackLinks($search);
|
|
return;
|
|
}
|
|
}
|
|
# Handle posted pages
|
|
if (&GetParam("oldtime", "") ne "") {
|
|
$id = &GetParam("title", "");
|
|
&DoPost() if &ValidIdOrDie($id);
|
|
return;
|
|
}
|
|
&ReportError(T('Invalid URL.'));
|
|
}
|
|
|
|
sub DoEdit {
|
|
my ($id, $isConflict, $oldTime, $newText, $preview) = @_;
|
|
my ($header, $editRows, $editCols, $userName, $revision, $oldText);
|
|
my ($summary, $isEdit, $pageTime);
|
|
|
|
if ($FreeLinks) {
|
|
$id = &FreeToNormal($id); # Take care of users like Markus Lude :-)
|
|
}
|
|
if (!&UserCanEdit($id, 1)) {
|
|
print &GetHeader('', T('Editing Denied'), '');
|
|
if (&UserIsBanned()) {
|
|
print T('Editing not allowed: user, ip, or network is blocked.');
|
|
print "<p>";
|
|
print T('Contact the wiki administrator for more information.');
|
|
} else {
|
|
print Ts('Editing not allowed: %s is read-only.', $SiteName);
|
|
}
|
|
print &GetCommonFooter();
|
|
return;
|
|
}
|
|
# Consider sending a new user-ID cookie if user does not have one
|
|
&OpenPage($id);
|
|
&OpenDefaultText();
|
|
$pageTime = $Section{'ts'};
|
|
$header = Ts('Editing %s', $id);
|
|
# Old revision handling
|
|
$revision = &GetParam('revision', '');
|
|
$revision =~ s/\D//g; # Remove non-numeric chars
|
|
if ($revision ne '') {
|
|
&OpenKeptRevisions('text_default');
|
|
if (!defined($KeptRevisions{$revision})) {
|
|
$revision = '';
|
|
# Consider better solution like error message?
|
|
} else {
|
|
&OpenKeptRevision($revision);
|
|
$header = Ts('Editing revision %s of ', $revision ) . $id;
|
|
}
|
|
}
|
|
$oldText = $Text{'text'};
|
|
if ($preview && !$isConflict) {
|
|
$oldText = $newText;
|
|
}
|
|
$editRows = &GetParam("editrows", 20);
|
|
$editCols = &GetParam("editcols", 65);
|
|
print &GetHeader($id, &QuoteHtml($header), '');
|
|
if ($revision ne '') {
|
|
print "\n<b>"
|
|
. Ts('Editing old revision %s.', $revision) . " "
|
|
. T('Saving this page will replace the latest revision with this text.')
|
|
. '</b><br>'
|
|
}
|
|
if ($isConflict) {
|
|
$editRows -= 10 if ($editRows > 19);
|
|
print "\n<H1>" . T('Edit Conflict!') . "</H1>\n";
|
|
if ($isConflict>1) {
|
|
# The main purpose of a new warning is to display more text
|
|
# and move the save button down from its old location.
|
|
print "\n<H2>" . T('(This is a new conflict)') . "</H2>\n";
|
|
}
|
|
print "<p><strong>",
|
|
T('Someone saved this page after you started editing.'), " ",
|
|
T('The top textbox contains the saved text.'), " ",
|
|
T('Only the text in the top textbox will be saved.'),
|
|
"</strong><br>\n",
|
|
T('Scroll down to see your edited text.'), "<br>\n";
|
|
print T('Last save time:'), ' ', &TimeToText($oldTime),
|
|
" (", T('Current time is:'), ' ', &TimeToText($Now), ")<br>\n";
|
|
}
|
|
print &GetFormStart();
|
|
print &GetHiddenValue("title", $id), "\n",
|
|
&GetHiddenValue("oldtime", $pageTime), "\n",
|
|
&GetHiddenValue("oldconflict", $isConflict), "\n";
|
|
if ($revision ne "") {
|
|
print &GetHiddenValue("revision", $revision), "\n";
|
|
}
|
|
print &GetTextArea('text', $oldText, $editRows, $editCols);
|
|
$summary = &GetParam("summary", "*");
|
|
print "<p>", T('Summary:'),
|
|
$q->textfield(-name=>'summary',
|
|
-default=>$summary, -override=>1,
|
|
-size=>60, -maxlength=>200);
|
|
if (&GetParam("recent_edit", '') eq "on") {
|
|
print "<br>", $q->checkbox(-name=>'recent_edit', -checked=>1,
|
|
-label=>T('This change is a minor edit.'));
|
|
} else {
|
|
print "<br>", $q->checkbox(-name=>'recent_edit',
|
|
-label=>T('This change is a minor edit.'));
|
|
}
|
|
if ($EmailNotify) {
|
|
print " " .
|
|
$q->checkbox(-name=> 'do_email_notify',
|
|
-label=>Ts('Send email notification that %s has been changed.', $id));
|
|
}
|
|
print "<br>";
|
|
if ($EditNote ne '') {
|
|
print T($EditNote) . '<br>'; # Allow translation
|
|
}
|
|
print $q->submit(-name=>'Save', -value=>T('Save')), "\n";
|
|
$userName = &GetParam("username", "");
|
|
if ($userName ne "") {
|
|
print ' (', T('Your user name is'), ' ',
|
|
&GetPageLink($userName) . ') ';
|
|
} else {
|
|
print ' (', Ts('Visit %s to set your user name.', &GetPrefsLink(), 1), ') ';
|
|
}
|
|
print $q->submit(-name=>'Preview', -value=>T('Preview')), "\n";
|
|
if ($isConflict) {
|
|
print "\n<br><hr><p><strong>", T('This is the text you submitted:'),
|
|
"</strong><p>",
|
|
&GetTextArea('newtext', $newText, $editRows, $editCols),
|
|
"<p>\n";
|
|
}
|
|
if ($preview) {
|
|
print '<div class=wikipreview>';
|
|
print "<hr class=wikilinepreview>\n";
|
|
print "<h2>", T('Preview:'), "</h2>\n";
|
|
if ($isConflict) {
|
|
print "<b>",
|
|
T('NOTE: This preview shows the revision of the other author.'),
|
|
"</b><hr>\n";
|
|
}
|
|
$MainPage = $id;
|
|
$MainPage =~ s|/.*||; # Only the main page name (remove subpage)
|
|
print &WikiToHTML($oldText) . "<hr class=wikilinepreview>\n";
|
|
print "<h2>", T('Preview only, not yet saved'), "</h2>\n";
|
|
print '</div>';
|
|
}
|
|
print $q->end_form;
|
|
if (!&GetParam('embed', $EmbedWiki)) {
|
|
print '<div class=wikifooter>';
|
|
print "<hr class=wikilinefooter>\n";
|
|
print &GetHistoryLink($id, T('View other revisions')) . "<br>\n";
|
|
print &GetGotoBar($id);
|
|
print '</div>';
|
|
}
|
|
print &GetMinimumFooter();
|
|
}
|
|
|
|
sub GetTextArea {
|
|
my ($name, $text, $rows, $cols) = @_;
|
|
|
|
if (&GetParam("editwide", 1)) {
|
|
return $q->textarea(-name=>$name, -default=>$text,
|
|
-rows=>$rows, -columns=>$cols, -override=>1,
|
|
-style=>'width:100%', -wrap=>'virtual');
|
|
}
|
|
return $q->textarea(-name=>$name, -default=>$text,
|
|
-rows=>$rows, -columns=>$cols, -override=>1,
|
|
-wrap=>'virtual');
|
|
}
|
|
|
|
sub DoEditPrefs {
|
|
my ($check, $recentName, %labels);
|
|
|
|
$recentName = $RCName;
|
|
$recentName =~ s/_/ /g;
|
|
&DoNewLogin() if ($UserID < 400);
|
|
print &GetHeader('', T('Editing Preferences'), '');
|
|
print '<div class=wikipref>';
|
|
print &GetFormStart();
|
|
print GetHiddenValue("edit_prefs", 1), "\n";
|
|
print '<b>' . T('User Information:') . "</b>\n";
|
|
print '<br>' . Ts('Your User ID number: %s', $UserID) . "\n";
|
|
print '<br>' . T('UserName:') . ' ', &GetFormText('username', "", 20, 50);
|
|
print ' ' . T('(blank to remove, or valid page name)');
|
|
print '<br>' . T('Set Password:') . ' ',
|
|
$q->password_field(-name=>'p_password', -value=>'*',
|
|
-size=>15, -maxlength=>50),
|
|
' ', T('(blank to remove password)'), '<br>(',
|
|
T('Passwords allow sharing preferences between multiple systems.'),
|
|
' ', T('Passwords are completely optional.'), ')';
|
|
if (($AdminPass ne '') || ($EditPass ne '')) {
|
|
print '<br>', T('Administrator Password:'), ' ',
|
|
$q->password_field(-name=>'p_adminpw', -value=>'*',
|
|
-size=>15, -maxlength=>50),
|
|
' ', T('(blank to remove password)'), '<br>',
|
|
T('(Administrator passwords are used for special maintenance.)');
|
|
}
|
|
if ($EmailNotify) {
|
|
print "<br>";
|
|
print &GetFormCheck('notify', 1,
|
|
T('Include this address in the site email list.')), ' ',
|
|
T('(Uncheck the box to remove the address.)');
|
|
print '<br>', T('Email Address:'), ' ',
|
|
&GetFormText('email', "", 30, 60);
|
|
}
|
|
print "<hr class=wikilinepref><b>$recentName:</b>\n";
|
|
print '<br>', T('Default days to display:'), ' ',
|
|
&GetFormText('rcdays', $RcDefault, 4, 9);
|
|
print "<br>", &GetFormCheck('rcnewtop', $RecentTop,
|
|
T('Most recent changes on top'));
|
|
print "<br>", &GetFormCheck('rcall', 0,
|
|
T('Show all changes (not just most recent)'));
|
|
%labels = (0=>T('Hide minor edits'), 1=>T('Show minor edits'),
|
|
2=>T('Show only minor edits'));
|
|
print '<br>', T('Minor edit display:'), ' ';
|
|
print $q->popup_menu(-name=>'p_rcshowedit',
|
|
-values=>[0,1,2], -labels=>\%labels,
|
|
-default=>&GetParam("rcshowedit", $ShowEdits));
|
|
print "<br>", &GetFormCheck('rcchangehist', 1,
|
|
T('Use "changes" as link to history'));
|
|
if ($UseDiff) {
|
|
print '<hr class=wikilinepref><b>', T('Differences:'), "</b>\n";
|
|
print "<br>", &GetFormCheck('diffrclink', 1,
|
|
Ts('Show (diff) links on %s', $recentName));
|
|
print "<br>", &GetFormCheck('alldiff', 0,
|
|
T('Show differences on all pages'));
|
|
print " (", &GetFormCheck('norcdiff', 1,
|
|
Ts('No differences on %s', $recentName)), ")";
|
|
%labels = (1=>T('Major'), 2=>T('Minor'), 3=>T('Author'));
|
|
print '<br>', T('Default difference type:'), ' ';
|
|
print $q->popup_menu(-name=>'p_defaultdiff',
|
|
-values=>[1,2,3], -labels=>\%labels,
|
|
-default=>&GetParam("defaultdiff", 1));
|
|
}
|
|
print '<hr class=wikilinepref><b>', T('Misc:'), "</b>\n";
|
|
# Note: TZ offset is added by TimeToText, so pre-subtract to cancel.
|
|
print '<br>', T('Server time:'), ' ', &TimeToText($Now-$TimeZoneOffset);
|
|
print '<br>', T('Time Zone offset (hours):'), ' ',
|
|
&GetFormText('tzoffset', 0, 4, 9);
|
|
print '<br>', &GetFormCheck('editwide', 1,
|
|
T('Use 100% wide edit area (if supported)'));
|
|
print '<br>',
|
|
T('Edit area rows:'), ' ', &GetFormText('editrows', 20, 4, 4),
|
|
' ', T('columns:'), ' ', &GetFormText('editcols', 65, 4, 4);
|
|
|
|
print '<br>', &GetFormCheck('toplinkbar', 1,
|
|
T('Show link bar on top'));
|
|
print '<br>', &GetFormCheck('linkrandom', 0,
|
|
T('Add "Random Page" link to link bar'));
|
|
print '<br>' . T('StyleSheet URL:') . ' ',
|
|
&GetFormText('stylesheet', "", 30, 150);
|
|
print '<br>', $q->submit(-name=>'Save', -value=>T('Save')), "\n";
|
|
print $q->end_form;
|
|
print '</div>';
|
|
if (!&GetParam('embed', $EmbedWiki)) {
|
|
print '<div class=wikifooter>';
|
|
print "<hr class=wikilinefooter>\n";
|
|
print &GetGotoBar('');
|
|
print '</div>';
|
|
}
|
|
print &GetMinimumFooter();
|
|
}
|
|
|
|
sub GetFormText {
|
|
my ($name, $default, $size, $max) = @_;
|
|
my $text = &GetParam($name, $default);
|
|
|
|
return $q->textfield(-name=>"p_$name", -default=>$text,
|
|
-override=>1, -size=>$size, -maxlength=>$max);
|
|
}
|
|
|
|
sub GetFormCheck {
|
|
my ($name, $default, $label) = @_;
|
|
my $checked = (&GetParam($name, $default) > 0);
|
|
|
|
return $q->checkbox(-name=>"p_$name", -override=>1, -checked=>$checked,
|
|
-label=>$label);
|
|
}
|
|
|
|
sub DoUpdatePrefs {
|
|
my ($username, $password, $stylesheet);
|
|
|
|
# All link bar settings should be updated before printing the header
|
|
&UpdatePrefCheckbox("toplinkbar");
|
|
&UpdatePrefCheckbox("linkrandom");
|
|
print &GetHeader('', T('Saving Preferences'), '');
|
|
if ($UserID < 1001) {
|
|
print '<b>',
|
|
Ts('Invalid UserID %s, preferences not saved.', $UserID), '</b>';
|
|
if ($UserID == 111) {
|
|
print '<br>',
|
|
T('(Preferences require cookies, but no cookie was sent.)');
|
|
}
|
|
print &GetCommonFooter();
|
|
return;
|
|
}
|
|
$username = &GetParam("p_username", "");
|
|
if ($FreeLinks) {
|
|
$username =~ s/^\[\[(.+)\]\]/$1/; # Remove [[ and ]] if added
|
|
$username = &FreeToNormal($username);
|
|
$username =~ s/_/ /g;
|
|
}
|
|
if ($username eq "") {
|
|
print T('UserName removed.'), '<br>';
|
|
delete $UserData{'username'};
|
|
} elsif ((!$FreeLinks) && (!($username =~ /^$LinkPattern$/))) {
|
|
print Ts('Invalid UserName %s: not saved.', $username), "<br>\n";
|
|
} elsif ($FreeLinks && (!($username =~ /^$FreeLinkPattern$/))) {
|
|
print Ts('Invalid UserName %s: not saved.', $username), "<br>\n";
|
|
} elsif (length($username) > 50) { # Too long
|
|
print T('UserName must be 50 characters or less. (not saved)'), "<br>\n";
|
|
} else {
|
|
print Ts('UserName %s saved.', $username), '<br>';
|
|
$UserData{'username'} = $username;
|
|
}
|
|
$password = &GetParam("p_password", "");
|
|
if ($password eq "") {
|
|
print T('Password removed.'), '<br>';
|
|
delete $UserData{'password'};
|
|
} elsif ($password ne "*") {
|
|
print T('Password changed.'), '<br>';
|
|
$UserData{'password'} = $password;
|
|
}
|
|
if (($AdminPass ne "") || ($EditPass ne "")) {
|
|
$password = &GetParam("p_adminpw", "");
|
|
if ($password eq "") {
|
|
print T('Administrator password removed.'), '<br>';
|
|
delete $UserData{'adminpw'};
|
|
} elsif ($password ne "*") {
|
|
print T('Administrator password changed.'), '<br>';
|
|
$UserData{'adminpw'} = $password;
|
|
if (&UserIsAdmin()) {
|
|
print T('User has administrative abilities.'), '<br>';
|
|
} elsif (&UserIsEditor()) {
|
|
print T('User has editor abilities.'), '<br>';
|
|
} else {
|
|
print T('User does not have administrative abilities.'), ' ',
|
|
T('(Password does not match administrative password(s).)'),
|
|
'<br>';
|
|
}
|
|
}
|
|
}
|
|
if ($EmailNotify) {
|
|
&UpdatePrefCheckbox("notify");
|
|
&UpdateEmailList();
|
|
}
|
|
&UpdatePrefNumber("rcdays", 0, 0, 999999);
|
|
&UpdatePrefCheckbox("rcnewtop");
|
|
&UpdatePrefCheckbox("rcall");
|
|
&UpdatePrefCheckbox("rcchangehist");
|
|
&UpdatePrefCheckbox("editwide");
|
|
if ($UseDiff) {
|
|
&UpdatePrefCheckbox("norcdiff");
|
|
&UpdatePrefCheckbox("diffrclink");
|
|
&UpdatePrefCheckbox("alldiff");
|
|
&UpdatePrefNumber("defaultdiff", 1, 1, 3);
|
|
}
|
|
&UpdatePrefNumber("rcshowedit", 1, 0, 2);
|
|
&UpdatePrefNumber("tzoffset", 0, -999, 999);
|
|
&UpdatePrefNumber("editrows", 1, 1, 999);
|
|
&UpdatePrefNumber("editcols", 1, 1, 999);
|
|
print T('Server time:'), ' ', &TimeToText($Now-$TimeZoneOffset), '<br>';
|
|
$TimeZoneOffset = &GetParam("tzoffset", 0) * (60 * 60);
|
|
print T('Local time:'), ' ', &TimeToText($Now), '<br>';
|
|
$stylesheet = &GetParam('p_stylesheet', '');
|
|
if ($stylesheet eq '') {
|
|
if (&GetParam('stylesheet', '') ne '') {
|
|
print T('StyleSheet URL removed.'), '<br>';
|
|
}
|
|
delete $UserData{'stylesheet'};
|
|
} else {
|
|
$stylesheet =~ s/[">]//g; # Remove characters that would cause problems
|
|
$UserData{'stylesheet'} = $stylesheet;
|
|
print T('StyleSheet setting saved.'), '<br>';
|
|
}
|
|
&SaveUserData();
|
|
print '<b>', T('Preferences saved.'), '</b>';
|
|
print &GetCommonFooter();
|
|
}
|
|
|
|
# add or remove email address from preferences to $EmailFile
|
|
sub UpdateEmailList {
|
|
my (@old_emails);
|
|
|
|
local $/ = "\n"; # don't slurp whole files in this sub.
|
|
if (my $new_email = $UserData{'email'} = &GetParam("p_email", "")) {
|
|
my $notify = $UserData{'notify'};
|
|
if (-f $EmailFile) {
|
|
open(NOTIFY, $EmailFile)
|
|
or die(Ts('Could not read from %s:', $EmailFile) . " $!\n");
|
|
@old_emails = <NOTIFY>;
|
|
close(NOTIFY);
|
|
} else {
|
|
@old_emails = ();
|
|
}
|
|
my $already_in_list = grep /$new_email/, @old_emails;
|
|
if ($notify and (not $already_in_list)) {
|
|
&RequestLock() or die(T('Could not get mail lock'));
|
|
if (!open(NOTIFY, ">>$EmailFile")) {
|
|
&ReleaseLock(); # Don't leave hangling locks
|
|
die(Ts('Could not append to %s:', $EmailFile) . " $!\n");
|
|
}
|
|
print NOTIFY $new_email, "\n";
|
|
close(NOTIFY);
|
|
&ReleaseLock();
|
|
}
|
|
elsif ((not $notify) and $already_in_list) {
|
|
&RequestLock() or die(T('Could not get mail lock'));
|
|
if (!open(NOTIFY, ">$EmailFile")) {
|
|
&ReleaseLock();
|
|
die(Ts('Could not overwrite %s:', "$EmailFile") . " $!\n");
|
|
}
|
|
foreach (@old_emails) {
|
|
print NOTIFY "$_" unless /$new_email/;
|
|
}
|
|
close(NOTIFY);
|
|
&ReleaseLock();
|
|
}
|
|
}
|
|
}
|
|
|
|
sub UpdatePrefCheckbox {
|
|
my ($param) = @_;
|
|
my $temp = &GetParam("p_$param", "*");
|
|
|
|
$UserData{$param} = 1 if ($temp eq "on");
|
|
$UserData{$param} = 0 if ($temp eq "*");
|
|
# It is possible to skip updating by using another value, like "2"
|
|
}
|
|
|
|
sub UpdatePrefNumber {
|
|
my ($param, $integer, $min, $max) = @_;
|
|
my $temp = &GetParam("p_$param", "*");
|
|
|
|
return if ($temp eq "*");
|
|
$temp =~ s/[^-\d\.]//g;
|
|
$temp =~ s/\..*// if ($integer);
|
|
return if ($temp eq "");
|
|
return if (($temp < $min) || ($temp > $max));
|
|
$UserData{$param} = $temp;
|
|
}
|
|
|
|
sub DoIndex {
|
|
print &GetHeader('', T('Index of all pages'), '');
|
|
&PrintPageList(&AllPagesList());
|
|
print &GetCommonFooter();
|
|
}
|
|
|
|
# Create a new user file/cookie pair
|
|
sub DoNewLogin {
|
|
# Consider warning if cookie already exists
|
|
# (maybe use "replace=1" parameter)
|
|
&CreateUserDir();
|
|
$SetCookie{'id'} = &GetNewUserId();
|
|
$SetCookie{'randkey'} = int(rand(1000000000));
|
|
$SetCookie{'rev'} = 1;
|
|
%UserCookie = %SetCookie;
|
|
$UserID = $SetCookie{'id'};
|
|
# The cookie will be transmitted in the next header
|
|
%UserData = %UserCookie;
|
|
$UserData{'createtime'} = $Now;
|
|
$UserData{'createip'} = $ENV{REMOTE_ADDR};
|
|
&SaveUserData();
|
|
}
|
|
|
|
sub DoEnterLogin {
|
|
print &GetHeader('', T('Login'), "");
|
|
print &GetFormStart();
|
|
print &GetHiddenValue('enter_login', 1), "\n";
|
|
print '<br>', T('User ID number:'), ' ',
|
|
$q->textfield(-name=>'p_userid', -value=>'',
|
|
-size=>15, -maxlength=>50);
|
|
print '<br>', T('Password:'), ' ',
|
|
$q->password_field(-name=>'p_password', -value=>'',
|
|
-size=>15, -maxlength=>50);
|
|
print '<br>', $q->submit(-name=>'Login', -value=>T('Login')), "\n";
|
|
print $q->end_form;
|
|
if (!&GetParam('embed', $EmbedWiki)) {
|
|
print '<div class=wikifooter>';
|
|
print "<hr class=wikilinefooter>\n";
|
|
print &GetGotoBar('');
|
|
print '</div>';
|
|
}
|
|
print &GetMinimumFooter();
|
|
}
|
|
|
|
sub DoLogin {
|
|
my ($unsafe_uid, $uid, $password, $success);
|
|
|
|
$success = 0;
|
|
$unsafe_uid = &GetParam("p_userid", "");
|
|
$uid = &SanitizeUserID($unsafe_uid);
|
|
$password = &GetParam("p_password", "");
|
|
if (($uid > 199) && ($password ne "") && ($password ne "*")) {
|
|
$UserID = $uid;
|
|
&LoadUserData();
|
|
if ($UserID > 199) {
|
|
if (defined($UserData{'password'}) &&
|
|
($UserData{'password'} eq $password)) {
|
|
$SetCookie{'id'} = $uid;
|
|
$SetCookie{'randkey'} = $UserData{'randkey'};
|
|
$SetCookie{'rev'} = 1;
|
|
$success = 1;
|
|
}
|
|
}
|
|
}
|
|
print &GetHeader('', T('Login Results'), '');
|
|
if ($success) {
|
|
print Ts('Login for user ID %s complete.', $unsafe_uid);
|
|
} else {
|
|
print Ts('Login for user ID %s failed.', $unsafe_uid);
|
|
}
|
|
if (!&GetParam('embed', $EmbedWiki)) {
|
|
print '<div class=wikifooter>';
|
|
print "<hr class=wikilinefooter>\n";
|
|
print &GetGotoBar('');
|
|
print '</div>';
|
|
}
|
|
print &GetMinimumFooter();
|
|
}
|
|
|
|
sub GetNewUserId {
|
|
my ($id);
|
|
|
|
$id = $StartUID;
|
|
while (-f &UserDataFilename($id+1000)) {
|
|
$id += 1000;
|
|
}
|
|
while (-f &UserDataFilename($id+100)) {
|
|
$id += 100;
|
|
}
|
|
while (-f &UserDataFilename($id+10)) {
|
|
$id += 10;
|
|
}
|
|
&RequestLock() or die(T('Could not get user-ID lock'));
|
|
while (-f &UserDataFilename($id)) {
|
|
$id++;
|
|
}
|
|
&WriteStringToFile(&UserDataFilename($id), "lock"); # reserve the ID
|
|
&ReleaseLock();
|
|
return $id;
|
|
}
|
|
|
|
# Consider user-level lock?
|
|
sub SaveUserData {
|
|
my ($userFile, $data);
|
|
|
|
&CreateUserDir();
|
|
$userFile = &UserDataFilename($UserID);
|
|
$data = join($FS1, %UserData);
|
|
&WriteStringToFile($userFile, $data);
|
|
}
|
|
|
|
sub CreateUserDir {
|
|
my ($n, $subdir);
|
|
|
|
if (!(-d "$UserDir/0")) {
|
|
&CreateDir($UserDir);
|
|
|
|
foreach $n (0..9) {
|
|
$subdir = "$UserDir/$n";
|
|
&CreateDir($subdir);
|
|
}
|
|
}
|
|
}
|
|
|
|
sub DoSearch {
|
|
my ($string) = @_;
|
|
|
|
if ($string eq '') {
|
|
&DoIndex();
|
|
return;
|
|
}
|
|
print &GetHeader('', &QuoteHtml(Ts('Search for: %s', $string)), '');
|
|
&PrintPageList(&SearchTitleAndBody($string));
|
|
print &GetCommonFooter();
|
|
}
|
|
|
|
sub DoBackLinks {
|
|
my ($string) = @_;
|
|
|
|
print &GetHeader('', &QuoteHtml(Ts('Backlinks for: %s', $string)), '');
|
|
# At this time the backlinks are mostly a renamed search.
|
|
# An initial attempt to match links only failed on subpages and free links.
|
|
# Escape some possibly problematic characters:
|
|
$string =~ s/([-'().,])/\\$1/g;
|
|
&PrintPageList(&SearchTitleAndBody($string));
|
|
print &GetCommonFooter();
|
|
}
|
|
|
|
sub PrintPageList {
|
|
my $pagename;
|
|
|
|
print "<h2>", Ts('%s pages found:', ($#_ + 1)), "</h2>\n";
|
|
foreach $pagename (@_) {
|
|
print ".... " if ($pagename =~ m|/|);
|
|
print &GetPageLink($pagename), "<br>\n";
|
|
}
|
|
}
|
|
|
|
sub DoLinks {
|
|
print &GetHeader('', &QuoteHtml(T('Full Link List')), '');
|
|
print "<pre>\n\n\n\n\n"; # Extra lines to get below the logo
|
|
&PrintLinkList(&GetFullLinkList());
|
|
print "</pre>\n";
|
|
print &GetCommonFooter();
|
|
}
|
|
|
|
sub PrintLinkList {
|
|
my ($pagelines, $page, $names, $editlink);
|
|
my ($link, $extra, @links, %pgExists);
|
|
|
|
%pgExists = ();
|
|
foreach $page (&AllPagesList()) {
|
|
$pgExists{$page} = 1;
|
|
}
|
|
$names = &GetParam("names", 1);
|
|
$editlink = &GetParam("editlink", 0);
|
|
foreach $pagelines (@_) {
|
|
@links = ();
|
|
foreach $page (split(' ', $pagelines)) {
|
|
if ($page =~ /\:/) { # URL or InterWiki form
|
|
if ($page =~ /$UrlPattern/) {
|
|
($link, $extra) = &UrlLink($page, 0); # No images
|
|
} else {
|
|
($link, $extra) = &InterPageLink($page, 0); # No images
|
|
}
|
|
} else {
|
|
if ($pgExists{$page}) {
|
|
$link = &GetPageLink($page);
|
|
} else {
|
|
$link = $page;
|
|
if ($editlink) {
|
|
$link .= &GetEditLink($page, "?");
|
|
}
|
|
}
|
|
}
|
|
push(@links, $link);
|
|
}
|
|
if (!$names) {
|
|
shift(@links);
|
|
}
|
|
print join(' ', @links), "\n";
|
|
}
|
|
}
|
|
|
|
sub GetFullLinkList {
|
|
my ($name, $unique, $sort, $exists, $empty, $link, $search);
|
|
my ($pagelink, $interlink, $urllink);
|
|
my (@found, @links, @newlinks, @pglist, %pgExists, %seen, $main);
|
|
|
|
$unique = &GetParam("unique", 1);
|
|
$sort = &GetParam("sort", 1);
|
|
$pagelink = &GetParam("page", 1);
|
|
$interlink = &GetParam("inter", 0);
|
|
$urllink = &GetParam("url", 0);
|
|
$exists = &GetParam("exists", 2);
|
|
$empty = &GetParam("empty", 0);
|
|
$search = &GetParam("search", "");
|
|
if (($interlink == 2) || ($urllink == 2)) {
|
|
$pagelink = 0;
|
|
}
|
|
%pgExists = ();
|
|
@pglist = &AllPagesList();
|
|
foreach $name (@pglist) {
|
|
$pgExists{$name} = 1;
|
|
}
|
|
%seen = ();
|
|
foreach $name (@pglist) {
|
|
@newlinks = ();
|
|
if ($unique != 2) {
|
|
%seen = ();
|
|
}
|
|
@links = &GetPageLinks($name, $pagelink, $interlink, $urllink);
|
|
if ($UseSubpage) {
|
|
$main = $name;
|
|
$main =~ s/\/.*//;
|
|
}
|
|
foreach $link (@links) {
|
|
if ($UseSubpage && ($link =~ /^\//)) {
|
|
$link = $main . $link;
|
|
}
|
|
$seen{$link}++;
|
|
if (($unique > 0) && ($seen{$link} != 1)) {
|
|
next;
|
|
}
|
|
if (($exists == 0) && ($pgExists{$link} == 1)) {
|
|
next;
|
|
}
|
|
if (($exists == 1) && ($pgExists{$link} != 1)) {
|
|
next;
|
|
}
|
|
if (($search ne "") && !($link =~ /$search/)) {
|
|
next;
|
|
}
|
|
push(@newlinks, $link);
|
|
}
|
|
@links = @newlinks;
|
|
if ($sort) {
|
|
@links = sort(@links);
|
|
}
|
|
unshift (@links, $name);
|
|
if ($empty || ($#links > 0)) { # If only one item, list is empty.
|
|
push(@found, join(' ', @links));
|
|
}
|
|
}
|
|
return @found;
|
|
}
|
|
|
|
sub GetPageLinks {
|
|
my ($name, $pagelink, $interlink, $urllink) = @_;
|
|
my ($text, @links);
|
|
|
|
@links = ();
|
|
&OpenPage($name);
|
|
&OpenDefaultText();
|
|
$text = $Text{'text'};
|
|
$text =~ s/<html>((.|\n)*?)<\/html>/ /ig;
|
|
$text =~ s/<nowiki>(.|\n)*?\<\/nowiki>/ /ig;
|
|
$text =~ s/<pre>(.|\n)*?\<\/pre>/ /ig;
|
|
$text =~ s/<code>(.|\n)*?\<\/code>/ /ig;
|
|
if ($interlink) {
|
|
$text =~ s/''+/ /g; # Quotes can adjacent to inter-site links
|
|
$text =~ s/$InterLinkPattern/push(@links, &StripUrlPunct($1)), ' '/ge;
|
|
} else {
|
|
$text =~ s/$InterLinkPattern/ /g;
|
|
}
|
|
if ($urllink) {
|
|
$text =~ s/''+/ /g; # Quotes can adjacent to URLs
|
|
$text =~ s/$UrlPattern/push(@links, &StripUrlPunct($1)), ' '/ge;
|
|
} else {
|
|
$text =~ s/$UrlPattern/ /g;
|
|
}
|
|
if ($pagelink) {
|
|
if ($FreeLinks) {
|
|
my $fl = $FreeLinkPattern;
|
|
$text =~ s/\[\[$fl\|[^\]]+\]\]/push(@links, &FreeToNormal($1)), ' '/ge;
|
|
$text =~ s/\[\[$fl\]\]/push(@links, &FreeToNormal($1)), ' '/ge;
|
|
}
|
|
if ($WikiLinks) {
|
|
$text =~ s/$LinkPattern/push(@links, &StripUrlPunct($1)), ' '/ge;
|
|
}
|
|
}
|
|
return @links;
|
|
}
|
|
|
|
sub DoPost {
|
|
my ($id, $editDiff, $old, $newAuthor, $pgtime, $oldrev, $preview, $user);
|
|
my $string = &GetParam("text", undef);
|
|
my $unsafe_id = &GetParam("title", "");
|
|
my $summary = &GetParam("summary", "");
|
|
my $oldtime = &GetParam("oldtime", "");
|
|
my $oldconflict = &GetParam("oldconflict", "");
|
|
my $isEdit = 0;
|
|
my $editTime = $Now;
|
|
my $authorAddr = $ENV{REMOTE_ADDR};
|
|
|
|
if ($FreeLinks) {
|
|
$unsafe_id = &FreeToNormal($unsafe_id);
|
|
}
|
|
$id = &SanitizePageName($unsafe_id);
|
|
if (!$id) {
|
|
&ReportError(Ts('Invalid Page %s', $unsafe_id));
|
|
return;
|
|
}
|
|
if (!&UserCanEdit($id, 1)) {
|
|
# This is an internal interface--we don't need to explain
|
|
&ReportError(Ts('Editing not allowed for %s.', $id));
|
|
return;
|
|
}
|
|
if (($id eq 'SampleUndefinedPage') ||
|
|
($id eq T('SampleUndefinedPage')) ||
|
|
($id eq 'Sample_Undefined_Page') ||
|
|
($id eq T('Sample_Undefined_Page'))) {
|
|
&ReportError(Ts('%s cannot be defined.', $id));
|
|
return;
|
|
}
|
|
$string = &RemoveFS($string);
|
|
$summary = &RemoveFS($summary);
|
|
$summary =~ s/[\r\n]//g;
|
|
if (length($summary) > 300) { # Too long (longer than form allows)
|
|
$summary = substr($summary, 0, 300);
|
|
}
|
|
# Add a newline to the end of the string (if it doesn't have one)
|
|
$string .= "\n" if (!($string =~ /\n$/));
|
|
# Lock before getting old page to prevent races
|
|
# Consider extracting lock section into sub, and eval-wrap it?
|
|
# (A few called routines can die, leaving locks.)
|
|
if ($LockCrash) {
|
|
&RequestLock() or die(T('Could not get editing lock'));
|
|
} else {
|
|
if (!&RequestLock()) {
|
|
&ForceReleaseLock('main');
|
|
}
|
|
# Clear all other locks.
|
|
&ForceReleaseLock('cache');
|
|
&ForceReleaseLock('diff');
|
|
&ForceReleaseLock('index');
|
|
}
|
|
&OpenPage($id);
|
|
&OpenDefaultText();
|
|
$old = $Text{'text'};
|
|
$oldrev = $Section{'revision'};
|
|
$pgtime = $Section{'ts'};
|
|
$preview = 0;
|
|
$preview = 1 if (&GetParam("Preview", "") ne "");
|
|
if (!$preview && ($old eq $string)) { # No changes (ok for preview)
|
|
&ReleaseLock();
|
|
&ReBrowsePage($id, "", 1);
|
|
return;
|
|
}
|
|
if (($UserID > 399) || ($Section{'id'} > 399)) {
|
|
$newAuthor = ($UserID ne $Section{'id'}); # known user(s)
|
|
} else {
|
|
$newAuthor = ($Section{'ip'} ne $authorAddr); # hostname fallback
|
|
}
|
|
$newAuthor = 1 if ($oldrev == 0); # New page
|
|
$newAuthor = 0 if (!$newAuthor); # Standard flag form, not empty
|
|
# Detect editing conflicts and resubmit edit
|
|
if (($oldrev > 0) && ($newAuthor && ($oldtime != $pgtime))) {
|
|
&ReleaseLock();
|
|
if ($oldconflict > 0) { # Conflict again...
|
|
&DoEdit($id, 2, $pgtime, $string, $preview);
|
|
} else {
|
|
&DoEdit($id, 1, $pgtime, $string, $preview);
|
|
}
|
|
return;
|
|
}
|
|
if ($preview) {
|
|
&ReleaseLock();
|
|
&DoEdit($id, 0, $pgtime, $string, 1);
|
|
return;
|
|
}
|
|
$user = &GetParam("username", "");
|
|
# If the person doing editing chooses, send out email notification
|
|
if ($EmailNotify) {
|
|
&EmailNotify($id, $user) if &GetParam("do_email_notify", "") eq 'on';
|
|
}
|
|
if (&GetParam("recent_edit", "") eq 'on') {
|
|
$isEdit = 1;
|
|
}
|
|
if (!$isEdit) {
|
|
&SetPageCache('oldmajor', $Section{'revision'});
|
|
}
|
|
if ($newAuthor) {
|
|
&SetPageCache('oldauthor', $Section{'revision'});
|
|
}
|
|
&SaveKeepSection();
|
|
&ExpireKeepFile();
|
|
if ($UseDiff) {
|
|
&UpdateDiffs($id, $editTime, $old, $string, $isEdit, $newAuthor);
|
|
}
|
|
$Text{'text'} = $string;
|
|
$Text{'minor'} = $isEdit;
|
|
$Text{'newauthor'} = $newAuthor;
|
|
$Text{'summary'} = $summary;
|
|
$Section{'host'} = &GetRemoteHost(1);
|
|
&SaveDefaultText();
|
|
&SavePage();
|
|
&WriteRcLog($id, $summary, $isEdit, $editTime, $Section{'revision'},
|
|
$user, $Section{'host'});
|
|
if ($UseCache) {
|
|
&UnlinkHtmlCache($id); # Old cached copy is invalid
|
|
if ($Page{'revision'} < 2) { # If this is a new page...
|
|
&NewPageCacheClear($id); # ...uncache pages linked to this one.
|
|
}
|
|
}
|
|
if ($UseIndex && ($Page{'revision'} == 1)) {
|
|
unlink($IndexFile); # Regenerate index on next request
|
|
}
|
|
&ReleaseLock();
|
|
&ReBrowsePage($id, "", 1);
|
|
}
|
|
|
|
sub UpdateDiffs {
|
|
my ($id, $editTime, $old, $new, $isEdit, $newAuthor) = @_;
|
|
my ($editDiff, $oldMajor, $oldAuthor);
|
|
|
|
$editDiff = &GetDiff($old, $new, 0); # 0 = already in lock
|
|
$oldMajor = &GetPageCache('oldmajor');
|
|
$oldAuthor = &GetPageCache('oldauthor');
|
|
if ($UseDiffLog) {
|
|
&WriteDiff($id, $editTime, $editDiff);
|
|
}
|
|
&SetPageCache('diff_default_minor', $editDiff);
|
|
if ($isEdit || !$newAuthor) {
|
|
&OpenKeptRevisions('text_default');
|
|
}
|
|
if (!$isEdit) {
|
|
&SetPageCache('diff_default_major', "1");
|
|
} else {
|
|
&SetPageCache('diff_default_major', &GetKeptDiff($new, $oldMajor, 0));
|
|
}
|
|
if ($newAuthor) {
|
|
&SetPageCache('diff_default_author', "1");
|
|
} elsif ($oldMajor == $oldAuthor) {
|
|
&SetPageCache('diff_default_author', "2");
|
|
} else {
|
|
&SetPageCache('diff_default_author', &GetKeptDiff($new, $oldAuthor, 0));
|
|
}
|
|
}
|
|
|
|
# Translation note: the email messages are still sent in English
|
|
# Send an email message.
|
|
sub SendEmail {
|
|
my ($to, $from, $reply, $subject, $message) = @_;
|
|
|
|
# sendmail options:
|
|
# -odq : send mail to queue (i.e. later when convenient)
|
|
# -oi : do not wait for "." line to exit
|
|
# -t : headers determine recipient.
|
|
open (SENDMAIL, "| $SendMail -oi -t ") or die "Can't send email: $!\n";
|
|
print SENDMAIL <<"EOF";
|
|
From: $from
|
|
To: $to
|
|
Reply-to: $reply
|
|
Subject: $subject\n
|
|
$message
|
|
EOF
|
|
close(SENDMAIL) or warn "sendmail didn't close nicely";
|
|
}
|
|
|
|
## Email folks who want to know a note that a page has been modified. - JimM.
|
|
sub EmailNotify {
|
|
local $/ = "\n"; # don't slurp whole files in this sub.
|
|
|
|
if ($EmailNotify) {
|
|
my ($id, $user) = @_;
|
|
if ($user) {
|
|
$user = " by $user";
|
|
}
|
|
my $address;
|
|
return if (!-f $EmailFile); # No notifications yet
|
|
open(EMAIL, $EmailFile)
|
|
or die "Can't open $EmailFile: $!\n";
|
|
$address = join ",", <EMAIL>;
|
|
$address =~ s/\n//g;
|
|
close(EMAIL);
|
|
my $home_url = $q->url();
|
|
my $page_url = $home_url . &ScriptLinkChar() . &UriEscape($id);
|
|
my $pref_url = $home_url . &ScriptLinkChar() . "action=editprefs";
|
|
my $editors_summary = $q->param("summary");
|
|
if (($editors_summary eq "*") or ($editors_summary eq "")){
|
|
$editors_summary = "";
|
|
}
|
|
else {
|
|
$editors_summary = "\n Summary: $editors_summary";
|
|
}
|
|
my $content = <<"END_MAIL_CONTENT";
|
|
|
|
The $SiteName page $id at
|
|
$page_url
|
|
has been changed$user to revision $Page{revision}. $editors_summary
|
|
|
|
(Replying to this notification will
|
|
send email to the entire mailing list,
|
|
so only do that if you mean to.
|
|
|
|
To remove yourself from this list, visit
|
|
$pref_url .)
|
|
END_MAIL_CONTENT
|
|
my $subject = "The $id page at $SiteName has been changed.";
|
|
# I'm setting the "reply-to" field to be the same as the "to:" field
|
|
# which seems appropriate for a mailing list, especially since the
|
|
# $EmailFrom string needn't be a real email address.
|
|
&SendEmail($address, $EmailFrom, $address, $subject, $content);
|
|
}
|
|
}
|
|
|
|
sub SearchTitleAndBody {
|
|
my ($string) = @_;
|
|
my ($name, $freeName, @found);
|
|
|
|
foreach $name (&AllPagesList()) {
|
|
&OpenPage($name);
|
|
&OpenDefaultText();
|
|
if (($Text{'text'} =~ /$string/i) || ($name =~ /$string/i)) {
|
|
push(@found, $name);
|
|
} elsif ($FreeLinks) {
|
|
if ($name =~ m/_/) {
|
|
$freeName = $name;
|
|
$freeName =~ s/_/ /g;
|
|
if ($freeName =~ /$string/i) {
|
|
push(@found, $name);
|
|
}
|
|
} elsif ($string =~ m/ /) {
|
|
$freeName = $string;
|
|
$freeName =~ s/ /_/g;
|
|
if ($Text{'text'} =~ /$freeName/i) {
|
|
push(@found, $name);
|
|
}
|
|
}
|
|
}
|
|
}
|
|
return @found;
|
|
}
|
|
|
|
sub SearchBody {
|
|
my ($string) = @_;
|
|
my ($name, @found);
|
|
|
|
foreach $name (&AllPagesList()) {
|
|
&OpenPage($name);
|
|
&OpenDefaultText();
|
|
if ($Text{'text'} =~ /$string/i){
|
|
push(@found, $name);
|
|
}
|
|
}
|
|
return @found;
|
|
}
|
|
|
|
sub UnlinkHtmlCache {
|
|
my ($id) = @_;
|
|
my $idFile;
|
|
|
|
$idFile = &GetHtmlCacheFile($id);
|
|
if (-f $idFile) {
|
|
unlink($idFile);
|
|
}
|
|
}
|
|
|
|
sub NewPageCacheClear {
|
|
my ($id) = @_;
|
|
my $name;
|
|
|
|
return if (!$UseCache);
|
|
$id =~ s|.+/|/|; # If subpage, search for just the subpage
|
|
# The following code used to search the body for the $id
|
|
foreach $name (&AllPagesList()) { # Remove all to be safe
|
|
&UnlinkHtmlCache($name);
|
|
}
|
|
}
|
|
|
|
# Note: all diff and recent-list operations should be done within locks.
|
|
sub DoUnlock {
|
|
my $LockMessage = T('Normal Unlock.');
|
|
|
|
print &GetHeader('', T('Removing edit lock'), '');
|
|
print '<p>', T('This operation may take several seconds...'), "\n";
|
|
if (&ForceReleaseLock('main')) {
|
|
$LockMessage = T('Forced Unlock.');
|
|
}
|
|
&ForceReleaseLock('cache');
|
|
&ForceReleaseLock('diff');
|
|
&ForceReleaseLock('index');
|
|
print "<br><h2>$LockMessage</h2>";
|
|
print &GetCommonFooter();
|
|
}
|
|
|
|
# Note: all diff and recent-list operations should be done within locks.
|
|
sub WriteRcLog {
|
|
my ($id, $summary, $isEdit, $editTime, $revision, $name, $rhost) = @_;
|
|
my ($extraTemp, %extra);
|
|
|
|
%extra = ();
|
|
$extra{'id'} = $UserID if ($UserID > 0);
|
|
$extra{'name'} = $name if ($name ne "");
|
|
$extra{'revision'} = $revision if ($revision ne "");
|
|
$extraTemp = join($FS2, %extra);
|
|
# The two fields at the end of a line are kind and extension-hash
|
|
my $rc_line = join($FS3, $editTime, $id, $summary,
|
|
$isEdit, $rhost, "0", $extraTemp);
|
|
if (!open(OUT, ">>$RcFile")) {
|
|
die(Ts('%s log error:', $RCName) . " $!");
|
|
}
|
|
print OUT $rc_line . "\n";
|
|
close(OUT);
|
|
}
|
|
|
|
sub WriteDiff {
|
|
my ($id, $editTime, $diffString) = @_;
|
|
|
|
open (OUT, ">>$DataDir/diff_log") or die(T('can not write diff_log'));
|
|
print OUT "------\n" . $id . "|" . $editTime . "\n";
|
|
print OUT $diffString;
|
|
close(OUT);
|
|
}
|
|
|
|
# Actions are vetoable if someone edits the page before
|
|
# the keep expiry time. For example, page deletion. If
|
|
# no one edits the page by the time the keep expiry time
|
|
# elapses, then no one has vetoed the last action, and the
|
|
# action is accepted.
|
|
# See http://www.usemod.com/cgi-bin/mb.pl?PageDeletion
|
|
sub ProcessVetos {
|
|
my ($expirets);
|
|
|
|
$expirets = $Now - ($KeepDays * 24 * 60 * 60);
|
|
return (0, T('(done)')) unless $Page{'ts'} < $expirets;
|
|
if ($DeletedPage && $Text{'text'} =~ /^\s*$DeletedPage\W*?(\n|$)/o) {
|
|
&DeletePage($OpenPageName, 1, 1);
|
|
return (1, T('(deleted)'));
|
|
}
|
|
if ($ReplaceFile && $Text{'text'} =~ /^\s*$ReplaceFile\:\s*(\S+)/o) {
|
|
my $fname = $1;
|
|
# Only replace an allowed, existing file.
|
|
if ((grep {$_ eq $fname} @ReplaceableFiles) && -e $fname) {
|
|
if ($Text{'text'} =~ /.*<pre>.*?\n(.*?)\s*<\/pre>/ims)
|
|
{
|
|
my $string = $1;
|
|
$string =~ s/\r\n/\n/gms;
|
|
open (OUT, ">$fname") or return 0;
|
|
print OUT $string;
|
|
close OUT;
|
|
return (0, T('(replaced)'));
|
|
}
|
|
}
|
|
}
|
|
return (0, T('(done)'));
|
|
}
|
|
|
|
sub DoMaintain {
|
|
my ($name, $fname, $data, $message, $status);
|
|
print &GetHeader('', T('Maintenance on all pages'), '');
|
|
$fname = "$DataDir/maintain";
|
|
if (!&UserIsAdmin()) {
|
|
if ((-f $fname) && ((-M $fname) < 0.5)) {
|
|
print T('Maintenance not done.'), ' ';
|
|
print T('(Maintenance can only be done once every 12 hours.)');
|
|
print ' ', T('Remove the "maintain" file or wait.');
|
|
print &GetCommonFooter();
|
|
return;
|
|
}
|
|
}
|
|
&RequestLock() or die(T('Could not get maintain-lock'));
|
|
foreach $name (&AllPagesList()) {
|
|
&OpenPage($name);
|
|
&OpenDefaultText();
|
|
($status, $message) = &ProcessVetos();
|
|
&ExpireKeepFile() unless $status;
|
|
print ".... " if ($name =~ m|/|);
|
|
print &GetPageLink($name);
|
|
print " $message<br>\n";
|
|
}
|
|
&WriteStringToFile($fname, Ts('Maintenance done at %s', &TimeToText($Now)));
|
|
&ReleaseLock();
|
|
# Do any rename/deletion commands
|
|
# (Must be outside lock because it will grab its own lock)
|
|
$fname = "$DataDir/editlinks";
|
|
if (-f $fname) {
|
|
$data = &ReadFileOrDie($fname);
|
|
print '<hr>', T('Processing rename/delete commands:'), "<br>\n";
|
|
&UpdateLinksList($data, 1, 1); # Always update RC and links
|
|
unlink("$fname.old");
|
|
rename($fname, "$fname.old");
|
|
}
|
|
if ($MaintTrimRc) {
|
|
&RequestLock() or die(T('Could not get lock for RC maintenance'));
|
|
$status = &TrimRc(); # Consider error messages?
|
|
&ReleaseLock();
|
|
}
|
|
print &GetCommonFooter();
|
|
}
|
|
|
|
# Must be called within a lock.
|
|
# Thanks to Alex Schroeder for original code
|
|
sub TrimRc {
|
|
my (@rc, @temp, $starttime, $days, $status, $data, $i, $ts);
|
|
|
|
# Determine the number of days to go back
|
|
$days = 0;
|
|
foreach (@RcDays) {
|
|
$days = $_ if $_ > $days;
|
|
}
|
|
$starttime = $Now - $days * 24 * 60 * 60;
|
|
return 1 if (!-f $RcFile); # No work if no file exists
|
|
($status, $data) = &ReadFile($RcFile);
|
|
if (!$status) {
|
|
print '<p><strong>' . Ts('Could not open %s log file', $RCName)
|
|
. ":</strong> $RcFile<p>"
|
|
. T('Error was') . ":\n<pre>$!</" . "pre>\n" . '<p>';
|
|
return 0;
|
|
}
|
|
# Move the old stuff from rc to temp
|
|
@rc = split(/\n/, $data);
|
|
for ($i = 0; $i < @rc; $i++) {
|
|
($ts) = split(/$FS3/, $rc[$i]);
|
|
last if ($ts >= $starttime);
|
|
}
|
|
return 1 if ($i < 1); # No lines to move from new to old
|
|
@temp = splice(@rc, 0, $i);
|
|
# Write new files and backups
|
|
if (!open(OUT, ">>$RcOldFile")) {
|
|
print '<p><strong>' . Ts('Could not open %s log file', $RCName)
|
|
. ":</strong> $RcOldFile<p>"
|
|
. T('Error was') . ":\n<pre>$!</" . "pre>\n" . '<p>';
|
|
return 0;
|
|
}
|
|
print OUT join("\n", @temp) . "\n";
|
|
close(OUT);
|
|
&WriteStringToFile($RcFile . '.old', $data);
|
|
$data = join("\n", @rc);
|
|
$data .= "\n" if ($data ne ''); # If no entries, don't add blank line
|
|
&WriteStringToFile($RcFile, $data);
|
|
return 1;
|
|
}
|
|
|
|
sub DoMaintainRc {
|
|
print &GetHeader('', T('Maintaining RC log'), '');
|
|
return if (!&UserIsAdminOrError());
|
|
&RequestLock() or die(T('Could not get lock for RC maintenance'));
|
|
if (&TrimRc()) {
|
|
print T('RC maintenance done.') . '<br>';
|
|
} else {
|
|
print T('RC maintenance not done.') . '<br>';
|
|
}
|
|
&ReleaseLock();
|
|
print &GetCommonFooter();
|
|
}
|
|
|
|
sub UserIsEditorOrError {
|
|
if (!&UserIsEditor()) {
|
|
print '<p>', T('This operation is restricted to site editors only...');
|
|
print &GetCommonFooter();
|
|
return 0;
|
|
}
|
|
return 1;
|
|
}
|
|
|
|
sub UserIsAdminOrError {
|
|
if (!&UserIsAdmin()) {
|
|
print '<p>', T('This operation is restricted to administrators only...');
|
|
print &GetCommonFooter();
|
|
return 0;
|
|
}
|
|
return 1;
|
|
}
|
|
|
|
sub DoEditLock {
|
|
my ($set, $fname);
|
|
|
|
$set = &GetParam("set", 1) ? 1 : 0;
|
|
if ($set) {
|
|
print &GetHeader('', T('Set global edit lock'), '');
|
|
} else {
|
|
print &GetHeader('', T('Remove global edit lock'), '');
|
|
}
|
|
return if (!&UserIsAdminOrError());
|
|
$fname = "$DataDir/noedit";
|
|
if ($set) {
|
|
&WriteStringToFile($fname, "editing locked.");
|
|
} else {
|
|
unlink($fname);
|
|
}
|
|
if (-f $fname) {
|
|
print '<p>', T('Edit lock created.'), '<br>';
|
|
} else {
|
|
print '<p>', T('Edit lock removed.'), '<br>';
|
|
}
|
|
print &GetCommonFooter();
|
|
}
|
|
|
|
sub DoPageLock {
|
|
my ($set, $fname, $unsafe_id, $id);
|
|
|
|
$set = &GetParam("set", 1) ? 1 : 0;
|
|
if ($set) {
|
|
print &GetHeader('', T('Set page edit lock'), '');
|
|
} else {
|
|
print &GetHeader('', T('Remove page edit lock'), '');
|
|
}
|
|
# Consider allowing page lock/unlock at editor level?
|
|
return if (!&UserIsAdminOrError());
|
|
$unsafe_id = &GetParam("id", "");
|
|
if ($unsafe_id eq "") {
|
|
print '<p>', T('Missing page id to lock/unlock...');
|
|
return;
|
|
}
|
|
return if (!&ValidIdOrDie($unsafe_id)); # Consider nicer error?
|
|
$id = &SanitizePageName($unsafe_id);
|
|
if (!$id) {
|
|
&ReportError(Ts('Invalid Page %s', $unsafe_id));
|
|
return;
|
|
}
|
|
$fname = &GetLockedPageFile($id);
|
|
if ($set) {
|
|
&WriteStringToFile($fname, "editing locked.");
|
|
} else {
|
|
unlink($fname);
|
|
}
|
|
if (-f $fname) {
|
|
print '<p>', Ts('Lock for %s created.', $id), '<br>';
|
|
} else {
|
|
print '<p>', Ts('Lock for %s removed.', $id), '<br>';
|
|
}
|
|
print &GetCommonFooter();
|
|
}
|
|
|
|
sub DoEditBanned {
|
|
my ($banList, $status);
|
|
|
|
print &GetHeader('', T('Editing Banned list'), '');
|
|
return if (!&UserIsAdminOrError());
|
|
($status, $banList) = &ReadFile("$DataDir/banlist");
|
|
$banList = "" if (!$status);
|
|
print &GetFormStart();
|
|
print GetHiddenValue("edit_ban", 1), "\n";
|
|
print "<b>Banned IP/network/host list:</b><br>\n";
|
|
print "<p>Each entry is either a commented line (starting with #), ",
|
|
"or a Perl regular expression (matching either an IP address or ",
|
|
"a hostname). <b>Note:</b> To test the ban on yourself, you must ",
|
|
"give up your admin access (remove password in Preferences).";
|
|
print "<p>Example:<br>",
|
|
"<tt># blocks hosts ending with .foocorp.com</tt><br>",
|
|
"<tt>\\.foocorp\\.com\$</tt><br>",
|
|
"<tt># blocks exact IP address</tt><br>",
|
|
"<tt>^123\\.21\\.3\\.9\$</tt><br>",
|
|
"<tt># blocks whole 123.21.3.* IP network</tt><br>",
|
|
"<tt>^123\\.21\\.3\\.\\d+\$</tt><p>";
|
|
print &GetTextArea('banlist', $banList, 12, 50);
|
|
print "<br>", $q->submit(-name=>'Save'), "\n";
|
|
print $q->end_form;
|
|
if (!&GetParam('embed', $EmbedWiki)) {
|
|
print '<div class=wikifooter>';
|
|
print "<hr class=wikilinefooter>\n";
|
|
print &GetGotoBar('');
|
|
print '</div>';
|
|
}
|
|
print &GetMinimumFooter();
|
|
}
|
|
|
|
sub DoUpdateBanned {
|
|
my ($newList, $fname);
|
|
|
|
print &GetHeader('', T('Updating Banned list'), '');
|
|
return if (!&UserIsAdminOrError());
|
|
$fname = "$DataDir/banlist";
|
|
$newList = &GetParam("banlist", "#Empty file");
|
|
if ($newList eq "") {
|
|
print "<p>", T('Empty banned list or error.');
|
|
print "<p>", T('Resubmit with at least one space character to remove.');
|
|
} elsif ($newList =~ /^\s*$/s) {
|
|
unlink($fname);
|
|
print "<p>", T('Removed banned list');
|
|
} else {
|
|
&WriteStringToFile($fname, $newList);
|
|
print "<p>", T('Updated banned list');
|
|
}
|
|
print &GetCommonFooter();
|
|
}
|
|
|
|
# ==== Editing/Deleting pages and links ====
|
|
sub DoEditLinks {
|
|
print &GetHeader('', T('Editing Links'), '');
|
|
if ($AdminDelete) {
|
|
return if (!&UserIsAdminOrError());
|
|
} else {
|
|
return if (!&UserIsEditorOrError());
|
|
}
|
|
print &GetFormStart();
|
|
print GetHiddenValue("edit_links", 1), "\n";
|
|
print "<b>Editing/Deleting page titles:</b><br>\n";
|
|
print "<p>Enter one command on each line. Commands are:<br>",
|
|
"<tt>!PageName</tt> -- deletes the page called PageName<br>\n",
|
|
"<tt>=OldPageName=NewPageName</tt> -- Renames OldPageName ",
|
|
"to NewPageName and updates links to OldPageName.<br>\n",
|
|
"<tt>|OldPageName|NewPageName</tt> -- Changes links to OldPageName ",
|
|
"to NewPageName.",
|
|
" (Used to rename links to non-existing pages.)<br>\n",
|
|
"<b>Note: page names are case-sensitive!</b>\n";
|
|
print &GetTextArea('commandlist', "", 12, 50);
|
|
print $q->checkbox(-name=>"p_changerc", -override=>1, -checked=>1,
|
|
-label=>"Edit $RCName");
|
|
print "<br>\n";
|
|
print $q->checkbox(-name=>"p_changetext", -override=>1, -checked=>1,
|
|
-label=>"Substitute text for rename");
|
|
print "<br>", $q->submit(-name=>'Edit'), "\n";
|
|
print $q->end_form;
|
|
if (!&GetParam('embed', $EmbedWiki)) {
|
|
print '<div class=wikifooter>';
|
|
print "<hr class=wikilinefooter>\n";
|
|
print &GetGotoBar('');
|
|
print '</div>';
|
|
}
|
|
print &GetMinimumFooter();
|
|
}
|
|
|
|
sub UpdateLinksList {
|
|
my ($commandList, $doRC, $doText) = @_;
|
|
|
|
if ($doText) {
|
|
&BuildLinkIndex();
|
|
}
|
|
&RequestLock() or die T('UpdateLinksList could not get main lock');
|
|
unlink($IndexFile) if ($UseIndex);
|
|
foreach (split(/\n/, $commandList)) {
|
|
s/\s+$//g;
|
|
next if (!(/^[=!|]/)); # Only valid commands.
|
|
print "Processing $_<br>\n";
|
|
if (/^\!(.+)/) {
|
|
&DeletePage($1, $doRC, $doText);
|
|
} elsif (/^\=(?:\[\[)?([^]=]+)(?:\]\])?\=(?:\[\[)?([^]=]+)(?:\]\])?/) {
|
|
&RenamePage($1, $2, $doRC, $doText);
|
|
} elsif (/^\|(?:\[\[)?([^]|]+)(?:\]\])?\|(?:\[\[)?([^]|]+)(?:\]\])?/) {
|
|
&RenameTextLinks($1, $2);
|
|
}
|
|
}
|
|
&NewPageCacheClear("."); # Clear cache (needs testing?)
|
|
unlink($IndexFile) if ($UseIndex);
|
|
&ReleaseLock();
|
|
}
|
|
|
|
sub BuildLinkIndex {
|
|
my (@pglist, $page, @links, $link, %seen);
|
|
|
|
@pglist = &AllPagesList();
|
|
%LinkIndex = ();
|
|
foreach $page (@pglist) {
|
|
&BuildLinkIndexPage($page);
|
|
}
|
|
}
|
|
|
|
sub BuildLinkIndexPage {
|
|
my ($page) = @_;
|
|
my (@links, $link, %seen);
|
|
|
|
@links = &GetPageLinks($page, 1, 0, 0);
|
|
%seen = ();
|
|
foreach $link (@links) {
|
|
if (defined($LinkIndex{$link})) {
|
|
if (!$seen{$link}) {
|
|
$LinkIndex{$link} .= " " . $page;
|
|
}
|
|
} else {
|
|
$LinkIndex{$link} .= " " . $page;
|
|
}
|
|
$seen{$link} = 1;
|
|
}
|
|
}
|
|
|
|
sub DoUpdateLinks {
|
|
my ($commandList, $doRC, $doText);
|
|
|
|
print &GetHeader('', T('Updating Links'), '');
|
|
if ($AdminDelete) {
|
|
return if (!&UserIsAdminOrError());
|
|
} else {
|
|
return if (!&UserIsEditorOrError());
|
|
}
|
|
$commandList = &GetParam("commandlist", "");
|
|
$doRC = &GetParam("p_changerc", "0");
|
|
$doRC = 1 if ($doRC eq "on");
|
|
$doText = &GetParam("p_changetext", "0");
|
|
$doText = 1 if ($doText eq "on");
|
|
if ($commandList eq "") {
|
|
print "<p>", T('Empty command list or error.');
|
|
} else {
|
|
&UpdateLinksList($commandList, $doRC, $doText);
|
|
print "<p>", T('Finished command list.');
|
|
}
|
|
print &GetCommonFooter();
|
|
}
|
|
|
|
sub EditRecentChanges {
|
|
my ($action, $old, $new) = @_;
|
|
|
|
&EditRecentChangesFile($RcFile, $action, $old, $new, 1);
|
|
&EditRecentChangesFile($RcOldFile, $action, $old, $new, 0);
|
|
}
|
|
|
|
sub EditRecentChangesFile {
|
|
my ($fname, $action, $old, $new, $printError) = @_;
|
|
my ($status, $fileData, $errorText, $rcline, @rclist);
|
|
my ($outrc, $ts, $page, $junk);
|
|
|
|
($status, $fileData) = &ReadFile($fname);
|
|
if (!$status) {
|
|
# Save error text if needed.
|
|
$errorText = "<p><strong>"
|
|
. Ts('Could not open %s log file:', $RCName)
|
|
. "</strong> $fname"
|
|
. "<p>" . T('Error was:') . "\n<pre>$!</pre>\n";
|
|
print $errorText if ($printError);
|
|
return;
|
|
}
|
|
$outrc = "";
|
|
@rclist = split(/\n/, $fileData);
|
|
foreach $rcline (@rclist) {
|
|
($ts, $page, $junk) = split(/$FS3/, $rcline);
|
|
if ($page eq $old) {
|
|
if ($action == 1) { # Delete
|
|
; # Do nothing (don't add line to new RC)
|
|
} elsif ($action == 2) {
|
|
$junk = $rcline;
|
|
$junk =~ s/^(\d+$FS3)$old($FS3)/"$1$new$2"/ge;
|
|
$outrc .= $junk . "\n";
|
|
}
|
|
} else {
|
|
$outrc .= $rcline . "\n";
|
|
}
|
|
}
|
|
&WriteStringToFile($fname . ".old", $fileData); # Backup copy
|
|
&WriteStringToFile($fname, $outrc);
|
|
}
|
|
|
|
# Delete and rename must be done inside locks.
|
|
sub DeletePage {
|
|
my ($page, $doRC, $doText) = @_;
|
|
my ($fname, $status);
|
|
|
|
$page =~ s/ /_/g;
|
|
$page =~ s/\[+//;
|
|
$page =~ s/\]+//;
|
|
$status = &ValidId($page);
|
|
if ($status ne "") {
|
|
print Tss('Delete-Page: page %1 is invalid, error is: %2', $page, $status)
|
|
. "<br>\n";
|
|
return;
|
|
}
|
|
$fname = &GetPageFile($page);
|
|
unlink($fname) if (-f $fname);
|
|
$fname = $KeepDir . "/" . &GetPageDirectory($page) . "/$page.kp";
|
|
unlink($fname) if (-f $fname);
|
|
unlink($IndexFile) if ($UseIndex);
|
|
&EditRecentChanges(1, $page, "") if ($doRC); # Delete page
|
|
# Currently don't do anything with page text
|
|
}
|
|
|
|
# Given text, returns substituted text
|
|
sub SubstituteTextLinks {
|
|
my ($old, $new, $text) = @_;
|
|
|
|
# Much of this is taken from the common markup
|
|
%SaveUrl = ();
|
|
$SaveUrlIndex = 0;
|
|
$text =~ s/$FS(\d)/$1/g; # Remove separators (paranoia)
|
|
if ($RawHtml) {
|
|
$text =~ s/(<html>((.|\n)*?)<\/html>)/&StoreRaw($1)/ige;
|
|
}
|
|
$text =~ s/(<pre>((.|\n)*?)<\/pre>)/&StoreRaw($1)/ige;
|
|
$text =~ s/(<code>((.|\n)*?)<\/code>)/&StoreRaw($1)/ige;
|
|
$text =~ s/(<nowiki>((.|\n)*?)<\/nowiki>)/&StoreRaw($1)/ige;
|
|
if ($FreeLinks) {
|
|
$text =~
|
|
s/\[\[$FreeLinkPattern\|([^\]]+)\]\]/&SubFreeLink($1,$2,$old,$new)/geo;
|
|
$text =~ s/\[\[$FreeLinkPattern\]\]/&SubFreeLink($1,"",$old,$new)/geo;
|
|
}
|
|
if ($BracketText) { # Links like [URL text of link]
|
|
$text =~ s/(\[$UrlPattern\s+([^\]]+?)\])/&StoreRaw($1)/geo;
|
|
$text =~ s/(\[$InterLinkPattern\s+([^\]]+?)\])/&StoreRaw($1)/geo;
|
|
}
|
|
$text =~ s/(\[?$UrlPattern\]?)/&StoreRaw($1)/geo;
|
|
$text =~ s/(\[?$InterLinkPattern\]?)/&StoreRaw($1)/geo;
|
|
if ($WikiLinks) {
|
|
$text =~ s/$LinkPattern/&SubWikiLink($1, $old, $new)/geo;
|
|
}
|
|
# Thanks to David Claughton for the following fix
|
|
1 while $text =~ s/$FS(\d+)$FS/$SaveUrl{$1}/ge; # Restore saved text
|
|
return $text;
|
|
}
|
|
|
|
sub SubFreeLink {
|
|
my ($link, $name, $old, $new) = @_;
|
|
my ($oldlink);
|
|
|
|
$oldlink = $link;
|
|
$link =~ s/^\s+//;
|
|
$link =~ s/\s+$//;
|
|
if (($link eq $old) || (&FreeToNormal($old) eq &FreeToNormal($link))) {
|
|
$link = $new;
|
|
} else {
|
|
$link = $oldlink; # Preserve spaces if no match
|
|
}
|
|
$link = "[[$link";
|
|
if ($name ne "") {
|
|
$link .= "|$name";
|
|
}
|
|
$link .= "]]";
|
|
return &StoreRaw($link);
|
|
}
|
|
|
|
sub SubWikiLink {
|
|
my ($link, $old, $new) = @_;
|
|
my ($newBracket);
|
|
|
|
$newBracket = 0;
|
|
if ($link eq $old) {
|
|
$link = $new;
|
|
if (!($new =~ /^$LinkPattern$/)) {
|
|
$link = "[[$link]]";
|
|
}
|
|
}
|
|
return &StoreRaw($link);
|
|
}
|
|
|
|
# Rename is mostly copied from expire
|
|
sub RenameKeepText {
|
|
my ($page, $old, $new) = @_;
|
|
my ($fname, $status, $data, @kplist, %tempSection, $changed);
|
|
my ($sectName, $newText);
|
|
|
|
$fname = $KeepDir . "/" . &GetPageDirectory($page) . "/$page.kp";
|
|
return if (!(-f $fname));
|
|
($status, $data) = &ReadFile($fname);
|
|
return if (!$status);
|
|
@kplist = split(/$FS1/, $data, -1); # -1 keeps trailing null fields
|
|
return if (scalar(@kplist) < 1); # Also empty
|
|
shift(@kplist) if ($kplist[0] eq ""); # First can be empty
|
|
return if (scalar(@kplist) < 1); # Also empty
|
|
%tempSection = split(/$FS2/, $kplist[0], -1);
|
|
if (!defined($tempSection{'keepts'})) {
|
|
return;
|
|
}
|
|
# First pass: optimize for nothing changed
|
|
$changed = 0;
|
|
foreach (@kplist) {
|
|
%tempSection = split(/$FS2/, $_, -1);
|
|
$sectName = $tempSection{'name'};
|
|
if ($sectName =~ /^(text_)/) {
|
|
%Text = split(/$FS3/, $tempSection{'data'}, -1);
|
|
$newText = &SubstituteTextLinks($old, $new, $Text{'text'});
|
|
$changed = 1 if ($Text{'text'} ne $newText);
|
|
}
|
|
}
|
|
return if (!$changed); # No sections changed
|
|
open (OUT, ">$fname") or return;
|
|
foreach (@kplist) {
|
|
%tempSection = split(/$FS2/, $_, -1);
|
|
$sectName = $tempSection{'name'};
|
|
if ($sectName =~ /^(text_)/) {
|
|
%Text = split(/$FS3/, $tempSection{'data'}, -1);
|
|
$newText = &SubstituteTextLinks($old, $new, $Text{'text'});
|
|
$Text{'text'} = $newText;
|
|
$tempSection{'data'} = join($FS3, %Text);
|
|
print OUT $FS1, join($FS2, %tempSection);
|
|
} else {
|
|
print OUT $FS1, $_;
|
|
}
|
|
}
|
|
close(OUT);
|
|
}
|
|
|
|
sub RenameTextLinks {
|
|
my ($old, $new) = @_;
|
|
my ($changed, $file, $page, $section, $oldText, $newText, $status);
|
|
my ($oldCanonical, @pageList);
|
|
|
|
$old =~ s/ /_/g;
|
|
$oldCanonical = &FreeToNormal($old);
|
|
$new =~ s/ /_/g;
|
|
$status = &ValidId($old);
|
|
if ($status ne "") {
|
|
print Tss('Rename-Text: old page %1 is invalid, error is: %2', $old, $status)
|
|
. "<br>\n";
|
|
return;
|
|
}
|
|
$status = &ValidId($new);
|
|
if ($status ne "") {
|
|
print Tss('Rename-Text: new page %1 is invalid, error is: %2', $new, $status)
|
|
. "<br>\n";
|
|
return;
|
|
}
|
|
$old =~ s/_/ /g;
|
|
$new =~ s/_/ /g;
|
|
# Note: the LinkIndex must be built prior to this routine
|
|
return if (!defined($LinkIndex{$oldCanonical}));
|
|
@pageList = split(' ', $LinkIndex{$oldCanonical});
|
|
foreach $page (@pageList) {
|
|
$changed = 0;
|
|
&OpenPage($page);
|
|
foreach $section (keys %Page) {
|
|
if ($section =~ /^text_/) {
|
|
&OpenSection($section);
|
|
%Text = split(/$FS3/, $Section{'data'}, -1);
|
|
$oldText = $Text{'text'};
|
|
$newText = &SubstituteTextLinks($old, $new, $oldText);
|
|
if ($oldText ne $newText) {
|
|
$Text{'text'} = $newText;
|
|
$Section{'data'} = join($FS3, %Text);
|
|
$Page{$section} = join($FS2, %Section);
|
|
$changed = 1;
|
|
}
|
|
} elsif ($section =~ /^cache_diff/) {
|
|
$oldText = $Page{$section};
|
|
$newText = &SubstituteTextLinks($old, $new, $oldText);
|
|
if ($oldText ne $newText) {
|
|
$Page{$section} = $newText;
|
|
$changed = 1;
|
|
}
|
|
}
|
|
# Add other text-sections (categories) here
|
|
}
|
|
if ($changed) {
|
|
$file = &GetPageFile($page);
|
|
&WriteStringToFile($file, join($FS1, %Page));
|
|
}
|
|
&RenameKeepText($page, $old, $new);
|
|
}
|
|
}
|
|
|
|
sub RenamePage {
|
|
my ($old, $new, $doRC, $doText) = @_;
|
|
my ($oldfname, $newfname, $oldkeep, $newkeep, $status);
|
|
|
|
$old =~ s/ /_/g;
|
|
$new = &FreeToNormal($new);
|
|
$status = &ValidId($old);
|
|
if ($status ne "") {
|
|
print Tss('Rename: old page %1 is invalid, error is: %2', $old, $status)
|
|
. "<br>\n";
|
|
return;
|
|
}
|
|
$status = &ValidId($new);
|
|
if ($status ne "") {
|
|
print Tss('Rename: new page %1 is invalid, error is: %2', $new, $status)
|
|
. "<br>\n";
|
|
return;
|
|
}
|
|
$newfname = &GetPageFile($new);
|
|
if (-f $newfname) {
|
|
print Ts('Rename: new page %s already exists--not renamed.', $new)
|
|
. "<br>\n";
|
|
return;
|
|
}
|
|
$oldfname = &GetPageFile($old);
|
|
if (!(-f $oldfname)) {
|
|
print Ts('Rename: old page %s does not exist--nothing done.', $old)
|
|
. "<br>\n";
|
|
return;
|
|
}
|
|
&CreatePageDir($PageDir, $new); # It might not exist yet
|
|
rename($oldfname, $newfname);
|
|
&CreatePageDir($KeepDir, $new);
|
|
$oldkeep = $KeepDir . "/" . &GetPageDirectory($old) . "/$old.kp";
|
|
$newkeep = $KeepDir . "/" . &GetPageDirectory($new) . "/$new.kp";
|
|
unlink($newkeep) if (-f $newkeep); # Clean up if needed.
|
|
rename($oldkeep, $newkeep);
|
|
unlink($IndexFile) if ($UseIndex);
|
|
my $oldlock = &GetLockedPageFile($old);
|
|
if (-f $oldlock) {
|
|
my $newlock = &GetLockedPageFile($new);
|
|
rename($oldlock, $newlock);
|
|
}
|
|
&EditRecentChanges(2, $old, $new) if ($doRC);
|
|
if ($doText) {
|
|
&BuildLinkIndexPage($new); # Keep index up-to-date
|
|
&RenameTextLinks($old, $new);
|
|
}
|
|
}
|
|
|
|
sub DoShowVersion {
|
|
print &GetHeader('', T('Displaying Wiki Version'), '');
|
|
print "<p>UseModWiki version 1.0.6</p>\n";
|
|
print &GetCommonFooter();
|
|
}
|
|
|
|
# Thanks to Phillip Riley for original code
|
|
sub DoDeletePage {
|
|
my ($unsafe_id) = @_;
|
|
my $id;
|
|
|
|
return if (!&ValidIdOrDie($unsafe_id));
|
|
$id = &SanitizePageName($unsafe_id);
|
|
if (!$id) {
|
|
&ReportError(Ts('Invalid Page %s', $unsafe_id));
|
|
return;
|
|
}
|
|
print &GetHeader('', Ts('Delete %s', $id), '');
|
|
return if (!&UserIsAdminOrError());
|
|
if ($ConfirmDel && !&GetParam('confirm', 0)) {
|
|
print '<p>';
|
|
print Ts('Confirm deletion of %s by following this link:', $id);
|
|
print '<br>' . &GetDeleteLink($id, T('Confirm Delete'), 1);
|
|
print '</p>';
|
|
print &GetCommonFooter();
|
|
return;
|
|
}
|
|
print '<p>';
|
|
if ($id eq $HomePage) {
|
|
print Ts('%s can not be deleted.', $HomePage);
|
|
} else {
|
|
if (-f &GetLockedPageFile($id)) {
|
|
print Ts('%s can not be deleted because it is locked.', $id);
|
|
} else {
|
|
# Must lock because of RC-editing
|
|
&RequestLock() or die(T('Could not get editing lock'));
|
|
DeletePage($id, 1, 1);
|
|
&ReleaseLock();
|
|
print Ts('%s has been deleted.', $id);
|
|
}
|
|
}
|
|
print '</p>';
|
|
print &GetCommonFooter();
|
|
}
|
|
|
|
# Thanks to Ross Kowalski and Iliyan Jeliazkov for original uploading code
|
|
sub DoUpload {
|
|
print &GetHeader('', T('File Upload Page'), '');
|
|
if (!$AllUpload) {
|
|
return if (!&UserIsEditorOrError());
|
|
}
|
|
print '<p>' . Ts('The current upload size limit is %s.', $MaxPost) . ' '
|
|
. Ts('Change the %s variable to increase this limit.', '$MaxPost');
|
|
print '</p><br>';
|
|
print '<FORM METHOD="post" ACTION="' . $ScriptName
|
|
. '" ENCTYPE="multipart/form-data">';
|
|
print '<input type="hidden" name="upload" value="1" />';
|
|
print T('File to Upload:'), ' <INPUT TYPE="file" NAME="file"><br><BR>';
|
|
print '<INPUT TYPE="submit" NAME="Submit" VALUE="', T('Upload'), '">';
|
|
print '</FORM>';
|
|
print &GetCommonFooter();
|
|
}
|
|
|
|
sub SaveUpload {
|
|
my ($filename, $printFilename, $uploadFilehandle);
|
|
|
|
print &GetHeader('', T('Upload Finished'), '');
|
|
if (!$AllUpload) {
|
|
return if (!&UserIsEditorOrError());
|
|
}
|
|
$UploadDir .= '/' if (substr($UploadDir, -1, 1) ne '/'); # End with /
|
|
$UploadUrl .= '/' if (substr($UploadUrl, -1, 1) ne '/'); # End with /
|
|
$filename = $q->param('file');
|
|
$filename =~ s/.*[\/\\](.*)/$1/; # Only name after last \ or /
|
|
$uploadFilehandle = $q->upload('file');
|
|
open UPLOADFILE, ">$UploadDir$filename";
|
|
binmode UPLOADFILE;
|
|
while (<$uploadFilehandle>) { print UPLOADFILE; }
|
|
close UPLOADFILE;
|
|
print T('The wiki link to your file is:') . "\n<br><BR>";
|
|
$printFilename = $filename;
|
|
$printFilename =~ s/ /\%20/g; # Replace spaces with escaped spaces
|
|
print "upload:" . $printFilename . "<BR><BR>\n";
|
|
if ($filename =~ /$ImageExtensions$/i) {
|
|
print '<HR><img src="' . $UploadUrl . $filename . '">' . "\n";
|
|
}
|
|
print &GetCommonFooter();
|
|
}
|
|
|
|
sub ConvertFsFile {
|
|
my ($oldFS, $newFS, $fname) = @_;
|
|
my ($oldData, $newData, $status);
|
|
|
|
return if (!-f $fname); # Convert only existing regular files
|
|
($status, $oldData) = &ReadFile($fname);
|
|
if (!$status) {
|
|
print '<br><strong>' . Ts('Could not open file %s', $fname)
|
|
. ':</strong>' . T('Error was') . ":\n<pre>$!</pre>\n" . '<br>';
|
|
return;
|
|
}
|
|
$newData = $oldData;
|
|
$newData =~ s/$oldFS(\d)/$newFS . $1/ge;
|
|
return if ($oldData eq $newData); # Do not write if the same
|
|
&WriteStringToFile($fname, $newData);
|
|
# print $fname . '<br>'; # progress report
|
|
}
|
|
|
|
# Converts up to 3 dirs deep (like page/A/Apple/subpage.db)
|
|
# Note that top level directory (page/keep/user) contains only dirs
|
|
sub ConvertFsDir {
|
|
my ($oldFS, $newFS, $topDir) = @_;
|
|
my (@dirs, @files, @subFiles, $dir, $file, $subFile, $fname, $subFname);
|
|
|
|
opendir(DIRLIST, $topDir);
|
|
@dirs = readdir(DIRLIST);
|
|
closedir(DIRLIST);
|
|
@dirs = sort(@dirs);
|
|
foreach $dir (@dirs) {
|
|
next if (substr($dir, 0, 1) eq '.'); # No ., .., or .dirs
|
|
next if (!-d "$topDir/$dir"); # Top level directories only
|
|
next if (-f "$topDir/$dir.cvt"); # Skip if already converted
|
|
opendir(DIRLIST, "$topDir/$dir");
|
|
@files = readdir(DIRLIST);
|
|
closedir(DIRLIST);
|
|
foreach $file (@files) {
|
|
next if (($file eq '.') || ($file eq '..'));
|
|
$fname = "$topDir/$dir/$file";
|
|
if (-f $fname) {
|
|
# print $fname . '<br>'; # progress
|
|
&ConvertFsFile($oldFS, $newFS, $fname);
|
|
} elsif (-d $fname) {
|
|
opendir(DIRLIST, $fname);
|
|
@subFiles = readdir(DIRLIST);
|
|
closedir(DIRLIST);
|
|
foreach $subFile (@subFiles) {
|
|
next if (($subFile eq '.') || ($subFile eq '..'));
|
|
$subFname = "$fname/$subFile";
|
|
if (-f $subFname) {
|
|
# print $subFname . '<br>'; # progress
|
|
&ConvertFsFile($oldFS, $newFS, $subFname);
|
|
}
|
|
}
|
|
}
|
|
}
|
|
&WriteStringToFile("$topDir/$dir.cvt", 'converted');
|
|
}
|
|
}
|
|
|
|
sub ConvertFsCleanup {
|
|
my ($topDir) = @_;
|
|
my (@dirs, $dir);
|
|
|
|
opendir(DIRLIST, $topDir);
|
|
@dirs = readdir(DIRLIST);
|
|
closedir(DIRLIST);
|
|
foreach $dir (@dirs) {
|
|
next if (substr($dir, 0, 1) eq '.'); # No ., .., or .dirs
|
|
next if (!-f "$topDir/$dir"); # Remove only files...
|
|
next unless ($dir =~ m/\.cvt$/); # ...that end with .cvt
|
|
unlink "$topDir/$dir";
|
|
}
|
|
}
|
|
|
|
sub DoConvert {
|
|
my $oldFS = "\xb3";
|
|
my $newFS = "\x1e\xff\xfe\x1e";
|
|
|
|
print &GetHeader('', T('Convert wiki DB'), '');
|
|
return if (!&UserIsAdminOrError());
|
|
if ($FS ne $newFS) {
|
|
print Ts('You must change the %s option before converting the wiki DB.',
|
|
'$NewFS') . '<br>';
|
|
return;
|
|
}
|
|
&WriteStringToFile("$DataDir/noedit", 'editing locked.');
|
|
print T('Wiki DB locked for conversion.') . '<br>';
|
|
print T('Converting Wiki DB...') . '<br>';
|
|
&ConvertFsFile($oldFS, $newFS, "$DataDir/rclog");
|
|
&ConvertFsFile($oldFS, $newFS, "$DataDir/rclog.old");
|
|
&ConvertFsFile($oldFS, $newFS, "$DataDir/oldrclog");
|
|
&ConvertFsFile($oldFS, $newFS, "$DataDir/oldrclog.old");
|
|
&ConvertFsDir($oldFS, $newFS, $PageDir);
|
|
&ConvertFsDir($oldFS, $newFS, $KeepDir);
|
|
&ConvertFsDir($oldFS, $newFS, $UserDir);
|
|
&ConvertFsCleanup($PageDir);
|
|
&ConvertFsCleanup($KeepDir);
|
|
&ConvertFsCleanup($UserDir);
|
|
print T('Finished converting wiki DB.') . '<br>';
|
|
print Ts('Remove file %s to unlock wiki for editing.', "$DataDir/noedit")
|
|
. '<br>';
|
|
print &GetCommonFooter();
|
|
}
|
|
|
|
# Remove user-id files if no useful preferences set
|
|
sub DoTrimUsers {
|
|
my (%Data, $status, $data, $maxID, $id, $removed, $keep);
|
|
my (@dirs, @files, $dir, $file, $item);
|
|
|
|
print &GetHeader('', T('Trim wiki users'), '');
|
|
return if (!&UserIsAdminOrError());
|
|
$removed = 0;
|
|
$maxID = 1001;
|
|
opendir(DIRLIST, $UserDir);
|
|
@dirs = readdir(DIRLIST);
|
|
closedir(DIRLIST);
|
|
foreach $dir (@dirs) {
|
|
next if (substr($dir, 0, 1) eq '.'); # No ., .., or .dirs
|
|
next if (!-d "$UserDir/$dir"); # Top level directories only
|
|
opendir(DIRLIST, "$UserDir/$dir");
|
|
@files = readdir(DIRLIST);
|
|
closedir(DIRLIST);
|
|
foreach $file (@files) {
|
|
if ($file =~ m/(\d+).db/) { # Only numeric ID files
|
|
$id = $1;
|
|
$maxID = $id if ($id > $maxID);
|
|
%Data = ();
|
|
($status, $data) = &ReadFile("$UserDir/$dir/$file");
|
|
if ($status) {
|
|
%Data = split(/$FS1/, $data, -1); # -1 keeps trailing null fields
|
|
$keep = 0;
|
|
foreach $item (qw(username password adminpw stylesheet)) {
|
|
$keep = 1 if (defined($Data{$item}) && ($Data{$item} ne ''));
|
|
}
|
|
if (!$keep) {
|
|
unlink "$UserDir/$dir/$file";
|
|
# print "$UserDir/$dir/$file" . '<br>'; # progress
|
|
$removed += 1;
|
|
}
|
|
}
|
|
}
|
|
}
|
|
}
|
|
print Ts('Removed %s files.', $removed) . '<br>';
|
|
print Ts('Recommended $StartUID setting is %s.', $maxID + 100) . '<br>';
|
|
print &GetCommonFooter();
|
|
}
|
|
#END_OF_OTHER_CODE
|
|
|
|
&DoWikiRequest() if ($RunCGI && (!$_ or $_ ne 'nocgi')); # Do everything.
|
|
1; # In case we are loaded from elsewhere
|
|
# == End of UseModWiki script. ===========================================
|