#!/usr/bin/perl # UseModWiki version 1.0 (September 12, 2003) # Copyright (C) 2000-2003 Clifford A. Adams # Copyright (C) 2002-2003 Sunir Shah # Based on the GPLed AtisWiki 0.3 (C) 1998 Markus Denker # # ...which was based on # the LGPLed CVWiki CVS-patches (C) 1997 Peter Merel # and The Original WikiWikiWeb (C) Ward Cunningham # (code reused with permission) # Email and ThinLine options by Jim Mahoney # # 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 = "wikidb"; # 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 = "aibolab"; # Name for this wiki (for multi-wiki sites) $SiteName = "Labbook aibolab.science.uva.nl"; # Name of site (used for titles) $HomePage = "Labbook"; # Home page (change space to _) $RCName = "RecentChanges"; # Name of changes page (change space to _) $LogoUrl = ""; # 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 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 = "aibolab"; # 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 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 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
tags, 0 = classic wiki
$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-6-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://shop.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 ... 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)"; $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 = ; 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) = @_; $text = T($text); $text =~ s/\%s/$string/; return $text; } sub Tss { my $text = @_[0]; $text = T($text); $text =~ s/\%([1-9])/$_[$1]/ge; return $text; } # == 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 = 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 { %SetCookie = (); $TimeZoneOffset = 0; undef $q->{'.cookies'}; # Clear cache if it exists (for SpeedyCGI) %UserData = (); # Fix for persistent environments. %UserCookie = $q->cookie($CookieName); $UserID = $UserCookie{'id'}; $UserID =~ s/\D//g; # Numeric only if ($UserID < 200) { $UserID = 111; } else { &LoadUserData($UserID); } if ($UserID > 199) { if (($UserData{'id'} != $UserCookie{'id'}) || ($UserData{'randkey'} != $UserCookie{'randkey'})) { $UserID = 113; %UserData = (); # Invalid. Consider warning message. } } if ($UserData{'tzoffset'} != 0) { $TimeZoneOffset = $UserData{'tzoffset'} * (60 * 60); } } sub DoBrowseRequest { my ($id, $action, $text); if (!$q->param) { # No parameter &BrowsePage($HomePage); return 1; } $id = &GetParam('keywords', ''); if ($id) { # 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); if ($revision ne '') { if (($revision eq $Page{'revision'}) || ($goodRevision ne '')) { $fullHtml .= '' . Ts('Showing revision %s', $revision) . "
"; } else { $fullHtml .= '' . Ts('Revision %s not available', $revision) . ' (' . T('showing current revision instead') . ')
'; } } $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 .= "
\n"; } $fullHtml .= '
'; $fullHtml .= &WikiToHTML($Text{'text'}); $fullHtml .= '
'; if (!&GetParam('embed', $EmbedWiki)) { $fullHtml .= "
\n"; } if (($id eq $RCName) || (T($RCName) eq $id) || (T($id) eq $RCName)) { print $fullHtml; print '
'; &DoRc(1); print '
'; print "
\n" if (!&GetParam('embed', $EmbedWiki)); 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 "

" . Ts('Updates since %s', &TimeToText($starttime)) . "

\n"; } } else { $daysago = &GetParam("days", 0); $daysago = &GetParam("rcdays", 0) if ($daysago == 0); if ($daysago) { $starttime = $Now - ((24*60*60)*$daysago); if ($showHTML) { print "

" . Ts('Updates in the last %s day' . (($daysago != 1)?"s":""), $daysago) . "

\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 "

" . Ts('Updates in the last %s day' . (($RcDefault != 1)?"s":""), $RcDefault) . "

\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 = '

' . Ts('Could not open %s log file', $RCName) . ": $RcFile

" . T('Error was') . ":\n

$!
\n" . '

' . 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 "

" . Ts('Could not open old %s log file', $RCName) . ": $RcOldFile

" . T('Error was') . ":\n

$!
\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 '(' . Ts('for %s only', &ScriptLink($idOnly, $idOnly)) . ')
'; } 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 "
" . &ScriptLink("action=rc&from=$lastTs", T('List new changes starting from')); print " " . &TimeToText($lastTs) . "
\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 '
' . Ts('No updates since %s', &TimeToText($starttime)) . "
\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 '

' . Ts('Page generated %s', &TimeToText($Now)), "
\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, $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'); $diffPrefix = $QuotedFullUrl . &QuoteHtml("?action=browse\&diff=4\&id="); $historyPrefix = $QuotedFullUrl . &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 .= "\n"; $inlist = 0; } $result .= "

" . $date . "

\n"; if (!$inlist) { $result .= "
    \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); $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 .= "
