?  search:
summary | log | graphiclog1 | graphiclog2 | commit | commitdiff | tree | refs | edit | fork
blame | history | raw | HEAD
wiki.pl: Port some fixes from upstream
[Orgmuse.git] / t / usemod-1.0.4.pl
blob254e1dd6147c968599afcaa44fb05b48c23a7424
1 #!/usr/bin/perl
2 # UseModWiki version 1.0.4 (December 1, 2007)
3 # Copyright (C) 2000-2003 Clifford A. Adams <caadams@usemod.com>
4 # Copyright (C) 2002-2003 Sunir Shah <sunir@sunir.org>
5 # Based on the GPLed AtisWiki 0.3 (C) 1998 Markus Denker
6 # <marcus@ira.uka.de>
7 # ...which was based on
8 # the LGPLed CVWiki CVS-patches (C) 1997 Peter Merel
9 # and The Original WikiWikiWeb (C) Ward Cunningham
10 # <ward@c2.com> (code reused with permission)
11 # Email and ThinLine options by Jim Mahoney <mahoney@marlboro.edu>
12 #
13 # This program is free software; you can redistribute it and/or modify
14 # it under the terms of the GNU General Public License as published by
15 # the Free Software Foundation; either version 2 of the License, or
16 # (at your option) any later version.
17 #
18 # This program is distributed in the hope that it will be useful,
19 # but WITHOUT ANY WARRANTY; without even the implied warranty of
20 # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
21 # GNU General Public License for more details.
22 #
23 # You should have received a copy of the GNU General Public License
24 # along with this program; if not, write to the
25 # Free Software Foundation, Inc.
26 # 59 Temple Place, Suite 330
27 # Boston, MA 02111-1307 USA
28
29 package UseModWiki;
30 use strict;
31 local $| = 1; # Do not buffer output (localized for mod_perl)
32
33 # Configuration/constant variables:
34 use vars qw(@RcDays @HtmlPairs @HtmlSingle
35 $TempDir $LockDir $DataDir $HtmlDir $UserDir $KeepDir $PageDir
36 $InterFile $RcFile $RcOldFile $IndexFile $FullUrl $SiteName $HomePage
37 $LogoUrl $RcDefault $IndentLimit $RecentTop $EditAllowed $UseDiff
38 $UseSubpage $UseCache $RawHtml $SimpleLinks $NonEnglish $LogoLeft
39 $KeepDays $HtmlTags $HtmlLinks $UseDiffLog $KeepMajor $KeepAuthor
40 $FreeUpper $EmailNotify $SendMail $EmailFrom $FastGlob $EmbedWiki
41 $ScriptTZ $BracketText $UseAmPm $UseConfig $UseIndex $UseLookup
42 $RedirType $AdminPass $EditPass $UseHeadings $NetworkFile $BracketWiki
43 $FreeLinks $WikiLinks $AdminDelete $FreeLinkPattern $RCName $RunCGI
44 $ShowEdits $ThinLine $LinkPattern $InterLinkPattern $InterSitePattern
45 $UrlProtocols $UrlPattern $ImageExtensions $RFCPattern $ISBNPattern
46 $FS $FS1 $FS2 $FS3 $CookieName $SiteBase $StyleSheet $NotFoundPg
47 $FooterNote $EditNote $MaxPost $NewText $NotifyDefault $HttpCharset
48 $UserGotoBar $DeletedPage $ReplaceFile @ReplaceableFiles $TableSyntax
49 $MetaKeywords $NamedAnchors $InterWikiMoniker $SiteDescription $RssLogoUrl
50 $NumberDates $EarlyRules $LateRules $NewFS $KeepSize $SlashLinks $BGColor
51 $UpperFirst $AdminBar $RepInterMap $DiffColor1 $DiffColor2 $ConfirmDel
52 $MaskHosts $LockCrash $ConfigFile $HistoryEdit $OldThinLine
53 @IsbnNames @IsbnPre @IsbnPost $EmailFile $FavIcon $RssDays $UserHeader
54 $UserBody $StartUID $ParseParas $AuthorFooter $UseUpload $AllUpload
55 $UploadDir $UploadUrl $LimitFileUrl $MaintTrimRc $SearchButton
56 $EditNameLink $UseMetaWiki @ImageSites $BracketImg );
57 # Note: $NotifyDefault is kept because it was a config variable in 0.90
58 # Other global variables:
59 use vars qw(%Page %Section %Text %InterSite %SaveUrl %SaveNumUrl
60 %KeptRevisions %UserCookie %SetCookie %UserData %IndexHash %Translate
61 %LinkIndex $InterSiteInit $SaveUrlIndex $SaveNumUrlIndex $MainPage
62 $OpenPageName @KeptList @IndexList $IndexInit $TableMode
63 $q $Now $UserID $TimeZoneOffset $ScriptName $BrowseCode $OtherCode
64 $AnchoredLinkPattern @HeadingNumbers $TableOfContents $QuotedFullUrl
65 $ConfigError $UploadPattern );
66
67 # == Configuration =====================================================
68 $DataDir = "/tmp/mywikidb"; # Main wiki directory
69 $UseConfig = 1; # 1 = use config file, 0 = do not look for config
70 $ConfigFile = "$DataDir/config"; # Configuration file
71
72 # Default configuration (used if UseConfig is 0)
73 $CookieName = "Wiki"; # Name for this wiki (for multi-wiki sites)
74 $SiteName = "Wiki"; # Name of site (used for titles)
75 $HomePage = "HomePage"; # Home page (change space to _)
76 $RCName = "RecentChanges"; # Name of changes page (change space to _)
77 $LogoUrl = "/wiki.gif"; # URL for site logo ("" for no logo)
78 $ENV{PATH} = "/usr/bin/"; # Path used to find "diff"
79 $ScriptTZ = ""; # Local time zone ("" means do not print)
80 $RcDefault = 30; # Default number of RecentChanges days
81 @RcDays = qw(1 3 7 30 90); # Days for links on RecentChanges
82 $KeepDays = 14; # Days to keep old revisions
83 $SiteBase = ""; # Full URL for <BASE> header
84 $FullUrl = ""; # Set if the auto-detected URL is wrong
85 $RedirType = 1; # 1 = CGI.pm, 2 = script, 3 = no redirect
86 $AdminPass = ""; # Set to non-blank to enable password(s)
87 $EditPass = ""; # Like AdminPass, but for editing only
88 $StyleSheet = ""; # URL for CSS stylesheet (like "/wiki.css")
89 $NotFoundPg = ""; # Page for not-found links ("" for blank pg)
90 $EmailFrom = "Wiki"; # Text for "From: " field of email notes.
91 $SendMail = "/usr/sbin/sendmail"; # Full path to sendmail executable
92 $FooterNote = ""; # HTML for bottom of every page
93 $EditNote = ""; # HTML notice above buttons on edit page
94 $MaxPost = 1024 * 210; # Maximum 210K posts (about 200K for pages)
95 $NewText = ""; # New page text ("" for default message)
96 $HttpCharset = ""; # Charset for pages, like "iso-8859-2"
97 $UserGotoBar = ""; # HTML added to end of goto bar
98 $InterWikiMoniker = ''; # InterWiki moniker for this wiki. (for RSS)
99 $SiteDescription = $SiteName; # Description of this wiki. (for RSS)
100 $RssLogoUrl = ''; # Optional image for RSS feed
101 $EarlyRules = ''; # Local syntax rules for wiki->html (evaled)
102 $LateRules = ''; # Local syntax rules for wiki->html (evaled)
103 $KeepSize = 0; # If non-zero, maximum size of keep file
104 $BGColor = 'white'; # Background color ('' to disable)
105 $DiffColor1 = '#ffffaf'; # Background color of old/deleted text
106 $DiffColor2 = '#cfffcf'; # Background color of new/added text
107 $FavIcon = ''; # URL of bookmark/favorites icon, or ''
108 $RssDays = 7; # Default number of days in RSS feed
109 $UserHeader = ''; # Optional HTML header additional content
110 $UserBody = ''; # Optional <BODY> tag additional content
111 $StartUID = 1001; # Starting number for user IDs
112 $UploadDir = ''; # Full path (like /foo/www/uploads) for files
113 $UploadUrl = ''; # Full URL (like http://foo.com/uploads)
114 @ImageSites = qw(); # Url prefixes of good image sites: ()=all
115
116 # Major options:
117 $UseSubpage = 1; # 1 = use subpages, 0 = do not use subpages
118 $UseCache = 0; # 1 = cache HTML pages, 0 = generate every page
119 $EditAllowed = 1; # 1 = editing allowed, 0 = read-only
120 $RawHtml = 0; # 1 = allow <HTML> tag, 0 = no raw HTML in pages
121 $HtmlTags = 0; # 1 = "unsafe" HTML tags, 0 = only minimal tags
122 $UseDiff = 1; # 1 = use diff features, 0 = do not use diff
123 $FreeLinks = 1; # 1 = use [[word]] links, 0 = LinkPattern only
124 $WikiLinks = 1; # 1 = use LinkPattern, 0 = use [[word]] only
125 $AdminDelete = 1; # 1 = Admin only deletes, 0 = Editor can delete
126 $RunCGI = 1; # 1 = Run script as CGI, 0 = Load but do not run
127 $EmailNotify = 0; # 1 = use email notices, 0 = no email on changes
128 $EmbedWiki = 0; # 1 = no headers/footers, 0 = normal wiki pages
129 $DeletedPage = 'DeletedPage'; # 0 = disable, 'PageName' = tag to delete page
130 $ReplaceFile = 'ReplaceFile'; # 0 = disable, 'PageName' = indicator tag
131 @ReplaceableFiles = (); # List of allowed server files to replace
132 $TableSyntax = 1; # 1 = wiki syntax tables, 0 = no table syntax
133 $NewFS = 0; # 1 = new multibyte $FS, 0 = old $FS
134 $UseUpload = 0; # 1 = allow uploads, 0 = no uploads
135
136 # Minor options:
137 $LogoLeft = 0; # 1 = logo on left, 0 = logo on right
138 $RecentTop = 1; # 1 = recent on top, 0 = recent on bottom
139 $UseDiffLog = 1; # 1 = save diffs to log, 0 = do not save diffs
140 $KeepMajor = 1; # 1 = keep major rev, 0 = expire all revisions
141 $KeepAuthor = 1; # 1 = keep author rev, 0 = expire all revisions
142 $ShowEdits = 0; # 1 = show minor edits, 0 = hide edits by default
143 $HtmlLinks = 0; # 1 = allow A HREF links, 0 = no raw HTML links
144 $SimpleLinks = 0; # 1 = only letters, 0 = allow _ and numbers
145 $NonEnglish = 0; # 1 = extra link chars, 0 = only A-Za-z chars
146 $ThinLine = 0; # 1 = fancy <hr> tags, 0 = classic wiki <hr>
147 $BracketText = 1; # 1 = allow [URL text], 0 = no link descriptions
148 $UseAmPm = 1; # 1 = use am/pm in times, 0 = use 24-hour times
149 $UseIndex = 0; # 1 = use index file, 0 = slow/reliable method
150 $UseHeadings = 1; # 1 = allow = h1 text =, 0 = no header formatting
151 $NetworkFile = 1; # 1 = allow remote file:, 0 = no file:// links
152 $BracketWiki = 0; # 1 = [WikiLnk txt] link, 0 = no local descriptions
153 $UseLookup = 1; # 1 = lookup host names, 0 = skip lookup (IP only)
154 $FreeUpper = 1; # 1 = force upper case, 0 = do not force case
155 $FastGlob = 1; # 1 = new faster code, 0 = old compatible code
156 $MetaKeywords = 1; # 1 = Google-friendly, 0 = search-engine averse
157 $NamedAnchors = 1; # 0 = no anchors, 1 = enable anchors,
158 # 2 = enable but suppress display
159 $SlashLinks = 0; # 1 = use script/action links, 0 = script?action
160 $UpperFirst = 1; # 1 = free links start uppercase, 0 = no ucfirst
161 $AdminBar = 1; # 1 = admins see admin links, 0 = no admin bar
162 $RepInterMap = 0; # 1 = intermap is replacable, 0 = not replacable
163 $ConfirmDel = 1; # 1 = delete link confirm page, 0 = immediate delete
164 $MaskHosts = 0; # 1 = mask hosts/IPs, 0 = no masking
165 $LockCrash = 0; # 1 = crash if lock stuck, 0 = auto clear locks
166 $HistoryEdit = 0; # 1 = edit links on history page, 0 = no edit links
167 $OldThinLine = 0; # 1 = old ==== thick line, 0 = ------ for thick line
168 $NumberDates = 0; # 1 = 2003-6-17 dates, 0 = June 17, 2003 dates
169 $ParseParas = 0; # 1 = new paragraph markup, 0 = old markup
170 $AuthorFooter = 1; # 1 = show last author in footer, 0 = do not show
171 $AllUpload = 0; # 1 = anyone can upload, 0 = only editor/admins
172 $LimitFileUrl = 1; # 1 = limited use of file: URLs, 0 = no limits
173 $MaintTrimRc = 0; # 1 = maintain action trims RC, 0 = only maintainrc
174 $SearchButton = 0; # 1 = search button on page, 0 = old behavior
175 $EditNameLink = 0; # 1 = edit links use name (CSS), 0 = '?' links
176 $UseMetaWiki = 0; # 1 = add MetaWiki search links, 0 = no MW links
177 $BracketImg = 1; # 1 = [url url.gif] becomes image link, 0 = no img
178
179 # Names of sites. (The first entry is used for the number link.)
180 @IsbnNames = ('bn.com', 'amazon.com', 'search');
181 # Full URL of each site before the ISBN
182 @IsbnPre = ('http://search.barnesandnoble.com/booksearch/isbninquiry.asp?isbn=',
183 'http://www.amazon.com/exec/obidos/ISBN=',
184 'http://www.pricescan.com/books/BookDetail.asp?isbn=');
185 # Rest of URL of each site after the ISBN (usually '')
186 @IsbnPost = ('', '', '');
187
188 # HTML tag lists, enabled if $HtmlTags is set.
189 # Scripting is currently possible with these tags,
190 # so they are *not* particularly "safe".
191 # Tags that must be in <tag> ... </tag> pairs:
192 @HtmlPairs = qw(b i u font big small sub sup h1 h2 h3 h4 h5 h6 cite code
193 em s strike strong tt var div center blockquote ol ul dl table caption);
194 # Single tags (that do not require a closing /tag)
195 @HtmlSingle = qw(br p hr li dt dd tr td th);
196 @HtmlPairs = (@HtmlPairs, @HtmlSingle); # All singles can also be pairs
197
198 # == You should not have to change anything below this line. =============
199 $IndentLimit = 20; # Maximum depth of nested lists
200 $PageDir = "$DataDir/page"; # Stores page data
201 $HtmlDir = "$DataDir/html"; # Stores HTML versions
202 $UserDir = "$DataDir/user"; # Stores user data
203 $KeepDir = "$DataDir/keep"; # Stores kept (old) page data
204 $TempDir = "$DataDir/temp"; # Temporary files and locks
205 $LockDir = "$TempDir/lock"; # DB is locked if this exists
206 $InterFile = "$DataDir/intermap"; # Interwiki site->url map
207 $RcFile = "$DataDir/rclog"; # New RecentChanges logfile
208 $RcOldFile = "$DataDir/oldrclog"; # Old RecentChanges logfile
209 $IndexFile = "$DataDir/pageidx"; # List of all pages
210 $EmailFile = "$DataDir/emails"; # Email notification lists
211
212 if ($RepInterMap) {
213 push @ReplaceableFiles, $InterFile;
214 }
215
216 # The "main" program, called at the end of this script file.
217 sub DoWikiRequest {
218 if ($UseConfig && (-f $ConfigFile)) {
219 $ConfigError = '';
220 if (!do $ConfigFile) { # Some error occurred
221 $ConfigError = $@;
222 if ($ConfigError eq '') {
223 # Unfortunately, if the last expr returns 0, one will get a false
224 # error above. To remain compatible with existing installs the
225 # wiki must not report an error unless there is error text in $@.
226 # (Errors in "use strict" may not have error text.)
227 # Uncomment the line below if you want to catch use strict errors.
228 # $ConfigError = T('Unknown Error (no error text)');
229 }
230 }
231 }
232 &InitLinkPatterns();
233 if (!&DoCacheBrowse()) {
234 eval $BrowseCode;
235 &InitRequest() or return;
236 if (!&DoBrowseRequest()) {
237 eval $OtherCode;
238 &DoOtherRequest();
239 }
240 }
241 }
242
243 # == Common and cache-browsing code ====================================
244 sub InitLinkPatterns {
245 my ($UpperLetter, $LowerLetter, $AnyLetter, $LpA, $LpB, $QDelim);
246
247 # Field separators are used in the URL-style patterns below.
248 if ($NewFS) {
249 $FS = "\x1e\xff\xfe\x1e"; # An unlikely sequence for any charset
250 } else {
251 $FS = "\xb3"; # The FS character is a superscript "3"
252 }
253 $FS1 = $FS . "1"; # The FS values are used to separate fields
254 $FS2 = $FS . "2"; # in stored hashtables and other data structures.
255 $FS3 = $FS . "3"; # The FS character is not allowed in user data.
256 $UpperLetter = "[A-Z";
257 $LowerLetter = "[a-z";
258 $AnyLetter = "[A-Za-z";
259 if ($NonEnglish) {
260 $UpperLetter .= "\xc0-\xde";
261 $LowerLetter .= "\xdf-\xff";
262 if ($NewFS) {
263 $AnyLetter .= "\x80-\xff";
264 } else {
265 $AnyLetter .= "\xc0-\xff";
266 }
267 }
268 if (!$SimpleLinks) {
269 $AnyLetter .= "_0-9";
270 }
271 $UpperLetter .= "]"; $LowerLetter .= "]"; $AnyLetter .= "]";
272 # Main link pattern: lowercase between uppercase, then anything
273 $LpA = $UpperLetter . "+" . $LowerLetter . "+" . $UpperLetter
274 . $AnyLetter . "*";
275 # Optional subpage link pattern: uppercase, lowercase, then anything
276 $LpB = $UpperLetter . "+" . $LowerLetter . "+" . $AnyLetter . "*";
277 if ($UseSubpage) {
278 # Loose pattern: If subpage is used, subpage may be simple name
279 $LinkPattern = "((?:(?:$LpA)?\\/$LpB)|$LpA)";
280 # Strict pattern: both sides must be the main LinkPattern
281 # $LinkPattern = "((?:(?:$LpA)?\\/)?$LpA)";
282 } else {
283 $LinkPattern = "($LpA)";
284 }
285 $QDelim = '(?:"")?'; # Optional quote delimiter (not in output)
286 $AnchoredLinkPattern = $LinkPattern . '#(\\w+)' . $QDelim if $NamedAnchors;
287 $LinkPattern .= $QDelim;
288 # Inter-site convention: sites must start with uppercase letter
289 # (Uppercase letter avoids confusion with URLs)
290 $InterSitePattern = $UpperLetter . $AnyLetter . "+";
291 $InterLinkPattern = "((?:$InterSitePattern:[^\\]\\s\"<>$FS]+)$QDelim)";
292 if ($FreeLinks) {
293 # Note: the - character must be first in $AnyLetter definition
294 if ($NonEnglish) {
295 if ($NewFS) {
296 $AnyLetter = "[-,.()' _0-9A-Za-z\x80-\xff]";
297 } else {
298 $AnyLetter = "[-,.()' _0-9A-Za-z\xc0-\xff]";
299 }
300 } else {
301 $AnyLetter = "[-,.()' _0-9A-Za-z]";
302 }
303 }
304 $FreeLinkPattern = "($AnyLetter+)";
305 if ($UseSubpage) {
306 $FreeLinkPattern = "((?:(?:$AnyLetter+)?\\/)?$AnyLetter+)";
307 }
308 $FreeLinkPattern .= $QDelim;
309 # Url-style links are delimited by one of:
310 # 1. Whitespace (kept in output)
311 # 2. Left or right angle-bracket (< or >) (kept in output)
312 # 3. Right square-bracket (]) (kept in output)
313 # 4. A single double-quote (") (kept in output)
314 # 5. A $FS (field separator) character (kept in output)
315 # 6. A double double-quote ("") (removed from output)
316 $UrlProtocols = "http|https|ftp|afs|news|nntp|mid|cid|mailto|wais|"
317 . "prospero|telnet|gopher";
318 $UrlProtocols .= '|file' if ($NetworkFile || !$LimitFileUrl);
319 $UrlPattern = "((?:(?:$UrlProtocols):[^\\]\\s\"<>$FS]+)$QDelim)";
320 $ImageExtensions = "(gif|jpg|png|bmp|jpeg|ico|tiff?)";
321 $RFCPattern = "RFC\\s?(\\d+)";
322 $ISBNPattern = "ISBN:?([0-9- xX]{10,})";
323 $UploadPattern = "upload:([^\\]\\s\"<>$FS]+)$QDelim";
324 }
325
326 # Simple HTML cache
327 sub DoCacheBrowse {
328 my ($query, $idFile, $text);
329
330 return 0 if (!$UseCache);
331 $query = $ENV{'QUERY_STRING'};
332 if (($query eq "") && ($ENV{'REQUEST_METHOD'} eq "GET")) {
333 $query = $HomePage; # Allow caching of home page.
334 }
335 if (!($query =~ /^$LinkPattern$/)) {
336 if (!($FreeLinks && ($query =~ /^$FreeLinkPattern$/))) {
337 return 0; # Only use cache for simple links
338 }
339 }
340 $idFile = &GetHtmlCacheFile($query);
341 if (-f $idFile) {
342 local $/ = undef; # Read complete files
343 open(INFILE, "<$idFile") or return 0;
344 $text = <INFILE>;
345 close INFILE;
346 print $text;
347 return 1;
348 }
349 return 0;
350 }
351
352 sub GetHtmlCacheFile {
353 my ($id) = @_;
354
355 return $HtmlDir . "/" . &GetPageDirectory($id) . "/$id.htm";
356 }
357
358 sub GetPageDirectory {
359 my ($id) = @_;
360
361 if ($id =~ /^([a-zA-Z])/) {
362 return uc($1);
363 }
364 return "other";
365 }
366
367 sub T {
368 my ($text) = @_;
369
370 if (defined($Translate{$text}) && ($Translate{$text} ne '')) {
371 return $Translate{$text};
372 }
373 return $text;
374 }
375
376 sub Ts {
377 my ($text, $string, $noquote) = @_;
378
379 $string = &QuoteHtml($string) unless $noquote;
380 $text = T($text);
381 $text =~ s/\%s/$string/;
382 return $text;
383 }
384
385 sub Tss {
386 my $text = $_[0];
387 my @args = @_;
388
389 @args = map {
390 $_ = &QuoteHtml($_);
391 } @args;
392 $text = T($text);
393 $text =~ s/\%([1-9])/$args[$1]/ge;
394 return $text;
395 }
396
397 sub QuoteHtml {
398 my ($html) = @_;
399
400 $html =~ s/&/&amp;/g;
401 $html =~ s/</&lt;/g;
402 $html =~ s/>/&gt;/g;
403 $html =~ s/&amp;([#a-zA-Z0-9]+);/&$1;/g; # Allow character references
404 return $html;
405 }
406
407 # == Normal page-browsing and RecentChanges code =======================
408 $BrowseCode = ""; # Comment next line to always compile (slower)
409 #$BrowseCode = <<'#END_OF_BROWSE_CODE';
410 use CGI;
411 use CGI::Carp qw(fatalsToBrowser);
412
413 sub InitRequest {
414 my @ScriptPath = split('/', "$ENV{SCRIPT_NAME}");
415
416 $CGI::POST_MAX = $MaxPost;
417 if ($UseUpload) {
418 $CGI::DISABLE_UPLOADS = 0; # allow uploads
419 } else {
420 $CGI::DISABLE_UPLOADS = 1; # no uploads
421 }
422 $q = new CGI;
423 # Fix some issues with editing UTF8 pages (if charset specified)
424 if ($HttpCharset ne '') {
425 $q->charset($HttpCharset);
426 }
427 $Now = time; # Reset in case script is persistent
428 $ScriptName = pop(@ScriptPath); # Name used in links
429 $IndexInit = 0; # Must be reset for each request
430 $InterSiteInit = 0;
431 %InterSite = ();
432 $MainPage = "."; # For subpages only, the name of the top-level page
433 $OpenPageName = ""; # Currently open page
434 &CreateDir($DataDir); # Create directory if it doesn't exist
435 if (!-d $DataDir) {
436 &ReportError(Ts('Could not create %s', $DataDir) . ": $!");
437 return 0;
438 }
439 &InitCookie(); # Reads in user data
440 return 1;
441 }
442
443 sub InitCookie {
444 %SetCookie = ();
445 $TimeZoneOffset = 0;
446 undef $q->{'.cookies'}; # Clear cache if it exists (for SpeedyCGI)
447 %UserData = (); # Fix for persistent environments.
448 %UserCookie = $q->cookie($CookieName);
449 $UserID = $UserCookie{'id'};
450 $UserID =~ s/\D//g; # Numeric only
451 if ($UserID < 200) {
452 $UserID = 111;
453 } else {
454 &LoadUserData($UserID);
455 }
456 if ($UserID > 199) {
457 if (($UserData{'id'} != $UserCookie{'id'}) ||
458 ($UserData{'randkey'} != $UserCookie{'randkey'})) {
459 $UserID = 113;
460 %UserData = (); # Invalid. Consider warning message.
461 }
462 }
463 if ($UserData{'tzoffset'} != 0) {
464 $TimeZoneOffset = $UserData{'tzoffset'} * (60 * 60);
465 }
466 }
467
468 sub DoBrowseRequest {
469 my ($id, $action, $text);
470
471 if (!$q->param) { # No parameter
472 &BrowsePage($HomePage);
473 return 1;
474 }
475 $id = &GetParam('keywords', '');
476 if ($id) { # Just script?PageName
477 if ($FreeLinks && (!-f &GetPageFile($id))) {
478 $id = &FreeToNormal($id);
479 }
480 if (($NotFoundPg ne '') && (!-f &GetPageFile($id))) {
481 $id = $NotFoundPg;
482 }
483 &BrowsePage($id) if &ValidIdOrDie($id);
484 return 1;
485 }
486 $action = lc(&GetParam('action', ''));
487 $id = &GetParam('id', '');
488 if ($action eq 'browse') {
489 if ($FreeLinks && (!-f &GetPageFile($id))) {
490 $id = &FreeToNormal($id);
491 }
492 if (($NotFoundPg ne '') && (!-f &GetPageFile($id))) {
493 $id = $NotFoundPg;
494 }
495 &BrowsePage($id) if &ValidIdOrDie($id);
496 return 1;
497 } elsif ($action eq 'rc') {
498 &BrowsePage($RCName);
499 return 1;
500 } elsif ($action eq 'random') {
501 &DoRandom();
502 return 1;
503 } elsif ($action eq 'history') {
504 &DoHistory($id) if &ValidIdOrDie($id);
505 return 1;
506 }
507 return 0; # Request not handled
508 }
509
510 sub BrowsePage {
511 my ($id) = @_;
512 my ($fullHtml, $oldId, $allDiff, $showDiff, $openKept);
513 my ($revision, $goodRevision, $diffRevision, $newText);
514
515 &OpenPage($id);
516 &OpenDefaultText();
517 $openKept = 0;
518 $revision = &GetParam('revision', '');
519 $revision =~ s/\D//g; # Remove non-numeric chars
520 $goodRevision = $revision; # Non-blank only if exists
521 if ($revision ne '') {
522 &OpenKeptRevisions('text_default');
523 $openKept = 1;
524 if (!defined($KeptRevisions{$revision})) {
525 $goodRevision = '';
526 } else {
527 &OpenKeptRevision($revision);
528 }
529 }
530 # Raw mode: just untranslated wiki text
531 if (&GetParam('raw', 0)) {
532 print &GetHttpHeader('text/plain');
533 print $Text{'text'};
534 return;
535 }
536 $newText = $Text{'text'}; # For differences
537 # Handle a single-level redirect
538 $oldId = &GetParam('oldid', '');
539 if (($oldId eq '') && (substr($Text{'text'}, 0, 10) eq '#REDIRECT ')) {
540 $oldId = $id;
541 if (($FreeLinks) && ($Text{'text'} =~ /\#REDIRECT\s+\[\[.+\]\]/)) {
542 ($id) = ($Text{'text'} =~ /\#REDIRECT\s+\[\[(.+)\]\]/);
543 $id = &FreeToNormal($id);
544 } else {
545 ($id) = ($Text{'text'} =~ /\#REDIRECT\s+(\S+)/);
546 }
547 if (&ValidId($id) eq '') {
548 # Consider revision in rebrowse?
549 &ReBrowsePage($id, $oldId, 0);
550 return;
551 } else { # Not a valid target, so continue as normal page
552 $id = $oldId;
553 $oldId = '';
554 }
555 }
556 $MainPage = $id;
557 $MainPage =~ s|/.*||; # Only the main page name (remove subpage)
558 $fullHtml = &GetHeader($id, &QuoteHtml($id), $oldId, 1);
559 if ($revision ne '') {
560 if (($revision eq $Page{'revision'}) || ($goodRevision ne '')) {
561 $fullHtml .= '<b>' . Ts('Showing revision %s', $revision) . "</b><br>";
562 } else {
563 $fullHtml .= '<b>' . Ts('Revision %s not available', $revision)
564 . ' (' . T('showing current revision instead')
565 . ')</b><br>';
566 }
567 }
568 $allDiff = &GetParam('alldiff', 0);
569 if ($allDiff != 0) {
570 $allDiff = &GetParam('defaultdiff', 1);
571 }
572 if ((($id eq $RCName) || (T($RCName) eq $id) || (T($id) eq $RCName))
573 && &GetParam('norcdiff', 1)) {
574 $allDiff = 0; # Only show if specifically requested
575 }
576 $showDiff = &GetParam('diff', $allDiff);
577 if ($UseDiff && $showDiff) {
578 $diffRevision = $goodRevision;
579 $diffRevision = &GetParam('diffrevision', $diffRevision);
580 # Eventually try to avoid the following keep-loading if possible?
581 &OpenKeptRevisions('text_default') if (!$openKept);
582 $fullHtml .= &GetDiffHTML($showDiff, $id, $diffRevision,
583 $revision, $newText);
584 $fullHtml .= "<hr class=wikilinediff>\n";
585 }
586 $fullHtml .= '<div class=wikitext>';
587 $fullHtml .= &WikiToHTML($Text{'text'});
588 $fullHtml .= '</div>';
589 if (($id eq $RCName) || (T($RCName) eq $id) || (T($id) eq $RCName)) {
590 print $fullHtml;
591 print "<hr class=wikilinerc>\n";
592 print '<div class=wikirc>';
593 &DoRc(1);
594 print '</div>';
595 print &GetFooterText($id, $goodRevision);
596 return;
597 }
598 $fullHtml .= &GetFooterText($id, $goodRevision);
599 print $fullHtml;
600 return if ($showDiff || ($revision ne '')); # Don't cache special version
601 &UpdateHtmlCache($id, $fullHtml) if ($UseCache && ($oldId eq ''));
602 }
603
604 sub ReBrowsePage {
605 my ($id, $oldId, $isEdit) = @_;
606
607 if ($oldId ne "") { # Target of #REDIRECT (loop breaking)
608 print &GetRedirectPage("action=browse&id=$id&oldid=$oldId",
609 $id, $isEdit);
610 } else {
611 print &GetRedirectPage($id, $id, $isEdit);
612 }
613 }
614
615 sub DoRc {
616 my ($rcType) = @_; # 0 = RSS, 1 = HTML
617 my ($fileData, $rcline, $i, $daysago, $lastTs, $ts, $idOnly);
618 my (@fullrc, $status, $oldFileData, $firstTs, $errorText, $showHTML);
619 my $starttime = 0;
620 my $showbar = 0;
621
622 if (0 == $rcType) {
623 $showHTML = 0;
624 } else {
625 $showHTML = 1;
626 }
627 if (&GetParam("from", 0)) {
628 $starttime = &GetParam("from", 0);
629 if ($showHTML) {
630 print "<h2>" . Ts('Updates since %s', &TimeToText($starttime))
631 . "</h2>\n";
632 }
633 } else {
634 $daysago = &GetParam("days", 0);
635 $daysago = &GetParam("rcdays", 0) if ($daysago == 0);
636 if ($daysago) {
637 $starttime = $Now - ((24*60*60)*$daysago);
638 if ($showHTML) {
639 print "<h2>" . Ts('Updates in the last %s day'
640 . (($daysago != 1)?"s":""), $daysago) . "</h2>\n";
641 }
642 # Note: must have two translations (for "day" and "days")
643 # Following comment line is for translation helper script
644 # Ts('Updates in the last %s days', '');
645 }
646 }
647 if ($starttime == 0) {
648 if (0 == $rcType) {
649 $starttime = $Now - ((24*60*60)*$RssDays);
650 } else {
651 $starttime = $Now - ((24*60*60)*$RcDefault);
652 }
653 if ($showHTML) {
654 print "<h2>" . Ts('Updates in the last %s day'
655 . (($RcDefault != 1)?"s":""), $RcDefault) . "</h2>\n";
656 }
657 # Translation of above line is identical to previous version
658 }
659 # Read rclog data (and oldrclog data if needed)
660 ($status, $fileData) = &ReadFile($RcFile);
661 $errorText = "";
662 if (!$status) {
663 # Save error text if needed.
664 $errorText = '<p><strong>' . Ts('Could not open %s log file', $RCName)
665 . ":</strong> $RcFile<p>"
666 . T('Error was') . ":\n<pre>$!</pre>\n" . '<p>'
667 . T('Note: This error is normal if no changes have been made.') . "\n";
668 }
669 @fullrc = split(/\n/, $fileData);
670 $firstTs = 0;
671 if (@fullrc > 0) { # Only false if no lines in file
672 ($firstTs) = split(/$FS3/, $fullrc[0]);
673 }
674 if (($firstTs == 0) || ($starttime <= $firstTs)) {
675 ($status, $oldFileData) = &ReadFile($RcOldFile);
676 if ($status) {
677 @fullrc = split(/\n/, $oldFileData . $fileData);
678 } else {
679 if ($errorText ne "") { # could not open either rclog file
680 print $errorText;
681 print "<p><strong>"
682 . Ts('Could not open old %s log file', $RCName)
683 . ":</strong> $RcOldFile<p>"
684 . T('Error was') . ":\n<pre>$!</pre>\n";
685 return;
686 }
687 }
688 }
689 $lastTs = 0;
690 if (@fullrc > 0) { # Only false if no lines in file
691 ($lastTs) = split(/$FS3/, $fullrc[$#fullrc]);
692 }
693 $lastTs++ if (($Now - $lastTs) > 5); # Skip last unless very recent
694
695 $idOnly = &GetParam("rcidonly", "");
696 if ($idOnly && $showHTML) {
697 print '<b>(' . Ts('for %s only', &ScriptLink($idOnly, &QuoteHtml($idOnly)), 1)
698 . ')</b><br>';
699 }
700 if ($showHTML) {
701 foreach $i (@RcDays) {
702 print " | " if $showbar;
703 $showbar = 1;
704 print &ScriptLink("action=rc&days=$i",
705 Ts('%s day' . (($i != 1)?'s':''), $i));
706 # Note: must have two translations (for "day" and "days")
707 # Following comment line is for translation helper script
708 # Ts('%s days', '');
709 }
710 print "<br>" . &ScriptLink("action=rc&from=$lastTs",
711 T('List new changes starting from'));
712 print " " . &TimeToText($lastTs) . "<br>\n";
713 }
714 $i = 0;
715 while ($i < @fullrc) { # Optimization: skip old entries quickly
716 ($ts) = split(/$FS3/, $fullrc[$i]);
717 if ($ts >= $starttime) {
718 $i -= 1000 if ($i > 0);
719 last;
720 }
721 $i += 1000;
722 }
723 $i -= 1000 if (($i > 0) && ($i >= @fullrc));
724 for (; $i < @fullrc ; $i++) {
725 ($ts) = split(/$FS3/, $fullrc[$i]);
726 last if ($ts >= $starttime);
727 }
728 if ($i == @fullrc && $showHTML) {
729 print '<br><strong>' . Ts('No updates since %s',
730 &TimeToText($starttime)) . "</strong><br>\n";
731 } else {
732 splice(@fullrc, 0, $i); # Remove items before index $i
733 # Consider an end-time limit (items older than X)
734 if (0 == $rcType) {
735 print &GetRcRss(@fullrc);
736 } else {
737 print &GetRcHtml(@fullrc);
738 }
739 }
740 if ($showHTML) {
741 print '<p>' . Ts('Page generated %s', &TimeToText($Now)), "<br>\n";
742 }
743 }
744
745 sub GetRc {
746 my $rcType = shift;
747 my @outrc = @_;
748 my ($rcline, $date, $newtop, $author, $inlist, $result);
749 my ($showedit, $link, $all, $idOnly, $headItem, $item);
750 my ($ts, $pagename, $summary, $isEdit, $host, $kind, $extraTemp);
751 my ($rcchangehist, $tEdit, $tChanges, $tDiff);
752 my ($headList, $pagePrefix, $historyPrefix, $diffPrefix);
753 my %extra = ();
754 my %changetime = ();
755 my %pagecount = ();
756
757 # Slice minor edits
758 $showedit = &GetParam("rcshowedit", $ShowEdits);
759 $showedit = &GetParam("showedit", $showedit);
760 if ($showedit != 1) {
761 my @temprc = ();
762 foreach $rcline (@outrc) {
763 ($ts, $pagename, $summary, $isEdit, $host) = split(/$FS3/, $rcline);
764 if ($showedit == 0) { # 0 = No edits
765 push(@temprc, $rcline) if (!$isEdit);
766 } else { # 2 = Only edits
767 push(@temprc, $rcline) if ($isEdit);
768 }
769 }
770 @outrc = @temprc;
771 }
772 # Optimize param fetches out of main loop
773 $rcchangehist = &GetParam("rcchangehist", 1);
774 # Optimize translations out of main loop
775 $tEdit = T('(edit)');
776 $tDiff = T('(diff)');
777 $tChanges = T('changes');
778 $pagePrefix = $QuotedFullUrl . &ScriptLinkChar();
779 $diffPrefix = $pagePrefix . &QuoteHtml("action=browse&diff=4&id=");
780 $historyPrefix = $pagePrefix . &QuoteHtml("action=history&id=");
781 foreach $rcline (@outrc) {
782 ($ts, $pagename) = split(/$FS3/, $rcline);
783 $pagecount{$pagename}++;
784 $changetime{$pagename} = $ts;
785 }
786 $date = "";
787 $all = &GetParam("rcall", 0);
788 $all = &GetParam("all", $all);
789 $newtop = &GetParam("rcnewtop", $RecentTop);
790 $newtop = &GetParam("newtop", $newtop);
791 $idOnly = &GetParam("rcidonly", "");
792 $inlist = 0;
793 $headList = '';
794 $result = '';
795 @outrc = reverse @outrc if ($newtop);
796 foreach $rcline (@outrc) {
797 ($ts, $pagename, $summary, $isEdit, $host, $kind, $extraTemp)
798 = split(/$FS3/, $rcline);
799 next if ((!$all) && ($ts < $changetime{$pagename}));
800 next if (($idOnly ne "") && ($idOnly ne $pagename));
801 %extra = split(/$FS2/, $extraTemp, -1);
802 if ($date ne &CalcDay($ts)) {
803 $date = &CalcDay($ts);
804 if (1 == $rcType) { # HTML
805 # add date, properly closing lists first
806 if ($inlist) {
807 $result .= "</UL>\n";
808 $inlist = 0;
809 }
810 $result .= "<p><strong>" . $date . "</strong></p>\n";
811 if (!$inlist) {
812 $result .= "<UL>\n";
813 $inlist = 1;
814 }
815 }
816 }
817 if (0 == $rcType) { # RSS
818 ($headItem, $item) = &GetRssRcLine($pagename, $ts, $host,
819 $extra{'name'}, $extra{'id'}, $summary, $isEdit,
820 $pagecount{$pagename}, $extra{'revision'},
821 $diffPrefix, $historyPrefix, $pagePrefix);
822 $headList .= $headItem;
823 $result .= $item;
824 } else { # HTML
825 $result .= &GetHtmlRcLine($pagename, $ts, $host, $extra{'name'},
826 $extra{'id'}, $summary, $isEdit,
827 $pagecount{$pagename}, $extra{'revision'},
828 $tEdit, $tDiff, $tChanges, $all, $rcchangehist);
829 }
830 }
831 if (1 == $rcType) {
832 $result .= "</UL>\n" if ($inlist); # Close final tag
833 }
834 return ($headList, $result); # Just ignore headList for HTML
835 }
836
837 sub GetRcHtml {
838 my ($html, $extra);
839
840 ($extra, $html) = &GetRc(1, @_);
841 return $html;
842 }
843
844 sub GetHtmlRcLine {
845 my ($pagename, $timestamp, $host, $userName, $userID, $summary,
846 $isEdit, $pagecount, $revision, $tEdit, $tDiff, $tChanges, $all,
847 $rcchangehist) = @_;
848 my ($author, $sum, $edit, $count, $link, $html);
849
850 $html = '';
851 $host = &QuoteHtml($host);
852 if (defined($userName) && defined($userID)) {
853 $author = &GetAuthorLink($host, $userName, $userID);
854 } else {
855 $author = &GetAuthorLink($host, "", 0);
856 }
857 $sum = "";
858 if (($summary ne "") && ($summary ne "*")) {
859 $summary = &QuoteHtml($summary);
860 $sum = "<strong>[$summary]</strong> ";
861 }
862 $edit = "";
863 $edit = "<em>$tEdit</em> " if ($isEdit);
864 $count = "";
865 if ((!$all) && ($pagecount > 1)) {
866 $count = "($pagecount ";
867 if ($rcchangehist) {
868 $count .= &GetHistoryLink($pagename, $tChanges);
869 } else {
870 $count .= $tChanges;
871 }
872 $count .= ") ";
873 }
874 $link = "";
875 if ($UseDiff && &GetParam("diffrclink", 1)) {
876 $link .= &ScriptLinkDiff(4, $pagename, $tDiff, "") . " ";
877 }
878 $link .= &GetPageLink($pagename);
879 $html .= "<li>$link ";
880 $html .= &CalcTime($timestamp) . " $count$edit" . " $sum";
881 $html .= ". . . . . $author\n";
882 return $html;
883 }
884
885 sub GetRcRss {
886 my ($rssHeader, $headList, $items);
887
888 # Normally get URL from script, but allow override
889 $FullUrl = $q->url(-full=>1) if ($FullUrl eq "");
890 $QuotedFullUrl = &QuoteHtml($FullUrl);
891 $SiteDescription = &QuoteHtml($SiteDescription);
892
893 my $ChannelAbout = &QuoteHtml($FullUrl . &ScriptLinkChar()
894 . $ENV{QUERY_STRING});
895 $rssHeader = <<RSS ;
896 <?xml version="1.0" encoding="ISO-8859-1"?>
897 <rdf:RDF
898 xmlns:rdf="http://www.w3.org/1999/02/22-rdf-syntax-ns#"
899 xmlns="http://purl.org/rss/1.0/"
900 xmlns:dc="http://purl.org/dc/elements/1.1/"
901 xmlns:wiki="http://purl.org/rss/1.0/modules/wiki/"
902 >
903 <channel rdf:about="$ChannelAbout">
904 <title>${\(&QuoteHtml($SiteName))}</title>
905 <link>${\($QuotedFullUrl . &ScriptLinkChar() . &QuoteHtml("$RCName"))}</link>
906 <description>${\(&QuoteHtml($SiteDescription))}</description>
907 <wiki:interwiki>
908 <rdf:Description link="$QuotedFullUrl">
909 <rdf:value>$InterWikiMoniker</rdf:value>
910 </rdf:Description>
911 </wiki:interwiki>
912 <items>
913 <rdf:Seq>
914 RSS
915 ($headList, $items) = &GetRc(0, @_);
916 $rssHeader .= $headList;
917 return <<RSS ;
918 $rssHeader
919 </rdf:Seq>
920 </items>
921 </channel>
922 <image rdf:about="${\(&QuoteHtml($RssLogoUrl))}">
923 <title>${\(&QuoteHtml($SiteName))}</title>
924 <url>$RssLogoUrl</url>
925 <link>$QuotedFullUrl</link>
926 </image>
927 $items
928 </rdf:RDF>
929 RSS
930 }
931
932 sub GetRssRcLine{
933 my ($pagename, $timestamp, $host, $userName, $userID, $summary, $isEdit,
934 $pagecount, $revision, $diffPrefix, $historyPrefix, $pagePrefix) = @_;
935 my ($pagenameEsc, $itemID, $description, $authorLink, $author, $status,
936 $importance, $date, $item, $headItem);
937
938 $pagenameEsc = CGI::escape($pagename);
939 # Add to list of items in the <channel/>
940 $itemID = $FullUrl . &ScriptLinkChar()
941 . &GetOldPageParameters('browse', $pagenameEsc, $revision);
942 $itemID = &QuoteHtml($itemID);
943 $headItem = " <rdf:li rdf:resource=\"$itemID\"/>\n";
944 # Add to list of items proper.
945 if (($summary ne "") && ($summary ne "*")) {
946 $description = &QuoteHtml($summary);
947 }
948 $host = &QuoteHtml($host);
949 if ($userName) {
950 $author = &QuoteHtml($userName);
951 $authorLink = 'link="' . $QuotedFullUrl . &ScriptLinkChar() . $author . '"';
952 } else {
953 $author = $host;
954 }
955 $status = (1 == $revision) ? 'new' : 'updated';
956 $importance = $isEdit ? 'minor' : 'major';
957 $timestamp += $TimeZoneOffset;
958 my ($sec, $min, $hour, $mday, $mon, $year) = localtime($timestamp);
959 $year += 1900;
960 $date = sprintf("%4d-%02d-%02dT%02d:%02d:%02d+%02d:00",
961 $year, $mon+1, $mday, $hour, $min, $sec, $TimeZoneOffset/(60*60));
962 $pagename = &QuoteHtml($pagename);
963 # Write it out longhand
964 $item = <<RSS ;
965 <item rdf:about="$itemID">
966 <title>$pagename</title>
967 <link>$pagePrefix$pagenameEsc</link>
968 <description>$description</description>
969 <dc:date>$date</dc:date>
970 <dc:contributor>
971 <rdf:Description wiki:host="$host" $authorLink>
972 <rdf:value>$author</rdf:value>
973 </rdf:Description>
974 </dc:contributor>
975 <wiki:status>$status</wiki:status>
976 <wiki:importance>$importance</wiki:importance>
977 <wiki:diff>$diffPrefix$pagenameEsc</wiki:diff>
978 <wiki:version>$revision</wiki:version>
979 <wiki:history>$historyPrefix$pagenameEsc</wiki:history>
980 </item>
981 RSS
982 return ($headItem, $item);
983 }
984
985 sub DoRss {
986 print "Content-type: text/xml\n\n";
987 &DoRc(0);
988 }
989
990 sub DoRandom {
991 my ($id, @pageList);
992
993 @pageList = &AllPagesList(); # Optimize?
994 $id = $pageList[int(rand($#pageList + 1))];
995 &ReBrowsePage($id, "", 0);
996 }
997
998 sub DoHistory {
999 my ($id) = @_;
1000 my ($html, $canEdit, $row, $newText);
1001
1002 print &GetHeader('', Ts('History of %s', $id), '') . '<br>';
1003 &OpenPage($id);
1004 &OpenDefaultText();
1005 $newText = $Text{'text'};
1006 $canEdit = 0;
1007 $canEdit = &UserCanEdit($id) if ($HistoryEdit);
1008 if ($UseDiff) {
1009 print <<EOF ;
1010 <form action="$ScriptName" METHOD="GET">
1011 <input type="hidden" name="action" value="browse"/>
1012 <input type="hidden" name="diff" value="1"/>
1013 <input type="hidden" name="id" value="$id"/>
1014 <table border="0" width="100%"><tr>
1015 EOF
1016 }
1017 $html = &GetHistoryLine($id, $Page{'text_default'}, $canEdit, $row++);
1018 &OpenKeptRevisions('text_default');
1019 foreach (reverse sort {$a <=> $b} keys %KeptRevisions) {
1020 next if ($_ eq ""); # (needed?)
1021 $html .= &GetHistoryLine($id, $KeptRevisions{$_}, $canEdit, $row++);
1022 }
1023 print $html;
1024 if ($UseDiff) {
1025 my $label = T('Compare');
1026 print "<tr><td align='center'><input type='submit' "
1027 . "value='$label'/>&nbsp;&nbsp;</td></table></form>\n";
1028 print "<hr class=wikilinediff>\n";
1029 print &GetDiffHTML(&GetParam('defaultdiff', 1), $id, '', '', $newText);
1030 }
1031 print &GetCommonFooter();
1032 }
1033
1034 sub GetMaskedHost {
1035 my ($text) = @_;
1036 my ($logText);
1037
1038 if (!$MaskHosts) {
1039 return $text;
1040 }
1041 $logText = T('(logged)');
1042 if (!($text =~ s/\d+$/$logText/)) { # IP address (ending numbers masked)
1043 $text =~ s/^[^\.\(]+/$logText/; # Host name: mask until first .
1044 }
1045 return $text;
1046 }
1047
1048 sub GetHistoryLine {
1049 my ($id, $section, $canEdit, $row) = @_;
1050 my ($html, $expirets, $rev, $summary, $host, $user, $uid, $ts, $minor);
1051 my (%sect, %revtext);
1052
1053 %sect = split(/$FS2/, $section, -1);
1054 %revtext = split(/$FS3/, $sect{'data'});
1055 $rev = $sect{'revision'};
1056 $summary = $revtext{'summary'};
1057 if ((defined($sect{'host'})) && ($sect{'host'} ne '')) {
1058 $host = $sect{'host'};
1059 } else {
1060 $host = $sect{'ip'};
1061 }
1062 $host = &GetMaskedHost($host);
1063 $user = $sect{'username'};
1064 $uid = $sect{'id'};
1065 $ts = $sect{'ts'};
1066 $minor = '';
1067 $minor = '<i>' . T('(edit)') . '</i> ' if ($revtext{'minor'});
1068 $expirets = $Now - ($KeepDays * 24 * 60 * 60);
1069 if ($UseDiff) {
1070 my ($c1, $c2);
1071 $c1 = 'checked="checked"' if 1 == $row;
1072 $c2 = 'checked="checked"' if 0 == $row;
1073 $html .= "<tr><td align='center'><input type='radio' "
1074 . "name='diffrevision' value='$rev' $c1/> ";
1075 $html .= "<input type='radio' name='revision' value='$rev' $c2/></td><td>";
1076 }
1077 if (0 == $row) { # current revision
1078 $html .= &GetPageLinkText($id, Ts('Revision %s', $rev)) . ' ';
1079 if ($canEdit) {
1080 $html .= &GetEditLink($id, T('Edit')) . ' ';
1081 }
1082 } else {
1083 $html .= &GetOldPageLink('browse', $id, $rev,
1084 Ts('Revision %s', $rev)) . ' ';
1085 if ($canEdit) {
1086 $html .= &GetOldPageLink('edit', $id, $rev, T('Edit')) . ' ';
1087 }
1088 }
1089 $html .= ". . " . $minor . &TimeToText($ts) . " ";
1090 $html .= T('by') . ' ' . &GetAuthorLink($host, $user, $uid) . " ";
1091 if (defined($summary) && ($summary ne "") && ($summary ne "*")) {
1092 $summary = &QuoteHtml($summary); # Thanks Sunir! :-)
1093 $html .= "<b>[$summary]</b> ";
1094 }
1095 $html .= $UseDiff ? "</tr>\n" : "<br>\n";
1096 return $html;
1097 }
1098
1099 # ==== HTML and page-oriented functions ====
1100 sub ScriptLinkChar {
1101 if ($SlashLinks) {
1102 return '/';
1103 }
1104 return '?';
1105 }
1106
1107 sub ScriptLink {
1108 my ($action, $text) = @_;
1109
1110 return '<a href="' . $ScriptName . &ScriptLinkChar() . &UriEscape($action)
1111 . "\">$text</a>";
1112 }
1113
1114 sub ScriptLinkClass {
1115 my ($action, $text, $class) = @_;
1116
1117 return '<a href="' . $ScriptName . &ScriptLinkChar() . &UriEscape($action)
1118 . '" class="' . $class . "\">$text</a>";
1119 }
1120
1121 sub GetPageLinkText {
1122 my ($id, $name) = @_;
1123
1124 $id =~ s|^/|$MainPage/|;
1125 if ($FreeLinks) {
1126 $id = &FreeToNormal($id);
1127 $name =~ s/_/ /g;
1128 }
1129 return &ScriptLinkClass($id, $name, 'wikipagelink');
1130 }
1131
1132 sub GetPageLink {
1133 my ($id) = @_;
1134
1135 return &GetPageLinkText($id, $id);
1136 }
1137
1138 sub GetEditLink {
1139 my ($id, $name) = @_;
1140
1141 if ($FreeLinks) {
1142 $id = &FreeToNormal($id);
1143 $name =~ s/_/ /g;
1144 }
1145 return &ScriptLinkClass("action=edit&id=$id", $name, 'wikipageedit');
1146 }
1147
1148 sub GetDeleteLink {
1149 my ($id, $name, $confirm) = @_;
1150
1151 if ($FreeLinks) {
1152 $id = &FreeToNormal($id);
1153 $name =~ s/_/ /g;
1154 }
1155 return &ScriptLink("action=delete&id=$id&confirm=$confirm", $name);
1156 }
1157
1158 sub GetOldPageParameters {
1159 my ($kind, $id, $revision) = @_;
1160
1161 $id = &FreeToNormal($id) if $FreeLinks;
1162 return "action=$kind&id=$id&revision=$revision";
1163 }
1164
1165 sub GetOldPageLink {
1166 my ($kind, $id, $revision, $name) = @_;
1167
1168 $name =~ s/_/ /g if $FreeLinks;
1169 return &ScriptLink(&GetOldPageParameters($kind, $id, $revision), $name);
1170 }
1171
1172 sub GetPageOrEditAnchoredLink {
1173 my ($id, $anchor, $name) = @_;
1174 my (@temp, $exists);
1175
1176 if ($name eq "") {
1177 $name = $id;
1178 if ($FreeLinks) {
1179 $name =~ s/_/ /g;
1180 }
1181 }
1182 $id =~ s|^/|$MainPage/|;
1183 if ($FreeLinks) {
1184 $id = &FreeToNormal($id);
1185 }
1186 $exists = 0;
1187 if ($UseIndex) {
1188 if (!$IndexInit) {
1189 @temp = &AllPagesList(); # Also initializes hash
1190 }
1191 $exists = 1 if ($IndexHash{$id});
1192 } elsif (-f &GetPageFile($id)) { # Page file exists
1193 $exists = 1;
1194 }
1195 if ($exists) {
1196 $id = "$id#$anchor" if $anchor;
1197 $name = "$name#$anchor" if $anchor && $NamedAnchors != 2;
1198 return &GetPageLinkText($id, $name);
1199 }
1200 if ($FreeLinks && !$EditNameLink) {
1201 if ($name =~ m| |) { # Not a single word
1202 $name = "[$name]"; # Add brackets so boundaries are obvious
1203 }
1204 }
1205 if ($EditNameLink) {
1206 return &GetEditLink($id, $name);
1207 } else {
1208 return $name . &GetEditLink($id, '?');
1209 }
1210 }
1211
1212 sub GetPageOrEditLink {
1213 my ($id, $name) = @_;
1214 return &GetPageOrEditAnchoredLink($id, "", $name);
1215 }
1216
1217 sub GetBackLinksSearchLink {
1218 my ($id) = @_;
1219 my $name = $id;
1220
1221 $id =~ s|.+/|/|; # Subpage match: search for just /SubName
1222 if ($FreeLinks) {
1223 $name =~ s/_/ /g; # Display with spaces
1224 $id =~ s/_/+/g; # Search for url-escaped spaces
1225 }
1226 return &ScriptLink("back=$id", $name);
1227 }
1228
1229 sub GetPrefsLink {
1230 return &ScriptLink("action=editprefs", T('Preferences'));
1231 }
1232
1233 sub GetRandomLink {
1234 return &ScriptLink("action=random", T('Random Page'));
1235 }
1236
1237 sub ScriptLinkDiff {
1238 my ($diff, $id, $text, $rev) = @_;
1239
1240 $rev = "&revision=$rev" if ($rev ne "");
1241 $diff = &GetParam("defaultdiff", 1) if ($diff == 4);
1242 return &ScriptLink("action=browse&diff=$diff&id=$id$rev", $text);
1243 }
1244
1245 sub ScriptLinkDiffRevision {
1246 my ($diff, $id, $rev, $text) = @_;
1247
1248 $rev = "&diffrevision=$rev" if ($rev ne "");
1249 $diff = &GetParam("defaultdiff", 1) if ($diff == 4);
1250 return &ScriptLink("action=browse&diff=$diff&id=$id$rev", $text);
1251 }
1252
1253 sub GetUploadLink {
1254 return &ScriptLink('action=upload', T('Upload'));
1255 }
1256
1257 sub ScriptLinkTitle {
1258 my ($action, $text, $title) = @_;
1259
1260 if ($FreeLinks) {
1261 $action =~ s/ /_/g;
1262 }
1263 return '<a href="' . $ScriptName . &ScriptLinkChar() . &UriEscape($action)
1264 . "\" title=\"$title\">$text</a>";
1265 }
1266
1267 sub GetAuthorLink {
1268 my ($host, $userName, $uid) = @_;
1269 my ($html, $title, $userNameShow);
1270
1271 $userNameShow = $userName;
1272 if ($FreeLinks) {
1273 $userName =~ s/ /_/g;
1274 $userNameShow =~ s/_/ /g;
1275 }
1276 if (&ValidId($userName) ne "") { # Invalid under current rules
1277 $userName = ""; # Just pretend it isn't there.
1278 }
1279 if (($uid > 0) && ($userName ne "")) {
1280 $html = &ScriptLinkTitle($userName, $userNameShow,
1281 Ts('ID %s', $uid) . ' ' . Ts('from %s', $host));
1282 } else {
1283 $html = $host;
1284 }
1285 return $html;
1286 }
1287
1288 sub GetHistoryLink {
1289 my ($id, $text) = @_;
1290
1291 if ($FreeLinks) {
1292 $id =~ s/ /_/g;
1293 }
1294 return &ScriptLink("action=history&id=$id", $text);
1295 }
1296
1297 sub GetHeader {
1298 my ($id, $title, $oldId, $backlinks) = @_;
1299 my $header = "";
1300 my $logoImage = "";
1301 my $result = "";
1302 my $embed = &GetParam('embed', $EmbedWiki);
1303 my $altText = T('[Home]');
1304
1305 $result = &GetHttpHeader('');
1306 if ($FreeLinks) {
1307 $title =~ s/_/ /g; # Display as spaces
1308 }
1309 $result .= &GetHtmlHeader("$SiteName: $title");
1310 return $result if ($embed);
1311
1312 $result .= '<div class=wikiheader>';
1313 if ($oldId ne '') {
1314 $result .= $q->h3('(' . Ts('redirected from %s',
1315 &GetEditLink($oldId, &QuoteHtml($oldId)), 1) . ')');
1316 }
1317 if ((!$embed) && ($LogoUrl ne "")) {
1318 $logoImage = "img src=\"$LogoUrl\" alt=\"$altText\" border=0";
1319 if (!$LogoLeft) {
1320 $logoImage .= " align=\"right\"";
1321 }
1322 $header = &ScriptLink($HomePage, "<$logoImage>");
1323 }
1324 if ($id and $backlinks) {
1325 $result .= $q->h1($header . &GetBackLinksSearchLink($id));
1326 } else {
1327 $result .= $q->h1($header . $title);
1328 }
1329 if (&GetParam("toplinkbar", 1)) {
1330 $result .= &GetGotoBar($id) . "<hr class=wikilineheader>";
1331 }
1332 $result .= '</div>';
1333 return $result;
1334 }
1335
1336 sub GetHttpHeader {
1337 my ($type) = @_;
1338 my $cookie;
1339
1340 $type = 'text/html' if ($type eq '');
1341 if (defined($SetCookie{'id'})) {
1342 $cookie = "$CookieName="
1343 . "rev&" . $SetCookie{'rev'}
1344 . "&id&" . $SetCookie{'id'}
1345 . "&randkey&" . $SetCookie{'randkey'};
1346 $cookie .= ";expires=Fri, 08-Sep-2013 19:48:23 GMT";
1347 if ($HttpCharset ne '') {
1348 return $q->header(-cookie=>$cookie,
1349 -type=>"$type; charset=$HttpCharset");
1350 }
1351 return $q->header(-cookie=>$cookie);
1352 }
1353 if ($HttpCharset ne '') {
1354 return $q->header(-type=>"$type; charset=$HttpCharset");
1355 }
1356 return $q->header(-type=>$type);
1357 }
1358
1359 sub GetHtmlHeader {
1360 my ($title) = @_;
1361 my ($dtd, $html, $bodyExtra, $stylesheet);
1362
1363 $html = '';
1364 $dtd = '-//IETF//DTD HTML//EN';
1365 $html = qq(<!DOCTYPE HTML PUBLIC "$dtd">\n);
1366 $title = $q->escapeHTML($title);
1367 $html .= "<HTML><HEAD><TITLE>$title</TITLE>\n";
1368 if ($FavIcon ne '') {
1369 $html .= '<LINK REL="SHORTCUT ICON" HREF="' . $FavIcon . '">'
1370 }
1371 if ($MetaKeywords) {
1372 my $keywords = $OpenPageName;
1373 $keywords =~ s/([a-z])([A-Z])/$1, $2/g;
1374 $html .= "<META NAME='KEYWORDS' CONTENT='$keywords'/>\n" if $keywords;
1375 }
1376 # we don't want robots indexing our history or other admin pages
1377 my $action = lc(&GetParam('action', ''));
1378 unless (!$action or $action eq "rc" or $action eq "index") {
1379 $html .= "<META NAME='robots' CONTENT='noindex,nofollow'>\n";
1380 }
1381 if ($SiteBase ne "") {
1382 $html .= qq(<BASE HREF="$SiteBase">\n);
1383 }
1384 $stylesheet = &GetParam('stylesheet', $StyleSheet);
1385 $stylesheet = $StyleSheet if ($stylesheet eq '');
1386 $stylesheet = '' if ($stylesheet eq '*'); # Allow removing override
1387 if ($stylesheet ne '') {
1388 $html .= qq(<LINK REL="stylesheet" HREF="$stylesheet">\n);
1389 }
1390 $html .= $UserHeader;
1391 $bodyExtra = '';
1392 if ($UserBody ne '') {
1393 $bodyExtra = ' ' . $UserBody;
1394 }
1395 if ($BGColor ne '') {
1396 $bodyExtra .= qq( BGCOLOR="$BGColor");
1397 }
1398 $html .= "</HEAD><BODY$bodyExtra>\n";
1399 return $html;
1400 }
1401
1402 sub GetFooterText {
1403 my ($id, $rev) = @_;
1404 my $result;
1405
1406 if (&GetParam('embed', $EmbedWiki)) {
1407 return $q->end_html;
1408 }
1409 $result = '<div class=wikifooter>';
1410 $result .= "<hr class=wikilinefooter>\n";
1411 $result .= &GetFormStart();
1412 $result .= &GetGotoBar($id);
1413 if (&UserCanEdit($id, 0)) {
1414 if ($rev ne '') {
1415 $result .= &GetOldPageLink('edit', $id, $rev,
1416 Ts('Edit revision %s of this page', $rev));
1417 } else {
1418 $result .= &GetEditLink($id, T('Edit text of this page'));
1419 }
1420 } else {
1421 $result .= T('This page is read-only');
1422 }
1423 $result .= ' | ';
1424 $result .= &GetHistoryLink($id, T('View other revisions'));
1425 if ($rev ne '') {
1426 $result .= ' | ';
1427 $result .= &GetPageLinkText($id, T('View current revision'));
1428 }
1429 if ($UseMetaWiki) {
1430 $result .= ' | <a href="http://sunir.org/apps/meta.pl?' . &UriEscape($id) . '">'
1431 . T('Search MetaWiki') . '</a>';
1432 }
1433 if ($Section{'revision'} > 0) {
1434 $result .= '<br>';
1435 if ($rev eq '') { # Only for most current rev
1436 $result .= T('Last edited');
1437 } else {
1438 $result .= T('Edited');
1439 }
1440 $result .= ' ' . &TimeToText($Section{ts});
1441 if ($AuthorFooter) {
1442 $result .= ' ' . Ts('by %s', &GetAuthorLink($Section{'host'},
1443 $Section{'username'}, $Section{'id'}), 1);
1444 }
1445 }
1446 if ($UseDiff) {
1447 $result .= ' ' . &ScriptLinkDiff(4, $id, T('(diff)'), $rev);
1448 }
1449 $result .= '<br>' . &GetSearchForm();
1450 if ($AdminBar && &UserIsAdmin()) {
1451 $result .= '<br>' . &GetAdminBar($id);
1452 }
1453 if ($DataDir =~ m|/tmp/|) {
1454 $result .= '<br><b>' . T('Warning') . ':</b> '
1455 . Ts('Database is stored in temporary directory %s',
1456 $DataDir) . '<br>';
1457 }
1458 if ($ConfigError ne '') {
1459 $result .= '<br><b>' . T('Config file error:') . '</b> '
1460 . $ConfigError . '<br>';
1461 }
1462 $result .= $q->endform;
1463 if ($FooterNote ne '') {
1464 $result .= T($FooterNote);
1465 }
1466 $result .= '</div>';
1467 $result .= &GetMinimumFooter();
1468 return $result;
1469 }
1470
1471 sub GetCommonFooter {
1472 my ($html);
1473
1474 $html = '<div class=wikifooter>' . '<hr class=wikilinefooter>'
1475 . &GetFormStart() . &GetGotoBar('')
1476 . &GetSearchForm() . $q->endform;
1477 if ($FooterNote ne '') {
1478 $html .= T($FooterNote);
1479 }
1480 $html .= '</div>' . $q->end_html;
1481 return $html;
1482 }
1483
1484 sub GetMinimumFooter {
1485 return $q->end_html;
1486 }
1487
1488 sub GetFormStart {
1489 return $q->startform("POST", "$ScriptName",
1490 "application/x-www-form-urlencoded");
1491 }
1492
1493 sub GetGotoBar {
1494 my ($id) = @_;
1495 my ($main, $bartext);
1496
1497 $bartext = &GetPageLink($HomePage);
1498 if ($id =~ m|/|) {
1499 $main = $id;
1500 $main =~ s|/.*||; # Only the main page name (remove subpage)
1501 $bartext .= " | " . &GetPageLink($main);
1502 }
1503 $bartext .= " | " . &GetPageLink($RCName);
1504 $bartext .= " | " . &GetPrefsLink();
1505 if ($UseUpload && &UserCanUpload()) {
1506 $bartext .= " | " . &GetUploadLink();
1507 }
1508 if (&GetParam("linkrandom", 0)) {
1509 $bartext .= " | " . &GetRandomLink();
1510 }
1511 if ($UserGotoBar ne '') {
1512 $bartext .= " | " . $UserGotoBar;
1513 }
1514 $bartext .= "<br>\n";
1515 return $bartext;
1516 }
1517
1518 # Admin bar contributed by ElMoro (with some changes)
1519 sub GetPageLockLink {
1520 my ($id, $status, $name) = @_;
1521
1522 if ($FreeLinks) {
1523 $id = &FreeToNormal($id);
1524 }
1525 return &ScriptLink("action=pagelock&set=$status&id=$id", $name);
1526 }
1527
1528 sub GetAdminBar {
1529 my ($id) = @_;
1530 my ($result);
1531
1532 $result = T('Administration') . ': ';
1533 if (-f &GetLockedPageFile($id)) {
1534 $result .= &GetPageLockLink($id, 0, T('Unlock page'));
1535 }
1536 else {
1537 $result .= &GetPageLockLink($id, 1, T('Lock page'));
1538 }
1539 $result .= " | " . &GetDeleteLink($id, T('Delete this page'), 0);
1540 $result .= " | " . &ScriptLink("action=editbanned", T("Edit Banned List"));
1541 $result .= " | " . &ScriptLink("action=maintain", T("Run Maintenance"));
1542 $result .= " | " . &ScriptLink("action=editlinks", T("Edit/Rename pages"));
1543 if (-f "$DataDir/noedit") {
1544 $result .= " | " . &ScriptLink("action=editlock&set=0", T("Unlock site"));
1545 } else {
1546 $result .= " | " . &ScriptLink("action=editlock&set=1", T("Lock site"));
1547 }
1548 return $result;
1549 }
1550
1551 sub GetSearchForm {
1552 my ($result);
1553
1554 $result = T('Search:') . ' ' . $q->textfield(-name=>'search', -size=>20);
1555 if ($SearchButton) {
1556 $result .= $q->submit('dosearch', T('Go!'));
1557 } else {
1558 $result .= &GetHiddenValue("dosearch", 1);
1559 }
1560 return $result;
1561 }
1562
1563 sub GetRedirectPage {
1564 my ($newid, $name, $isEdit) = @_;
1565 my ($url, $html);
1566 my ($nameLink);
1567
1568 # Normally get URL from script, but allow override.
1569 $FullUrl = $q->url(-full=>1) if ($FullUrl eq "");
1570 $url = $FullUrl . &ScriptLinkChar() . &UriEscape($newid);
1571 $nameLink = "<a href=\"$url\">$name</a>";
1572 if ($RedirType < 3) {
1573 if ($RedirType == 1) { # Use CGI.pm
1574 # NOTE: do NOT use -method (does not work with old CGI.pm versions)
1575 # Thanks to Daniel Neri for fixing this problem.
1576 $html = $q->redirect(-uri=>$url);
1577 } else { # Minimal header
1578 $html = "Status: 302 Moved\n";
1579 $html .= "Location: $url\n";
1580 $html .= "Content-Type: text/html\n"; # Needed for browser failure
1581 $html .= "\n";
1582 }
1583 $html .= "\n" . Ts('Your browser should go to the %s page.', $newid);
1584 $html .= ' ' . Ts('If it does not, click %s to continue.', $nameLink);
1585 } else {
1586 if ($isEdit) {
1587 $html = &GetHeader('', T('Thanks for editing...'), '');
1588 $html .= Ts('Thank you for editing %s.', $nameLink);
1589 } else {
1590 $html = &GetHeader('', T('Link to another page...'), '');
1591 }
1592 $html .= "\n<p>";
1593 $html .= Ts('Follow the %s link to continue.', $nameLink);
1594 $html .= &GetMinimumFooter();
1595 }
1596 return $html;
1597 }
1598
1599 # ==== Common wiki markup ====
1600 sub RestoreSavedText {
1601 my ($text) = @_;
1602
1603 1 while $text =~ s/$FS(\d+)$FS/$SaveUrl{$1}/ge; # Restore saved text
1604 return $text;
1605 }
1606
1607 sub RemoveFS {
1608 my ($text) = @_;
1609
1610 # Note: must remove all $FS, and $FS may be multi-byte/char separator
1611 $text =~ s/($FS)+(\d)/$2/g;
1612 return $text;
1613 }
1614
1615 sub WikiToHTML {
1616 my ($pageText) = @_;
1617 $TableMode = 0;
1618
1619 %SaveUrl = ();
1620 %SaveNumUrl = ();
1621 $SaveUrlIndex = 0;
1622 $SaveNumUrlIndex = 0;
1623 $pageText = &RemoveFS($pageText);
1624 if ($RawHtml) {
1625 $pageText =~ s/<html>((.|\n)*?)<\/html>/&StoreRaw($1)/ige;
1626 }
1627 $pageText = &QuoteHtml($pageText);
1628 $pageText =~ s/\\ *\r?\n/ /g; # Join lines with backslash at end
1629 if ($ParseParas) {
1630 # Note: The following 3 rules may span paragraphs, so they are
1631 # copied from CommonMarkup
1632 $pageText =~
1633 s/\&lt;nowiki\&gt;((.|\n)*?)\&lt;\/nowiki\&gt;/&StoreRaw($1)/ige;
1634 $pageText =~
1635 s/\&lt;pre\&gt;((.|\n)*?)\&lt;\/pre\&gt;/&StorePre($1, "pre")/ige;
1636 $pageText =~
1637 s/\&lt;code\&gt;((.|\n)*?)\&lt;\/code\&gt;/&StorePre($1, "code")/ige;
1638 $pageText =~ s/((.|\n)+?\n)\s*(\n|$)/&ParseParagraph($1)/geo;
1639 $pageText =~ s/(.*)<\/p>(.+)$/$1.&ParseParagraph($2)/seo;
1640 } else {
1641 $pageText = &CommonMarkup($pageText, 1, 0); # Multi-line markup
1642 $pageText = &WikiLinesToHtml($pageText); # Line-oriented markup
1643 }
1644 while (@HeadingNumbers) {
1645 pop @HeadingNumbers;
1646 $TableOfContents .= "</dd></dl>\n\n";
1647 }
1648 $pageText =~ s/&lt;toc&gt;/$TableOfContents/gi;
1649 if ($LateRules ne '') {
1650 $pageText = &EvalLocalRules($LateRules, $pageText, 0);
1651 }
1652 return &RestoreSavedText($pageText);
1653 }
1654
1655 sub CommonMarkup {
1656 my ($text, $useImage, $doLines) = @_;
1657 local $_ = $text;
1658
1659 if ($doLines < 2) { # 2 = do line-oriented only
1660 # The <nowiki> tag stores text with no markup (except quoting HTML)
1661 s/\&lt;nowiki\&gt;((.|\n)*?)\&lt;\/nowiki\&gt;/&StoreRaw($1)/ige;
1662 # The <pre> tag wraps the stored text with the HTML <pre> tag
1663 s/\&lt;pre\&gt;((.|\n)*?)\&lt;\/pre\&gt;/&StorePre($1, "pre")/ige;
1664 s/\&lt;code\&gt;((.|\n)*?)\&lt;\/code\&gt;/&StorePre($1, "code")/ige;
1665 if ($EarlyRules ne '') {
1666 $_ = &EvalLocalRules($EarlyRules, $_, !$useImage);
1667 }
1668 s/\[\#(\w+)\]/&StoreHref(" name=\"$1\"")/ge if $NamedAnchors;
1669 if ($HtmlTags) {
1670 my ($t);
1671 foreach $t (@HtmlPairs) {
1672 s/\&lt;$t(\s[^<>]+?)?\&gt;(.*?)\&lt;\/$t\&gt;/<$t$1>$2<\/$t>/gis;
1673 }
1674 foreach $t (@HtmlSingle) {
1675 s/\&lt;$t(\s[^<>]+?)?\&gt;/<$t$1>/gi;
1676 }
1677 } else {
1678 # Note that these tags are restricted to a single line
1679 s/\&lt;b\&gt;(.*?)\&lt;\/b\&gt;/<b>$1<\/b>/gi;
1680 s/\&lt;i\&gt;(.*?)\&lt;\/i\&gt;/<i>$1<\/i>/gi;
1681 s/\&lt;strong\&gt;(.*?)\&lt;\/strong\&gt;/<strong>$1<\/strong>/gi;
1682 s/\&lt;em\&gt;(.*?)\&lt;\/em\&gt;/<em>$1<\/em>/gi;
1683 }
1684 s/\&lt;tt\&gt;(.*?)\&lt;\/tt\&gt;/<tt>$1<\/tt>/gis; # <tt> (MeatBall)
1685 s/\&lt;br\&gt;/<br>/gi; # Allow simple line break anywhere
1686 if ($HtmlLinks) {
1687 s/\&lt;A(\s[^<>]+?)\&gt;(.*?)\&lt;\/a\&gt;/&StoreHref($1, $2)/gise;
1688 }
1689 if ($FreeLinks) {
1690 # Consider: should local free-link descriptions be conditional?
1691 # Also, consider that one could write [[Bad Page|Good Page]]?
1692 s/\[\[$FreeLinkPattern\|([^\]]+)\]\]/&StorePageOrEditLink($1, $2)/geo;
1693 s/\[\[$FreeLinkPattern\]\]/&StorePageOrEditLink($1, "")/geo;
1694 }
1695 if ($BracketText) { # Links like [URL text of link]
1696 s/\[$UrlPattern\s+([^\]]+?)\]/&StoreBracketUrl($1, $2, $useImage)/geos;
1697 s/\[$InterLinkPattern\s+([^\]]+?)\]/&StoreBracketInterPage($1, $2,
1698 $useImage)/geos;
1699 if ($WikiLinks && $BracketWiki) { # Local bracket-links
1700 s/\[$LinkPattern\s+([^\]]+?)\]/&StoreBracketLink($1, $2)/geos;
1701 s/\[$AnchoredLinkPattern\s+([^\]]+?)\]/&StoreBracketAnchoredLink($1,
1702 $2, $3)/geos if $NamedAnchors;
1703 }
1704 }
1705 s/\[$UrlPattern\]/&StoreBracketUrl($1, "", 0)/geo;
1706 s/\[$InterLinkPattern\]/&StoreBracketInterPage($1, "", 0)/geo;
1707 s/\b$UrlPattern/&StoreUrl($1, $useImage)/geo;
1708 s/\b$InterLinkPattern/&StoreInterPage($1, $useImage)/geo;
1709 if ($UseUpload) {
1710 s/$UploadPattern/&StoreUpload($1)/geo;
1711 }
1712 if ($WikiLinks) {
1713 s/$AnchoredLinkPattern/&StoreRaw(&GetPageOrEditAnchoredLink($1,
1714 $2, ""))/geo if $NamedAnchors;
1715 # CAA: Putting \b in front of $LinkPattern breaks /SubPage links
1716 # (subpage links without the main page)
1717 s/$LinkPattern/&GetPageOrEditLink($1, "")/geo;
1718 }
1719 s/\b$RFCPattern/&StoreRFC($1)/geo;
1720 s/\b$ISBNPattern/&StoreISBN($1)/geo;
1721 if ($ThinLine) {
1722 if ($OldThinLine) { # Backwards compatible, conflicts with headers
1723 s/====+/<hr noshade class=wikiline size=2>/g;
1724 } else { # New behavior--no conflict
1725 s/------+/<hr noshade class=wikiline size=2>/g;
1726 }
1727 s/----+/<hr noshade class=wikiline size=1>/g;
1728 } else {
1729 s/----+/<hr class=wikiline>/g;
1730 }
1731 }
1732 if ($doLines) { # 0 = no line-oriented, 1 or 2 = do line-oriented
1733 # The quote markup patterns avoid overlapping tags (with 5 quotes)
1734 # by matching the inner quotes for the strong pattern.
1735 s/('*)'''(.*?)'''/$1<strong>$2<\/strong>/g;
1736 s/''(.*?)''/<em>$1<\/em>/g;
1737 if ($UseHeadings) {
1738 s/(^|\n)\s*(\=+)\s+([^\n]+)\s+\=+/&WikiHeading($1, $2, $3)/geo;
1739 }
1740 if ($TableMode) {
1741 s/((\|\|)+)/"<\/TD><TD COLSPAN=\"" . (length($1)\/2) . "\">"/ge;
1742 }
1743 }
1744 return $_;
1745 }
1746
1747 sub EmptyCellsToNbsp {
1748 my ($row) = @_;
1749
1750 $row =~ s/(?<=\|\|)\s+(?=\|\|)/&nbsp;/g;
1751 $row =~ s/^\s+(?=\|\|)/&nbsp;/;
1752 $row =~ s/(?<=\|\|)\s+$/&nbsp;/;
1753 return $row;
1754 }
1755
1756 sub WikiLinesToHtml {
1757 my ($pageText) = @_;
1758 my ($pageHtml, @htmlStack, $code, $codeAttributes, $depth, $oldCode);
1759
1760 @htmlStack = ();
1761 $depth = 0;
1762 $pageHtml = "";
1763 foreach (split(/\n/, $pageText)) { # Process lines one-at-a-time
1764 $code = '';
1765 $codeAttributes = '';
1766 $TableMode = 0;
1767 $_ .= "\n";
1768 if (s/^(\;+)([^:]+\:?)\:/<dt>$2<dd>/) {
1769 $code = "DL";
1770 $depth = length $1;
1771 } elsif (s/^(\:+)/<dt><dd>/) {
1772 $code = "DL";
1773 $depth = length $1;
1774 } elsif (s/^(\*+)/<li>/) {
1775 $code = "UL";
1776 $depth = length $1;
1777 } elsif (s/^(\#+)/<li>/) {
1778 $code = "OL";
1779 $depth = length $1;
1780 } elsif ($TableSyntax &&
1781 s/^((\|\|)+)(.*)\|\|\s*$/"<TR VALIGN='CENTER' "
1782 . "ALIGN='CENTER'><TD colspan='"
1783 . (length($1)\/2) . "'>" . EmptyCellsToNbsp($3) . "<\/TD><\/TR>\n"/e) {
1784 $code = 'TABLE';
1785 $codeAttributes = "BORDER='1'";
1786 $TableMode = 1;
1787 $depth = 1;
1788 } elsif (/^[ \t].*\S/) {
1789 $code = "PRE";
1790 $depth = 1;
1791 } else {
1792 $depth = 0;
1793 }
1794 while (@htmlStack > $depth) { # Close tags as needed
1795 $pageHtml .= "</" . pop(@htmlStack) . ">\n";
1796 }
1797 if ($depth > 0) {
1798 $depth = $IndentLimit if ($depth > $IndentLimit);
1799 if (@htmlStack) { # Non-empty stack
1800 $oldCode = pop(@htmlStack);
1801 if ($oldCode ne $code) {
1802 $pageHtml .= "</$oldCode><$code>\n";
1803 }
1804 push(@htmlStack, $code);
1805 }
1806 while (@htmlStack < $depth) {
1807 push(@htmlStack, $code);
1808 $pageHtml .= "<$code $codeAttributes>\n";
1809 }
1810 }
1811 if (!$ParseParas) {
1812 s/^\s*$/<p>\n/; # Blank lines become <p> tags
1813 }
1814 $pageHtml .= &CommonMarkup($_, 1, 2); # Line-oriented common markup
1815 }
1816 while (@htmlStack > 0) { # Clear stack
1817 $pageHtml .= "</" . pop(@htmlStack) . ">\n";
1818 }
1819 return $pageHtml;
1820 }
1821
1822 sub EvalLocalRules {
1823 my ($rules, $origText, $isDiff) = @_;
1824 my ($text, $reportError, $errorText);
1825
1826 $text = $origText;
1827 $reportError = 1;
1828 # Basic idea: the $rules should change $text, possibly with different
1829 # behavior if $isDiff is true (no images or color changes?)
1830 # Note: for fun, the $rules could also change $reportError and $origText
1831 if (!eval $rules) {
1832 $errorText = $@;
1833 if ($errorText eq '') {
1834 # Search for "Unknown Error" for the reason the next line is commented
1835 # $errorText = T('Unknown Error (no error text)');
1836 }
1837 if ($errorText ne '') {
1838 $text = $origText; # Consider: should partial results be kept?
1839 if ($reportError) {
1840 $text .= '<hr><b>' . T('Local rule error:') . '</b><br>'
1841 . &QuoteHtml($errorText);
1842 }
1843 }
1844 }
1845 return $text;
1846 }
1847
1848 sub UriEscape {
1849 my ($uri) = @_;
1850 $uri =~ s/([\x00-\x1f\x7f-\xff])/sprintf("%%%02X", ord($1))/ge;
1851 $uri =~ s/\&/\&amp;/g;
1852 return $uri;
1853 }
1854
1855 sub ParseParagraph {
1856 my ($text) = @_;
1857
1858 $text = &CommonMarkup($text, 1, 0); # Multi-line markup
1859 $text = &WikiLinesToHtml($text); # Line-oriented markup
1860 return "<p>$text</p>\n";
1861 }
1862
1863 sub StoreInterPage {
1864 my ($id, $useImage) = @_;
1865 my ($link, $extra);
1866
1867 ($link, $extra) = &InterPageLink($id, $useImage);
1868 # Next line ensures no empty links are stored
1869 $link = &StoreRaw($link) if ($link ne "");
1870 return $link . $extra;
1871 }
1872
1873 sub InterPageLink {
1874 my ($id, $useImage) = @_;
1875 my ($name, $site, $remotePage, $url, $punct);
1876
1877 ($id, $punct) = &SplitUrlPunct($id);
1878 $name = $id;
1879 ($site, $remotePage) = split(/:/, $id, 2);
1880 $url = &GetSiteUrl($site);
1881 return ("", $id . $punct) if ($url eq "");
1882 $remotePage =~ s/&amp;/&/g; # Unquote common URL HTML
1883 $url .= $remotePage;
1884 return (&UrlLinkOrImage($url, $name, $useImage), $punct);
1885 }
1886
1887 sub StoreBracketInterPage {
1888 my ($id, $text, $useImage) = @_;
1889 my ($site, $remotePage, $url, $index);
1890
1891 ($site, $remotePage) = split(/:/, $id, 2);
1892 $remotePage =~ s/&amp;/&/g; # Unquote common URL HTML
1893 $url = &GetSiteUrl($site);
1894 if ($text ne "") {
1895 return "[$id $text]" if ($url eq "");
1896 } else {
1897 return "[$id]" if ($url eq "");
1898 $text = &GetBracketUrlIndex($id);
1899 }
1900 $url .= $remotePage;
1901 if ($BracketImg && $useImage && &ImageAllowed($text)) {
1902 $text = "<img src=\"$text\">";
1903 } else {
1904 $text = "[$text]";
1905 }
1906 return &StoreRaw("<a href=\"$url\">$text</a>");
1907 }
1908
1909 sub GetBracketUrlIndex {
1910 my ($id) = @_;
1911 my ($index, $key);
1912
1913 # Consider plain array?
1914 if ($SaveNumUrl{$id} > 0) {
1915 return $SaveNumUrl{$id};
1916 }
1917 $SaveNumUrlIndex++; # Start with 1
1918 $SaveNumUrl{$id} = $SaveNumUrlIndex;
1919 return $SaveNumUrlIndex;
1920 }
1921
1922 sub GetSiteUrl {
1923 my ($site) = @_;
1924 my ($data, $status);
1925
1926 if (!$InterSiteInit) {
1927 ($status, $data) = &ReadFile($InterFile);
1928 if ($status) {
1929 %InterSite = split(/\s+/, $data); # Consider defensive code
1930 }
1931 # Check for definitions to allow file to override automatic settings
1932 if (!defined($InterSite{'LocalWiki'})) {
1933 $InterSite{'LocalWiki'} = $ScriptName . &ScriptLinkChar();
1934 }
1935 if (!defined($InterSite{'Local'})) {
1936 $InterSite{'Local'} = $ScriptName . &ScriptLinkChar();
1937 }
1938 $InterSiteInit = 1; # Init only once per request
1939 }
1940 return $InterSite{$site} if (defined($InterSite{$site}));
1941 return '';
1942 }
1943
1944 sub StoreRaw {
1945 my ($html) = @_;
1946
1947 $SaveUrl{$SaveUrlIndex} = $html;
1948 return $FS . $SaveUrlIndex++ . $FS;
1949 }
1950
1951 sub StorePre {
1952 my ($html, $tag) = @_;
1953
1954 return &StoreRaw("<$tag>" . $html . "</$tag>");
1955 }
1956
1957 sub StoreHref {
1958 my ($anchor, $text) = @_;
1959
1960 return "<a" . &StoreRaw($anchor) . ">$text</a>";
1961 }
1962
1963 sub StoreUrl {
1964 my ($name, $useImage) = @_;
1965 my ($link, $extra);
1966
1967 ($link, $extra) = &UrlLink($name, $useImage);
1968 # Next line ensures no empty links are stored
1969 $link = &StoreRaw($link) if ($link ne "");
1970 return $link . $extra;
1971 }
1972
1973 sub UrlLink {
1974 my ($rawname, $useImage) = @_;
1975 my ($name, $punct);
1976
1977 ($name, $punct) = &SplitUrlPunct($rawname);
1978 if ($LimitFileUrl && ($NetworkFile && $name =~ m|^file:|)) {
1979 # Only do remote file:// links. No file:///c|/windows.
1980 if ($name =~ m|^file://[^/]|) {
1981 return ("<a href=\"$name\">$name</a>", $punct);
1982 }
1983 return ($rawname, '');
1984 }
1985 return (&UrlLinkOrImage($name, $name, $useImage), $punct);
1986 }
1987
1988 sub UrlLinkOrImage {
1989 my ($url, $name, $useImage) = @_;
1990
1991 # Restricted image URLs so that mailto:foo@bar.gif is not an image
1992 if ($useImage && &ImageAllowed($url)) {
1993 return "<img src=\"$url\">";
1994 }
1995 return "<a href=\"$url\">$name</a>";
1996 }
1997
1998 sub ImageAllowed {
1999 my ($url) = @_;
2000 my ($site, $imagePrefixes);
2001
2002 $imagePrefixes = 'http:|https:|ftp:';
2003 $imagePrefixes .= '|file:' if (!$LimitFileUrl);
2004 return 0 unless ($url =~ /^($imagePrefixes).+\.$ImageExtensions$/i);
2005 return 0 if ($url =~ /"/); # No HTML-breaking quotes allowed
2006 return 1 if (@ImageSites < 1); # Most common case: () means all allowed
2007 return 0 if ($ImageSites[0] eq 'none'); # Special case: none allowed
2008 foreach $site (@ImageSites) {
2009 return 1 if ($site eq substr($url, 0, length($site))); # Match prefix
2010 }
2011 return 0;
2012 }
2013
2014 sub StoreBracketUrl {
2015 my ($url, $text, $useImage) = @_;
2016
2017 if ($text eq "") {
2018 $text = &GetBracketUrlIndex($url);
2019 } elsif ($text =~ /^$InterLinkPattern$/) {
2020 my @interlink = split(/:/, $text, 2);
2021 $text = &GetSiteUrl($interlink[0]) . $interlink[1];
2022 }
2023 if ($BracketImg && $useImage && &ImageAllowed($text)) {
2024 $text = "<img src=\"$text\">";
2025 } else {
2026 $text = "[$text]";
2027 }
2028 return &StoreRaw("<a href=\"$url\">$text</a>");
2029 }
2030
2031 sub StoreBracketLink {
2032 my ($name, $text) = @_;
2033
2034 return &StoreRaw(&GetPageLinkText($name, "[$text]"));
2035 }
2036
2037 sub StoreBracketAnchoredLink {
2038 my ($name, $anchor, $text) = @_;
2039
2040 return &StoreRaw(&GetPageLinkText("$name#$anchor", "[$text]"));
2041 }
2042
2043 sub StorePageOrEditLink {
2044 my ($page, $name) = @_;
2045
2046 if ($FreeLinks) {
2047 $page =~ s/^\s+//; # Trim extra spaces
2048 $page =~ s/\s+$//;
2049 $page =~ s|\s*/\s*|/|; # ...also before/after subpages
2050 }
2051 $name =~ s/^\s+//;
2052 $name =~ s/\s+$//;
2053 return &StoreRaw(&GetPageOrEditLink($page, $name));
2054 }
2055
2056 sub StoreRFC {
2057 my ($num) = @_;
2058
2059 return &StoreRaw(&RFCLink($num));
2060 }
2061
2062 sub RFCLink {
2063 my ($num) = @_;
2064
2065 return "<a href=\"http://www.faqs.org/rfcs/rfc${num}.html\">RFC $num</a>";
2066 }
2067
2068 sub StoreUpload {
2069 my ($url) = @_;
2070
2071 return &StoreRaw(&UploadLink($url));
2072 }
2073
2074 sub UploadLink {
2075 my ($filename) = @_;
2076 my ($html, $url);
2077
2078 return $filename if ($UploadUrl eq ''); # No bad links if misconfigured
2079 $UploadUrl .= '/' if (substr($UploadUrl, -1, 1) ne '/'); # End with /
2080 $url = $UploadUrl . $filename;
2081 $html = '<a href="' . $url . '">';
2082 if (&ImageAllowed($url)) {
2083 $html .= '<img src="' . $url . '" alt="upload:' . $filename . '">';
2084 } else {
2085 $html .= 'upload:' . $filename;
2086 }
2087 $html .= '</a>';
2088 return $html;
2089 }
2090
2091 sub StoreISBN {
2092 my ($num) = @_;
2093
2094 return &StoreRaw(&ISBNLink($num));
2095 }
2096
2097 sub ISBNALink {
2098 my ($num, $pre, $post, $text) = @_;
2099
2100 return '<a href="' . $pre . $num . $post . '">' . $text . '</a>';
2101 }
2102
2103 sub ISBNLink {
2104 my ($rawnum) = @_;
2105 my ($rawprint, $html, $num, $numSites, $i);
2106
2107 $num = $rawnum;
2108 $rawprint = $rawnum;
2109 $rawprint =~ s/ +$//;
2110 $num =~ s/[- ]//g;
2111 $numSites = scalar @IsbnNames; # Number of entries
2112 if ((length($num) != 10) || ($numSites < 1)) {
2113 return "ISBN $rawnum";
2114 }
2115 $html = &ISBNALink($num, $IsbnPre[0], $IsbnPost[0], 'ISBN ' . $rawprint);
2116 if ($numSites > 1) {
2117 $html .= ' (';
2118 $i = 1;
2119 while ($i < $numSites) {
2120 $html .= &ISBNALink($num, $IsbnPre[$i], $IsbnPost[$i], $IsbnNames[$i]);
2121 if ($i < ($numSites - 1)) { # Not the last site
2122 $html .= ', ';
2123 }
2124 $i++;
2125 }
2126 $html .= ')';
2127 }
2128 $html .= " " if ($rawnum =~ / $/); # Add space if old ISBN had space.
2129 return $html;
2130 }
2131
2132 sub SplitUrlPunct {
2133 my ($url) = @_;
2134 my ($punct);
2135
2136 if ($url =~ s/\"\"$//) {
2137 return ($url, ""); # Delete double-quote delimiters here
2138 }
2139 $punct = "";
2140 if ($NewFS) {
2141 ($punct) = ($url =~ /([^a-zA-Z0-9\/\x80-\xff]+)$/);
2142 $url =~ s/([^a-zA-Z0-9\/\x80-\xff]+)$//;
2143 } else {
2144 ($punct) = ($url =~ /([^a-zA-Z0-9\/\xc0-\xff]+)$/);
2145 $url =~ s/([^a-zA-Z0-9\/\xc0-\xff]+)$//;
2146 }
2147 return ($url, $punct);
2148 }
2149
2150 sub StripUrlPunct {
2151 my ($url) = @_;
2152 my ($junk);
2153
2154 ($url, $junk) = &SplitUrlPunct($url);
2155 return $url;
2156 }
2157
2158 sub WikiHeadingNumber {
2159 my ($depth, $text) = @_;
2160 my ($anchor, $number);
2161
2162 return '' unless --$depth > 0; # Don't number H1s because it looks stupid
2163 while (scalar @HeadingNumbers < ($depth-1)) {
2164 push @HeadingNumbers, 1;
2165 $TableOfContents .= '<dl><dt> </dt><dd>';
2166 }
2167 if (scalar @HeadingNumbers < $depth) {
2168 push @HeadingNumbers, 0;
2169 $TableOfContents .= '<dl><dt> </dt><dd>';
2170 }
2171 while (scalar @HeadingNumbers > $depth) {
2172 pop @HeadingNumbers;
2173 $TableOfContents .= "</dd></dl>\n\n";
2174 }
2175 $HeadingNumbers[$#HeadingNumbers]++;
2176 $number = (join '.', @HeadingNumbers) . '. ';
2177 # Remove embedded links. THIS IS FRAGILE!
2178 $text = &RestoreSavedText($text);
2179 $text =~ s/\<a\s[^\>]*?\>\?\<\/a\>//si; # No such page syntax
2180 $text =~ s/\<a\s[^\>]*?\>(.*?)\<\/a\>/$1/si;
2181 # Cook anchor by canonicalizing $text.
2182 $anchor = $text;
2183 $anchor =~ s/\<.*?\>//g;
2184 $anchor =~ s/\W/_/g;
2185 $anchor =~ s/__+/_/g;
2186 $anchor =~ s/^_//;
2187 $anchor =~ s/_$//;
2188 # Last ditch effort
2189 $anchor = '_' . (join '_', @HeadingNumbers) unless $anchor;
2190 $TableOfContents .= $number . &ScriptLink("$OpenPageName#$anchor",$text)
2191 . "</dd>\n<dt> </dt><dd>";
2192 return &StoreHref(" name=\"$anchor\"") . $number;
2193 }
2194
2195 sub WikiHeading {
2196 my ($pre, $depth, $text) = @_;
2197
2198 $depth = length($depth);
2199 $depth = 6 if ($depth > 6);
2200 $text =~ s/^\s*#\s+/&WikiHeadingNumber($depth,$')/e; # $' == $POSTMATCH
2201 return $pre . "<H$depth>$text</H$depth>\n";
2202 }
2203
2204 # ==== Difference markup and HTML ====
2205 sub GetDiffHTML {
2206 my ($diffType, $id, $revOld, $revNew, $newText) = @_;
2207 my ($html, $diffText, $diffTextTwo, $priorName, $links, $usecomma);
2208 my ($major, $minor, $author, $useMajor, $useMinor, $useAuthor, $cacheName);
2209
2210 $links = "(";
2211 $usecomma = 0;
2212 $major = &ScriptLinkDiff(1, $id, T('major diff'), "");
2213 $minor = &ScriptLinkDiff(2, $id, T('minor diff'), "");
2214 $author = &ScriptLinkDiff(3, $id, T('author diff'), "");
2215 $useMajor = 1;
2216 $useMinor = 1;
2217 $useAuthor = 1;
2218 $diffType = &GetParam("defaultdiff", 1) if ($diffType == 4);
2219 if ($diffType == 1) {
2220 $priorName = T('major');
2221 $cacheName = 'major';
2222 $useMajor = 0;
2223 } elsif ($diffType == 2) {
2224 $priorName = T('minor');
2225 $cacheName = 'minor';
2226 $useMinor = 0;
2227 } elsif ($diffType == 3) {
2228 $priorName = T('author');
2229 $cacheName = 'author';
2230 $useAuthor = 0;
2231 }
2232 if ($revOld ne "") {
2233 # Note: OpenKeptRevisions must have been done by caller.
2234 # Eventually optimize if same as cached revision
2235 $diffText = &GetKeptDiff($newText, $revOld, 1); # 1 = get lock
2236 if ($diffText eq "") {
2237 $diffText = T('(The revisions are identical or unavailable.)');
2238 }
2239 } else {
2240 $diffText = &GetCacheDiff($cacheName);
2241 }
2242 $useMajor = 0 if ($useMajor && ($diffText eq &GetCacheDiff("major")));
2243 $useMinor = 0 if ($useMinor && ($diffText eq &GetCacheDiff("minor")));
2244 $useAuthor = 0 if ($useAuthor && ($diffText eq &GetCacheDiff("author")));
2245 $useMajor = 0 if ((!defined(&GetPageCache('oldmajor'))) ||
2246 (&GetPageCache("oldmajor") < 1));
2247 $useAuthor = 0 if ((!defined(&GetPageCache('oldauthor'))) ||
2248 (&GetPageCache("oldauthor") < 1));
2249 if ($useMajor) {
2250 $links .= $major;
2251 $usecomma = 1;
2252 }
2253 if ($useMinor) {
2254 $links .= ", " if ($usecomma);
2255 $links .= $minor;
2256 $usecomma = 1;
2257 }
2258 if ($useAuthor) {
2259 $links .= ", " if ($usecomma);
2260 $links .= $author;
2261 }
2262 if (!($useMajor || $useMinor || $useAuthor)) {
2263 $links .= T('no other diffs');
2264 }
2265 $links .= ")";
2266 if ((!defined($diffText)) || ($diffText eq "")) {
2267 $diffText = T('No diff available.');
2268 }
2269 if ($revOld ne "") {
2270 my $currentRevision = T('current revision');
2271 $currentRevision = Ts('revision %s', $revNew) if $revNew;
2272 $html = '<b>'
2273 . Tss("Difference (from revision %1 to %2)", $revOld, $currentRevision)
2274 . "</b>\n" . "$links<br>" . &DiffToHTML($diffText);
2275 } else {
2276 if (($diffType != 2) &&
2277 ((!defined(&GetPageCache("old$cacheName"))) ||
2278 (&GetPageCache("old$cacheName") < 1))) {
2279 $html = '<b>'
2280 . Ts('No diff available--this is the first %s revision.',
2281 $priorName) . "</b>\n$links";
2282 } else {
2283 $html = '<b>'
2284 . Ts('Difference (from prior %s revision)', $priorName)
2285 . "</b>\n$links<br>" . &DiffToHTML($diffText);
2286 }
2287 }
2288 @HeadingNumbers = ();
2289 $TableOfContents = '';
2290 return $html;
2291 }
2292
2293 sub GetCacheDiff {
2294 my ($type) = @_;
2295 my ($diffText);
2296
2297 $diffText = &GetPageCache("diff_default_$type");
2298 $diffText = &GetCacheDiff('minor') if ($diffText eq "1");
2299 $diffText = &GetCacheDiff('major') if ($diffText eq "2");
2300 return $diffText;
2301 }
2302
2303 # Must be done after minor diff is set and OpenKeptRevisions called
2304 sub GetKeptDiff {
2305 my ($newText, $oldRevision, $lock) = @_;
2306 my (%sect, %data, $oldText);
2307
2308 $oldText = "";
2309 if (defined($KeptRevisions{$oldRevision})) {
2310 %sect = split(/$FS2/, $KeptRevisions{$oldRevision}, -1);
2311 %data = split(/$FS3/, $sect{'data'}, -1);
2312 $oldText = $data{'text'};
2313 }
2314 return "" if ($oldText eq ""); # Old revision not found
2315 return &GetDiff($oldText, $newText, $lock);
2316 }
2317
2318 sub GetDiff {
2319 my ($old, $new, $lock) = @_;
2320 my ($diff_out, $oldName, $newName);
2321
2322 &CreateDir($TempDir);
2323 $oldName = "$TempDir/old_diff";
2324 $newName = "$TempDir/new_diff";
2325 if ($lock) {
2326 &RequestDiffLock() or return "";
2327 $oldName .= "_locked";
2328 $newName .= "_locked";
2329 }
2330 &WriteStringToFile($oldName, $old);
2331 &WriteStringToFile($newName, $new);
2332 $diff_out = `diff $oldName $newName`;
2333 &ReleaseDiffLock() if ($lock);
2334 $diff_out =~ s/\\ No newline.*\n//g; # Get rid of common complaint.
2335 # No need to unlink temp files--next diff will just overwrite.
2336 return $diff_out;
2337 }
2338
2339 sub DiffToHTML {
2340 my ($html) = @_;
2341 my ($tChanged, $tRemoved, $tAdded);
2342
2343 $tChanged = T('Changed:');
2344 $tRemoved = T('Removed:');
2345 $tAdded = T('Added:');
2346 $html =~ s/\n--+//g;
2347 # Note: Need spaces before <br> to be different from diff section.
2348 $html =~ s/(^|\n)(\d+.*c.*)/$1 <br><strong>$tChanged $2<\/strong><br>/g;
2349 $html =~ s/(^|\n)(\d+.*d.*)/$1 <br><strong>$tRemoved $2<\/strong><br>/g;
2350 $html =~ s/(^|\n)(\d+.*a.*)/$1 <br><strong>$tAdded $2<\/strong><br>/g;
2351 $html =~ s/\n((<.*\n)+)/&ColorDiff($1, $DiffColor1, 0)/ge;
2352 $html =~ s/\n((>.*\n)+)/&ColorDiff($1, $DiffColor2, 1)/ge;
2353 return $html;
2354 }
2355
2356 sub ColorDiff {
2357 my ($diff, $color, $type) = @_;
2358 my ($colorHtml, $classHtml);
2359
2360 $diff =~ s/(^|\n)[<>]/$1/g;
2361 $diff = &QuoteHtml($diff);
2362 # Do some of the Wiki markup rules:
2363 %SaveUrl = ();
2364 %SaveNumUrl = ();
2365 $SaveUrlIndex = 0;
2366 $SaveNumUrlIndex = 0;
2367 $diff = &RemoveFS($diff);
2368 $diff = &CommonMarkup($diff, 0, 1); # No images, all patterns
2369 if ($LateRules ne '') {
2370 $diff = &EvalLocalRules($LateRules, $diff, 1);
2371 }
2372 1 while $diff =~ s/$FS(\d+)$FS/$SaveUrl{$1}/ge; # Restore saved text
2373 $diff =~ s/\r?\n/<br>/g;
2374 $colorHtml = '';
2375 if ($color ne '') {
2376 $colorHtml = " bgcolor=$color";
2377 }
2378 if ($type) {
2379 $classHtml = ' class=wikidiffnew';
2380 } else {
2381 $classHtml = ' class=wikidiffold';
2382 }
2383 return "<table width=\"95\%\"$colorHtml$classHtml><tr><td>\n" . $diff
2384 . "</td></tr></table>\n";
2385 }
2386
2387 # ==== Database (Page, Section, Text, Kept, User) functions ====
2388 sub OpenNewPage {
2389 my ($id) = @_;
2390
2391 %Page = ();
2392 $Page{'version'} = 3; # Data format version
2393 $Page{'revision'} = 0; # Number of edited times
2394 $Page{'tscreate'} = $Now; # Set once at creation
2395 $Page{'ts'} = $Now; # Updated every edit
2396 }
2397
2398 sub OpenNewSection {
2399 my ($name, $data) = @_;
2400
2401 %Section = ();
2402 $Section{'name'} = $name;
2403 $Section{'version'} = 1; # Data format version
2404 $Section{'revision'} = 0; # Number of edited times
2405 $Section{'tscreate'} = $Now; # Set once at creation
2406 $Section{'ts'} = $Now; # Updated every edit
2407 $Section{'ip'} = $ENV{REMOTE_ADDR};
2408 $Section{'host'} = ''; # Updated only for real edits (can be slow)
2409 $Section{'id'} = $UserID;
2410 $Section{'username'} = &GetParam("username", "");
2411 $Section{'data'} = $data;
2412 $Page{$name} = join($FS2, %Section); # Replace with save?
2413 }
2414
2415 sub OpenNewText {
2416 my ($name) = @_; # Name of text (usually "default")
2417 %Text = ();
2418 if ($NewText ne '') {
2419 $Text{'text'} = T($NewText);
2420 } else {
2421 $Text{'text'} = T('Describe the new page here.') . "\n";
2422 }
2423 $Text{'text'} .= "\n" if (substr($Text{'text'}, -1, 1) ne "\n");
2424 $Text{'minor'} = 0; # Default as major edit
2425 $Text{'newauthor'} = 1; # Default as new author
2426 $Text{'summary'} = '';
2427 &OpenNewSection("text_$name", join($FS3, %Text));
2428 }
2429
2430 sub GetPageFile {
2431 my ($id) = @_;
2432
2433 return $PageDir . "/" . &GetPageDirectory($id) . "/$id.db";
2434 }
2435
2436 sub OpenPage {
2437 my ($id) = @_;
2438 my ($fname, $data);
2439
2440 if ($OpenPageName eq $id) {
2441 return;
2442 }
2443 %Section = ();
2444 %Text = ();
2445 $fname = &GetPageFile($id);
2446 if (-f $fname) {
2447 $data = &ReadFileOrDie($fname);
2448 %Page = split(/$FS1/, $data, -1); # -1 keeps trailing null fields
2449 } else {
2450 &OpenNewPage($id);
2451 }
2452 if ($Page{'version'} != 3) {
2453 &UpdatePageVersion();
2454 }
2455 $OpenPageName = $id;
2456 }
2457
2458 sub OpenSection {
2459 my ($name) = @_;
2460
2461 if (!defined($Page{$name})) {
2462 &OpenNewSection($name, "");
2463 } else {
2464 %Section = split(/$FS2/, $Page{$name}, -1);
2465 }
2466 }
2467
2468 sub OpenText {
2469 my ($name) = @_;
2470
2471 if (!defined($Page{"text_$name"})) {
2472 &OpenNewText($name);
2473 } else {
2474 &OpenSection("text_$name");
2475 %Text = split(/$FS3/, $Section{'data'}, -1);
2476 }
2477 }
2478
2479 sub OpenDefaultText {
2480 &OpenText('default');
2481 }
2482
2483 # Called after OpenKeptRevisions
2484 sub OpenKeptRevision {
2485 my ($revision) = @_;
2486
2487 %Section = split(/$FS2/, $KeptRevisions{$revision}, -1);
2488 %Text = split(/$FS3/, $Section{'data'}, -1);
2489 }
2490
2491 sub GetPageCache {
2492 my ($name) = @_;
2493
2494 return $Page{"cache_$name"};
2495 }
2496
2497 # Always call SavePage within a lock.
2498 sub SavePage {
2499 my $file = &GetPageFile($OpenPageName);
2500
2501 $Page{'revision'} += 1; # Number of edited times
2502 $Page{'ts'} = $Now; # Updated every edit
2503 &CreatePageDir($PageDir, $OpenPageName);
2504 &WriteStringToFile($file, join($FS1, %Page));
2505 }
2506
2507 sub SaveSection {
2508 my ($name, $data) = @_;
2509
2510 $Section{'revision'} += 1; # Number of edited times
2511 $Section{'ts'} = $Now; # Updated every edit
2512 $Section{'ip'} = $ENV{REMOTE_ADDR};
2513 $Section{'id'} = $UserID;
2514 $Section{'username'} = &GetParam("username", "");
2515 $Section{'data'} = $data;
2516 $Page{$name} = join($FS2, %Section);
2517 }
2518
2519 sub SaveText {
2520 my ($name) = @_;
2521
2522 &SaveSection("text_$name", join($FS3, %Text));
2523 }
2524
2525 sub SaveDefaultText {
2526 &SaveText('default');
2527 }
2528
2529 sub SetPageCache {
2530 my ($name, $data) = @_;
2531
2532 $Page{"cache_$name"} = $data;
2533 }
2534
2535 sub UpdatePageVersion {
2536 &ReportError(T('Bad page version (or corrupt page).'));
2537 }
2538
2539 sub KeepFileName {
2540 return $KeepDir . "/" . &GetPageDirectory($OpenPageName)
2541 . "/$OpenPageName.kp";
2542 }
2543
2544 sub SaveKeepSection {
2545 my $file = &KeepFileName();
2546 my $data;
2547
2548 return if ($Section{'revision'} < 1); # Don't keep "empty" revision
2549 $Section{'keepts'} = $Now;
2550 $data = $FS1 . join($FS2, %Section);
2551 &CreatePageDir($KeepDir, $OpenPageName);
2552 &AppendStringToFileLimited($file, $data, $KeepSize);
2553 }
2554
2555 sub ExpireKeepFile {
2556 my ($fname, $data, @kplist, %tempSection, $expirets);
2557 my ($anyExpire, $anyKeep, $expire, %keepFlag, $sectName, $sectRev);
2558 my ($oldMajor, $oldAuthor);
2559
2560 $fname = &KeepFileName();
2561 return if (!(-f $fname));
2562 $data = &ReadFileOrDie($fname);
2563 @kplist = split(/$FS1/, $data, -1); # -1 keeps trailing null fields
2564 return if (length(@kplist) < 1); # Also empty
2565 shift(@kplist) if ($kplist[0] eq ""); # First can be empty
2566 return if (length(@kplist) < 1); # Also empty
2567 %tempSection = split(/$FS2/, $kplist[0], -1);
2568 if (!defined($tempSection{'keepts'})) {
2569 return; # Bad keep file
2570 }
2571 $expirets = $Now - ($KeepDays * 24 * 60 * 60);
2572 return if ($tempSection{'keepts'} >= $expirets); # Nothing old enough
2573 $anyExpire = 0;
2574 $anyKeep = 0;
2575 %keepFlag = ();
2576 $oldMajor = &GetPageCache('oldmajor');
2577 $oldAuthor = &GetPageCache('oldauthor');
2578 foreach (reverse @kplist) {
2579 %tempSection = split(/$FS2/, $_, -1);
2580 $sectName = $tempSection{'name'};
2581 $sectRev = $tempSection{'revision'};
2582 $expire = 0;
2583 if ($sectName eq "text_default") {
2584 if (($KeepMajor && ($sectRev == $oldMajor)) ||
2585 ($KeepAuthor && ($sectRev == $oldAuthor))) {
2586 $expire = 0;
2587 } elsif ($tempSection{'keepts'} < $expirets) {
2588 $expire = 1;
2589 }
2590 } else {
2591 if ($tempSection{'keepts'} < $expirets) {
2592 $expire = 1;
2593 }
2594 }
2595 if (!$expire) {
2596 $keepFlag{$sectRev . "," . $sectName} = 1;
2597 $anyKeep = 1;
2598 } else {
2599 $anyExpire = 1;
2600 }
2601 }
2602 if (!$anyKeep) { # Empty, so remove file
2603 unlink($fname);
2604 return;
2605 }
2606 return if (!$anyExpire); # No sections expired
2607 open (OUT, ">$fname") or die (Ts('cant write %s', $fname) . ": $!");
2608 foreach (@kplist) {
2609 %tempSection = split(/$FS2/, $_, -1);
2610 $sectName = $tempSection{'name'};
2611 $sectRev = $tempSection{'revision'};
2612 if ($keepFlag{$sectRev . "," . $sectName}) {
2613 print OUT $FS1, $_;
2614 }
2615 }
2616 close(OUT);
2617 }
2618
2619 sub OpenKeptList {
2620 my ($fname, $data);
2621
2622 @KeptList = ();
2623 $fname = &KeepFileName();
2624 return if (!(-f $fname));
2625 $data = &ReadFileOrDie($fname);
2626 @KeptList = split(/$FS1/, $data, -1); # -1 keeps trailing null fields
2627 }
2628
2629 sub OpenKeptRevisions {
2630 my ($name) = @_; # Name of section
2631 my ($fname, $data, %tempSection);
2632
2633 %KeptRevisions = ();
2634 &OpenKeptList();
2635 foreach (@KeptList) {
2636 %tempSection = split(/$FS2/, $_, -1);
2637 next if ($tempSection{'name'} ne $name);
2638 $KeptRevisions{$tempSection{'revision'}} = $_;
2639 }
2640 }
2641
2642 sub LoadUserData {
2643 my ($data, $status);
2644
2645 %UserData = ();
2646 ($status, $data) = &ReadFile(&UserDataFilename($UserID));
2647 if (!$status) {
2648 $UserID = 112; # Could not open file. Consider warning message?
2649 return;
2650 }
2651 %UserData = split(/$FS1/, $data, -1); # -1 keeps trailing null fields
2652 }
2653
2654 sub UserDataFilename {
2655 my ($id) = @_;
2656
2657 return "" if ($id < 1);
2658 return $UserDir . "/" . ($id % 10) . "/$id.db";
2659 }
2660
2661 # ==== Misc. functions ====
2662 sub ReportError {
2663 my ($errmsg) = @_;
2664
2665 print $q->header, $q->start_html, "<H2>", &QuoteHtml($errmsg), "</H2>", $q->end_html;
2666 }
2667
2668 sub ValidId {
2669 my ($id) = @_;
2670
2671 if (length($id) > 120) {
2672 return Ts('Page name is too long: %s', $id);
2673 }
2674 if ($id =~ m| |) {
2675 return Ts('Page name may not contain space characters: %s', $id);
2676 }
2677 if ($UseSubpage) {
2678 if ($id =~ m|.*/.*/|) {
2679 return Ts('Too many / characters in page %s', $id);
2680 }
2681 if ($id =~ /^\//) {
2682 return Ts('Invalid Page %s (subpage without main page)', $id);
2683 }
2684 if ($id =~ /\/$/) {
2685 return Ts('Invalid Page %s (missing subpage name)', $id);
2686 }
2687 }
2688 if ($FreeLinks) {
2689 $id =~ s/ /_/g;
2690 if (!$UseSubpage) {
2691 if ($id =~ /\//) {
2692 return Ts('Invalid Page %s (/ not allowed)', $id);
2693 }
2694 }
2695 if (!($id =~ m|^$FreeLinkPattern$|)) {
2696 return Ts('Invalid Page %s', $id);
2697 }
2698 if ($id =~ m|\.db$|) {
2699 return Ts('Invalid Page %s (must not end with .db)', $id);
2700 }
2701 if ($id =~ m|\.lck$|) {
2702 return Ts('Invalid Page %s (must not end with .lck)', $id);
2703 }
2704 return "";
2705 } else {
2706 if (!($id =~ /^$LinkPattern$/)) {
2707 return Ts('Invalid Page %s', $id);
2708 }
2709 }
2710 return "";
2711 }
2712
2713 sub ValidIdOrDie {
2714 my ($id) = @_;
2715 my $error;
2716
2717 $error = &ValidId($id);
2718 if ($error ne "") {
2719 &ReportError($error);
2720 return 0;
2721 }
2722 return 1;
2723 }
2724
2725 sub UserCanEdit {
2726 my ($id, $deepCheck) = @_;
2727
2728 # Optimized for the "everyone can edit" case (don't check passwords)
2729 if (($id ne "") && (-f &GetLockedPageFile($id))) {
2730 return 1 if (&UserIsAdmin()); # Requires more privledges
2731 # Consider option for editor-level to edit these pages?
2732 return 0;
2733 }
2734 if (!$EditAllowed) {
2735 return 1 if (&UserIsEditor());
2736 return 0;
2737 }
2738 if (-f "$DataDir/noedit") {
2739 return 1 if (&UserIsEditor());
2740 return 0;
2741 }
2742 if ($deepCheck) { # Deeper but slower checks (not every page)
2743 return 1 if (&UserIsEditor());
2744 return 0 if (&UserIsBanned());
2745 }
2746 return 1;
2747 }
2748
2749 sub UserIsBanned {
2750 my ($host, $ip, $data, $status);
2751
2752 ($status, $data) = &ReadFile("$DataDir/banlist");
2753 return 0 if (!$status); # No file exists, so no ban
2754 $data =~ s/\r//g;
2755 $ip = $ENV{'REMOTE_ADDR'};
2756 $host = &GetRemoteHost(0);
2757 foreach (split(/\n/, $data)) {
2758 next if ((/^\s*$/) || (/^#/)); # Skip empty, spaces, or comments
2759 return 1 if ($ip =~ /$_/i);
2760 return 1 if ($host =~ /$_/i);
2761 }
2762 return 0;
2763 }
2764
2765 sub UserIsAdmin {
2766 my (@pwlist, $userPassword);
2767
2768 return 0 if ($AdminPass eq "");
2769 $userPassword = &GetParam("adminpw", "");
2770 return 0 if ($userPassword eq "");
2771 foreach (split(/\s+/, $AdminPass)) {
2772 next if ($_ eq "");
2773 return 1 if ($userPassword eq $_);
2774 }
2775 return 0;
2776 }
2777
2778 sub UserIsEditor {
2779 my (@pwlist, $userPassword);
2780
2781 return 1 if (&UserIsAdmin()); # Admin includes editor
2782 return 0 if ($EditPass eq "");
2783 $userPassword = &GetParam("adminpw", ""); # Used for both
2784 return 0 if ($userPassword eq "");
2785 foreach (split(/\s+/, $EditPass)) {
2786 next if ($_ eq "");
2787 return 1 if ($userPassword eq $_);
2788 }
2789 return 0;
2790 }
2791
2792 sub UserCanUpload {
2793 return 1 if (&UserIsEditor());
2794 return $AllUpload;
2795 }
2796
2797 sub GetLockedPageFile {
2798 my ($id) = @_;
2799
2800 return $PageDir . "/" . &GetPageDirectory($id) . "/$id.lck";
2801 }
2802
2803 sub RequestLockDir {
2804 my ($name, $tries, $wait, $errorDie) = @_;
2805 my ($lockName, $n);
2806
2807 &CreateDir($TempDir);
2808 $lockName = $LockDir . $name;
2809 $n = 0;
2810 while (mkdir($lockName, 0555) == 0) {
2811 if ($! != 17) {
2812 die(Ts('can not make %s', $LockDir) . ": $!\n") if $errorDie;
2813 return 0;
2814 }
2815 return 0 if ($n++ >= $tries);
2816 sleep($wait);
2817 }
2818 return 1;
2819 }
2820
2821 sub ReleaseLockDir {
2822 my ($name) = @_;
2823
2824 rmdir($LockDir . $name);
2825 }
2826
2827 sub RequestLock {
2828 # 10 tries, 3 second wait, possibly die on error
2829 return &RequestLockDir("main", 10, 3, $LockCrash);
2830 }
2831
2832 sub ReleaseLock {
2833 &ReleaseLockDir('main');
2834 }
2835
2836 sub ForceReleaseLock {
2837 my ($name) = @_;
2838 my $forced;
2839
2840 # First try to obtain lock (in case of normal edit lock)
2841 # 5 tries, 3 second wait, do not die on error
2842 $forced = !&RequestLockDir($name, 5, 3, 0);
2843 &ReleaseLockDir($name); # Release the lock, even if we didn't get it.
2844 return $forced;
2845 }
2846
2847 sub RequestCacheLock {
2848 # 4 tries, 2 second wait, do not die on error
2849 return &RequestLockDir('cache', 4, 2, 0);
2850 }
2851
2852 sub ReleaseCacheLock {
2853 &ReleaseLockDir('cache');
2854 }
2855
2856 sub RequestDiffLock {
2857 # 4 tries, 2 second wait, do not die on error
2858 return &RequestLockDir('diff', 4, 2, 0);
2859 }
2860
2861 sub ReleaseDiffLock {
2862 &ReleaseLockDir('diff');
2863 }
2864
2865 # Index lock is not very important--just return error if not available
2866 sub RequestIndexLock {
2867 # 1 try, 2 second wait, do not die on error
2868 return &RequestLockDir('index', 1, 2, 0);
2869 }
2870
2871 sub ReleaseIndexLock {
2872 &ReleaseLockDir('index');
2873 }
2874
2875 sub ReadFile {
2876 my ($fileName) = @_;
2877 my ($data);
2878 local $/ = undef; # Read complete files
2879
2880 if (open(IN, "<$fileName")) {
2881 $data=<IN>;
2882 close IN;
2883 return (1, $data);
2884 }
2885 return (0, "");
2886 }
2887
2888 sub ReadFileOrDie {
2889 my ($fileName) = @_;
2890 my ($status, $data);
2891
2892 ($status, $data) = &ReadFile($fileName);
2893 if (!$status) {
2894 die(Ts('Can not open %s', $fileName) . ": $!");
2895 }
2896 return $data;
2897 }
2898
2899 sub WriteStringToFile {
2900 my ($file, $string) = @_;
2901
2902 open (OUT, ">$file") or die(Ts('cant write %s', $file) . ": $!");
2903 print OUT $string;
2904 close(OUT);
2905 }
2906
2907 sub AppendStringToFile {
2908 my ($file, $string) = @_;
2909
2910 open (OUT, ">>$file") or die(Ts('cant write %s', $file) . ": $!");
2911 print OUT $string;
2912 close(OUT);
2913 }
2914
2915 sub AppendStringToFileLimited {
2916 my ($file, $string, $limit) = @_;
2917
2918 if (($limit < 1) || (((-s $file) + length($string)) <= $limit)) {
2919 &AppendStringToFile($file, $string);
2920 }
2921 }
2922
2923 sub CreateDir {
2924 my ($newdir) = @_;
2925
2926 mkdir($newdir, 0775) if (!(-d $newdir));
2927 }
2928
2929 sub CreatePageDir {
2930 my ($dir, $id) = @_;
2931 my $subdir;
2932
2933 &CreateDir($dir); # Make sure main page exists
2934 $subdir = $dir . "/" . &GetPageDirectory($id);
2935 &CreateDir($subdir);
2936 if ($id =~ m|([^/]+)/|) {
2937 $subdir = $subdir . "/" . $1;
2938 &CreateDir($subdir);
2939 }
2940 }
2941
2942 sub UpdateHtmlCache {
2943 my ($id, $html) = @_;
2944 my $idFile;
2945
2946 $idFile = &GetHtmlCacheFile($id);
2947 &CreatePageDir($HtmlDir, $id);
2948 if (&RequestCacheLock()) {
2949 &WriteStringToFile($idFile, $html);
2950 &ReleaseCacheLock();
2951 }
2952 }
2953
2954 sub GenerateAllPagesList {
2955 my (@pages, @dirs, $id, $dir, @pageFiles, @subpageFiles, $subId);
2956
2957 @pages = ();
2958 if ($FastGlob) {
2959 # The following was inspired by the FastGlob code by Marc W. Mengel.
2960 # Thanks to Bob Showalter for pointing out the improvement.
2961 opendir(PAGELIST, $PageDir);
2962 @dirs = readdir(PAGELIST);
2963 closedir(PAGELIST);
2964 @dirs = sort(@dirs);
2965 foreach $dir (@dirs) {
2966 next if (substr($dir, 0, 1) eq '.'); # No ., .., or .dirs or files
2967 opendir(PAGELIST, "$PageDir/$dir");
2968 @pageFiles = readdir(PAGELIST);
2969 closedir(PAGELIST);
2970 foreach $id (@pageFiles) {
2971 next if (($id eq '.') || ($id eq '..'));
2972 if (substr($id, -3) eq '.db') {
2973 push(@pages, substr($id, 0, -3));
2974 } elsif (substr($id, -4) ne '.lck') {
2975 opendir(PAGELIST, "$PageDir/$dir/$id");
2976 @subpageFiles = readdir(PAGELIST);
2977 closedir(PAGELIST);
2978 foreach $subId (@subpageFiles) {
2979 if (substr($subId, -3) eq '.db') {
2980 push(@pages, "$id/" . substr($subId, 0, -3));
2981 }
2982 }
2983 }
2984 }
2985 }
2986 } else {
2987 # Old slow/compatible method.
2988 @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);
2989 foreach $dir (@dirs) {
2990 if (-e "$PageDir/$dir") { # Thanks to Tim Holt
2991 while (<$PageDir/$dir/*.db $PageDir/$dir/*/*.db>) {
2992 s|^$PageDir/||;
2993 m|^[^/]+/(\S*).db|;
2994 $id = $1;
2995 push(@pages, $id);
2996 }
2997 }
2998 }
2999 }
3000 return sort(@pages);
3001 }
3002
3003 sub AllPagesList {
3004 my ($rawIndex, $refresh, $status);
3005
3006 if (!$UseIndex) {
3007 return &GenerateAllPagesList();
3008 }
3009 $refresh = &GetParam("refresh", 0);
3010 if ($IndexInit && !$refresh) {
3011 # Note for mod_perl: $IndexInit is reset for each query
3012 # Eventually consider some timestamp-solution to keep cache?
3013 return @IndexList;
3014 }
3015 if ((!$refresh) && (-f $IndexFile)) {
3016 ($status, $rawIndex) = &ReadFile($IndexFile);
3017 if ($status) {
3018 %IndexHash = split(/\s+/, $rawIndex);
3019 @IndexList = sort(keys %IndexHash);
3020 $IndexInit = 1;
3021 return @IndexList;
3022 }
3023 # If open fails just refresh the index
3024 }
3025 @IndexList = ();
3026 %IndexHash = ();
3027 @IndexList = &GenerateAllPagesList();
3028 foreach (@IndexList) {
3029 $IndexHash{$_} = 1;
3030 }
3031 $IndexInit = 1; # Initialized for this run of the script
3032 # Try to write out the list for future runs
3033 &RequestIndexLock() or return @IndexList;
3034 &WriteStringToFile($IndexFile, join(" ", %IndexHash));
3035 &ReleaseIndexLock();
3036 return @IndexList;
3037 }
3038
3039 sub CalcDay {
3040 my ($ts) = @_;
3041
3042 $ts += $TimeZoneOffset;
3043 my ($sec, $min, $hour, $mday, $mon, $year) = localtime($ts);
3044 if ($NumberDates) {
3045 return ($year + 1900) . '-' . ($mon+1) . '-' . $mday;
3046 }
3047 return ("January", "February", "March", "April", "May", "June",
3048 "July", "August", "September", "October", "November",
3049 "December")[$mon]. " " . $mday . ", " . ($year+1900);
3050 }
3051
3052 sub CalcTime {
3053 my ($ts) = @_;
3054 my ($ampm, $mytz);
3055
3056 $ts += $TimeZoneOffset;
3057 my ($sec, $min, $hour, $mday, $mon, $year) = localtime($ts);
3058 $mytz = "";
3059 if (($TimeZoneOffset == 0) && ($ScriptTZ ne "")) {
3060 $mytz = " " . $ScriptTZ;
3061 }
3062 $ampm = "";
3063 if ($UseAmPm) {
3064 $ampm = " am";
3065 if ($hour > 11) {
3066 $ampm = " pm";
3067 $hour = $hour - 12;
3068 }
3069 $hour = 12 if ($hour == 0);
3070 }
3071 $min = "0" . $min if ($min<10);
3072 return $hour . ":" . $min . $ampm . $mytz;
3073 }
3074
3075 sub TimeToText {
3076 my ($t) = @_;
3077
3078 return &CalcDay($t) . " " . &CalcTime($t);
3079 }
3080
3081 sub GetParam {
3082 my ($name, $default) = @_;
3083 my $result;
3084
3085 $result = $q->param($name);
3086 if (!defined($result)) {
3087 if (defined($UserData{$name})) {
3088 $result = $UserData{$name};
3089 } else {
3090 $result = $default;
3091 }
3092 }
3093 return $result;
3094 }
3095
3096 sub GetHiddenValue {
3097 my ($name, $value) = @_;
3098
3099 $q->param($name, $value);
3100 return $q->hidden($name);
3101 }
3102
3103 sub GetRemoteHost {
3104 my ($doMask) = @_;
3105 my ($rhost, $iaddr);
3106
3107 $rhost = $ENV{REMOTE_HOST};
3108 if ($UseLookup && ($rhost eq "")) {
3109 # Catch errors (including bad input) without aborting the script
3110 eval 'use Socket; $iaddr = inet_aton($ENV{REMOTE_ADDR});'
3111 . '$rhost = gethostbyaddr($iaddr, AF_INET)';
3112 }
3113 if ($rhost eq "") {
3114 $rhost = $ENV{REMOTE_ADDR};
3115 }
3116 $rhost = &GetMaskedHost($rhost) if ($doMask);
3117 return $rhost;
3118 }
3119
3120 sub FreeToNormal {
3121 my ($id) = @_;
3122
3123 $id =~ s/ /_/g;
3124 $id = ucfirst($id) if ($UpperFirst || $FreeUpper);
3125 if (index($id, '_') > -1) { # Quick check for any space/underscores
3126 $id =~ s/__+/_/g;
3127 $id =~ s/^_//;
3128 $id =~ s/_$//;
3129 if ($UseSubpage) {
3130 $id =~ s|_/|/|g;
3131 $id =~ s|/_|/|g;
3132 }
3133 }
3134 if ($FreeUpper) {
3135 # Note that letters after ' are *not* capitalized
3136 if ($id =~ m|[-_.,\(\)/][a-z]|) { # Quick check for non-canonical case
3137 $id =~ s|([-_.,\(\)/])([a-z])|$1 . uc($2)|ge;
3138 }
3139 }
3140 return $id;
3141 }
3142 #END_OF_BROWSE_CODE
3143
3144 # == Page-editing and other special-action code ========================
3145 $OtherCode = ""; # Comment next line to always compile (slower)
3146 #$OtherCode = <<'#END_OF_OTHER_CODE';
3147
3148 sub DoOtherRequest {
3149 my ($id, $action, $text, $search);
3150
3151 $action = &GetParam("action", "");
3152 $id = &GetParam("id", "");
3153 if ($action ne "") {
3154 $action = lc($action);
3155 if ($action eq "edit") {
3156 &DoEdit($id, 0, 0, "", 0) if &ValidIdOrDie($id);
3157 } elsif ($action eq "unlock") {
3158 &DoUnlock();
3159 } elsif ($action eq "index") {
3160 &DoIndex();
3161 } elsif ($action eq "links") {
3162 &DoLinks();
3163 } elsif ($action eq "maintain") {
3164 &DoMaintain();
3165 } elsif ($action eq "pagelock") {
3166 &DoPageLock();
3167 } elsif ($action eq "editlock") {
3168 &DoEditLock();
3169 } elsif ($action eq "editprefs") {
3170 &DoEditPrefs();
3171 } elsif ($action eq "editbanned") {
3172 &DoEditBanned();
3173 } elsif ($action eq "editlinks") {
3174 &DoEditLinks();
3175 } elsif ($action eq "login") {
3176 &DoEnterLogin();
3177 } elsif ($action eq "newlogin") {
3178 $UserID = 0;
3179 &DoEditPrefs(); # Also creates new ID
3180 } elsif ($action eq "version") {
3181 &DoShowVersion();
3182 } elsif ($action eq "rss") {
3183 &DoRss();
3184 } elsif ($action eq "delete") {
3185 &DoDeletePage($id);
3186 } elsif ($UseUpload && ($action eq "upload")) {
3187 &DoUpload();
3188 } elsif ($action eq "maintainrc") {
3189 &DoMaintainRc();
3190 } elsif ($action eq "convert") {
3191 &DoConvert();
3192 } elsif ($action eq "trimusers") {
3193 &DoTrimUsers();
3194 } else {
3195 &ReportError(Ts('Invalid action parameter %s', $action));
3196 }
3197 return;
3198 }
3199 if (&GetParam("edit_prefs", 0)) {
3200 &DoUpdatePrefs();
3201 return;
3202 }
3203 if (&GetParam("edit_ban", 0)) {
3204 &DoUpdateBanned();
3205 return;
3206 }
3207 if (&GetParam("enter_login", 0)) {
3208 &DoLogin();
3209 return;
3210 }
3211 if (&GetParam("edit_links", 0)) {
3212 &DoUpdateLinks();
3213 return;
3214 }
3215 if ($UseUpload && (&GetParam("upload", 0))) {
3216 &SaveUpload();
3217 return;
3218 }
3219 $search = &GetParam("search", "");
3220 if (($search ne "") || (&GetParam("dosearch", "") ne "")) {
3221 &DoSearch($search);
3222 return;
3223 } else {
3224 $search = &GetParam("back","");
3225 if ($search ne "") {
3226 &DoBackLinks($search);
3227 return;
3228 }
3229 }
3230 # Handle posted pages
3231 if (&GetParam("oldtime", "") ne "") {
3232 $id = &GetParam("title", "");
3233 &DoPost() if &ValidIdOrDie($id);
3234 return;
3235 }
3236 &ReportError(T('Invalid URL.'));
3237 }
3238
3239 sub DoEdit {
3240 my ($id, $isConflict, $oldTime, $newText, $preview) = @_;
3241 my ($header, $editRows, $editCols, $userName, $revision, $oldText);
3242 my ($summary, $isEdit, $pageTime);
3243
3244 if ($FreeLinks) {
3245 $id = &FreeToNormal($id); # Take care of users like Markus Lude :-)
3246 }
3247 if (!&UserCanEdit($id, 1)) {
3248 print &GetHeader('', T('Editing Denied'), '');
3249 if (&UserIsBanned()) {
3250 print T('Editing not allowed: user, ip, or network is blocked.');
3251 print "<p>";
3252 print T('Contact the wiki administrator for more information.');
3253 } else {
3254 print Ts('Editing not allowed: %s is read-only.', $SiteName);
3255 }
3256 print &GetCommonFooter();
3257 return;
3258 }
3259 # Consider sending a new user-ID cookie if user does not have one
3260 &OpenPage($id);
3261 &OpenDefaultText();
3262 $pageTime = $Section{'ts'};
3263 $header = Ts('Editing %s', $id);
3264 # Old revision handling
3265 $revision = &GetParam('revision', '');
3266 $revision =~ s/\D//g; # Remove non-numeric chars
3267 if ($revision ne '') {
3268 &OpenKeptRevisions('text_default');
3269 if (!defined($KeptRevisions{$revision})) {
3270 $revision = '';
3271 # Consider better solution like error message?
3272 } else {
3273 &OpenKeptRevision($revision);
3274 $header = Ts('Editing revision %s of ', $revision ) . $id;
3275 }
3276 }
3277 $oldText = $Text{'text'};
3278 if ($preview && !$isConflict) {
3279 $oldText = $newText;
3280 }
3281 $editRows = &GetParam("editrows", 20);
3282 $editCols = &GetParam("editcols", 65);
3283 print &GetHeader($id, &QuoteHtml($header), '');
3284 if ($revision ne '') {
3285 print "\n<b>"
3286 . Ts('Editing old revision %s.', $revision) . " "
3287 . T('Saving this page will replace the latest revision with this text.')
3288 . '</b><br>'
3289 }
3290 if ($isConflict) {
3291 $editRows -= 10 if ($editRows > 19);
3292 print "\n<H1>" . T('Edit Conflict!') . "</H1>\n";
3293 if ($isConflict>1) {
3294 # The main purpose of a new warning is to display more text
3295 # and move the save button down from its old location.
3296 print "\n<H2>" . T('(This is a new conflict)') . "</H2>\n";
3297 }
3298 print "<p><strong>",
3299 T('Someone saved this page after you started editing.'), " ",
3300 T('The top textbox contains the saved text.'), " ",
3301 T('Only the text in the top textbox will be saved.'),
3302 "</strong><br>\n",
3303 T('Scroll down to see your edited text.'), "<br>\n";
3304 print T('Last save time:'), ' ', &TimeToText($oldTime),
3305 " (", T('Current time is:'), ' ', &TimeToText($Now), ")<br>\n";
3306 }
3307 print &GetFormStart();
3308 print &GetHiddenValue("title", $id), "\n",
3309 &GetHiddenValue("oldtime", $pageTime), "\n",
3310 &GetHiddenValue("oldconflict", $isConflict), "\n";
3311 if ($revision ne "") {
3312 print &GetHiddenValue("revision", $revision), "\n";
3313 }
3314 print &GetTextArea('text', $oldText, $editRows, $editCols);
3315 $summary = &GetParam("summary", "*");
3316 print "<p>", T('Summary:'),
3317 $q->textfield(-name=>'summary',
3318 -default=>$summary, -override=>1,
3319 -size=>60, -maxlength=>200);
3320 if (&GetParam("recent_edit") eq "on") {
3321 print "<br>", $q->checkbox(-name=>'recent_edit', -checked=>1,
3322 -label=>T('This change is a minor edit.'));
3323 } else {
3324 print "<br>", $q->checkbox(-name=>'recent_edit',
3325 -label=>T('This change is a minor edit.'));
3326 }
3327 if ($EmailNotify) {
3328 print "&nbsp;&nbsp;&nbsp;" .
3329 $q->checkbox(-name=> 'do_email_notify',
3330 -label=>Ts('Send email notification that %s has been changed.', $id));
3331 }
3332 print "<br>";
3333 if ($EditNote ne '') {
3334 print T($EditNote) . '<br>'; # Allow translation
3335 }
3336 print $q->submit(-name=>'Save', -value=>T('Save')), "\n";
3337 $userName = &GetParam("username", "");
3338 if ($userName ne "") {
3339 print ' (', T('Your user name is'), ' ',
3340 &GetPageLink($userName) . ') ';
3341 } else {
3342 print ' (', Ts('Visit %s to set your user name.', &GetPrefsLink(), 1), ') ';
3343 }
3344 print $q->submit(-name=>'Preview', -value=>T('Preview')), "\n";
3345 if ($isConflict) {
3346 print "\n<br><hr><p><strong>", T('This is the text you submitted:'),
3347 "</strong><p>",
3348 &GetTextArea('newtext', $newText, $editRows, $editCols),
3349 "<p>\n";
3350 }
3351 if ($preview) {
3352 print '<div class=wikipreview>';
3353 print "<hr class=wikilinepreview>\n";
3354 print "<h2>", T('Preview:'), "</h2>\n";
3355 if ($isConflict) {
3356 print "<b>",
3357 T('NOTE: This preview shows the revision of the other author.'),
3358 "</b><hr>\n";
3359 }
3360 $MainPage = $id;
3361 $MainPage =~ s|/.*||; # Only the main page name (remove subpage)
3362 print &WikiToHTML($oldText) . "<hr class=wikilinepreview>\n";
3363 print "<h2>", T('Preview only, not yet saved'), "</h2>\n";
3364 print '</div>';
3365 }
3366 print $q->endform;
3367 if (!&GetParam('embed', $EmbedWiki)) {
3368 print '<div class=wikifooter>';
3369 print "<hr class=wikilinefooter>\n";
3370 print &GetHistoryLink($id, T('View other revisions')) . "<br>\n";
3371 print &GetGotoBar($id);
3372 print '</div>';
3373 }
3374 print &GetMinimumFooter();
3375 }
3376
3377 sub GetTextArea {
3378 my ($name, $text, $rows, $cols) = @_;
3379
3380 if (&GetParam("editwide", 1)) {
3381 return $q->textarea(-name=>$name, -default=>$text,
3382 -rows=>$rows, -columns=>$cols, -override=>1,
3383 -style=>'width:100%', -wrap=>'virtual');
3384 }
3385 return $q->textarea(-name=>$name, -default=>$text,
3386 -rows=>$rows, -columns=>$cols, -override=>1,
3387 -wrap=>'virtual');
3388 }
3389
3390 sub DoEditPrefs {
3391 my ($check, $recentName, %labels);
3392
3393 $recentName = $RCName;
3394 $recentName =~ s/_/ /g;
3395 &DoNewLogin() if ($UserID < 400);
3396 print &GetHeader('', T('Editing Preferences'), '');
3397 print '<div class=wikipref>';
3398 print &GetFormStart();
3399 print GetHiddenValue("edit_prefs", 1), "\n";
3400 print '<b>' . T('User Information:') . "</b>\n";
3401 print '<br>' . Ts('Your User ID number: %s', $UserID) . "\n";
3402 print '<br>' . T('UserName:') . ' ', &GetFormText('username', "", 20, 50);
3403 print ' ' . T('(blank to remove, or valid page name)');
3404 print '<br>' . T('Set Password:') . ' ',
3405 $q->password_field(-name=>'p_password', -value=>'*',
3406 -size=>15, -maxlength=>50),
3407 ' ', T('(blank to remove password)'), '<br>(',
3408 T('Passwords allow sharing preferences between multiple systems.'),
3409 ' ', T('Passwords are completely optional.'), ')';
3410 if (($AdminPass ne '') || ($EditPass ne '')) {
3411 print '<br>', T('Administrator Password:'), ' ',
3412 $q->password_field(-name=>'p_adminpw', -value=>'*',
3413 -size=>15, -maxlength=>50),
3414 ' ', T('(blank to remove password)'), '<br>',
3415 T('(Administrator passwords are used for special maintenance.)');
3416 }
3417 if ($EmailNotify) {
3418 print "<br>";
3419 print &GetFormCheck('notify', 1,
3420 T('Include this address in the site email list.')), ' ',
3421 T('(Uncheck the box to remove the address.)');
3422 print '<br>', T('Email Address:'), ' ',
3423 &GetFormText('email', "", 30, 60);
3424 }
3425 print "<hr class=wikilinepref><b>$recentName:</b>\n";
3426 print '<br>', T('Default days to display:'), ' ',
3427 &GetFormText('rcdays', $RcDefault, 4, 9);
3428 print "<br>", &GetFormCheck('rcnewtop', $RecentTop,
3429 T('Most recent changes on top'));
3430 print "<br>", &GetFormCheck('rcall', 0,
3431 T('Show all changes (not just most recent)'));
3432 %labels = (0=>T('Hide minor edits'), 1=>T('Show minor edits'),
3433 2=>T('Show only minor edits'));
3434 print '<br>', T('Minor edit display:'), ' ';
3435 print $q->popup_menu(-name=>'p_rcshowedit',
3436 -values=>[0,1,2], -labels=>\%labels,
3437 -default=>&GetParam("rcshowedit", $ShowEdits));
3438 print "<br>", &GetFormCheck('rcchangehist', 1,
3439 T('Use "changes" as link to history'));
3440 if ($UseDiff) {
3441 print '<hr class=wikilinepref><b>', T('Differences:'), "</b>\n";
3442 print "<br>", &GetFormCheck('diffrclink', 1,
3443 Ts('Show (diff) links on %s', $recentName));
3444 print "<br>", &GetFormCheck('alldiff', 0,
3445 T('Show differences on all pages'));
3446 print " (", &GetFormCheck('norcdiff', 1,
3447 Ts('No differences on %s', $recentName)), ")";
3448 %labels = (1=>T('Major'), 2=>T('Minor'), 3=>T('Author'));
3449 print '<br>', T('Default difference type:'), ' ';
3450 print $q->popup_menu(-name=>'p_defaultdiff',
3451 -values=>[1,2,3], -labels=>\%labels,
3452 -default=>&GetParam("defaultdiff", 1));
3453 }
3454 print '<hr class=wikilinepref><b>', T('Misc:'), "</b>\n";
3455 # Note: TZ offset is added by TimeToText, so pre-subtract to cancel.
3456 print '<br>', T('Server time:'), ' ', &TimeToText($Now-$TimeZoneOffset);
3457 print '<br>', T('Time Zone offset (hours):'), ' ',
3458 &GetFormText('tzoffset', 0, 4, 9);
3459 print '<br>', &GetFormCheck('editwide', 1,
3460 T('Use 100% wide edit area (if supported)'));
3461 print '<br>',
3462 T('Edit area rows:'), ' ', &GetFormText('editrows', 20, 4, 4),
3463 ' ', T('columns:'), ' ', &GetFormText('editcols', 65, 4, 4);
3464
3465 print '<br>', &GetFormCheck('toplinkbar', 1,
3466 T('Show link bar on top'));
3467 print '<br>', &GetFormCheck('linkrandom', 0,
3468 T('Add "Random Page" link to link bar'));
3469 print '<br>' . T('StyleSheet URL:') . ' ',
3470 &GetFormText('stylesheet', "", 30, 150);
3471 print '<br>', $q->submit(-name=>'Save', -value=>T('Save')), "\n";
3472 print $q->endform;
3473 print '</div>';
3474 if (!&GetParam('embed', $EmbedWiki)) {
3475 print '<div class=wikifooter>';
3476 print "<hr class=wikilinefooter>\n";
3477 print &GetGotoBar('');
3478 print '</div>';
3479 }
3480 print &GetMinimumFooter();
3481 }
3482
3483 sub GetFormText {
3484 my ($name, $default, $size, $max) = @_;
3485 my $text = &GetParam($name, $default);
3486
3487 return $q->textfield(-name=>"p_$name", -default=>$text,
3488 -override=>1, -size=>$size, -maxlength=>$max);
3489 }
3490
3491 sub GetFormCheck {
3492 my ($name, $default, $label) = @_;
3493 my $checked = (&GetParam($name, $default) > 0);
3494
3495 return $q->checkbox(-name=>"p_$name", -override=>1, -checked=>$checked,
3496 -label=>$label);
3497 }
3498
3499 sub DoUpdatePrefs {
3500 my ($username, $password, $stylesheet);
3501
3502 # All link bar settings should be updated before printing the header
3503 &UpdatePrefCheckbox("toplinkbar");
3504 &UpdatePrefCheckbox("linkrandom");
3505 print &GetHeader('', T('Saving Preferences'), '');
3506 print '<br>';
3507 if ($UserID < 1001) {
3508 print '<b>',
3509 Ts('Invalid UserID %s, preferences not saved.', $UserID), '</b>';
3510 if ($UserID == 111) {
3511 print '<br>',
3512 T('(Preferences require cookies, but no cookie was sent.)');
3513 }
3514 print &GetCommonFooter();
3515 return;
3516 }
3517 $username = &GetParam("p_username", "");
3518 if ($FreeLinks) {
3519 $username =~ s/^\[\[(.+)\]\]/$1/; # Remove [[ and ]] if added
3520 $username = &FreeToNormal($username);
3521 $username =~ s/_/ /g;
3522 }
3523 if ($username eq "") {
3524 print T('UserName removed.'), '<br>';
3525 undef $UserData{'username'};
3526 } elsif ((!$FreeLinks) && (!($username =~ /^$LinkPattern$/))) {
3527 print Ts('Invalid UserName %s: not saved.', $username), "<br>\n";
3528 } elsif ($FreeLinks && (!($username =~ /^$FreeLinkPattern$/))) {
3529 print Ts('Invalid UserName %s: not saved.', $username), "<br>\n";
3530 } elsif (length($username) > 50) { # Too long
3531 print T('UserName must be 50 characters or less. (not saved)'), "<br>\n";
3532 } else {
3533 print Ts('UserName %s saved.', $username), '<br>';
3534 $UserData{'username'} = $username;
3535 }
3536 $password = &GetParam("p_password", "");
3537 if ($password eq "") {
3538 print T('Password removed.'), '<br>';
3539 undef $UserData{'password'};
3540 } elsif ($password ne "*") {
3541 print T('Password changed.'), '<br>';
3542 $UserData{'password'} = $password;
3543 }
3544 if (($AdminPass ne "") || ($EditPass ne "")) {
3545 $password = &GetParam("p_adminpw", "");
3546 if ($password eq "") {
3547 print T('Administrator password removed.'), '<br>';
3548 undef $UserData{'adminpw'};
3549 } elsif ($password ne "*") {
3550 print T('Administrator password changed.'), '<br>';
3551 $UserData{'adminpw'} = $password;
3552 if (&UserIsAdmin()) {
3553 print T('User has administrative abilities.'), '<br>';
3554 } elsif (&UserIsEditor()) {
3555 print T('User has editor abilities.'), '<br>';
3556 } else {
3557 print T('User does not have administrative abilities.'), ' ',
3558 T('(Password does not match administrative password(s).)'),
3559 '<br>';
3560 }
3561 }
3562 }
3563 if ($EmailNotify) {
3564 &UpdatePrefCheckbox("notify");
3565 &UpdateEmailList();
3566 }
3567 &UpdatePrefNumber("rcdays", 0, 0, 999999);
3568 &UpdatePrefCheckbox("rcnewtop");
3569 &UpdatePrefCheckbox("rcall");
3570 &UpdatePrefCheckbox("rcchangehist");
3571 &UpdatePrefCheckbox("editwide");
3572 if ($UseDiff) {
3573 &UpdatePrefCheckbox("norcdiff");
3574 &UpdatePrefCheckbox("diffrclink");
3575 &UpdatePrefCheckbox("alldiff");
3576 &UpdatePrefNumber("defaultdiff", 1, 1, 3);
3577 }
3578 &UpdatePrefNumber("rcshowedit", 1, 0, 2);
3579 &UpdatePrefNumber("tzoffset", 0, -999, 999);
3580 &UpdatePrefNumber("editrows", 1, 1, 999);
3581 &UpdatePrefNumber("editcols", 1, 1, 999);
3582 print T('Server time:'), ' ', &TimeToText($Now-$TimeZoneOffset), '<br>';
3583 $TimeZoneOffset = &GetParam("tzoffset", 0) * (60 * 60);
3584 print T('Local time:'), ' ', &TimeToText($Now), '<br>';
3585 $stylesheet = &GetParam('p_stylesheet', '');
3586 if ($stylesheet eq '') {
3587 if (&GetParam('stylesheet', '') ne '') {
3588 print T('StyleSheet URL removed.'), '<br>';
3589 }
3590 undef $UserData{'stylesheet'};
3591 } else {
3592 $stylesheet =~ s/[">]//g; # Remove characters that would cause problems
3593 $UserData{'stylesheet'} = $stylesheet;
3594 print T('StyleSheet setting saved.'), '<br>';
3595 }
3596 &SaveUserData();
3597 print '<b>', T('Preferences saved.'), '</b>';
3598 print &GetCommonFooter();
3599 }
3600
3601 # add or remove email address from preferences to $EmailFile
3602 sub UpdateEmailList {
3603 my (@old_emails);
3604
3605 local $/ = "\n"; # don't slurp whole files in this sub.
3606 if (my $new_email = $UserData{'email'} = &GetParam("p_email", "")) {
3607 my $notify = $UserData{'notify'};
3608 if (-f $EmailFile) {
3609 open(NOTIFY, $EmailFile)
3610 or die(Ts('Could not read from %s:', $EmailFile) . " $!\n");
3611 @old_emails = <NOTIFY>;
3612 close(NOTIFY);
3613 } else {
3614 @old_emails = ();
3615 }
3616 my $already_in_list = grep /$new_email/, @old_emails;
3617 if ($notify and (not $already_in_list)) {
3618 &RequestLock() or die(T('Could not get mail lock'));
3619 if (!open(NOTIFY, ">>$EmailFile")) {
3620 &ReleaseLock(); # Don't leave hangling locks
3621 die(Ts('Could not append to %s:', $EmailFile) . " $!\n");
3622 }
3623 print NOTIFY $new_email, "\n";
3624 close(NOTIFY);
3625 &ReleaseLock();
3626 }
3627 elsif ((not $notify) and $already_in_list) {
3628 &RequestLock() or die(T('Could not get mail lock'));
3629 if (!open(NOTIFY, ">$EmailFile")) {
3630 &ReleaseLock();
3631 die(Ts('Could not overwrite %s:', "$EmailFile") . " $!\n");
3632 }
3633 foreach (@old_emails) {
3634 print NOTIFY "$_" unless /$new_email/;
3635 }
3636 close(NOTIFY);
3637 &ReleaseLock();
3638 }
3639 }
3640 }
3641
3642 sub UpdatePrefCheckbox {
3643 my ($param) = @_;
3644 my $temp = &GetParam("p_$param", "*");
3645
3646 $UserData{$param} = 1 if ($temp eq "on");
3647 $UserData{$param} = 0 if ($temp eq "*");
3648 # It is possible to skip updating by using another value, like "2"
3649 }
3650
3651 sub UpdatePrefNumber {
3652 my ($param, $integer, $min, $max) = @_;
3653 my $temp = &GetParam("p_$param", "*");
3654
3655 return if ($temp eq "*");
3656 $temp =~ s/[^-\d\.]//g;
3657 $temp =~ s/\..*// if ($integer);
3658 return if ($temp eq "");
3659 return if (($temp < $min) || ($temp > $max));
3660 $UserData{$param} = $temp;
3661 }
3662
3663 sub DoIndex {
3664 print &GetHeader('', T('Index of all pages'), '');
3665 print '<br>';
3666 &PrintPageList(&AllPagesList());
3667 print &GetCommonFooter();
3668 }
3669
3670 # Create a new user file/cookie pair
3671 sub DoNewLogin {
3672 # Consider warning if cookie already exists
3673 # (maybe use "replace=1" parameter)
3674 &CreateUserDir();
3675 $SetCookie{'id'} = &GetNewUserId();
3676 $SetCookie{'randkey'} = int(rand(1000000000));
3677 $SetCookie{'rev'} = 1;
3678 %UserCookie = %SetCookie;
3679 $UserID = $SetCookie{'id'};
3680 # The cookie will be transmitted in the next header
3681 %UserData = %UserCookie;
3682 $UserData{'createtime'} = $Now;
3683 $UserData{'createip'} = $ENV{REMOTE_ADDR};
3684 &SaveUserData();
3685 }
3686
3687 sub DoEnterLogin {
3688 print &GetHeader('', T('Login'), "");
3689 print &GetFormStart();
3690 print &GetHiddenValue('enter_login', 1), "\n";
3691 print '<br>', T('User ID number:'), ' ',
3692 $q->textfield(-name=>'p_userid', -value=>'',
3693 -size=>15, -maxlength=>50);
3694 print '<br>', T('Password:'), ' ',
3695 $q->password_field(-name=>'p_password', -value=>'',
3696 -size=>15, -maxlength=>50);
3697 print '<br>', $q->submit(-name=>'Login', -value=>T('Login')), "\n";
3698 print $q->endform;
3699 if (!&GetParam('embed', $EmbedWiki)) {
3700 print '<div class=wikifooter>';
3701 print "<hr class=wikilinefooter>\n";
3702 print &GetGotoBar('');
3703 print '</div>';
3704 }
3705 print &GetMinimumFooter();
3706 }
3707
3708 sub DoLogin {
3709 my ($uid, $password, $success);
3710
3711 $success = 0;
3712 $uid = &GetParam("p_userid", "");
3713 $uid =~ s/\D//g;
3714 $password = &GetParam("p_password", "");
3715 if (($uid > 199) && ($password ne "") && ($password ne "*")) {
3716 $UserID = $uid;
3717 &LoadUserData();
3718 if ($UserID > 199) {
3719 if (defined($UserData{'password'}) &&
3720 ($UserData{'password'} eq $password)) {
3721 $SetCookie{'id'} = $uid;
3722 $SetCookie{'randkey'} = $UserData{'randkey'};
3723 $SetCookie{'rev'} = 1;
3724 $success = 1;
3725 }
3726 }
3727 }
3728 print &GetHeader('', T('Login Results'), '');
3729 if ($success) {
3730 print Ts('Login for user ID %s complete.', $uid);
3731 } else {
3732 print Ts('Login for user ID %s failed.', $uid);
3733 }
3734 if (!&GetParam('embed', $EmbedWiki)) {
3735 print '<div class=wikifooter>';
3736 print "<hr class=wikilinefooter>\n";
3737 print &GetGotoBar('');
3738 print '</div>';
3739 }
3740 print &GetMinimumFooter();
3741 }
3742
3743 sub GetNewUserId {
3744 my ($id);
3745
3746 $id = $StartUID;
3747 while (-f &UserDataFilename($id+1000)) {
3748 $id += 1000;
3749 }
3750 while (-f &UserDataFilename($id+100)) {
3751 $id += 100;
3752 }
3753 while (-f &UserDataFilename($id+10)) {
3754 $id += 10;
3755 }
3756 &RequestLock() or die(T('Could not get user-ID lock'));
3757 while (-f &UserDataFilename($id)) {
3758 $id++;
3759 }
3760 &WriteStringToFile(&UserDataFilename($id), "lock"); # reserve the ID
3761 &ReleaseLock();
3762 return $id;
3763 }
3764
3765 # Consider user-level lock?
3766 sub SaveUserData {
3767 my ($userFile, $data);
3768
3769 &CreateUserDir();
3770 $userFile = &UserDataFilename($UserID);
3771 $data = join($FS1, %UserData);
3772 &WriteStringToFile($userFile, $data);
3773 }
3774
3775 sub CreateUserDir {
3776 my ($n, $subdir);
3777
3778 if (!(-d "$UserDir/0")) {
3779 &CreateDir($UserDir);
3780
3781 foreach $n (0..9) {
3782 $subdir = "$UserDir/$n";
3783 &CreateDir($subdir);
3784 }
3785 }
3786 }
3787
3788 sub DoSearch {
3789 my ($string) = @_;
3790
3791 if ($string eq '') {
3792 &DoIndex();
3793 return;
3794 }
3795 print &GetHeader('', &QuoteHtml(Ts('Search for: %s', $string)), '');
3796 print '<br>';
3797 &PrintPageList(&SearchTitleAndBody($string));
3798 print &GetCommonFooter();
3799 }
3800
3801 sub DoBackLinks {
3802 my ($string) = @_;
3803
3804 print &GetHeader('', &QuoteHtml(Ts('Backlinks for: %s', $string)), '');
3805 print '<br>';
3806 # At this time the backlinks are mostly a renamed search.
3807 # An initial attempt to match links only failed on subpages and free links.
3808 # Escape some possibly problematic characters:
3809 $string =~ s/([-'().,])/\\$1/g;
3810 &PrintPageList(&SearchTitleAndBody($string));
3811 print &GetCommonFooter();
3812 }
3813
3814 sub PrintPageList {
3815 my $pagename;
3816
3817 print "<h2>", Ts('%s pages found:', ($#_ + 1)), "</h2>\n";
3818 foreach $pagename (@_) {
3819 print ".... " if ($pagename =~ m|/|);
3820 print &GetPageLink($pagename), "<br>\n";
3821 }
3822 }
3823
3824 sub DoLinks {
3825 print &GetHeader('', &QuoteHtml(T('Full Link List')), '');
3826 print "<hr><pre>\n\n\n\n\n"; # Extra lines to get below the logo
3827 &PrintLinkList(&GetFullLinkList());
3828 print "</pre>\n";
3829 print &GetCommonFooter();
3830 }
3831
3832 sub PrintLinkList {
3833 my ($pagelines, $page, $names, $editlink);
3834 my ($link, $extra, @links, %pgExists);
3835
3836 %pgExists = ();
3837 foreach $page (&AllPagesList()) {
3838 $pgExists{$page} = 1;
3839 }
3840 $names = &GetParam("names", 1);
3841 $editlink = &GetParam("editlink", 0);
3842 foreach $pagelines (@_) {
3843 @links = ();
3844 foreach $page (split(' ', $pagelines)) {
3845 if ($page =~ /\:/) { # URL or InterWiki form
3846 if ($page =~ /$UrlPattern/) {
3847 ($link, $extra) = &UrlLink($page, 0); # No images
3848 } else {
3849 ($link, $extra) = &InterPageLink($page, 0); # No images
3850 }
3851 } else {
3852 if ($pgExists{$page}) {
3853 $link = &GetPageLink($page);
3854 } else {
3855 $link = $page;
3856 if ($editlink) {
3857 $link .= &GetEditLink($page, "?");
3858 }
3859 }
3860 }
3861 push(@links, $link);
3862 }
3863 if (!$names) {
3864 shift(@links);
3865 }
3866 print join(' ', @links), "\n";
3867 }
3868 }
3869
3870 sub GetFullLinkList {
3871 my ($name, $unique, $sort, $exists, $empty, $link, $search);
3872 my ($pagelink, $interlink, $urllink);
3873 my (@found, @links, @newlinks, @pglist, %pgExists, %seen, $main);
3874
3875 $unique = &GetParam("unique", 1);
3876 $sort = &GetParam("sort", 1);
3877 $pagelink = &GetParam("page", 1);
3878 $interlink = &GetParam("inter", 0);
3879 $urllink = &GetParam("url", 0);
3880 $exists = &GetParam("exists", 2);
3881 $empty = &GetParam("empty", 0);
3882 $search = &GetParam("search", "");
3883 if (($interlink == 2) || ($urllink == 2)) {
3884 $pagelink = 0;
3885 }
3886 %pgExists = ();
3887 @pglist = &AllPagesList();
3888 foreach $name (@pglist) {
3889 $pgExists{$name} = 1;
3890 }
3891 %seen = ();
3892 foreach $name (@pglist) {
3893 @newlinks = ();
3894 if ($unique != 2) {
3895 %seen = ();
3896 }
3897 @links = &GetPageLinks($name, $pagelink, $interlink, $urllink);
3898 if ($UseSubpage) {
3899 $main = $name;
3900 $main =~ s/\/.*//;
3901 }
3902 foreach $link (@links) {
3903 if ($UseSubpage && ($link =~ /^\//)) {
3904 $link = $main . $link;
3905 }
3906 $seen{$link}++;
3907 if (($unique > 0) && ($seen{$link} != 1)) {
3908 next;
3909 }
3910 if (($exists == 0) && ($pgExists{$link} == 1)) {
3911 next;
3912 }
3913 if (($exists == 1) && ($pgExists{$link} != 1)) {
3914 next;
3915 }
3916 if (($search ne "") && !($link =~ /$search/)) {
3917 next;
3918 }
3919 push(@newlinks, $link);
3920 }
3921 @links = @newlinks;
3922 if ($sort) {
3923 @links = sort(@links);
3924 }
3925 unshift (@links, $name);
3926 if ($empty || ($#links > 0)) { # If only one item, list is empty.
3927 push(@found, join(' ', @links));
3928 }
3929 }
3930 return @found;
3931 }
3932
3933 sub GetPageLinks {
3934 my ($name, $pagelink, $interlink, $urllink) = @_;
3935 my ($text, @links);
3936
3937 @links = ();
3938 &OpenPage($name);
3939 &OpenDefaultText();
3940 $text = $Text{'text'};
3941 $text =~ s/<html>((.|\n)*?)<\/html>/ /ig;
3942 $text =~ s/<nowiki>(.|\n)*?\<\/nowiki>/ /ig;
3943 $text =~ s/<pre>(.|\n)*?\<\/pre>/ /ig;
3944 $text =~ s/<code>(.|\n)*?\<\/code>/ /ig;
3945 if ($interlink) {
3946 $text =~ s/''+/ /g; # Quotes can adjacent to inter-site links
3947 $text =~ s/$InterLinkPattern/push(@links, &StripUrlPunct($1)), ' '/ge;
3948 } else {
3949 $text =~ s/$InterLinkPattern/ /g;
3950 }
3951 if ($urllink) {
3952 $text =~ s/''+/ /g; # Quotes can adjacent to URLs
3953 $text =~ s/$UrlPattern/push(@links, &StripUrlPunct($1)), ' '/ge;
3954 } else {
3955 $text =~ s/$UrlPattern/ /g;
3956 }
3957 if ($pagelink) {
3958 if ($FreeLinks) {
3959 my $fl = $FreeLinkPattern;
3960 $text =~ s/\[\[$fl\|[^\]]+\]\]/push(@links, &FreeToNormal($1)), ' '/ge;
3961 $text =~ s/\[\[$fl\]\]/push(@links, &FreeToNormal($1)), ' '/ge;
3962 }
3963 if ($WikiLinks) {
3964 $text =~ s/$LinkPattern/push(@links, &StripUrlPunct($1)), ' '/ge;
3965 }
3966 }
3967 return @links;
3968 }
3969
3970 sub DoPost {
3971 my ($editDiff, $old, $newAuthor, $pgtime, $oldrev, $preview, $user);
3972 my $string = &GetParam("text", undef);
3973 my $id = &GetParam("title", "");
3974 my $summary = &GetParam("summary", "");
3975 my $oldtime = &GetParam("oldtime", "");
3976 my $oldconflict = &GetParam("oldconflict", "");
3977 my $isEdit = 0;
3978 my $editTime = $Now;
3979 my $authorAddr = $ENV{REMOTE_ADDR};
3980
3981 if ($FreeLinks) {
3982 $id = &FreeToNormal($id);
3983 }
3984 if (!&UserCanEdit($id, 1)) {
3985 # This is an internal interface--we don't need to explain
3986 &ReportError(Ts('Editing not allowed for %s.', $id));
3987 return;
3988 }
3989 if (($id eq 'SampleUndefinedPage') ||
3990 ($id eq T('SampleUndefinedPage')) ||
3991 ($id eq 'Sample_Undefined_Page') ||
3992 ($id eq T('Sample_Undefined_Page'))) {
3993 &ReportError(Ts('%s cannot be defined.', $id));
3994 return;
3995 }
3996 $string = &RemoveFS($string);
3997 $summary = &RemoveFS($summary);
3998 $summary =~ s/[\r\n]//g;
3999 if (length($summary) > 300) { # Too long (longer than form allows)
4000 $summary = substr($summary, 0, 300);
4001 }
4002 # Add a newline to the end of the string (if it doesn't have one)
4003 $string .= "\n" if (!($string =~ /\n$/));
4004 # Lock before getting old page to prevent races
4005 # Consider extracting lock section into sub, and eval-wrap it?
4006 # (A few called routines can die, leaving locks.)
4007 if ($LockCrash) {
4008 &RequestLock() or die(T('Could not get editing lock'));
4009 } else {
4010 if (!&RequestLock()) {
4011 &ForceReleaseLock('main');
4012 }
4013 # Clear all other locks.
4014 &ForceReleaseLock('cache');
4015 &ForceReleaseLock('diff');
4016 &ForceReleaseLock('index');
4017 }
4018 &OpenPage($id);
4019 &OpenDefaultText();
4020 $old = $Text{'text'};
4021 $oldrev = $Section{'revision'};
4022 $pgtime = $Section{'ts'};
4023 $preview = 0;
4024 $preview = 1 if (&GetParam("Preview", "") ne "");
4025 if (!$preview && ($old eq $string)) { # No changes (ok for preview)
4026 &ReleaseLock();
4027 &ReBrowsePage($id, "", 1);
4028 return;
4029 }
4030 if (($UserID > 399) || ($Section{'id'} > 399)) {
4031 $newAuthor = ($UserID ne $Section{'id'}); # known user(s)
4032 } else {
4033 $newAuthor = ($Section{'ip'} ne $authorAddr); # hostname fallback
4034 }
4035 $newAuthor = 1 if ($oldrev == 0); # New page
4036 $newAuthor = 0 if (!$newAuthor); # Standard flag form, not empty
4037 # Detect editing conflicts and resubmit edit
4038 if (($oldrev > 0) && ($newAuthor && ($oldtime != $pgtime))) {
4039 &ReleaseLock();
4040 if ($oldconflict > 0) { # Conflict again...
4041 &DoEdit($id, 2, $pgtime, $string, $preview);
4042 } else {
4043 &DoEdit($id, 1, $pgtime, $string, $preview);
4044 }
4045 return;
4046 }
4047 if ($preview) {
4048 &ReleaseLock();
4049 &DoEdit($id, 0, $pgtime, $string, 1);
4050 return;
4051 }
4052 $user = &GetParam("username", "");
4053 # If the person doing editing chooses, send out email notification
4054 if ($EmailNotify) {
4055 &EmailNotify($id, $user) if &GetParam("do_email_notify", "") eq 'on';
4056 }
4057 if (&GetParam("recent_edit", "") eq 'on') {
4058 $isEdit = 1;
4059 }
4060 if (!$isEdit) {
4061 &SetPageCache('oldmajor', $Section{'revision'});
4062 }
4063 if ($newAuthor) {
4064 &SetPageCache('oldauthor', $Section{'revision'});
4065 }
4066 &SaveKeepSection();
4067 &ExpireKeepFile();
4068 if ($UseDiff) {
4069 &UpdateDiffs($id, $editTime, $old, $string, $isEdit, $newAuthor);
4070 }
4071 $Text{'text'} = $string;
4072 $Text{'minor'} = $isEdit;
4073 $Text{'newauthor'} = $newAuthor;
4074 $Text{'summary'} = $summary;
4075 $Section{'host'} = &GetRemoteHost(1);
4076 &SaveDefaultText();
4077 &SavePage();
4078 &WriteRcLog($id, $summary, $isEdit, $editTime, $Section{'revision'},
4079 $user, $Section{'host'});
4080 if ($UseCache) {
4081 &UnlinkHtmlCache($id); # Old cached copy is invalid
4082 if ($Page{'revision'} < 2) { # If this is a new page...
4083 &NewPageCacheClear($id); # ...uncache pages linked to this one.
4084 }
4085 }
4086 if ($UseIndex && ($Page{'revision'} == 1)) {
4087 unlink($IndexFile); # Regenerate index on next request
4088 }
4089 &ReleaseLock();
4090 &ReBrowsePage($id, "", 1);
4091 }
4092
4093 sub UpdateDiffs {
4094 my ($id, $editTime, $old, $new, $isEdit, $newAuthor) = @_;
4095 my ($editDiff, $oldMajor, $oldAuthor);
4096
4097 $editDiff = &GetDiff($old, $new, 0); # 0 = already in lock
4098 $oldMajor = &GetPageCache('oldmajor');
4099 $oldAuthor = &GetPageCache('oldauthor');
4100 if ($UseDiffLog) {
4101 &WriteDiff($id, $editTime, $editDiff);
4102 }
4103 &SetPageCache('diff_default_minor', $editDiff);
4104 if ($isEdit || !$newAuthor) {
4105 &OpenKeptRevisions('text_default');
4106 }
4107 if (!$isEdit) {
4108 &SetPageCache('diff_default_major', "1");
4109 } else {
4110 &SetPageCache('diff_default_major', &GetKeptDiff($new, $oldMajor, 0));
4111 }
4112 if ($newAuthor) {
4113 &SetPageCache('diff_default_author', "1");
4114 } elsif ($oldMajor == $oldAuthor) {
4115 &SetPageCache('diff_default_author', "2");
4116 } else {
4117 &SetPageCache('diff_default_author', &GetKeptDiff($new, $oldAuthor, 0));
4118 }
4119 }
4120
4121 # Translation note: the email messages are still sent in English
4122 # Send an email message.
4123 sub SendEmail {
4124 my ($to, $from, $reply, $subject, $message) = @_;
4125
4126 # sendmail options:
4127 # -odq : send mail to queue (i.e. later when convenient)
4128 # -oi : do not wait for "." line to exit
4129 # -t : headers determine recipient.
4130 open (SENDMAIL, "| $SendMail -oi -t ") or die "Can't send email: $!\n";
4131 print SENDMAIL <<"EOF";
4132 From: $from
4133 To: $to
4134 Reply-to: $reply
4135 Subject: $subject\n
4136 $message
4137 EOF
4138 close(SENDMAIL) or warn "sendmail didn't close nicely";
4139 }
4140
4141 ## Email folks who want to know a note that a page has been modified. - JimM.
4142 sub EmailNotify {
4143 local $/ = "\n"; # don't slurp whole files in this sub.
4144
4145 if ($EmailNotify) {
4146 my ($id, $user) = @_;
4147 if ($user) {
4148 $user = " by $user";
4149 }
4150 my $address;
4151 return if (!-f $EmailFile); # No notifications yet
4152 open(EMAIL, $EmailFile)
4153 or die "Can't open $EmailFile: $!\n";
4154 $address = join ",", <EMAIL>;
4155 $address =~ s/\n//g;
4156 close(EMAIL);
4157 my $home_url = $q->url();
4158 my $page_url = $home_url . &ScriptLinkChar() . &UriEscape($id);
4159 my $pref_url = $home_url . &ScriptLinkChar() . "action=editprefs";
4160 my $editors_summary = $q->param("summary");
4161 if (($editors_summary eq "*") or ($editors_summary eq "")){
4162 $editors_summary = "";
4163 }
4164 else {
4165 $editors_summary = "\n Summary: $editors_summary";
4166 }
4167 my $content = <<"END_MAIL_CONTENT";
4168
4169 The $SiteName page $id at
4170 $page_url
4171 has been changed$user to revision $Page{revision}. $editors_summary
4172
4173 (Replying to this notification will
4174 send email to the entire mailing list,
4175 so only do that if you mean to.
4176
4177 To remove yourself from this list, visit
4178 $pref_url .)
4179 END_MAIL_CONTENT
4180 my $subject = "The $id page at $SiteName has been changed.";
4181 # I'm setting the "reply-to" field to be the same as the "to:" field
4182 # which seems appropriate for a mailing list, especially since the
4183 # $EmailFrom string needn't be a real email address.
4184 &SendEmail($address, $EmailFrom, $address, $subject, $content);
4185 }
4186 }
4187
4188 sub SearchTitleAndBody {
4189 my ($string) = @_;
4190 my ($name, $freeName, @found);
4191
4192 foreach $name (&AllPagesList()) {
4193 &OpenPage($name);
4194 &OpenDefaultText();
4195 if (($Text{'text'} =~ /$string/i) || ($name =~ /$string/i)) {
4196 push(@found, $name);
4197 } elsif ($FreeLinks) {
4198 if ($name =~ m/_/) {
4199 $freeName = $name;
4200 $freeName =~ s/_/ /g;
4201 if ($freeName =~ /$string/i) {
4202 push(@found, $name);
4203 }
4204 } elsif ($string =~ m/ /) {
4205 $freeName = $string;
4206 $freeName =~ s/ /_/g;
4207 if ($Text{'text'} =~ /$freeName/i) {
4208 push(@found, $name);
4209 }
4210 }
4211 }
4212 }
4213 return @found;
4214 }
4215
4216 sub SearchBody {
4217 my ($string) = @_;
4218 my ($name, @found);
4219
4220 foreach $name (&AllPagesList()) {
4221 &OpenPage($name);
4222 &OpenDefaultText();
4223 if ($Text{'text'} =~ /$string/i){
4224 push(@found, $name);
4225 }
4226 }
4227 return @found;
4228 }
4229
4230 sub UnlinkHtmlCache {
4231 my ($id) = @_;
4232 my $idFile;
4233
4234 $idFile = &GetHtmlCacheFile($id);
4235 if (-f $idFile) {
4236 unlink($idFile);
4237 }
4238 }
4239
4240 sub NewPageCacheClear {
4241 my ($id) = @_;
4242 my $name;
4243
4244 return if (!$UseCache);
4245 $id =~ s|.+/|/|; # If subpage, search for just the subpage
4246 # The following code used to search the body for the $id
4247 foreach $name (&AllPagesList()) { # Remove all to be safe
4248 &UnlinkHtmlCache($name);
4249 }
4250 }
4251
4252 # Note: all diff and recent-list operations should be done within locks.
4253 sub DoUnlock {
4254 my $LockMessage = T('Normal Unlock.');
4255
4256 print &GetHeader('', T('Removing edit lock'), '');
4257 print '<p>', T('This operation may take several seconds...'), "\n";
4258 if (&ForceReleaseLock('main')) {
4259 $LockMessage = T('Forced Unlock.');
4260 }
4261 &ForceReleaseLock('cache');
4262 &ForceReleaseLock('diff');
4263 &ForceReleaseLock('index');
4264 print "<br><h2>$LockMessage</h2>";
4265 print &GetCommonFooter();
4266 }
4267
4268 # Note: all diff and recent-list operations should be done within locks.
4269 sub WriteRcLog {
4270 my ($id, $summary, $isEdit, $editTime, $revision, $name, $rhost) = @_;
4271 my ($extraTemp, %extra);
4272
4273 %extra = ();
4274 $extra{'id'} = $UserID if ($UserID > 0);
4275 $extra{'name'} = $name if ($name ne "");
4276 $extra{'revision'} = $revision if ($revision ne "");
4277 $extraTemp = join($FS2, %extra);
4278 # The two fields at the end of a line are kind and extension-hash
4279 my $rc_line = join($FS3, $editTime, $id, $summary,
4280 $isEdit, $rhost, "0", $extraTemp);
4281 if (!open(OUT, ">>$RcFile")) {
4282 die(Ts('%s log error:', $RCName) . " $!");
4283 }
4284 print OUT $rc_line . "\n";
4285 close(OUT);
4286 }
4287
4288 sub WriteDiff {
4289 my ($id, $editTime, $diffString) = @_;
4290
4291 open (OUT, ">>$DataDir/diff_log") or die(T('can not write diff_log'));
4292 print OUT "------\n" . $id . "|" . $editTime . "\n";
4293 print OUT $diffString;
4294 close(OUT);
4295 }
4296
4297 # Actions are vetoable if someone edits the page before
4298 # the keep expiry time. For example, page deletion. If
4299 # no one edits the page by the time the keep expiry time
4300 # elapses, then no one has vetoed the last action, and the
4301 # action is accepted.
4302 # See http://www.usemod.com/cgi-bin/mb.pl?PageDeletion
4303 sub ProcessVetos {
4304 my ($expirets);
4305
4306 $expirets = $Now - ($KeepDays * 24 * 60 * 60);
4307 return (0, T('(done)')) unless $Page{'ts'} < $expirets;
4308 if ($DeletedPage && $Text{'text'} =~ /^\s*$DeletedPage\W*?(\n|$)/o) {
4309 &DeletePage($OpenPageName, 1, 1);
4310 return (1, T('(deleted)'));
4311 }
4312 if ($ReplaceFile && $Text{'text'} =~ /^\s*$ReplaceFile\:\s*(\S+)/o) {
4313 my $fname = $1;
4314 # Only replace an allowed, existing file.
4315 if ((grep {$_ eq $fname} @ReplaceableFiles) && -e $fname) {
4316 if ($Text{'text'} =~ /.*<pre>.*?\n(.*?)\s*<\/pre>/ims)
4317 {
4318 my $string = $1;
4319 $string =~ s/\r\n/\n/gms;
4320 open (OUT, ">$fname") or return 0;
4321 print OUT $string;
4322 close OUT;
4323 return (0, T('(replaced)'));
4324 }
4325 }
4326 }
4327 return (0, T('(done)'));
4328 }
4329
4330 sub DoMaintain {
4331 my ($name, $fname, $data, $message, $status);
4332 print &GetHeader('', T('Maintenance on all pages'), '');
4333 print "<br>";
4334 $fname = "$DataDir/maintain";
4335 if (!&UserIsAdmin()) {
4336 if ((-f $fname) && ((-M $fname) < 0.5)) {
4337 print T('Maintenance not done.'), ' ';
4338 print T('(Maintenance can only be done once every 12 hours.)');
4339 print ' ', T('Remove the "maintain" file or wait.');
4340 print &GetCommonFooter();
4341 return;
4342 }
4343 }
4344 &RequestLock() or die(T('Could not get maintain-lock'));
4345 foreach $name (&AllPagesList()) {
4346 &OpenPage($name);
4347 &OpenDefaultText();
4348 ($status, $message) = &ProcessVetos();
4349 &ExpireKeepFile() unless $status;
4350 print ".... " if ($name =~ m|/|);
4351 print &GetPageLink($name);
4352 print " $message<br>\n";
4353 }
4354 &WriteStringToFile($fname, Ts('Maintenance done at %s', &TimeToText($Now)));
4355 &ReleaseLock();
4356 # Do any rename/deletion commands
4357 # (Must be outside lock because it will grab its own lock)
4358 $fname = "$DataDir/editlinks";
4359 if (-f $fname) {
4360 $data = &ReadFileOrDie($fname);
4361 print '<hr>', T('Processing rename/delete commands:'), "<br>\n";
4362 &UpdateLinksList($data, 1, 1); # Always update RC and links
4363 unlink("$fname.old");
4364 rename($fname, "$fname.old");
4365 }
4366 if ($MaintTrimRc) {
4367 &RequestLock() or die(T('Could not get lock for RC maintenance'));
4368 $status = &TrimRc(); # Consider error messages?
4369 &ReleaseLock();
4370 }
4371 print &GetCommonFooter();
4372 }
4373
4374 # Must be called within a lock.
4375 # Thanks to Alex Schroeder for original code
4376 sub TrimRc {
4377 my (@rc, @temp, $starttime, $days, $status, $data, $i, $ts);
4378
4379 # Determine the number of days to go back
4380 $days = 0;
4381 foreach (@RcDays) {
4382 $days = $_ if $_ > $days;
4383 }
4384 $starttime = $Now - $days * 24 * 60 * 60;
4385 return 1 if (!-f $RcFile); # No work if no file exists
4386 ($status, $data) = &ReadFile($RcFile);
4387 if (!$status) {
4388 print '<p><strong>' . Ts('Could not open %s log file', $RCName)
4389 . ":</strong> $RcFile<p>"
4390 . T('Error was') . ":\n<pre>$!</" . "pre>\n" . '<p>';
4391 return 0;
4392 }
4393 # Move the old stuff from rc to temp
4394 @rc = split(/\n/, $data);
4395 for ($i = 0; $i < @rc; $i++) {
4396 ($ts) = split(/$FS3/, $rc[$i]);
4397 last if ($ts >= $starttime);
4398 }
4399 return 1 if ($i < 1); # No lines to move from new to old
4400 @temp = splice(@rc, 0, $i);
4401 # Write new files and backups
4402 if (!open(OUT, ">>$RcOldFile")) {
4403 print '<p><strong>' . Ts('Could not open %s log file', $RCName)
4404 . ":</strong> $RcOldFile<p>"
4405 . T('Error was') . ":\n<pre>$!</" . "pre>\n" . '<p>';
4406 return 0;
4407 }
4408 print OUT join("\n", @temp) . "\n";
4409 close(OUT);
4410 &WriteStringToFile($RcFile . '.old', $data);
4411 $data = join("\n", @rc);
4412 $data .= "\n" if ($data ne ''); # If no entries, don't add blank line
4413 &WriteStringToFile($RcFile, $data);
4414 return 1;
4415 }
4416
4417 sub DoMaintainRc {
4418 print &GetHeader('', T('Maintaining RC log'), '');
4419 return if (!&UserIsAdminOrError());
4420 &RequestLock() or die(T('Could not get lock for RC maintenance'));
4421 if (&TrimRc()) {
4422 print '<br>' . T('RC maintenance done.') . '<br>';
4423 } else {
4424 print '<br>' . T('RC maintenance not done.') . '<br>';
4425 }
4426 &ReleaseLock();
4427 print &GetCommonFooter();
4428 }
4429
4430 sub UserIsEditorOrError {
4431 if (!&UserIsEditor()) {
4432 print '<p>', T('This operation is restricted to site editors only...');
4433 print &GetCommonFooter();
4434 return 0;
4435 }
4436 return 1;
4437 }
4438
4439 sub UserIsAdminOrError {
4440 if (!&UserIsAdmin()) {
4441 print '<p>', T('This operation is restricted to administrators only...');
4442 print &GetCommonFooter();
4443 return 0;
4444 }
4445 return 1;
4446 }
4447
4448 sub DoEditLock {
4449 my ($fname);
4450
4451 print &GetHeader('', T('Set or Remove global edit lock'), '');
4452 return if (!&UserIsAdminOrError());
4453 $fname = "$DataDir/noedit";
4454 if (&GetParam("set", 1)) {
4455 &WriteStringToFile($fname, "editing locked.");
4456 } else {
4457 unlink($fname);
4458 }
4459 if (-f $fname) {
4460 print '<p>', T('Edit lock created.'), '<br>';
4461 } else {
4462 print '<p>', T('Edit lock removed.'), '<br>';
4463 }
4464 print &GetCommonFooter();
4465 }
4466
4467 sub DoPageLock {
4468 my ($fname, $id);
4469
4470 print &GetHeader('', T('Set or Remove page edit lock'), '');
4471 # Consider allowing page lock/unlock at editor level?
4472 return if (!&UserIsAdminOrError());
4473 $id = &GetParam("id", "");
4474 if ($id eq "") {
4475 print '<p>', T('Missing page id to lock/unlock...');
4476 return;
4477 }
4478 return if (!&ValidIdOrDie($id)); # Consider nicer error?
4479 $fname = &GetLockedPageFile($id);
4480 if (&GetParam("set", 1)) {
4481 &WriteStringToFile($fname, "editing locked.");
4482 } else {
4483 unlink($fname);
4484 }
4485 if (-f $fname) {
4486 print '<p>', Ts('Lock for %s created.', $id), '<br>';
4487 } else {
4488 print '<p>', Ts('Lock for %s removed.', $id), '<br>';
4489 }
4490 print &GetCommonFooter();
4491 }
4492
4493 sub DoEditBanned {
4494 my ($banList, $status);
4495
4496 print &GetHeader('', T('Editing Banned list'), '');
4497 return if (!&UserIsAdminOrError());
4498 ($status, $banList) = &ReadFile("$DataDir/banlist");
4499 $banList = "" if (!$status);
4500 print &GetFormStart();
4501 print GetHiddenValue("edit_ban", 1), "\n";
4502 print "<b>Banned IP/network/host list:</b><br>\n";
4503 print "<p>Each entry is either a commented line (starting with #), ",
4504 "or a Perl regular expression (matching either an IP address or ",
4505 "a hostname). <b>Note:</b> To test the ban on yourself, you must ",
4506 "give up your admin access (remove password in Preferences).";
4507 print "<p>Example:<br>",
4508 "# blocks hosts ending with .foocorp.com<br>",
4509 "\\.foocorp\\.com\$<br>",
4510 "# blocks exact IP address<br>",
4511 "^123\\.21\\.3\\.9\$<br>",
4512 "# blocks whole 123.21.3.* IP network<br>",
4513 "^123\\.21\\.3\\.\\d+\$<p>";
4514 print &GetTextArea('banlist', $banList, 12, 50);
4515 print "<br>", $q->submit(-name=>'Save'), "\n";
4516 print $q->endform;
4517 if (!&GetParam('embed', $EmbedWiki)) {
4518 print '<div class=wikifooter>';
4519 print "<hr class=wikilinefooter>\n";
4520 print &GetGotoBar('');
4521 print '</div>';
4522 }
4523 print &GetMinimumFooter();
4524 }
4525
4526 sub DoUpdateBanned {
4527 my ($newList, $fname);
4528
4529 print &GetHeader('', T('Updating Banned list'), '');
4530 return if (!&UserIsAdminOrError());
4531 $fname = "$DataDir/banlist";
4532 $newList = &GetParam("banlist", "#Empty file");
4533 if ($newList eq "") {
4534 print "<p>", T('Empty banned list or error.');
4535 print "<p>", T('Resubmit with at least one space character to remove.');
4536 } elsif ($newList =~ /^\s*$/s) {
4537 unlink($fname);
4538 print "<p>", T('Removed banned list');
4539 } else {
4540 &WriteStringToFile($fname, $newList);
4541 print "<p>", T('Updated banned list');
4542 }
4543 print &GetCommonFooter();
4544 }
4545
4546 # ==== Editing/Deleting pages and links ====
4547 sub DoEditLinks {
4548 print &GetHeader('', T('Editing Links'), '');
4549 if ($AdminDelete) {
4550 return if (!&UserIsAdminOrError());
4551 } else {
4552 return if (!&UserIsEditorOrError());
4553 }
4554 print &GetFormStart();
4555 print GetHiddenValue("edit_links", 1), "\n";
4556 print "<b>Editing/Deleting page titles:</b><br>\n";
4557 print "<p>Enter one command on each line. Commands are:<br>",
4558 "<tt>!PageName</tt> -- deletes the page called PageName<br>\n",
4559 "<tt>=OldPageName=NewPageName</tt> -- Renames OldPageName ",
4560 "to NewPageName and updates links to OldPageName.<br>\n",
4561 "<tt>|OldPageName|NewPageName</tt> -- Changes links to OldPageName ",
4562 "to NewPageName.",
4563 " (Used to rename links to non-existing pages.)<br>\n",
4564 "<b>Note: page names are case-sensitive!</b>\n";
4565 print &GetTextArea('commandlist', "", 12, 50);
4566 print $q->checkbox(-name=>"p_changerc", -override=>1, -checked=>1,
4567 -label=>"Edit $RCName");
4568 print "<br>\n";
4569 print $q->checkbox(-name=>"p_changetext", -override=>1, -checked=>1,
4570 -label=>"Substitute text for rename");
4571 print "<br>", $q->submit(-name=>'Edit'), "\n";
4572 print $q->endform;
4573 if (!&GetParam('embed', $EmbedWiki)) {
4574 print '<div class=wikifooter>';
4575 print "<hr class=wikilinefooter>\n";
4576 print &GetGotoBar('');
4577 print '</div>';
4578 }
4579 print &GetMinimumFooter();
4580 }
4581
4582 sub UpdateLinksList {
4583 my ($commandList, $doRC, $doText) = @_;
4584
4585 if ($doText) {
4586 &BuildLinkIndex();
4587 }
4588 &RequestLock() or die T('UpdateLinksList could not get main lock');
4589 unlink($IndexFile) if ($UseIndex);
4590 foreach (split(/\n/, $commandList)) {
4591 s/\s+$//g;
4592 next if (!(/^[=!|]/)); # Only valid commands.
4593 print "Processing $_<br>\n";
4594 if (/^\!(.+)/) {
4595 &DeletePage($1, $doRC, $doText);
4596 } elsif (/^\=(?:\[\[)?([^]=]+)(?:\]\])?\=(?:\[\[)?([^]=]+)(?:\]\])?/) {
4597 &RenamePage($1, $2, $doRC, $doText);
4598 } elsif (/^\|(?:\[\[)?([^]|]+)(?:\]\])?\|(?:\[\[)?([^]|]+)(?:\]\])?/) {
4599 &RenameTextLinks($1, $2);
4600 }
4601 }
4602 &NewPageCacheClear("."); # Clear cache (needs testing?)
4603 unlink($IndexFile) if ($UseIndex);
4604 &ReleaseLock();
4605 }
4606
4607 sub BuildLinkIndex {
4608 my (@pglist, $page, @links, $link, %seen);
4609
4610 @pglist = &AllPagesList();
4611 %LinkIndex = ();
4612 foreach $page (@pglist) {
4613 &BuildLinkIndexPage($page);
4614 }
4615 }
4616
4617 sub BuildLinkIndexPage {
4618 my ($page) = @_;
4619 my (@links, $link, %seen);
4620
4621 @links = &GetPageLinks($page, 1, 0, 0);
4622 %seen = ();
4623 foreach $link (@links) {
4624 if (defined($LinkIndex{$link})) {
4625 if (!$seen{$link}) {
4626 $LinkIndex{$link} .= " " . $page;
4627 }
4628 } else {
4629 $LinkIndex{$link} .= " " . $page;
4630 }
4631 $seen{$link} = 1;
4632 }
4633 }
4634
4635 sub DoUpdateLinks {
4636 my ($commandList, $doRC, $doText);
4637
4638 print &GetHeader('', T('Updating Links'), '');
4639 if ($AdminDelete) {
4640 return if (!&UserIsAdminOrError());
4641 } else {
4642 return if (!&UserIsEditorOrError());
4643 }
4644 $commandList = &GetParam("commandlist", "");
4645 $doRC = &GetParam("p_changerc", "0");
4646 $doRC = 1 if ($doRC eq "on");
4647 $doText = &GetParam("p_changetext", "0");
4648 $doText = 1 if ($doText eq "on");
4649 if ($commandList eq "") {
4650 print "<p>", T('Empty command list or error.');
4651 } else {
4652 &UpdateLinksList($commandList, $doRC, $doText);
4653 print "<p>", T('Finished command list.');
4654 }
4655 print &GetCommonFooter();
4656 }
4657
4658 sub EditRecentChanges {
4659 my ($action, $old, $new) = @_;
4660
4661 &EditRecentChangesFile($RcFile, $action, $old, $new, 1);
4662 &EditRecentChangesFile($RcOldFile, $action, $old, $new, 0);
4663 }
4664
4665 sub EditRecentChangesFile {
4666 my ($fname, $action, $old, $new, $printError) = @_;
4667 my ($status, $fileData, $errorText, $rcline, @rclist);
4668 my ($outrc, $ts, $page, $junk);
4669
4670 ($status, $fileData) = &ReadFile($fname);
4671 if (!$status) {
4672 # Save error text if needed.
4673 $errorText = "<p><strong>"
4674 . Ts('Could not open %s log file:', $RCName)
4675 . "</strong> $fname"
4676 . "<p>" . T('Error was:') . "\n<pre>$!</pre>\n";
4677 print $errorText if ($printError);
4678 return;
4679 }
4680 $outrc = "";
4681 @rclist = split(/\n/, $fileData);
4682 foreach $rcline (@rclist) {
4683 ($ts, $page, $junk) = split(/$FS3/, $rcline);
4684 if ($page eq $old) {
4685 if ($action == 1) { # Delete
4686 ; # Do nothing (don't add line to new RC)
4687 } elsif ($action == 2) {
4688 $junk = $rcline;
4689 $junk =~ s/^(\d+$FS3)$old($FS3)/"$1$new$2"/ge;
4690 $outrc .= $junk . "\n";
4691 }
4692 } else {
4693 $outrc .= $rcline . "\n";
4694 }
4695 }
4696 &WriteStringToFile($fname . ".old", $fileData); # Backup copy
4697 &WriteStringToFile($fname, $outrc);
4698 }
4699
4700 # Delete and rename must be done inside locks.
4701 sub DeletePage {
4702 my ($page, $doRC, $doText) = @_;
4703 my ($fname, $status);
4704
4705 $page =~ s/ /_/g;
4706 $page =~ s/\[+//;
4707 $page =~ s/\]+//;
4708 $status = &ValidId($page);
4709 if ($status ne "") {
4710 print Tss('Delete-Page: page %1 is invalid, error is: %2', $page, $status)
4711 . "<br>\n";
4712 return;
4713 }
4714 $fname = &GetPageFile($page);
4715 unlink($fname) if (-f $fname);
4716 $fname = $KeepDir . "/" . &GetPageDirectory($page) . "/$page.kp";
4717 unlink($fname) if (-f $fname);
4718 unlink($IndexFile) if ($UseIndex);
4719 &EditRecentChanges(1, $page, "") if ($doRC); # Delete page
4720 # Currently don't do anything with page text
4721 }
4722
4723 # Given text, returns substituted text
4724 sub SubstituteTextLinks {
4725 my ($old, $new, $text) = @_;
4726
4727 # Much of this is taken from the common markup
4728 %SaveUrl = ();
4729 $SaveUrlIndex = 0;
4730 $text =~ s/$FS(\d)/$1/g; # Remove separators (paranoia)
4731 if ($RawHtml) {
4732 $text =~ s/(<html>((.|\n)*?)<\/html>)/&StoreRaw($1)/ige;
4733 }
4734 $text =~ s/(<pre>((.|\n)*?)<\/pre>)/&StoreRaw($1)/ige;
4735 $text =~ s/(<code>((.|\n)*?)<\/code>)/&StoreRaw($1)/ige;
4736 $text =~ s/(<nowiki>((.|\n)*?)<\/nowiki>)/&StoreRaw($1)/ige;
4737 if ($FreeLinks) {
4738 $text =~
4739 s/\[\[$FreeLinkPattern\|([^\]]+)\]\]/&SubFreeLink($1,$2,$old,$new)/geo;
4740 $text =~ s/\[\[$FreeLinkPattern\]\]/&SubFreeLink($1,"",$old,$new)/geo;
4741 }
4742 if ($BracketText) { # Links like [URL text of link]
4743 $text =~ s/(\[$UrlPattern\s+([^\]]+?)\])/&StoreRaw($1)/geo;
4744 $text =~ s/(\[$InterLinkPattern\s+([^\]]+?)\])/&StoreRaw($1)/geo;
4745 }
4746 $text =~ s/(\[?$UrlPattern\]?)/&StoreRaw($1)/geo;
4747 $text =~ s/(\[?$InterLinkPattern\]?)/&StoreRaw($1)/geo;
4748 if ($WikiLinks) {
4749 $text =~ s/$LinkPattern/&SubWikiLink($1, $old, $new)/geo;
4750 }
4751 # Thanks to David Claughton for the following fix
4752 1 while $text =~ s/$FS(\d+)$FS/$SaveUrl{$1}/ge; # Restore saved text
4753 return $text;
4754 }
4755
4756 sub SubFreeLink {
4757 my ($link, $name, $old, $new) = @_;
4758 my ($oldlink);
4759
4760 $oldlink = $link;
4761 $link =~ s/^\s+//;
4762 $link =~ s/\s+$//;
4763 if (($link eq $old) || (&FreeToNormal($old) eq &FreeToNormal($link))) {
4764 $link = $new;
4765 } else {
4766 $link = $oldlink; # Preserve spaces if no match
4767 }
4768 $link = "[[$link";
4769 if ($name ne "") {
4770 $link .= "|$name";
4771 }
4772 $link .= "]]";
4773 return &StoreRaw($link);
4774 }
4775
4776 sub SubWikiLink {
4777 my ($link, $old, $new) = @_;
4778 my ($newBracket);
4779
4780 $newBracket = 0;
4781 if ($link eq $old) {
4782 $link = $new;
4783 if (!($new =~ /^$LinkPattern$/)) {
4784 $link = "[[$link]]";
4785 }
4786 }
4787 return &StoreRaw($link);
4788 }
4789
4790 # Rename is mostly copied from expire
4791 sub RenameKeepText {
4792 my ($page, $old, $new) = @_;
4793 my ($fname, $status, $data, @kplist, %tempSection, $changed);
4794 my ($sectName, $newText);
4795
4796 $fname = $KeepDir . "/" . &GetPageDirectory($page) . "/$page.kp";
4797 return if (!(-f $fname));
4798 ($status, $data) = &ReadFile($fname);
4799 return if (!$status);
4800 @kplist = split(/$FS1/, $data, -1); # -1 keeps trailing null fields
4801 return if (length(@kplist) < 1); # Also empty
4802 shift(@kplist) if ($kplist[0] eq ""); # First can be empty
4803 return if (length(@kplist) < 1); # Also empty
4804 %tempSection = split(/$FS2/, $kplist[0], -1);
4805 if (!defined($tempSection{'keepts'})) {
4806 return;
4807 }
4808 # First pass: optimize for nothing changed
4809 $changed = 0;
4810 foreach (@kplist) {
4811 %tempSection = split(/$FS2/, $_, -1);
4812 $sectName = $tempSection{'name'};
4813 if ($sectName =~ /^(text_)/) {
4814 %Text = split(/$FS3/, $tempSection{'data'}, -1);
4815 $newText = &SubstituteTextLinks($old, $new, $Text{'text'});
4816 $changed = 1 if ($Text{'text'} ne $newText);
4817 }
4818 }
4819 return if (!$changed); # No sections changed
4820 open (OUT, ">$fname") or return;
4821 foreach (@kplist) {
4822 %tempSection = split(/$FS2/, $_, -1);
4823 $sectName = $tempSection{'name'};
4824 if ($sectName =~ /^(text_)/) {
4825 %Text = split(/$FS3/, $tempSection{'data'}, -1);
4826 $newText = &SubstituteTextLinks($old, $new, $Text{'text'});
4827 $Text{'text'} = $newText;
4828 $tempSection{'data'} = join($FS3, %Text);
4829 print OUT $FS1, join($FS2, %tempSection);
4830 } else {
4831 print OUT $FS1, $_;
4832 }
4833 }
4834 close(OUT);
4835 }
4836
4837 sub RenameTextLinks {
4838 my ($old, $new) = @_;
4839 my ($changed, $file, $page, $section, $oldText, $newText, $status);
4840 my ($oldCanonical, @pageList);
4841
4842 $old =~ s/ /_/g;
4843 $oldCanonical = &FreeToNormal($old);
4844 $new =~ s/ /_/g;
4845 $status = &ValidId($old);
4846 if ($status ne "") {
4847 print Tss('Rename-Text: old page %1 is invalid, error is: %2', $old, $status)
4848 . "<br>\n";
4849 return;
4850 }
4851 $status = &ValidId($new);
4852 if ($status ne "") {
4853 print Tss('Rename-Text: new page %1 is invalid, error is: %2', $new, $status)
4854 . "<br>\n";
4855 return;
4856 }
4857 $old =~ s/_/ /g;
4858 $new =~ s/_/ /g;
4859 # Note: the LinkIndex must be built prior to this routine
4860 return if (!defined($LinkIndex{$oldCanonical}));
4861 @pageList = split(' ', $LinkIndex{$oldCanonical});
4862 foreach $page (@pageList) {
4863 $changed = 0;
4864 &OpenPage($page);
4865 foreach $section (keys %Page) {
4866 if ($section =~ /^text_/) {
4867 &OpenSection($section);
4868 %Text = split(/$FS3/, $Section{'data'}, -1);
4869 $oldText = $Text{'text'};
4870 $newText = &SubstituteTextLinks($old, $new, $oldText);
4871 if ($oldText ne $newText) {
4872 $Text{'text'} = $newText;
4873 $Section{'data'} = join($FS3, %Text);
4874 $Page{$section} = join($FS2, %Section);
4875 $changed = 1;
4876 }
4877 } elsif ($section =~ /^cache_diff/) {
4878 $oldText = $Page{$section};
4879 $newText = &SubstituteTextLinks($old, $new, $oldText);
4880 if ($oldText ne $newText) {
4881 $Page{$section} = $newText;
4882 $changed = 1;
4883 }
4884 }
4885 # Add other text-sections (categories) here
4886 }
4887 if ($changed) {
4888 $file = &GetPageFile($page);
4889 &WriteStringToFile($file, join($FS1, %Page));
4890 }
4891 &RenameKeepText($page, $old, $new);
4892 }
4893 }
4894
4895 sub RenamePage {
4896 my ($old, $new, $doRC, $doText) = @_;
4897 my ($oldfname, $newfname, $oldkeep, $newkeep, $status);
4898
4899 $old =~ s/ /_/g;
4900 $new = &FreeToNormal($new);
4901 $status = &ValidId($old);
4902 if ($status ne "") {
4903 print Tss('Rename: old page %1 is invalid, error is: %2', $old, $status)
4904 . "<br>\n";
4905 return;
4906 }
4907 $status = &ValidId($new);
4908 if ($status ne "") {
4909 print Tss('Rename: new page %1 is invalid, error is: %2', $new, $status)
4910 . "<br>\n";
4911 return;
4912 }
4913 $newfname = &GetPageFile($new);
4914 if (-f $newfname) {
4915 print Ts('Rename: new page %s already exists--not renamed.', $new)
4916 . "<br>\n";
4917 return;
4918 }
4919 $oldfname = &GetPageFile($old);
4920 if (!(-f $oldfname)) {
4921 print Ts('Rename: old page %s does not exist--nothing done.', $old)
4922 . "<br>\n";
4923 return;
4924 }
4925 &CreatePageDir($PageDir, $new); # It might not exist yet
4926 rename($oldfname, $newfname);
4927 &CreatePageDir($KeepDir, $new);
4928 $oldkeep = $KeepDir . "/" . &GetPageDirectory($old) . "/$old.kp";
4929 $newkeep = $KeepDir . "/" . &GetPageDirectory($new) . "/$new.kp";
4930 unlink($newkeep) if (-f $newkeep); # Clean up if needed.
4931 rename($oldkeep, $newkeep);
4932 unlink($IndexFile) if ($UseIndex);
4933 &EditRecentChanges(2, $old, $new) if ($doRC);
4934 if ($doText) {
4935 &BuildLinkIndexPage($new); # Keep index up-to-date
4936 &RenameTextLinks($old, $new);
4937 }
4938 }
4939
4940 sub DoShowVersion {
4941 print &GetHeader('', T('Displaying Wiki Version'), '');
4942 print "<p>UseModWiki version 1.0.4</p>\n";
4943 print &GetCommonFooter();
4944 }
4945
4946 # Thanks to Phillip Riley for original code
4947 sub DoDeletePage {
4948 my ($id) = @_;
4949
4950 return if (!&ValidIdOrDie($id));
4951 print &GetHeader('', Ts('Delete %s', $id), '');
4952 return if (!&UserIsAdminOrError());
4953 if ($ConfirmDel && !&GetParam('confirm', 0)) {
4954 print '<p>';
4955 print Ts('Confirm deletion of %s by following this link:', $id);
4956 print '<br>' . &GetDeleteLink($id, T('Confirm Delete'), 1);
4957 print '</p>';
4958 print &GetCommonFooter();
4959 return;
4960 }
4961 print '<p>';
4962 if ($id eq $HomePage) {
4963 print Ts('%s can not be deleted.', $HomePage);
4964 } else {
4965 if (-f &GetLockedPageFile($id)) {
4966 print Ts('%s can not be deleted because it is locked.', $id);
4967 } else {
4968 # Must lock because of RC-editing
4969 &RequestLock() or die(T('Could not get editing lock'));
4970 DeletePage($id, 1, 1);
4971 &ReleaseLock();
4972 print Ts('%s has been deleted.', $id);
4973 }
4974 }
4975 print '</p>';
4976 print &GetCommonFooter();
4977 }
4978
4979 # Thanks to Ross Kowalski and Iliyan Jeliazkov for original uploading code
4980 sub DoUpload {
4981 print &GetHeader('', T('File Upload Page'), '');
4982 if (!$AllUpload) {
4983 return if (!&UserIsEditorOrError());
4984 }
4985 print '<p>' . Ts('The current upload size limit is %s.', $MaxPost) . ' '
4986 . Ts('Change the %s variable to increase this limit.', '$MaxPost');
4987 print '</p><br>';
4988 print '<FORM METHOD="post" ACTION="' . $ScriptName
4989 . '" ENCTYPE="multipart/form-data">';
4990 print '<input type="hidden" name="upload" value="1" />';
4991 print T('File to Upload:'), ' <INPUT TYPE="file" NAME="file"><br><BR>';
4992 print '<INPUT TYPE="submit" NAME="Submit" VALUE="', T('Upload'), '">';
4993 print '</FORM>';
4994 print &GetCommonFooter();
4995 }
4996
4997 sub SaveUpload {
4998 my ($filename, $printFilename, $uploadFilehandle);
4999
5000 print &GetHeader('', T('Upload Finished'), '');
5001 if (!$AllUpload) {
5002 return if (!&UserIsEditorOrError());
5003 }
5004 $UploadDir .= '/' if (substr($UploadDir, -1, 1) ne '/'); # End with /
5005 $UploadUrl .= '/' if (substr($UploadUrl, -1, 1) ne '/'); # End with /
5006 $filename = $q->param('file');
5007 $filename =~ s/.*[\/\\](.*)/$1/; # Only name after last \ or /
5008 $uploadFilehandle = $q->upload('file');
5009 open UPLOADFILE, ">$UploadDir$filename";
5010 binmode UPLOADFILE;
5011 while (<$uploadFilehandle>) { print UPLOADFILE; }
5012 close UPLOADFILE;
5013 print T('The wiki link to your file is:') . "\n<br><BR>";
5014 $printFilename = $filename;
5015 $printFilename =~ s/ /\%20/g; # Replace spaces with escaped spaces
5016 print "upload:" . $printFilename . "<BR><BR>\n";
5017 if ($filename =~ /$ImageExtensions$/i) {
5018 print '<HR><img src="' . $UploadUrl . $filename . '">' . "\n";
5019 }
5020 print &GetCommonFooter();
5021 }
5022
5023 sub ConvertFsFile {
5024 my ($oldFS, $newFS, $fname) = @_;
5025 my ($oldData, $newData, $status);
5026
5027 return if (!-f $fname); # Convert only existing regular files
5028 ($status, $oldData) = &ReadFile($fname);
5029 if (!$status) {
5030 print '<br><strong>' . Ts('Could not open file %s', $fname)
5031 . ':</strong>' . T('Error was') . ":\n<pre>$!</pre>\n" . '<br>';
5032 return;
5033 }
5034 $newData = $oldData;
5035 $newData =~ s/$oldFS(\d)/$newFS . $1/ge;
5036 return if ($oldData eq $newData); # Do not write if the same
5037 &WriteStringToFile($fname, $newData);
5038 # print $fname . '<br>'; # progress report
5039 }
5040
5041 # Converts up to 3 dirs deep (like page/A/Apple/subpage.db)
5042 # Note that top level directory (page/keep/user) contains only dirs
5043 sub ConvertFsDir {
5044 my ($oldFS, $newFS, $topDir) = @_;
5045 my (@dirs, @files, @subFiles, $dir, $file, $subFile, $fname, $subFname);
5046
5047 opendir(DIRLIST, $topDir);
5048 @dirs = readdir(DIRLIST);
5049 closedir(DIRLIST);
5050 @dirs = sort(@dirs);
5051 foreach $dir (@dirs) {
5052 next if (substr($dir, 0, 1) eq '.'); # No ., .., or .dirs
5053 next if (!-d "$topDir/$dir"); # Top level directories only
5054 next if (-f "$topDir/$dir.cvt"); # Skip if already converted
5055 opendir(DIRLIST, "$topDir/$dir");
5056 @files = readdir(DIRLIST);
5057 closedir(DIRLIST);
5058 foreach $file (@files) {
5059 next if (($file eq '.') || ($file eq '..'));
5060 $fname = "$topDir/$dir/$file";
5061 if (-f $fname) {
5062 # print $fname . '<br>'; # progress
5063 &ConvertFsFile($oldFS, $newFS, $fname);
5064 } elsif (-d $fname) {
5065 opendir(DIRLIST, $fname);
5066 @subFiles = readdir(DIRLIST);
5067 closedir(DIRLIST);
5068 foreach $subFile (@subFiles) {
5069 next if (($subFile eq '.') || ($subFile eq '..'));
5070 $subFname = "$fname/$subFile";
5071 if (-f $subFname) {
5072 # print $subFname . '<br>'; # progress
5073 &ConvertFsFile($oldFS, $newFS, $subFname);
5074 }
5075 }
5076 }
5077 }
5078 &WriteStringToFile("$topDir/$dir.cvt", 'converted');
5079 }
5080 }
5081
5082 sub ConvertFsCleanup {
5083 my ($topDir) = @_;
5084 my (@dirs, $dir);
5085
5086 opendir(DIRLIST, $topDir);
5087 @dirs = readdir(DIRLIST);
5088 closedir(DIRLIST);
5089 foreach $dir (@dirs) {
5090 next if (substr($dir, 0, 1) eq '.'); # No ., .., or .dirs
5091 next if (!-f "$topDir/$dir"); # Remove only files...
5092 next unless ($dir =~ m/\.cvt$/); # ...that end with .cvt
5093 unlink "$topDir/$dir";
5094 }
5095 }
5096
5097 sub DoConvert {
5098 my $oldFS = "\xb3";
5099 my $newFS = "\x1e\xff\xfe\x1e";
5100
5101 print &GetHeader('', T('Convert wiki DB'), '');
5102 return if (!&UserIsAdminOrError());
5103 if ($FS ne $newFS) {
5104 print Ts('You must change the %s option before converting the wiki DB.',
5105 '$NewFS') . '<br>';
5106 return;
5107 }
5108 &WriteStringToFile("$DataDir/noedit", 'editing locked.');
5109 print T('Wiki DB locked for conversion.') . '<br>';
5110 print T('Converting Wiki DB...') . '<br>';
5111 &ConvertFsFile($oldFS, $newFS, "$DataDir/rclog");
5112 &ConvertFsFile($oldFS, $newFS, "$DataDir/rclog.old");
5113 &ConvertFsFile($oldFS, $newFS, "$DataDir/oldrclog");
5114 &ConvertFsFile($oldFS, $newFS, "$DataDir/oldrclog.old");
5115 &ConvertFsDir($oldFS, $newFS, $PageDir);
5116 &ConvertFsDir($oldFS, $newFS, $KeepDir);
5117 &ConvertFsDir($oldFS, $newFS, $UserDir);
5118 &ConvertFsCleanup($PageDir);
5119 &ConvertFsCleanup($KeepDir);
5120 &ConvertFsCleanup($UserDir);
5121 print T('Finished converting wiki DB.') . '<br>';
5122 print Ts('Remove file %s to unlock wiki for editing.', "$DataDir/noedit")
5123 . '<br>';
5124 print &GetCommonFooter();
5125 }
5126
5127 # Remove user-id files if no useful preferences set
5128 sub DoTrimUsers {
5129 my (%Data, $status, $data, $maxID, $id, $removed, $keep);
5130 my (@dirs, @files, $dir, $file, $item);
5131
5132 print &GetHeader('', T('Trim wiki users'), '');
5133 return if (!&UserIsAdminOrError());
5134 $removed = 0;
5135 $maxID = 1001;
5136 opendir(DIRLIST, $UserDir);
5137 @dirs = readdir(DIRLIST);
5138 closedir(DIRLIST);
5139 foreach $dir (@dirs) {
5140 next if (substr($dir, 0, 1) eq '.'); # No ., .., or .dirs
5141 next if (!-d "$UserDir/$dir"); # Top level directories only
5142 opendir(DIRLIST, "$UserDir/$dir");
5143 @files = readdir(DIRLIST);
5144 closedir(DIRLIST);
5145 foreach $file (@files) {
5146 if ($file =~ m/(\d+).db/) { # Only numeric ID files
5147 $id = $1;
5148 $maxID = $id if ($id > $maxID);
5149 %Data = ();
5150 ($status, $data) = &ReadFile("$UserDir/$dir/$file");
5151 if ($status) {
5152 %Data = split(/$FS1/, $data, -1); # -1 keeps trailing null fields
5153 $keep = 0;
5154 foreach $item (qw(username password adminpw stylesheet)) {
5155 $keep = 1 if (defined($Data{$item}) && ($Data{$item} ne ''));
5156 }
5157 if (!$keep) {
5158 unlink "$UserDir/$dir/$file";
5159 # print "$UserDir/$dir/$file" . '<br>'; # progress
5160 $removed += 1;
5161 }
5162 }
5163 }
5164 }
5165 }
5166 print Ts('Removed %s files.', $removed) . '<br>';
5167 print Ts('Recommended $StartUID setting is %s.', $maxID + 100) . '<br>';
5168 print &GetCommonFooter();
5169 }
5170 #END_OF_OTHER_CODE
5171
5172 &DoWikiRequest() if ($RunCGI && ($_ ne 'nocgi')); # Do everything.
5173 1; # In case we are loaded from elsewhere
5174 # == End of UseModWiki script. ===========================================