\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 = "[$summary] "; } $edit = ""; $edit = "$tEdit " 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 .= "
  • $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 = < ${\(&QuoteHtml($SiteName))} ${\($QuotedFullUrl . &QuoteHtml("?$RCName"))} ${\(&QuoteHtml($SiteDescription))} $InterWikiMoniker RSS ($headList, $items) = &GetRc(0, @_); $rssHeader .= $headList; return < ${\(&QuoteHtml($SiteName))} $RssLogoUrl $QuotedFullUrl $items RSS } sub GetRssRcLine{ my ($pagename, $timestamp, $host, $userName, $userID, $summary, $isEdit, $pagecount, $revision, $diffPrefix, $historyPrefix) = @_; my ($itemID, $description, $authorLink, $author, $status, $importance, $date, $item, $headItem); # Add to list of items in the $itemID = $FullUrl . &ScriptLinkChar() . &GetOldPageParameters('browse', $pagename, $revision); $itemID = &QuoteHtml($itemID); $headItem = " \n"; # Add to list of items proper. if (($summary ne "") && ($summary ne "*")) { $description = &QuoteHtml($summary); } $host = &QuoteHtml($host); if ($userName) { $author = &QuoteHtml($userName); $authorLink = "link=\"$QuotedFullUrl?$author\""; } else { $author = $host; } $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); # Write it out longhand $item = < $pagename $QuotedFullUrl?$pagename $description $date $author $status $importance $diffPrefix$pagename $revision $historyPrefix$pagename RSS return ($headItem, $item); } sub DoRss { print "Content-type: text/xml\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 } $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 "
      
    \n"; print "
    \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 = '' . T('(edit)') . ' ' if ($revtext{'minor'}); $expirets = $Now - ($KeepDays * 24 * 60 * 60); if ($UseDiff) { my ($c1, $c2); $c1 = 'checked="checked"' if 1 == $row; $c2 = 'checked="checked"' if 0 == $row; $html .= " "; $html .= ""; } 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 .= "[$summary] "; } $html .= $UseDiff ? "\n" : "
    \n"; return $html; } # ==== HTML and page-oriented functions ==== sub ScriptLinkChar { if ($SlashLinks) { return '/'; } return '?'; } sub ScriptLink { my ($action, $text) = @_; return "$text"; } sub ScriptLinkClass { my ($action, $text, $class) = @_; return "$text"; } 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) = @_; 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"); return $result if ($embed); $result .= '
    '; if ($oldId ne '') { $result .= $q->h3('(' . Ts('redirected from %s', &GetEditLink($oldId, $oldId)) . ')'); } if ((!$embed) && ($LogoUrl ne "")) { $logoImage = "img src=\"$LogoUrl\" alt=\"$altText\" border=0"; if (!$LogoLeft) { $logoImage .= " align=\"right\""; } $header = &ScriptLink($HomePage, "<$logoImage>"); } if ($id ne '') { $result .= $q->h1($header . &GetBackLinksSearchLink($id)); } else { $result .= $q->h1($header . $title); } if (&GetParam("toplinkbar", 1)) { $result .= &GetGotoBar($id) . "
    "; } $result .= '
    '; return $result; } sub GetHttpHeader { my ($type) = @_; my $cookie; $type = 'text/html' if ($type eq ''); if (defined($SetCookie{'id'})) { $cookie = "$CookieName=" . "rev&" . $SetCookie{'rev'} . "&id&" . $SetCookie{'id'} . "&randkey&" . $SetCookie{'randkey'}; $cookie .= ";expires=Fri, 08-Sep-2013 19:48:23 GMT"; 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) = @_; my ($dtd, $html, $bodyExtra, $stylesheet); $html = ''; $dtd = '-//IETF//DTD HTML//EN'; $html = qq(\n); $title = $q->escapeHTML($title); $html .= "$title\n"; if ($FavIcon ne '') { $html .= '' } if ($MetaKeywords) { my $keywords = $OpenPageName; $keywords =~ s/([a-z])([A-Z])/$1, $2/g; $html .= "\n" if $keywords; } if ($SiteBase ne "") { $html .= qq(\n); } $stylesheet = &GetParam('stylesheet', $StyleSheet); $stylesheet = $StyleSheet if ($stylesheet eq ''); $stylesheet = '' if ($stylesheet eq '*'); # Allow removing override if ($stylesheet ne '') { $html .= qq(\n); } $html .= $UserHeader; $bodyExtra = ''; if ($UserBody ne '') { $bodyExtra = ' ' . $UserBody; } if ($BGColor ne '') { $bodyExtra .= qq( BGCOLOR="$BGColor"); } $html .= "\n"; return $html; } sub GetFooterText { my ($id, $rev) = @_; my $result; if (&GetParam('embed', $EmbedWiki)) { return $q->end_html; } $result = '
    '; $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 .= ' | ' . T('Search MetaWiki') . ''; } if ($Section{'revision'} > 0) { $result .= '
    '; 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'})); } } if ($UseDiff) { $result .= ' ' . &ScriptLinkDiff(4, $id, T('(diff)'), $rev); } $result .= '
    ' . &GetSearchForm(); if ($AdminBar && &UserIsAdmin()) { $result .= '
    ' . &GetAdminBar($id); } if ($DataDir =~ m|/tmp/|) { $result .= '
    ' . T('Warning') . ': ' . Ts('Database is stored in temporary directory %s', $DataDir) . '
    '; } if ($ConfigError ne '') { $result .= '
    ' . T('Config file error:') . ' ' . $ConfigError . '
    '; } $result .= $q->endform; if ($FooterNote ne '') { $result .= T($FooterNote); } $result .= '
    '; $result .= &GetMinimumFooter(); return $result; } sub GetCommonFooter { my ($html); $html = '
    ' . '
    ' . &GetFormStart() . &GetGotoBar('') . &GetSearchForm() . $q->endform; if ($FooterNote ne '') { $html .= T($FooterNote); } $html .= '
    ' . $q->end_html; return $html; } sub GetMinimumFooter { return $q->end_html; } sub GetFormStart { return $q->startform("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 .= "
    \n"; return $bartext; } 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() . $newid; $nameLink = "$name"; 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

    "; $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/((.|\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 } while (@HeadingNumbers) { pop @HeadingNumbers; $TableOfContents .= "\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 tag stores text with no markup (except quoting HTML) s/\<nowiki\>((.|\n)*?)\<\/nowiki\>/&StoreRaw($1)/ige; # The

     tag wraps the stored text with the HTML 
     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\>/$1<\/b>/gi;
          s/\<i\>(.*?)\<\/i\>/$1<\/i>/gi;
          s/\<strong\>(.*?)\<\/strong\>/$1<\/strong>/gi;
          s/\<em\>(.*?)\<\/em\>/$1<\/em>/gi;
        }
        s/\<tt\>(.*?)\<\/tt\>/$1<\/tt>/gis;  #  (MeatBall)
        s/\<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 ($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 ($UseUpload) { s/$UploadPattern/&StoreUpload($1)/geo; } if ($ThinLine) { if ($OldThinLine) { # Backwards compatible, conflicts with headers s/====+/
    /g; } else { # New behavior--no conflict s/------+/
    /g; } s/----+/
    /g; } else { s/----+/
    /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$2<\/strong>/g; s/''(.*?)''/$1<\/em>/g; if ($UseHeadings) { s/(^|\n)\s*(\=+)\s+([^\n]+)\s+\=+/&WikiHeading($1, $2, $3)/geo; } if ($TableMode) { s/((\|\|)+)/"<\/TD>"/ge; } } return $_; } 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/^(\;+)([^:]+\:?)\:/
    $2
    /) { $code = "DL"; $depth = length $1; } elsif (s/^(\:+)/
    /) { $code = "DL"; $depth = length $1; } elsif (s/^(\*+)/
  • /) { $code = "UL"; $depth = length $1; } elsif (s/^(\#+)/
  • /) { $code = "OL"; $depth = length $1; } elsif ($TableSyntax && s/^((\|\|)+)(.*)\|\|\s*$/"$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 .= "\n"; } if ($depth > 0) { $depth = $IndentLimit if ($depth > $IndentLimit); if (@htmlStack) { # Non-empty stack $oldCode = pop(@htmlStack); if ($oldCode ne $code) { $pageHtml .= "<$code>\n"; } push(@htmlStack, $code); } while (@htmlStack < $depth) { push(@htmlStack, $code); $pageHtml .= "<$code $codeAttributes>\n"; } } if (!$ParseParas) { s/^\s*$/

    \n/; # Blank lines become

    tags } $pageHtml .= &CommonMarkup($_, 1, 2); # Line-oriented common markup } while (@htmlStack > 0) { # Clear stack $pageHtml .= "\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 .= '


    ' . T('Local rule error:') . '
    ' . &QuoteHtml($errorText); } } } return $text; } sub QuoteHtml { my ($html) = @_; $html =~ s/&/&/g; $html =~ s//>/g; $html =~ s/&([#a-zA-Z0-9]+);/&$1;/g; # Allow character references return $html; } sub ParseParagraph { my ($text) = @_; $text = &CommonMarkup($text, 1, 0); # Multi-line markup $text = &WikiLinesToHtml($text); # Line-oriented markup return "

    $text

    \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 = ""; } else { $text = "[$text]"; } return &StoreRaw("$text"); } 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 . ""); } sub StoreHref { my ($anchor, $text) = @_; return "$text"; } 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 ("$name", $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 ""; } return "$name"; } sub ImageAllowed { my ($url) = @_; my ($site, $imagePrefixes); $imagePrefixes = 'http:|https:|ftp:'; $imagePrefixes .= '|file:' if (!$LimitFileUrl); return 0 unless ($url =~ /^($imagePrefixes).+\.$ImageExtensions$/); 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); } if ($BracketImg && $useImage && &ImageAllowed($text)) { $text = ""; } else { $text = "[$text]"; } return &StoreRaw("$text"); } 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 "RFC $num"; } 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 = ''; if (&ImageAllowed($url)) { $html .= 'upload:' . $filename . ''; } else { $html .= 'upload:' . $filename; } $html .= ''; return $html; } sub StoreISBN { my ($num) = @_; return &StoreRaw(&ISBNLink($num)); } sub ISBNALink { my ($num, $pre, $post, $text) = @_; return '' . $text . ''; } 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\/\xc0-\xff]+)$//; } else { ($punct) = ($url =~ /([^a-zA-Z0-9\/\xc0-\xff]+)$/); $url =~ s/([^a-zA-Z0-9\/\xc0-\xff]+)$//; } 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 .= '
    '; } if (scalar @HeadingNumbers < $depth) { push @HeadingNumbers, 0; $TableOfContents .= '
    '; } while (scalar @HeadingNumbers > $depth) { pop @HeadingNumbers; $TableOfContents .= "
    \n\n"; } $HeadingNumbers[$#HeadingNumbers]++; $number = (join '.', @HeadingNumbers) . '. '; # Remove embedded links. THIS IS FRAGILE! $text = &RestoreSavedText($text); $text =~ s/\]*?\>\?\<\/a\>//si; # No such page syntax $text =~ 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) . "
    \n
    "; 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 . "$text\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 = '' . Tss("Difference (from revision %1 to %2)", $revOld, $currentRevision) . "\n" . "$links
    " . &DiffToHTML($diffText); } else { if (($diffType != 2) && ((!defined(&GetPageCache("old$cacheName"))) || (&GetPageCache("old$cacheName") < 1))) { $html = '' . Ts('No diff available--this is the first %s revision.', $priorName) . "\n$links"; } else { $html = '' . Ts('Difference (from prior %s revision)', $priorName) . "\n$links
    " . &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
    to be different from diff section. $html =~ s/(^|\n)(\d+.*c.*)/$1
    $tChanged $2<\/strong>
    /g; $html =~ s/(^|\n)(\d+.*d.*)/$1
    $tRemoved $2<\/strong>
    /g; $html =~ s/(^|\n)(\d+.*a.*)/$1
    $tAdded $2<\/strong>
    /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/
    /g; $colorHtml = ''; if ($color ne '') { $colorHtml = " bgcolor=$color"; } if ($type) { $classHtml = ' class=wikidiffnew'; } else { $classHtml = ' class=wikidiffold'; } return "
    \n" . $diff . "
    \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 (length(@kplist) < 1); # Also empty shift(@kplist) if ($kplist[0] eq ""); # First can be empty return if (length(@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 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, "

    ", $errmsg, "

    ", $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 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 (@pwlist, $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 (@pwlist, $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=; 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 ($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; } $ampm = ""; if ($UseAmPm) { $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, $text, $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 "

    "; 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('', &QuoteHtml($header), ''); if ($revision ne '') { print "\n" . Ts('Editing old revision %s.', $revision) . " " . T('Saving this page will replace the latest revision with this text.') . '
    ' } if ($isConflict) { $editRows -= 10 if ($editRows > 19); print "\n

    " . T('Edit Conflict!') . "

    \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

    " . T('(This is a new conflict)') . "

    \n"; } print "

    ", 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.'), "
    \n", T('Scroll down to see your edited text.'), "
    \n"; print T('Last save time:'), ' ', &TimeToText($oldTime), " (", T('Current time is:'), ' ', &TimeToText($Now), ")
    \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 "

    ", T('Summary:'), $q->textfield(-name=>'summary', -default=>$summary, -override=>1, -size=>60, -maxlength=>200); if (&GetParam("recent_edit") eq "on") { print "
    ", $q->checkbox(-name=>'recent_edit', -checked=>1, -label=>T('This change is a minor edit.')); } else { print "
    ", $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 "
    "; if ($EditNote ne '') { print T($EditNote) . '
    '; # 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()), ') '; } print $q->submit(-name=>'Preview', -value=>T('Preview')), "\n"; if ($isConflict) { print "\n


    ", T('This is the text you submitted:'), "

    ", &GetTextArea('newtext', $newText, $editRows, $editCols), "

    \n"; } print "


    \n"; if ($preview) { print '
    '; print "

    ", T('Preview:'), "

    \n"; if ($isConflict) { print "", T('NOTE: This preview shows the revision of the other author.'), "
    \n"; } $MainPage = $id; $MainPage =~ s|/.*||; # Only the main page name (remove subpage) print &WikiToHTML($oldText) . "
    \n"; print "

    ", T('Preview only, not yet saved'), "

    \n"; print '
    '; } print '
    '; print &GetHistoryLink($id, T('View other revisions')) . "
    \n"; print &GetGotoBar($id); print $q->endform; print '
    '; 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 '
    '; print &GetFormStart(); print GetHiddenValue("edit_prefs", 1), "\n"; print '' . T('User Information:') . "\n"; print '
    ' . Ts('Your User ID number: %s', $UserID) . "\n"; print '
    ' . T('UserName:') . ' ', &GetFormText('username', "", 20, 50); print ' ' . T('(blank to remove, or valid page name)'); print '
    ' . T('Set Password:') . ' ', $q->password_field(-name=>'p_password', -value=>'*', -size=>15, -maxlength=>50), ' ', T('(blank to remove password)'), '
    (', T('Passwords allow sharing preferences between multiple systems.'), ' ', T('Passwords are completely optional.'), ')'; if (($AdminPass ne '') || ($EditPass ne '')) { print '
    ', T('Administrator Password:'), ' ', $q->password_field(-name=>'p_adminpw', -value=>'*', -size=>15, -maxlength=>50), ' ', T('(blank to remove password)'), '
    ', T('(Administrator passwords are used for special maintenance.)'); } if ($EmailNotify) { print "
    "; print &GetFormCheck('notify', 1, T('Include this address in the site email list.')), ' ', T('(Uncheck the box to remove the address.)'); print '
    ', T('Email Address:'), ' ', &GetFormText('email', "", 30, 60); } print "
    $recentName:\n"; print '
    ', T('Default days to display:'), ' ', &GetFormText('rcdays', $RcDefault, 4, 9); print "
    ", &GetFormCheck('rcnewtop', $RecentTop, T('Most recent changes on top')); print "
    ", &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 '
    ', T('Minor edit display:'), ' '; print $q->popup_menu(-name=>'p_rcshowedit', -values=>[0,1,2], -labels=>\%labels, -default=>&GetParam("rcshowedit", $ShowEdits)); print "
    ", &GetFormCheck('rcchangehist', 1, T('Use "changes" as link to history')); if ($UseDiff) { print '
    ', T('Differences:'), "\n"; print "
    ", &GetFormCheck('diffrclink', 1, Ts('Show (diff) links on %s', $recentName)); print "
    ", &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 '
    ', T('Default difference type:'), ' '; print $q->popup_menu(-name=>'p_defaultdiff', -values=>[1,2,3], -labels=>\%labels, -default=>&GetParam("defaultdiff", 1)); } print '
    ', T('Misc:'), "\n"; # Note: TZ offset is added by TimeToText, so pre-subtract to cancel. print '
    ', T('Server time:'), ' ', &TimeToText($Now-$TimeZoneOffset); print '
    ', T('Time Zone offset (hours):'), ' ', &GetFormText('tzoffset', 0, 4, 9); print '
    ', &GetFormCheck('editwide', 1, T('Use 100% wide edit area (if supported)')); print '
    ', T('Edit area rows:'), ' ', &GetFormText('editrows', 20, 4, 4), ' ', T('columns:'), ' ', &GetFormText('editcols', 65, 4, 4); print '
    ', &GetFormCheck('toplinkbar', 1, T('Show link bar on top')); print '
    ', &GetFormCheck('linkrandom', 0, T('Add "Random Page" link to link bar')); print '
    ' . T('StyleSheet URL:') . ' ', &GetFormText('stylesheet', "", 30, 150); print '
    ', $q->submit(-name=>'Save', -value=>T('Save')), "\n"; print '
    '; print "
    \n"; print '
    '; print &GetGotoBar(''); print $q->endform; print '
    '; 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'), ''); print '
    '; if ($UserID < 1001) { print '', Ts('Invalid UserID %s, preferences not saved.', $UserID), ''; if ($UserID == 111) { print '
    ', 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.'), '
    '; undef $UserData{'username'}; } elsif ((!$FreeLinks) && (!($username =~ /^$LinkPattern$/))) { print Ts('Invalid UserName %s: not saved.', $username), "
    \n"; } elsif ($FreeLinks && (!($username =~ /^$FreeLinkPattern$/))) { print Ts('Invalid UserName %s: not saved.', $username), "
    \n"; } elsif (length($username) > 50) { # Too long print T('UserName must be 50 characters or less. (not saved)'), "
    \n"; } else { print Ts('UserName %s saved.', $username), '
    '; $UserData{'username'} = $username; } $password = &GetParam("p_password", ""); if ($password eq "") { print T('Password removed.'), '
    '; undef $UserData{'password'}; } elsif ($password ne "*") { print T('Password changed.'), '
    '; $UserData{'password'} = $password; } if (($AdminPass ne "") || ($EditPass ne "")) { $password = &GetParam("p_adminpw", ""); if ($password eq "") { print T('Administrator password removed.'), '
    '; undef $UserData{'adminpw'}; } elsif ($password ne "*") { print T('Administrator password changed.'), '
    '; $UserData{'adminpw'} = $password; if (&UserIsAdmin()) { print T('User has administrative abilities.'), '
    '; } elsif (&UserIsEditor()) { print T('User has editor abilities.'), '
    '; } else { print T('User does not have administrative abilities.'), ' ', T('(Password does not match administrative password(s).)'), '
    '; } } } 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), '
    '; $TimeZoneOffset = &GetParam("tzoffset", 0) * (60 * 60); print T('Local time:'), ' ', &TimeToText($Now), '
    '; $stylesheet = &GetParam('p_stylesheet', ''); if ($stylesheet eq '') { if (&GetParam('stylesheet', '') ne '') { print T('StyleSheet URL removed.'), '
    '; } undef $UserData{'stylesheet'}; } else { $stylesheet =~ s/[">]//g; # Remove characters that would cause problems $UserData{'stylesheet'} = $stylesheet; print T('StyleSheet setting saved.'), '
    '; } &SaveUserData(); print '', T('Preferences saved.'), ''; 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 = ; 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'), ''); print '
    '; &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 '
    ', T('User ID number:'), ' ', $q->textfield(-name=>'p_userid', -value=>'', -size=>15, -maxlength=>50); print '
    ', T('Password:'), ' ', $q->password_field(-name=>'p_password', -value=>'', -size=>15, -maxlength=>50); print '
    ', $q->submit(-name=>'Login', -value=>T('Login')), "\n"; print "
    \n"; print &GetGotoBar(''); print $q->endform; print &GetMinimumFooter(); } sub DoLogin { my ($uid, $password, $success); $success = 0; $uid = &GetParam("p_userid", ""); $uid =~ s/\D//g; $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.', $uid); } else { print Ts('Login for user ID %s failed.', $uid); } print "
    \n"; print &GetGotoBar(''); print $q->endform; 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)), ''); print '
    '; &PrintPageList(&SearchTitleAndBody($string)); print &GetCommonFooter(); } sub DoBackLinks { my ($string) = @_; print &GetHeader('', &QuoteHtml(Ts('Backlinks for: %s', $string)), ''); print '
    '; # 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 "

    ", Ts('%s pages found:', ($#_ + 1)), "

    \n"; foreach $pagename (@_) { print ".... " if ($pagename =~ m|/|); print &GetPageLink($pagename), "
    \n"; } } sub DoLinks { print &GetHeader('', &QuoteHtml(T('Full Link List')), ''); print "
    \n\n\n\n\n";  # Extra lines to get below the logo
      &PrintLinkList(&GetFullLinkList());
      print "
    \n"; print &GetMinimumFooter(); } 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); $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); foreach $link (@links) { $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/((.|\n)*?)<\/html>/ /ig; $text =~ s/(.|\n)*?\<\/nowiki>/ /ig; $text =~ s/
    (.|\n)*?\<\/pre>/ /ig;
      $text =~ s/(.|\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 ($editDiff, $old, $newAuthor, $pgtime, $oldrev, $preview, $user);
      my $string = &GetParam("text", undef);
      my $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 (!&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 ",", ;
        $address =~ s/\n//g;
        close(EMAIL);
        my $home_url = $q->url();
        my $page_url = $home_url . "?$id";
        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
      ${home_url}?action=editprefs .)
    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 && ($name =~ m/_/)) {
          $freeName = $name;
          $freeName =~ s/_/ /g;
          if ($freeName =~ /$string/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 '

    ', T('This operation may take several seconds...'), "\n"; if (&ForceReleaseLock('main')) { $LockMessage = T('Forced Unlock.'); } &ForceReleaseLock('cache'); &ForceReleaseLock('diff'); &ForceReleaseLock('index'); print "

    $LockMessage

    "; 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'} =~ /.*
    .*?\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'), '');
      print "
    "; $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
    \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 '
    ', T('Processing rename/delete commands:'), "
    \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 '

    ' . Ts('Could not open %s log file', $RCName) . ": $RcFile

    " . T('Error was') . ":\n

    $!\n" . '

    '; 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 '

    ' . Ts('Could not open %s log file', $RCName) . ": $RcOldFile

    " . T('Error was') . ":\n

    $!\n" . '

    '; 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.') . '
    '; } else { print '
    ' . T('RC maintenance not done.') . '
    '; } &ReleaseLock(); print &GetCommonFooter(); } sub UserIsEditorOrError { if (!&UserIsEditor()) { print '

    ', T('This operation is restricted to site editors only...'); print &GetCommonFooter(); return 0; } return 1; } sub UserIsAdminOrError { if (!&UserIsAdmin()) { print '

    ', T('This operation is restricted to administrators only...'); print &GetCommonFooter(); return 0; } return 1; } sub DoEditLock { my ($fname); print &GetHeader('', T('Set or Remove global edit lock'), ''); return if (!&UserIsAdminOrError()); $fname = "$DataDir/noedit"; if (&GetParam("set", 1)) { &WriteStringToFile($fname, "editing locked."); } else { unlink($fname); } if (-f $fname) { print '

    ', T('Edit lock created.'), '
    '; } else { print '

    ', T('Edit lock removed.'), '
    '; } print &GetCommonFooter(); } sub DoPageLock { my ($fname, $id); print &GetHeader('', T('Set or Remove page edit lock'), ''); # Consider allowing page lock/unlock at editor level? return if (!&UserIsAdminOrError()); $id = &GetParam("id", ""); if ($id eq "") { print '

    ', T('Missing page id to lock/unlock...'); return; } return if (!&ValidIdOrDie($id)); # Consider nicer error? $fname = &GetLockedPageFile($id); if (&GetParam("set", 1)) { &WriteStringToFile($fname, "editing locked."); } else { unlink($fname); } if (-f $fname) { print '

    ', Ts('Lock for %s created.', $id), '
    '; } else { print '

    ', Ts('Lock for %s removed.', $id), '
    '; } print &GetCommonFooter(); } sub DoEditBanned { my ($banList, $status); print &GetHeader("", "Editing Banned list", ""); return if (!&UserIsAdminOrError()); ($status, $banList) = &ReadFile("$DataDir/banlist"); $banList = "" if (!$status); print &GetFormStart(); print GetHiddenValue("edit_ban", 1), "\n"; print "Banned IP/network/host list:
    \n"; print "

    Each entry is either a commented line (starting with #), ", "or a Perl regular expression (matching either an IP address or ", "a hostname). Note: To test the ban on yourself, you must ", "give up your admin access (remove password in Preferences)."; print "

    Example:
    ", "# blocks hosts ending with .foocorp.com
    ", "\\.foocorp\\.com\$
    ", "# blocks exact IP address
    ", "^123\\.21\\.3\\.9\$
    ", "# blocks whole 123.21.3.* IP network
    ", "^123\\.21\\.3\\.\\d+\$

    "; print &GetTextArea('banlist', $banList, 12, 50); print "
    ", $q->submit(-name=>'Save'), "\n"; print "


    \n"; print &GetGotoBar(""); print $q->endform; print &GetMinimumFooter(); } sub DoUpdateBanned { my ($newList, $fname); print &GetHeader("", "Updating Banned list", ""); return if (!&UserIsAdminOrError()); $fname = "$DataDir/banlist"; $newList = &GetParam("banlist", "#Empty file"); if ($newList eq "") { print "

    Empty banned list or error."; print "

    Resubmit with at least one space character to remove."; } elsif ($newList =~ /^\s*$/s) { unlink($fname); print "

    Removed banned list"; } else { &WriteStringToFile($fname, $newList); print "

    Updated banned list"; } print &GetCommonFooter(); } # ==== Editing/Deleting pages and links ==== sub DoEditLinks { print &GetHeader("", "Editing Links", ""); if ($AdminDelete) { return if (!&UserIsAdminOrError()); } else { return if (!&UserIsEditorOrError()); } print &GetFormStart(); print GetHiddenValue("edit_links", 1), "\n"; print "Editing/Deleting page titles:
    \n"; print "

    Enter one command on each line. Commands are:
    ", "!PageName -- deletes the page called PageName
    \n", "=OldPageName=NewPageName -- Renames OldPageName ", "to NewPageName and updates links to OldPageName.
    \n", "|OldPageName|NewPageName -- Changes links to OldPageName ", "to NewPageName.", " (Used to rename links to non-existing pages.)
    \n", "Note: page names are case-sensitive!\n"; print &GetTextArea('commandlist', "", 12, 50); print $q->checkbox(-name=>"p_changerc", -override=>1, -checked=>1, -label=>"Edit $RCName"); print "
    \n"; print $q->checkbox(-name=>"p_changetext", -override=>1, -checked=>1, -label=>"Substitute text for rename"); print "
    ", $q->submit(-name=>'Edit'), "\n"; print "


    \n"; print &GetGotoBar(""); print $q->endform; 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 $_
    \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 "

    Empty command list or error."; } else { &UpdateLinksList($commandList, $doRC, $doText); print "

    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 = "

    Could not open $RCName log file:" . " $fname

    Error was:\n

    $!
    \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 "Delete-Page: page $page is invalid, error is: $status
    \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/(((.|\n)*?)<\/html>)/&StoreRaw($1)/ige; } $text =~ s/(
    ((.|\n)*?)<\/pre>)/&StoreRaw($1)/ige;
      $text =~ s/(((.|\n)*?)<\/code>)/&StoreRaw($1)/ige;
      $text =~ s/(((.|\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 (length(@kplist) < 1);  # Also empty
      shift(@kplist)  if ($kplist[0] eq "");  # First can be empty
      return  if (length(@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 "Rename-Text: old page $old is invalid, error is: $status
    \n"; return; } $status = &ValidId($new); if ($status ne "") { print "Rename-Text: new page $new is invalid, error is: $status
    \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 "Rename: old page $old is invalid, error is: $status
    \n"; return; } $status = &ValidId($new); if ($status ne "") { print "Rename: new page $new is invalid, error is: $status
    \n"; return; } $newfname = &GetPageFile($new); if (-f $newfname) { print "Rename: new page $new already exists--not renamed.
    \n"; return; } $oldfname = &GetPageFile($old); if (!(-f $oldfname)) { print "Rename: old page $old does not exist--nothing done.
    \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); &EditRecentChanges(2, $old, $new) if ($doRC); if ($doText) { &BuildLinkIndexPage($new); # Keep index up-to-date &RenameTextLinks($old, $new); } } sub DoShowVersion { print &GetHeader("", "Displaying Wiki Version", ""); print "

    UseModWiki version 1.0

    \n"; print &GetCommonFooter(); } # 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; } # Thanks to Phillip Riley for original code sub DoDeletePage { my ($id) = @_; return if (!&ValidIdOrDie($id)); return if (!&UserIsAdminOrError()); if ($ConfirmDel && !&GetParam('confirm', 0)) { print &GetHeader('', Ts('Confirm Delete %s', $id), ''); print '

    '; print Ts('Confirm deletion of %s by following this link:', $id); print '
    ' . &GetDeleteLink($id, T('Confirm Delete'), 1); print '

    '; print &GetCommonFooter(); return; } print &GetHeader('', Ts('Delete %s', $id), ''); print '

    '; 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 '

    '; 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 '

    ' . Ts('The current upload size limit is %s.', $MaxPost) . ' ' . Ts('Change the %s variable to increase this limit.', '$MaxPost'); print '


    '; print '
    '; print ''; print 'File to Upload:

    '; print ''; print '
    '; 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"; while (<$uploadFilehandle>) { print UPLOADFILE; } close UPLOADFILE; print T('The wiki link to your file is:') . "\n

    "; $printFilename = $filename; $printFilename =~ s/ /\%20/g; # Replace spaces with escaped spaces print "upload:" . $printFilename . "

    \n"; if ($filename =~ /${ImageExtensions}$/) { print '
    ' . "\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 '
    ' . Ts('Could not open file %s', $fname) . ':' . T('Error was') . ":\n
    $!
    \n" . '
    '; 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 . '
    '; # 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 . '
    '; # 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 . '
    '; # 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') . '
    '; return; } &WriteStringToFile("$DataDir/noedit", 'editing locked.'); print T('Wiki DB locked for conversion.') . '
    '; print T('Converting Wiki DB...') . '
    '; &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.') . '
    '; print Ts('Remove file %s to unlock wiki for editing.', "$DataDir/noedit") . '
    '; 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" . '
    '; # progress $removed += 1; } } } } } print Ts('Removed %s files.', $removed) . '
    '; print Ts('Recommended $StartUID setting is %s.', $maxID + 100) . '
    '; print &GetCommonFooter(); } #END_OF_OTHER_CODE &DoWikiRequest() if ($RunCGI && ($_ ne 'nocgi')); # Do everything. 1; # In case we are loaded from elsewhere # == End of UseModWiki script. ===========================================