commit 922fcc803efa3fab751c90ab4d4467115c8ff9c9 Author: Markus Lude Date: Tue Oct 25 10:54:48 2016 +0200 import version 1.0, from Clifford Adams diff --git a/INSTALL b/INSTALL new file mode 100644 index 0000000..26c7036 --- /dev/null +++ b/INSTALL @@ -0,0 +1,122 @@ +Installation instructions for UseModWiki 1.0 +Last updated: September 11, 2003 +See the UPGRADE file for instructions to upgrade an existing wiki. + +------ +New Installations: + +The following instructions should work for most UNIX-based systems. +See http://www.usemod.com/cgi-bin/wiki.pl?UseModWiki/InstallWindows for +instructions if you are installing under Microsoft Windows. + +1. Copy the file "wiki.pl" to your cgi-bin directory. You can rename + the file to another name if you like. (Some servers may require + the name to end in ".pl" or ".cgi".) + +2. For some servers, you may need to change the permissions on the wiki.pl + script. (The command "chmod 755 wiki.pl" should be correct.) + +3. Create the wiki database directory. This directory must be writable + by the wiki CGI script. (You may need to use another chmod command.) + If the directory does not exist, the script will attempt to create it. + +4. If your installation of Perl is not located in /usr/bin/perl, you will + need to change the "/usr/bin/perl" text in the first line of wiki.pl. + (On UNIX-like systems this is usually unnecessary. For Windows, + "#!perl" (without the quotes) may also work.) + +5. Edit the "wiki.pl" file. The configuration section starts around + line 60. The main configuration variable is: + + $DataDir = "/tmp/mywikidb"; # Main page database + + ... which is the wiki database directory. The default directory is + in /tmp, which is not a good location for a long-term wiki. (Many + systems will erase the contents of /tmp when they crash or reboot.) + Change this directory to the one you created in step 3, using the + full path name, like "/home/domainname/www/wikidb". + +6. Most of the wiki's configuration variables can be stored and edited + outside the script. (You still need to edit the script to set the + $DataDir variable.) To do this, copy the "config" file to your wiki's + $DataDir directory and edit it. + + The advantage of editing the config file (rather than the script) is that + upgrades to future versions are much easier--you only need to make the + changes above rather than re-edit all of your local configuration. + + You will probably want to change the following configuration values: + + $CookieName = "Wiki"; # Name for this wiki (for multi-wiki sites) + + ... If your site uses multiple copies of UseModWiki, you must + make sure that each copy has a unique $CookieName. The + cookies store user-specific settings and preferences. + + $SiteName = "Wiki"; # Name of site (used for titles) + + ... This name is used in the title of every page. + + $HomePage = "HomePage"; # Home page (must be valid LinkPattern) + + ... This is the name of the wiki page users will go to when: + * The user clicks on the logo image, or + * The user does not specify a page in their URL. + + $LogoUrl = "/wiki.gif"; # URL for site logo ("" for no logo) + + ... This is the URL for the logo image. If it is "", the logo will + not be displayed. + +7. If you are installing the wiki on a web server using a non-standard + port number (like 8080), then you must also set $FullUrl to the + full path of your wiki, like: + + $FullUrl = "http://www.mydomain.com:8080/cgi-bin/wiki.pl"; + + If you are using a non-standard port and do not set $FullUrl, then + the wiki may not go to the right URL after editing a page. + + (If your site's URLs are like "http://www.mydomain.com/pagename" + (without a number like "8080"), then you should not need to + modify the $FullUrl setting.) + +8. If you wish to use the provided wiki.gif image, copy it to the top + directory of your www pages. (Or see step 6 to change the LogoUrl + variable.) + +9. (Optional) To use the supplied InterWiki site definitions, copy the + file "intermap" into the database directory (from step 3). + +10. Start your web browser, and go to the URL of the wiki.pl script. + You should be able to edit and add new pages. + +------ +Likely Problems: + +[Note that the path names (like /tmp/mydb/mywikidb) may be different + in your error messages.] + +1. The output message: + Could not go to or create /tmp/mydb/mywikidb: No such file or directory +...means that the database directory in step 5 above did not exist, + and the wiki script could not create the directory. + +2. The output message: + Could not go to or create /tmp/mydb/mywikidb: Permission denied +...means that the database directory exists, but it does not have the + proper permissions for the script to read it. + +3. If you see the message: + can't make /tmp/mydb/mywikidb/lock: Permission denied +...when saving a page, it means that the script could not write to + the database directory. + +4. If you can save your changes, but you do not see the changed page after + editing (or if you go to the wrong URL after editing), you may need to + set the FullUrl configuration variable. A sample setting for this + variable would be $FullUrl = "http://www.mysite.com/cgi-bin/mywiki.pl". + +5. If saving a page takes more than 20-30 seconds, it is possible that + there is a problem with the hostname lookup step. Try setting the + $UseLookup configuration variable to 0. diff --git a/LICENSE b/LICENSE new file mode 100644 index 0000000..befaf30 --- /dev/null +++ b/LICENSE @@ -0,0 +1,367 @@ + GNU GENERAL PUBLIC LICENSE + Version 2, June 1991 + + Copyright (C) 1989, 1991 Free Software Foundation, Inc. + 59 Temple Place, Suite 330, Boston, MA +02111-1307 USA + Everyone is permitted to copy and distribute verbatim copies + of this license document, but changing it is not allowed. + + Preamble + + The licenses for most software are designed to take away your +freedom to share and change it. By contrast, the GNU General Public +License is intended to guarantee your freedom to share and change free +software--to make sure the software is free for all its users. This +General Public License applies to most of the Free Software +Foundation's software and to any other program whose authors commit to +using it. (Some other Free Software Foundation software is covered by +the GNU Library General Public License instead.) You can apply it to +your programs, too. + + When we speak of free software, we are referring to freedom, not +price. Our General Public Licenses are designed to make sure that you +have the freedom to distribute copies of free software (and charge for +this service if you wish), that you receive source code or can get it +if you want it, that you can change the software or use pieces of it +in new free programs; and that you know you can do these things. + + To protect your rights, we need to make restrictions that forbid +anyone to deny you these rights or to ask you to surrender the rights. +These restrictions translate to certain responsibilities for you if you +distribute copies of the software, or if you modify it. + + For example, if you distribute copies of such a program, whether +gratis or for a fee, you must give the recipients all the rights that +you have. You must make sure that they, too, receive or can get the +source code. And you must show them these terms so they know their +rights. + + We protect your rights with two steps: (1) copyright the software, and +(2) offer you this license which gives you legal permission to copy, +distribute and/or modify the software. + + Also, for each author's protection and ours, we want to make certain +that everyone understands that there is no warranty for this free +software. If the software is modified by someone else and passed on, we +want its recipients to know that what they have is not the original, so +that any problems introduced by others will not reflect on the original +authors' reputations. + + Finally, any free program is threatened constantly by software +patents. We wish to avoid the danger that redistributors of a free +program will individually obtain patent licenses, in effect making the +program proprietary. To prevent this, we have made it clear that any +patent must be licensed for everyone's free use or not licensed at all. + + The precise terms and conditions for copying, distribution and +modification follow. + + GNU GENERAL PUBLIC LICENSE + TERMS AND CONDITIONS FOR COPYING, DISTRIBUTION AND MODIFICATION + + 0. This License applies to any program or other work which contains +a notice placed by the copyright holder saying it may be distributed +under the terms of this General Public License. The "Program", below, +refers to any such program or work, and a "work based on the Program" +means either the Program or any derivative work under copyright law: +that is to say, a work containing the Program or a portion of it, +either verbatim or with modifications and/or translated into another +language. (Hereinafter, translation is included without limitation in +the term "modification".) Each licensee is addressed as "you". + +Activities other than copying, distribution and modification are not +covered by this License; they are outside its scope. The act of +running the Program is not restricted, and the output from the Program +is covered only if its contents constitute a work based on the +Program (independent of having been made by running the Program). +Whether that is true depends on what the Program does. + + 1. You may copy and distribute verbatim copies of the Program's +source code as you receive it, in any medium, provided that you +conspicuously and appropriately publish on each copy an appropriate +copyright notice and disclaimer of warranty; keep intact all the +notices that refer to this License and to the absence of any warranty; +and give any other recipients of the Program a copy of this License +along with the Program. + +You may charge a fee for the physical act of transferring a copy, and +you may at your option offer warranty protection in exchange for a fee. + + 2. You may modify your copy or copies of the Program or any portion +of it, thus forming a work based on the Program, and copy and +distribute such modifications or work under the terms of Section 1 +above, provided that you also meet all of these conditions: + + a) You must cause the modified files to carry prominent notices + stating that you changed the files and the date of any change. + + b) You must cause any work that you distribute or publish, that in + whole or in part contains or is derived from the Program or any + part thereof, to be licensed as a whole at no charge to all third + parties under the terms of this License. + + c) If the modified program normally reads commands interactively + when run, you must cause it, when started running for such + interactive use in the most ordinary way, to print or display an + announcement including an appropriate copyright notice and a + notice that there is no warranty (or else, saying that you provide + a warranty) and that users may redistribute the program under + these conditions, and telling the user how to view a copy of this + License. (Exception: if the Program itself is interactive but + does not normally print such an announcement, your work based on + the Program is not required to print an announcement.) + +These requirements apply to the modified work as a whole. If +identifiable sections of that work are not derived from the Program, +and can be reasonably considered independent and separate works in +themselves, then this License, and its terms, do not apply to those +sections when you distribute them as separate works. But when you +distribute the same sections as part of a whole which is a work based +on the Program, the distribution of the whole must be on the terms of +this License, whose permissions for other licensees extend to the +entire whole, and thus to each and every part regardless of who wrote +it. + +Thus, it is not the intent of this section to claim rights or contest +your rights to work written entirely by you; rather, the intent is to +exercise the right to control the distribution of derivative or +collective works based on the Program. + +In addition, mere aggregation of another work not based on the Program +with the Program (or with a work based on the Program) on a volume of +a storage or distribution medium does not bring the other work under +the scope of this License. + + 3. You may copy and distribute the Program (or a work based on it, +under Section 2) in object code or executable form under the terms of +Sections 1 and 2 above provided that you also do one of the following: + + a) Accompany it with the complete corresponding machine-readable + source code, which must be distributed under the terms of Sections + 1 and 2 above on a medium customarily used for software interchange; +or, + + b) Accompany it with a written offer, valid for at least three + years, to give any third party, for a charge no more than your + cost of physically performing source distribution, a complete + machine-readable copy of the corresponding source code, to be + distributed under the terms of Sections 1 and 2 above on a medium + customarily used for software interchange; or, + + c) Accompany it with the information you received as to the offer + to distribute corresponding source code. (This alternative is + allowed only for noncommercial distribution and only if you + received the program in object code or executable form with such + an offer, in accord with Subsection b above.) + +The source code for a work means the preferred form of the work for +making modifications to it. For an executable work, complete source +code means all the source code for all modules it contains, plus any +associated interface definition files, plus the scripts used to +control compilation and installation of the executable. However, as a +special exception, the source code distributed need not include +anything that is normally distributed (in either source or binary +form) with the major components (compiler, kernel, and so on) of the +operating system on which the executable runs, unless that component +itself accompanies the executable. + +If distribution of executable or object code is made by offering +access to copy from a designated place, then offering equivalent +access to copy the source code from the same place counts as +distribution of the source code, even though third parties are not +compelled to copy the source along with the object code. + + 4. You may not copy, modify, sublicense, or distribute the Program +except as expressly provided under this License. Any attempt +otherwise to copy, modify, sublicense or distribute the Program is +void, and will automatically terminate your rights under this License. +However, parties who have received copies, or rights, from you under +this License will not have their licenses terminated so long as such +parties remain in full compliance. + + 5. You are not required to accept this License, since you have not +signed it. However, nothing else grants you permission to modify or +distribute the Program or its derivative works. These actions are +prohibited by law if you do not accept this License. Therefore, by +modifying or distributing the Program (or any work based on the +Program), you indicate your acceptance of this License to do so, and +all its terms and conditions for copying, distributing or modifying +the Program or works based on it. + + 6. Each time you redistribute the Program (or any work based on the +Program), the recipient automatically receives a license from the +original licensor to copy, distribute or modify the Program subject to +these terms and conditions. You may not impose any further +restrictions on the recipients' exercise of the rights granted herein. +You are not responsible for enforcing compliance by third parties to +this License. + + 7. If, as a consequence of a court judgment or allegation of patent +infringement or for any other reason (not limited to patent issues), +conditions are imposed on you (whether by court order, agreement or +otherwise) that contradict the conditions of this License, they do not +excuse you from the conditions of this License. If you cannot +distribute so as to satisfy simultaneously your obligations under this +License and any other pertinent obligations, then as a consequence you +may not distribute the Program at all. For example, if a patent +license would not permit royalty-free redistribution of the Program by +all those who receive copies directly or indirectly through you, then +the only way you could satisfy both it and this License would be to +refrain entirely from distribution of the Program. + +If any portion of this section is held invalid or unenforceable under +any particular circumstance, the balance of the section is intended to +apply and the section as a whole is intended to apply in other +circumstances. + +It is not the purpose of this section to induce you to infringe any +patents or other property right claims or to contest validity of any +such claims; this section has the sole purpose of protecting the +integrity of the free software distribution system, which is +implemented by public license practices. Many people have made +generous contributions to the wide range of software distributed +through that system in reliance on consistent application of that +system; it is up to the author/donor to decide if he or she is willing +to distribute software through any other system and a licensee cannot +impose that choice. + +This section is intended to make thoroughly clear what is believed to +be a consequence of the rest of this License. + + 8. If the distribution and/or use of the Program is restricted in +certain countries either by patents or by copyrighted interfaces, the +original copyright holder who places the Program under this License +may add an explicit geographical distribution limitation excluding +those countries, so that distribution is permitted only in or among +countries not thus excluded. In such case, this License incorporates +the limitation as if written in the body of this License. + + 9. The Free Software Foundation may publish revised and/or new +versions +of the General Public License from time to time. Such new versions will +be similar in spirit to the present version, but may differ in detail to +address new problems or concerns. + +Each version is given a distinguishing version number. If the Program +specifies a version number of this License which applies to it and "any +later version", you have the option of following the terms and +conditions +either of that version or of any later version published by the Free +Software Foundation. If the Program does not specify a version number +of +this License, you may choose any version ever published by the Free +Software +Foundation. + + 10. If you wish to incorporate parts of the Program into other free +programs whose distribution conditions are different, write to the +author +to ask for permission. For software which is copyrighted by the Free +Software Foundation, write to the Free Software Foundation; we sometimes +make exceptions for this. Our decision will be guided by the two goals +of preserving the free status of all derivatives of our free software +and +of promoting the sharing and reuse of software generally. + + NO WARRANTY + + 11. BECAUSE THE PROGRAM IS LICENSED FREE OF CHARGE, THERE IS NO +WARRANTY +FOR THE PROGRAM, TO THE EXTENT PERMITTED BY APPLICABLE LAW. EXCEPT WHEN +OTHERWISE STATED IN WRITING THE COPYRIGHT HOLDERS AND/OR OTHER PARTIES +PROVIDE THE PROGRAM "AS IS" WITHOUT WARRANTY OF ANY KIND, EITHER +EXPRESSED +OR IMPLIED, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF +MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE. THE ENTIRE RISK +AS +TO THE QUALITY AND PERFORMANCE OF THE PROGRAM IS WITH YOU. SHOULD THE +PROGRAM PROVE DEFECTIVE, YOU ASSUME THE COST OF ALL NECESSARY SERVICING, +REPAIR OR CORRECTION. + + 12. IN NO EVENT UNLESS REQUIRED BY APPLICABLE LAW OR AGREED TO IN +WRITING +WILL ANY COPYRIGHT HOLDER, OR ANY OTHER PARTY WHO MAY MODIFY AND/OR +REDISTRIBUTE THE PROGRAM AS PERMITTED ABOVE, BE LIABLE TO YOU FOR +DAMAGES, +INCLUDING ANY GENERAL, SPECIAL, INCIDENTAL OR CONSEQUENTIAL DAMAGES +ARISING +OUT OF THE USE OR INABILITY TO USE THE PROGRAM (INCLUDING BUT NOT +LIMITED +TO LOSS OF DATA OR DATA BEING RENDERED INACCURATE OR LOSSES SUSTAINED BY +YOU OR THIRD PARTIES OR A FAILURE OF THE PROGRAM TO OPERATE WITH ANY +OTHER +PROGRAMS), EVEN IF SUCH HOLDER OR OTHER PARTY HAS BEEN ADVISED OF THE +POSSIBILITY OF SUCH DAMAGES. + + END OF TERMS AND CONDITIONS + + How to Apply These Terms to Your New Programs + + If you develop a new program, and you want it to be of the greatest +possible use to the public, the best way to achieve this is to make it +free software which everyone can redistribute and change under these +terms. + + To do so, attach the following notices to the program. It is safest +to attach them to the start of each source file to most effectively +convey the exclusion of warranty; and each file should have at least +the "copyright" line and a pointer to where the full notice is found. + + + Copyright (C) 19yy + + This program is free software; you can redistribute it and/or modify + it under the terms of the GNU General Public License as published by + the Free Software Foundation; either version 2 of the License, or + (at your option) any later version. + + This program is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + GNU General Public License for more details. + + You should have received a copy of the GNU General Public License + along with this program; if not, write to the Free Software + Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 +USA + + +Also add information on how to contact you by electronic and paper mail. + +If the program is interactive, make it output a short notice like this +when it starts in an interactive mode: + + Gnomovision version 69, Copyright (C) 19yy name of author + Gnomovision comes with ABSOLUTELY NO WARRANTY; for details type +`show w'. + This is free software, and you are welcome to redistribute it + under certain conditions; type `show c' for details. + +The hypothetical commands `show w' and `show c' should show the +appropriate +parts of the General Public License. Of course, the commands you use +may +be called something other than `show w' and `show c'; they could even be +mouse-clicks or menu items--whatever suits your program. + +You should also get your employer (if you work as a programmer) or your +school, if any, to sign a "copyright disclaimer" for the program, if +necessary. Here is a sample; alter the names: + + Yoyodyne, Inc., hereby disclaims all copyright interest in the program + `Gnomovision' (which makes passes at compilers) written by James +Hacker. + + , 1 April 1989 + Ty Coon, President of Vice + +This General Public License does not permit incorporating your program +into +proprietary programs. If your program is a subroutine library, you may +consider it more useful to permit linking proprietary applications with +the +library. If this is what you want to do, use the GNU Library General +Public License instead of this License. + diff --git a/README b/README new file mode 100644 index 0000000..69c0479 --- /dev/null +++ b/README @@ -0,0 +1,26 @@ +README for UseModWiki 1.0 +Last updated: August 1, 2003 + +Release notes: + +Visit http://www.usemod.com/cgi-bin/wiki.pl for documentation and official +announcements regarding UseModWiki. The current documentation is minimal, +but the developers and some users will try to answer any questions. + +Please send questions or comments to usemod@usemod.com. + +A mailing list for major UseModWiki announcements (releases and critical +bugs) is available. Send mail to usemod@usemod.com to join the list. + +------ +Security: + +Wiki administrators should be aware of the risks of enabling the HTML +or email options in UseModWiki. Permitting full HTML editing allows a +malicious user to cause the browsers of other users to execute +arbitrary Javascript, Java applets, or other possible sources of +security holes. The email option could be misused to send annoying +mail to third parties (since no validation is done on the email +addresses entered into the Preferences page). These options may be +useful for small trusted groups, but they are not advised for wikis +open to the general public. diff --git a/UPGRADE b/UPGRADE new file mode 100644 index 0000000..4f68a22 --- /dev/null +++ b/UPGRADE @@ -0,0 +1,100 @@ +Upgrade instructions for UseModWiki 1.0 +Last updated: September 11, 2003 +See the INSTALL file for new installations. + +Please email usemod@usemod.com with any questions, comments, or suggestions. + +------ +Upgrading from 0.90, 0.91, or 0.92: + +1. Make a backup of your current wiki script and your database directory + ($DataDir). + +2. Copy the wiki.pl file to your cgi-bin directory, overwriting your + old wiki script. You may need to change the permissions on the + new script file. + +3. Edit the wiki script in your cgi-bin directory, and change the line + reading: $DataDir = "/tmp/mywikidb"; # Main wiki directory + ...to point to your existing wiki database directory. + +4. If you are using the "config"-file method for your wiki settings, + you can stop here (if you accept the defaults for new settings). + If you want to change these settings, copy the appropriate lines from + the new settings below to your config file and change them there. + +5. If you did *not* use the config-file method for your settings, change + the settings in the new script to match your old script. + +Note that the default settings enable the "free-links" feature. If you +want to continue using a "traditional" wiki (that does not allow free-links), +you should change $FreeLinks to 0. + +------ +Upgrading from older versions (before 0.90) is possible, but requires +a conversion utility for the database. Contact usemod@usemod.com for +upgrade instructions. + +------ +# New configuration settings added after 0.92: +$InterWikiMoniker = ''; # InterWiki moniker for this wiki. (for RSS) +$SiteDescription = $SiteName; # Description of this wiki. (for RSS) +$RssLogoUrl = ''; # Optional image for RSS feed +$KeepSize = 0; # If non-zero, maximum size of keep file +$BGColor = 'white'; # Background color ('' to disable) +$DiffColor1 = '#ffffaf'; # Background color of old/deleted text +$DiffColor2 = '#cfffcf'; # Background color of new/added text +$FavIcon = ''; # URL of bookmark/favorites icon, or '' +$RssDays = 7; # Default number of days in RSS feed +$UserHeader = ''; # Optional HTML header additional content +$UserBody = ''; # Optional tag additional content +$EarlyRules = ''; # Local syntax rules for wiki->html (evaled) +$LateRules = ''; # Local syntax rules for wiki->html (evaled) +$StartUID = 1001; # Starting number for user IDs +$UploadDir = ''; # Full path (like /foo/www/uploads) for files +$UploadUrl = ''; # Full URL (like http://foo.com/uploads) +@ImageSites = qw(); # Url prefixes of good image sites: ()=all + +$DeletedPage = 'DeletedPage'; # 0 = disable, 'PageName' = tag to delete page +$ReplaceFile = 'ReplaceFile'; # 0 = disable, 'PageName' = indicator tag +@ReplaceableFiles = (); # List of allowed server files to replace +$TableSyntax = 1; # 1 = wiki syntax tables, 0 = no table syntax +$NewFS = 0; # 1 = new multibyte $FS, 0 = old $FS +$UseUpload = 0; # 1 = allow uploads, 0 = no uploads + +$MetaKeywords = 1; # 1 = Google-friendly, 0 = search-engine averse +$NamedAnchors = 1; # 0 = no anchors, 1 = enable anchors, + # 2 = enable but suppress display +$SlashLinks = 0; # 1 = use script/action links, 0 = script?action +$UpperFirst = 1; # 1 = free links start uppercase, 0 = no ucfirst +$AdminBar = 1; # 1 = admins see admin links, 0 = no admin bar +$RepInterMap = 0; # 1 = intermap is replacable, 0 = not replacable +$ConfirmDel = 1; # 1 = delete link confirm page, 0 = immediate delete +$MaskHosts = 0; # 1 = mask hosts/IPs, 0 = no masking +$LockCrash = 0; # 1 = crash if lock stuck, 0 = auto clear locks +$HistoryEdit = 0; # 1 = edit links on history page, 0 = no edit links +$OldThinLine = 0; # 1 = old ==== thick line, 0 = ------ for thick line +$NumberDates = 0; # 1 = 2003-6-17 dates, 0 = June 17, 2003 dates +$ParseParas = 0; # 1 = new paragraph markup, 0 = old markup +$AuthorFooter = 1; # 1 = show last author in footer, 0 = do not show +$AllUpload = 0; # 1 = anyone can upload, 0 = only editor/admins +$LimitFileUrl = 1; # 1 = limited use of file: URLs, 0 = no limits +$MaintTrimRc = 0; # 1 = maintain action trims RC, 0 = only maintainrc +$SearchButton = 0; # 1 = search button on page, 0 = old behavior +$EditNameLink = 0; # 1 = edit links use name (CSS), 0 = '?' links +$UseMetaWiki = 0; # 1 = add MetaWiki search links, 0 = no MW links +$BracketImg = 1; # 1 = [url url.gif] becomes image link, 0 = no img + +# Names of sites. (The first entry is used for the number link.) +@IsbnNames = ('bn.com', 'amazon.com', 'powells.com', 'search'); +# Full URL of each site before the ISBN +@IsbnPre = ('http://shop.barnesandnoble.com/bookSearch/isbnInquiry.asp?isbn=', + 'http://www.amazon.com/exec/obidos/ISBN=', + 'http://www.powells.com/cgi-bin/biblio?isbn=', + 'http://www.pricescan.com/books/BookDetail.asp?isbn='); +# Rest of URL of each site after the ISBN (usually '') +@IsbnPost = ('', '', '', ''); + +$EmailFile = "$DataDir/emails"; # Email notification lists +# End of new configuration settings +==== end of UPGRADE document ==== diff --git a/config b/config new file mode 100644 index 0000000..e82258a --- /dev/null +++ b/config @@ -0,0 +1,143 @@ +# == Configuration ======================================================= +# Original version from UseModWiki 1.0 + +$CookieName = "Wiki"; # Name for this wiki (for multi-wiki sites) +$SiteName = "Wiki"; # Name of site (used for titles) +$HomePage = "HomePage"; # Home page (change space to _) +$RCName = "RecentChanges"; # Name of changes page (change space to _) +$LogoUrl = "/wiki.gif"; # URL for site logo ("" for no logo) +$ENV{PATH} = "/usr/bin/"; # Path used to find "diff" +$ScriptTZ = ""; # Local time zone ("" means do not print) +$RcDefault = 30; # Default number of RecentChanges days +@RcDays = qw(1 3 7 30 90); # Days for links on RecentChanges +$KeepDays = 14; # Days to keep old revisions +$SiteBase = ""; # Full URL for header +$FullUrl = ""; # Set if the auto-detected URL is wrong +$RedirType = 1; # 1 = CGI.pm, 2 = script, 3 = no redirect +$AdminPass = ""; # Set to non-blank to enable password(s) +$EditPass = ""; # Like AdminPass, but for editing only +$StyleSheet = ""; # URL for CSS stylesheet (like "/wiki.css") +$NotFoundPg = ""; # Page for not-found links ("" for blank pg) +$EmailFrom = "Wiki"; # Text for "From: " field of email notes. +$SendMail = "/usr/sbin/sendmail"; # Full path to sendmail executable +$FooterNote = ""; # HTML for bottom of every page +$EditNote = ""; # HTML notice above buttons on edit page +$MaxPost = 1024 * 210; # Maximum 210K posts (about 200K for pages) +$NewText = ""; # New page text ("" for default message) +$HttpCharset = ""; # Charset for pages, like "iso-8859-2" +$UserGotoBar = ""; # HTML added to end of goto bar +$InterWikiMoniker = ''; # InterWiki moniker for this wiki. (for RSS) +$SiteDescription = $SiteName; # Description of this wiki. (for RSS) +$RssLogoUrl = ''; # Optional image for RSS feed +$EarlyRules = ''; # Local syntax rules for wiki->html (evaled) +$LateRules = ''; # Local syntax rules for wiki->html (evaled) +$KeepSize = 0; # If non-zero, maximum size of keep file +$BGColor = 'white'; # Background color ('' to disable) +$DiffColor1 = '#ffffaf'; # Background color of old/deleted text +$DiffColor2 = '#cfffcf'; # Background color of new/added text +$FavIcon = ''; # URL of bookmark/favorites icon, or '' +$RssDays = 7; # Default number of days in RSS feed +$UserHeader = ''; # Optional HTML header additional content +$UserBody = ''; # Optional tag additional content +$StartUID = 1001; # Starting number for user IDs +$UploadDir = ''; # Full path (like /foo/www/uploads) for files +$UploadUrl = ''; # Full URL (like http://foo.com/uploads) +@ImageSites = qw(); # Url prefixes of good image sites: ()=all + +# Major options: +$UseSubpage = 1; # 1 = use subpages, 0 = do not use subpages +$UseCache = 0; # 1 = cache HTML pages, 0 = generate every page +$EditAllowed = 1; # 1 = editing allowed, 0 = read-only +$RawHtml = 0; # 1 = allow tag, 0 = no raw HTML in pages +$HtmlTags = 0; # 1 = "unsafe" HTML tags, 0 = only minimal tags +$UseDiff = 1; # 1 = use diff features, 0 = do not use diff +$FreeLinks = 1; # 1 = use [[word]] links, 0 = LinkPattern only +$WikiLinks = 1; # 1 = use LinkPattern, 0 = use [[word]] only +$AdminDelete = 1; # 1 = Admin only deletes, 0 = Editor can delete +$RunCGI = 1; # 1 = Run script as CGI, 0 = Load but do not run +$EmailNotify = 0; # 1 = use email notices, 0 = no email on changes +$EmbedWiki = 0; # 1 = no headers/footers, 0 = normal wiki pages +$DeletedPage = 'DeletedPage'; # 0 = disable, 'PageName' = tag to delete page +$ReplaceFile = 'ReplaceFile'; # 0 = disable, 'PageName' = indicator tag +@ReplaceableFiles = (); # List of allowed server files to replace +$TableSyntax = 1; # 1 = wiki syntax tables, 0 = no table syntax +$NewFS = 0; # 1 = new multibyte $FS, 0 = old $FS +$UseUpload = 0; # 1 = allow uploads, 0 = no uploads + +# Minor options: +$LogoLeft = 0; # 1 = logo on left, 0 = logo on right +$RecentTop = 1; # 1 = recent on top, 0 = recent on bottom +$UseDiffLog = 1; # 1 = save diffs to log, 0 = do not save diffs +$KeepMajor = 1; # 1 = keep major rev, 0 = expire all revisions +$KeepAuthor = 1; # 1 = keep author rev, 0 = expire all revisions +$ShowEdits = 0; # 1 = show minor edits, 0 = hide edits by default +$HtmlLinks = 0; # 1 = allow A HREF links, 0 = no raw HTML links +$SimpleLinks = 0; # 1 = only letters, 0 = allow _ and numbers +$NonEnglish = 0; # 1 = extra link chars, 0 = only A-Za-z chars +$ThinLine = 0; # 1 = fancy
tags, 0 = classic wiki
+$BracketText = 1; # 1 = allow [URL text], 0 = no link descriptions +$UseAmPm = 1; # 1 = use am/pm in times, 0 = use 24-hour times +$UseIndex = 0; # 1 = use index file, 0 = slow/reliable method +$UseHeadings = 1; # 1 = allow = h1 text =, 0 = no header formatting +$NetworkFile = 1; # 1 = allow remote file:, 0 = no file:// links +$BracketWiki = 0; # 1 = [WikiLnk txt] link, 0 = no local descriptions +$UseLookup = 1; # 1 = lookup host names, 0 = skip lookup (IP only) +$FreeUpper = 1; # 1 = force upper case, 0 = do not force case +$FastGlob = 1; # 1 = new faster code, 0 = old compatible code +$MetaKeywords = 1; # 1 = Google-friendly, 0 = search-engine averse +$NamedAnchors = 1; # 0 = no anchors, 1 = enable anchors, + # 2 = enable but suppress display +$SlashLinks = 0; # 1 = use script/action links, 0 = script?action +$UpperFirst = 1; # 1 = free links start uppercase, 0 = no ucfirst +$AdminBar = 1; # 1 = admins see admin links, 0 = no admin bar +$RepInterMap = 0; # 1 = intermap is replacable, 0 = not replacable +$ConfirmDel = 1; # 1 = delete link confirm page, 0 = immediate delete +$MaskHosts = 0; # 1 = mask hosts/IPs, 0 = no masking +$LockCrash = 0; # 1 = crash if lock stuck, 0 = auto clear locks +$HistoryEdit = 0; # 1 = edit links on history page, 0 = no edit links +$OldThinLine = 0; # 1 = old ==== thick line, 0 = ------ for thick line +$NumberDates = 0; # 1 = 2003-6-17 dates, 0 = June 17, 2003 dates +$ParseParas = 0; # 1 = new paragraph markup, 0 = old markup +$AuthorFooter = 1; # 1 = show last author in footer, 0 = do not show +$AllUpload = 0; # 1 = anyone can upload, 0 = only editor/admins +$LimitFileUrl = 1; # 1 = limited use of file: URLs, 0 = no limits +$MaintTrimRc = 0; # 1 = maintain action trims RC, 0 = only maintainrc +$SearchButton = 0; # 1 = search button on page, 0 = old behavior +$EditNameLink = 0; # 1 = edit links use name (CSS), 0 = '?' links +$UseMetaWiki = 0; # 1 = add MetaWiki search links, 0 = no MW links +$BracketImg = 1; # 1 = [url url.gif] becomes image link, 0 = no img + +# Names of sites. (The first entry is used for the number link.) +@IsbnNames = ('bn.com', 'amazon.com', 'search'); +# Full URL of each site before the ISBN +@IsbnPre = ('http://shop.barnesandnoble.com/bookSearch/isbnInquiry.asp?isbn=', + 'http://www.amazon.com/exec/obidos/ISBN=', + 'http://www.pricescan.com/books/BookDetail.asp?isbn='); +# Rest of URL of each site after the ISBN (usually '') +@IsbnPost = ('', '', ''); + +# HTML tag lists, enabled if $HtmlTags is set. +# Scripting is currently possible with these tags, +# so they are *not* particularly "safe". +# Tags that must be in ... pairs: +@HtmlPairs = qw(b i u font big small sub sup h1 h2 h3 h4 h5 h6 cite code + em s strike strong tt var div center blockquote ol ul dl table caption); +# Single tags (that do not require a closing /tag) +@HtmlSingle = qw(br p hr li dt dd tr td th); +@HtmlPairs = (@HtmlPairs, @HtmlSingle); # All singles can also be pairs + +# == You should not have to change anything below this line. ============= +$IndentLimit = 20; # Maximum depth of nested lists +$PageDir = "$DataDir/page"; # Stores page data +$HtmlDir = "$DataDir/html"; # Stores HTML versions +$UserDir = "$DataDir/user"; # Stores user data +$KeepDir = "$DataDir/keep"; # Stores kept (old) page data +$TempDir = "$DataDir/temp"; # Temporary files and locks +$LockDir = "$TempDir/lock"; # DB is locked if this exists +$InterFile = "$DataDir/intermap"; # Interwiki site->url map +$RcFile = "$DataDir/rclog"; # New RecentChanges logfile +$RcOldFile = "$DataDir/oldrclog"; # Old RecentChanges logfile +$IndexFile = "$DataDir/pageidx"; # List of all pages +$EmailFile = "$DataDir/emails"; # Email notification lists + +# == End of Configuration ================================================= diff --git a/intermap b/intermap new file mode 100644 index 0000000..9cead67 --- /dev/null +++ b/intermap @@ -0,0 +1,10 @@ +Acronym http://www.acronymfinder.com/af-query.asp?String=exact&Acronym= +Cache http://www.google.com/search?q=cache: +Dictionary http://www.dict.org/bin/Dict?Database=*&Form=Dict1&Strategy=*&Query= +Google http://www.google.com/search?q= +GoogleGroups http://groups.google.com/groups?q= +IMDB http://us.imdb.com/Title? +JargonFile http://sunir.org/apps/meta.pl?wiki=JargonFile&redirect= +UseMod http://www.usemod.com/cgi-bin/wiki.pl? +Wiki http://c2.com/cgi/wiki? +WikiPedia http://www.wikipedia.org/wiki/ diff --git a/misc/trans.pl b/misc/trans.pl new file mode 100644 index 0000000..f710ae6 --- /dev/null +++ b/misc/trans.pl @@ -0,0 +1,514 @@ +%Translate = split('\n',< trans.pl +# ... creates a new/empty translation table from wiki.pl +# umtrans.pl wiki.pl trans.pl > newtrans.pl +# ... creates a new translation table using wiki.pl and an old table + +if ((@ARGV < 1) || (@ARGV > 2)) { + # Usage later + die("Wrong number of arguments"); +} + +%Translate = (); +if (@ARGV == 2) { + do (pop(@ARGV)); # Evaluate second argument and remove it +} + +%seen = (); + +sub trans { + my ($string) = @_; + my ($result); + + $result = ''; +# Uncomment the next line to create a test translation table +# $result = 'X_' . $string . '_W'; + + $result = $Translate{$string} if (defined($Translate{$string})); + + return ' ' if ($seen{$string}); + $seen{$string} = 1; + print $string . "\n" . $result . "\n"; + return ' '; +} + +print '%Translate = split(\'\n\',<) { + s/T\(\'([^']+)/&trans($1)/ge; + s/Tss?\(\'([^']+)/&trans($1)/ge; + s/T\(\"([^"]+)/&trans($1)/ge; + s/Tss?\(\"([^"]+)/&trans($1)/ge; +} + +print "END_OF_TRANSLATION\n"; diff --git a/wiki.css b/wiki.css new file mode 100644 index 0000000..af8589e --- /dev/null +++ b/wiki.css @@ -0,0 +1,49 @@ +/* The following is a sample CSS file for UseModWiki 1.0. + It is not pretty, but it demonstrates all of the new DIVs and + tag classes. */ +DIV.wikitext { + background-color : #ccc; +} +DIV.wikipreview { + background-color : Lightblue; +} +DIV.wikiheader { + background-color : Lightpink; +} +DIV.wikirc { + background-color : Lightblue; +} +DIV.wikifooter { + background-color : Lightpink; +} +DIV.wikipref { + background-color : orange; +} +HR.wikilinefooter { + height : 3px; +} +HR.wikilineheader { + height : 2px; + border : double; +} +HR.wikiline { + height : 2px; + color : blue; +} +HR.wikilinepref { + color : red; + height : 5px; +} +A.wikipagelink { + background-color : orange; +} +A.wikipageedit { + color : red; + border-bottom : 1px dotted #a00 +} +TABLE.wikidiffold { + background-color : orange; +} +TABLE.wikidiffnew { + background-color : Lightgreen; +} diff --git a/wiki.gif b/wiki.gif new file mode 100644 index 0000000..e33d33f Binary files /dev/null and b/wiki.gif differ diff --git a/wiki.pl b/wiki.pl new file mode 100755 index 0000000..ecb43b2 --- /dev/null +++ b/wiki.pl @@ -0,0 +1,5096 @@ +#!/usr/bin/perl +# UseModWiki version 1.0 (September 12, 2003) +# Copyright (C) 2000-2003 Clifford A. Adams +# Copyright (C) 2002-2003 Sunir Shah +# Based on the GPLed AtisWiki 0.3 (C) 1998 Markus Denker +# +# ...which was based on +# the LGPLed CVWiki CVS-patches (C) 1997 Peter Merel +# and The Original WikiWikiWeb (C) Ward Cunningham +# (code reused with permission) +# Email and ThinLine options by Jim Mahoney +# +# This program is free software; you can redistribute it and/or modify +# it under the terms of the GNU General Public License as published by +# the Free Software Foundation; either version 2 of the License, or +# (at your option) any later version. +# +# This program is distributed in the hope that it will be useful, +# but WITHOUT ANY WARRANTY; without even the implied warranty of +# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +# GNU General Public License for more details. +# +# You should have received a copy of the GNU General Public License +# along with this program; if not, write to the +# Free Software Foundation, Inc. +# 59 Temple Place, Suite 330 +# Boston, MA 02111-1307 USA + +package UseModWiki; +use strict; +local $| = 1; # Do not buffer output (localized for mod_perl) + +# Configuration/constant variables: +use vars qw(@RcDays @HtmlPairs @HtmlSingle + $TempDir $LockDir $DataDir $HtmlDir $UserDir $KeepDir $PageDir + $InterFile $RcFile $RcOldFile $IndexFile $FullUrl $SiteName $HomePage + $LogoUrl $RcDefault $IndentLimit $RecentTop $EditAllowed $UseDiff + $UseSubpage $UseCache $RawHtml $SimpleLinks $NonEnglish $LogoLeft + $KeepDays $HtmlTags $HtmlLinks $UseDiffLog $KeepMajor $KeepAuthor + $FreeUpper $EmailNotify $SendMail $EmailFrom $FastGlob $EmbedWiki + $ScriptTZ $BracketText $UseAmPm $UseConfig $UseIndex $UseLookup + $RedirType $AdminPass $EditPass $UseHeadings $NetworkFile $BracketWiki + $FreeLinks $WikiLinks $AdminDelete $FreeLinkPattern $RCName $RunCGI + $ShowEdits $ThinLine $LinkPattern $InterLinkPattern $InterSitePattern + $UrlProtocols $UrlPattern $ImageExtensions $RFCPattern $ISBNPattern + $FS $FS1 $FS2 $FS3 $CookieName $SiteBase $StyleSheet $NotFoundPg + $FooterNote $EditNote $MaxPost $NewText $NotifyDefault $HttpCharset + $UserGotoBar $DeletedPage $ReplaceFile @ReplaceableFiles $TableSyntax + $MetaKeywords $NamedAnchors $InterWikiMoniker $SiteDescription $RssLogoUrl + $NumberDates $EarlyRules $LateRules $NewFS $KeepSize $SlashLinks $BGColor + $UpperFirst $AdminBar $RepInterMap $DiffColor1 $DiffColor2 $ConfirmDel + $MaskHosts $LockCrash $ConfigFile $HistoryEdit $OldThinLine + @IsbnNames @IsbnPre @IsbnPost $EmailFile $FavIcon $RssDays $UserHeader + $UserBody $StartUID $ParseParas $AuthorFooter $UseUpload $AllUpload + $UploadDir $UploadUrl $LimitFileUrl $MaintTrimRc $SearchButton + $EditNameLink $UseMetaWiki @ImageSites $BracketImg ); +# Note: $NotifyDefault is kept because it was a config variable in 0.90 +# Other global variables: +use vars qw(%Page %Section %Text %InterSite %SaveUrl %SaveNumUrl + %KeptRevisions %UserCookie %SetCookie %UserData %IndexHash %Translate + %LinkIndex $InterSiteInit $SaveUrlIndex $SaveNumUrlIndex $MainPage + $OpenPageName @KeptList @IndexList $IndexInit $TableMode + $q $Now $UserID $TimeZoneOffset $ScriptName $BrowseCode $OtherCode + $AnchoredLinkPattern @HeadingNumbers $TableOfContents $QuotedFullUrl + $ConfigError $UploadPattern ); + +# == Configuration ===================================================== +$DataDir = "/tmp/mywikidb"; # Main wiki directory +$UseConfig = 1; # 1 = use config file, 0 = do not look for config +$ConfigFile = "$DataDir/config"; # Configuration file + +# Default configuration (used if UseConfig is 0) +$CookieName = "Wiki"; # Name for this wiki (for multi-wiki sites) +$SiteName = "Wiki"; # Name of site (used for titles) +$HomePage = "HomePage"; # Home page (change space to _) +$RCName = "RecentChanges"; # Name of changes page (change space to _) +$LogoUrl = "/wiki.gif"; # URL for site logo ("" for no logo) +$ENV{PATH} = "/usr/bin/"; # Path used to find "diff" +$ScriptTZ = ""; # Local time zone ("" means do not print) +$RcDefault = 30; # Default number of RecentChanges days +@RcDays = qw(1 3 7 30 90); # Days for links on RecentChanges +$KeepDays = 14; # Days to keep old revisions +$SiteBase = ""; # Full URL for header +$FullUrl = ""; # Set if the auto-detected URL is wrong +$RedirType = 1; # 1 = CGI.pm, 2 = script, 3 = no redirect +$AdminPass = ""; # Set to non-blank to enable password(s) +$EditPass = ""; # Like AdminPass, but for editing only +$StyleSheet = ""; # URL for CSS stylesheet (like "/wiki.css") +$NotFoundPg = ""; # Page for not-found links ("" for blank pg) +$EmailFrom = "Wiki"; # Text for "From: " field of email notes. +$SendMail = "/usr/sbin/sendmail"; # Full path to sendmail executable +$FooterNote = ""; # HTML for bottom of every page +$EditNote = ""; # HTML notice above buttons on edit page +$MaxPost = 1024 * 210; # Maximum 210K posts (about 200K for pages) +$NewText = ""; # New page text ("" for default message) +$HttpCharset = ""; # Charset for pages, like "iso-8859-2" +$UserGotoBar = ""; # HTML added to end of goto bar +$InterWikiMoniker = ''; # InterWiki moniker for this wiki. (for RSS) +$SiteDescription = $SiteName; # Description of this wiki. (for RSS) +$RssLogoUrl = ''; # Optional image for RSS feed +$EarlyRules = ''; # Local syntax rules for wiki->html (evaled) +$LateRules = ''; # Local syntax rules for wiki->html (evaled) +$KeepSize = 0; # If non-zero, maximum size of keep file +$BGColor = 'white'; # Background color ('' to disable) +$DiffColor1 = '#ffffaf'; # Background color of old/deleted text +$DiffColor2 = '#cfffcf'; # Background color of new/added text +$FavIcon = ''; # URL of bookmark/favorites icon, or '' +$RssDays = 7; # Default number of days in RSS feed +$UserHeader = ''; # Optional HTML header additional content +$UserBody = ''; # Optional tag additional content +$StartUID = 1001; # Starting number for user IDs +$UploadDir = ''; # Full path (like /foo/www/uploads) for files +$UploadUrl = ''; # Full URL (like http://foo.com/uploads) +@ImageSites = qw(); # Url prefixes of good image sites: ()=all + +# Major options: +$UseSubpage = 1; # 1 = use subpages, 0 = do not use subpages +$UseCache = 0; # 1 = cache HTML pages, 0 = generate every page +$EditAllowed = 1; # 1 = editing allowed, 0 = read-only +$RawHtml = 0; # 1 = allow tag, 0 = no raw HTML in pages +$HtmlTags = 0; # 1 = "unsafe" HTML tags, 0 = only minimal tags +$UseDiff = 1; # 1 = use diff features, 0 = do not use diff +$FreeLinks = 1; # 1 = use [[word]] links, 0 = LinkPattern only +$WikiLinks = 1; # 1 = use LinkPattern, 0 = use [[word]] only +$AdminDelete = 1; # 1 = Admin only deletes, 0 = Editor can delete +$RunCGI = 1; # 1 = Run script as CGI, 0 = Load but do not run +$EmailNotify = 0; # 1 = use email notices, 0 = no email on changes +$EmbedWiki = 0; # 1 = no headers/footers, 0 = normal wiki pages +$DeletedPage = 'DeletedPage'; # 0 = disable, 'PageName' = tag to delete page +$ReplaceFile = 'ReplaceFile'; # 0 = disable, 'PageName' = indicator tag +@ReplaceableFiles = (); # List of allowed server files to replace +$TableSyntax = 1; # 1 = wiki syntax tables, 0 = no table syntax +$NewFS = 0; # 1 = new multibyte $FS, 0 = old $FS +$UseUpload = 0; # 1 = allow uploads, 0 = no uploads + +# Minor options: +$LogoLeft = 0; # 1 = logo on left, 0 = logo on right +$RecentTop = 1; # 1 = recent on top, 0 = recent on bottom +$UseDiffLog = 1; # 1 = save diffs to log, 0 = do not save diffs +$KeepMajor = 1; # 1 = keep major rev, 0 = expire all revisions +$KeepAuthor = 1; # 1 = keep author rev, 0 = expire all revisions +$ShowEdits = 0; # 1 = show minor edits, 0 = hide edits by default +$HtmlLinks = 0; # 1 = allow A HREF links, 0 = no raw HTML links +$SimpleLinks = 0; # 1 = only letters, 0 = allow _ and numbers +$NonEnglish = 0; # 1 = extra link chars, 0 = only A-Za-z chars +$ThinLine = 0; # 1 = fancy
tags, 0 = classic wiki
+$BracketText = 1; # 1 = allow [URL text], 0 = no link descriptions +$UseAmPm = 1; # 1 = use am/pm in times, 0 = use 24-hour times +$UseIndex = 0; # 1 = use index file, 0 = slow/reliable method +$UseHeadings = 1; # 1 = allow = h1 text =, 0 = no header formatting +$NetworkFile = 1; # 1 = allow remote file:, 0 = no file:// links +$BracketWiki = 0; # 1 = [WikiLnk txt] link, 0 = no local descriptions +$UseLookup = 1; # 1 = lookup host names, 0 = skip lookup (IP only) +$FreeUpper = 1; # 1 = force upper case, 0 = do not force case +$FastGlob = 1; # 1 = new faster code, 0 = old compatible code +$MetaKeywords = 1; # 1 = Google-friendly, 0 = search-engine averse +$NamedAnchors = 1; # 0 = no anchors, 1 = enable anchors, + # 2 = enable but suppress display +$SlashLinks = 0; # 1 = use script/action links, 0 = script?action +$UpperFirst = 1; # 1 = free links start uppercase, 0 = no ucfirst +$AdminBar = 1; # 1 = admins see admin links, 0 = no admin bar +$RepInterMap = 0; # 1 = intermap is replacable, 0 = not replacable +$ConfirmDel = 1; # 1 = delete link confirm page, 0 = immediate delete +$MaskHosts = 0; # 1 = mask hosts/IPs, 0 = no masking +$LockCrash = 0; # 1 = crash if lock stuck, 0 = auto clear locks +$HistoryEdit = 0; # 1 = edit links on history page, 0 = no edit links +$OldThinLine = 0; # 1 = old ==== thick line, 0 = ------ for thick line +$NumberDates = 0; # 1 = 2003-6-17 dates, 0 = June 17, 2003 dates +$ParseParas = 0; # 1 = new paragraph markup, 0 = old markup +$AuthorFooter = 1; # 1 = show last author in footer, 0 = do not show +$AllUpload = 0; # 1 = anyone can upload, 0 = only editor/admins +$LimitFileUrl = 1; # 1 = limited use of file: URLs, 0 = no limits +$MaintTrimRc = 0; # 1 = maintain action trims RC, 0 = only maintainrc +$SearchButton = 0; # 1 = search button on page, 0 = old behavior +$EditNameLink = 0; # 1 = edit links use name (CSS), 0 = '?' links +$UseMetaWiki = 0; # 1 = add MetaWiki search links, 0 = no MW links +$BracketImg = 1; # 1 = [url url.gif] becomes image link, 0 = no img + +# Names of sites. (The first entry is used for the number link.) +@IsbnNames = ('bn.com', 'amazon.com', 'search'); +# Full URL of each site before the ISBN +@IsbnPre = ('http://shop.barnesandnoble.com/bookSearch/isbnInquiry.asp?isbn=', + 'http://www.amazon.com/exec/obidos/ISBN=', + 'http://www.pricescan.com/books/BookDetail.asp?isbn='); +# Rest of URL of each site after the ISBN (usually '') +@IsbnPost = ('', '', ''); + +# HTML tag lists, enabled if $HtmlTags is set. +# Scripting is currently possible with these tags, +# so they are *not* particularly "safe". +# Tags that must be in ... pairs: +@HtmlPairs = qw(b i u font big small sub sup h1 h2 h3 h4 h5 h6 cite code + em s strike strong tt var div center blockquote ol ul dl table caption); +# Single tags (that do not require a closing /tag) +@HtmlSingle = qw(br p hr li dt dd tr td th); +@HtmlPairs = (@HtmlPairs, @HtmlSingle); # All singles can also be pairs + +# == You should not have to change anything below this line. ============= +$IndentLimit = 20; # Maximum depth of nested lists +$PageDir = "$DataDir/page"; # Stores page data +$HtmlDir = "$DataDir/html"; # Stores HTML versions +$UserDir = "$DataDir/user"; # Stores user data +$KeepDir = "$DataDir/keep"; # Stores kept (old) page data +$TempDir = "$DataDir/temp"; # Temporary files and locks +$LockDir = "$TempDir/lock"; # DB is locked if this exists +$InterFile = "$DataDir/intermap"; # Interwiki site->url map +$RcFile = "$DataDir/rclog"; # New RecentChanges logfile +$RcOldFile = "$DataDir/oldrclog"; # Old RecentChanges logfile +$IndexFile = "$DataDir/pageidx"; # List of all pages +$EmailFile = "$DataDir/emails"; # Email notification lists + +if ($RepInterMap) { + push @ReplaceableFiles, $InterFile; +} + +# The "main" program, called at the end of this script file. +sub DoWikiRequest { + if ($UseConfig && (-f $ConfigFile)) { + $ConfigError = ''; + if (!do $ConfigFile) { # Some error occurred + $ConfigError = $@; + if ($ConfigError eq '') { + # Unfortunately, if the last expr returns 0, one will get a false + # error above. To remain compatible with existing installs the + # wiki must not report an error unless there is error text in $@. + # (Errors in "use strict" may not have error text.) + # Uncomment the line below if you want to catch use strict errors. +# $ConfigError = T('Unknown Error (no error text)'); + } + } + } + &InitLinkPatterns(); + if (!&DoCacheBrowse()) { + eval $BrowseCode; + &InitRequest() or return; + if (!&DoBrowseRequest()) { + eval $OtherCode; + &DoOtherRequest(); + } + } +} + +# == Common and cache-browsing code ==================================== +sub InitLinkPatterns { + my ($UpperLetter, $LowerLetter, $AnyLetter, $LpA, $LpB, $QDelim); + + # Field separators are used in the URL-style patterns below. + if ($NewFS) { + $FS = "\x1e\xff\xfe\x1e"; # An unlikely sequence for any charset + } else { + $FS = "\xb3"; # The FS character is a superscript "3" + } + $FS1 = $FS . "1"; # The FS values are used to separate fields + $FS2 = $FS . "2"; # in stored hashtables and other data structures. + $FS3 = $FS . "3"; # The FS character is not allowed in user data. + $UpperLetter = "[A-Z"; + $LowerLetter = "[a-z"; + $AnyLetter = "[A-Za-z"; + if ($NonEnglish) { + $UpperLetter .= "\xc0-\xde"; + $LowerLetter .= "\xdf-\xff"; + if ($NewFS) { + $AnyLetter .= "\x80-\xff"; + } else { + $AnyLetter .= "\xc0-\xff"; + } + } + if (!$SimpleLinks) { + $AnyLetter .= "_0-9"; + } + $UpperLetter .= "]"; $LowerLetter .= "]"; $AnyLetter .= "]"; + # Main link pattern: lowercase between uppercase, then anything + $LpA = $UpperLetter . "+" . $LowerLetter . "+" . $UpperLetter + . $AnyLetter . "*"; + # Optional subpage link pattern: uppercase, lowercase, then anything + $LpB = $UpperLetter . "+" . $LowerLetter . "+" . $AnyLetter . "*"; + if ($UseSubpage) { + # Loose pattern: If subpage is used, subpage may be simple name + $LinkPattern = "((?:(?:$LpA)?\\/$LpB)|$LpA)"; + # Strict pattern: both sides must be the main LinkPattern + # $LinkPattern = "((?:(?:$LpA)?\\/)?$LpA)"; + } else { + $LinkPattern = "($LpA)"; + } + $QDelim = '(?:"")?'; # Optional quote delimiter (not in output) + $AnchoredLinkPattern = $LinkPattern . '#(\\w+)' . $QDelim if $NamedAnchors; + $LinkPattern .= $QDelim; + # Inter-site convention: sites must start with uppercase letter + # (Uppercase letter avoids confusion with URLs) + $InterSitePattern = $UpperLetter . $AnyLetter . "+"; + $InterLinkPattern = "((?:$InterSitePattern:[^\\]\\s\"<>$FS]+)$QDelim)"; + if ($FreeLinks) { + # Note: the - character must be first in $AnyLetter definition + if ($NonEnglish) { + if ($NewFS) { + $AnyLetter = "[-,.()' _0-9A-Za-z\x80-\xff]"; + } else { + $AnyLetter = "[-,.()' _0-9A-Za-z\xc0-\xff]"; + } + } else { + $AnyLetter = "[-,.()' _0-9A-Za-z]"; + } + } + $FreeLinkPattern = "($AnyLetter+)"; + if ($UseSubpage) { + $FreeLinkPattern = "((?:(?:$AnyLetter+)?\\/)?$AnyLetter+)"; + } + $FreeLinkPattern .= $QDelim; + # Url-style links are delimited by one of: + # 1. Whitespace (kept in output) + # 2. Left or right angle-bracket (< or >) (kept in output) + # 3. Right square-bracket (]) (kept in output) + # 4. A single double-quote (") (kept in output) + # 5. A $FS (field separator) character (kept in output) + # 6. A double double-quote ("") (removed from output) + $UrlProtocols = "http|https|ftp|afs|news|nntp|mid|cid|mailto|wais|" + . "prospero|telnet|gopher"; + $UrlProtocols .= '|file' if ($NetworkFile || !$LimitFileUrl); + $UrlPattern = "((?:(?:$UrlProtocols):[^\\]\\s\"<>$FS]+)$QDelim)"; + $ImageExtensions = "(gif|jpg|png|bmp|jpeg)"; + $RFCPattern = "RFC\\s?(\\d+)"; + $ISBNPattern = "ISBN:?([0-9- xX]{10,})"; + $UploadPattern = "upload:([^\\]\\s\"<>$FS]+)$QDelim"; +} + +# Simple HTML cache +sub DoCacheBrowse { + my ($query, $idFile, $text); + + return 0 if (!$UseCache); + $query = $ENV{'QUERY_STRING'}; + if (($query eq "") && ($ENV{'REQUEST_METHOD'} eq "GET")) { + $query = $HomePage; # Allow caching of home page. + } + if (!($query =~ /^$LinkPattern$/)) { + if (!($FreeLinks && ($query =~ /^$FreeLinkPattern$/))) { + return 0; # Only use cache for simple links + } + } + $idFile = &GetHtmlCacheFile($query); + if (-f $idFile) { + local $/ = undef; # Read complete files + open(INFILE, "<$idFile") or return 0; + $text = ; + close INFILE; + print $text; + return 1; + } + return 0; +} + +sub GetHtmlCacheFile { + my ($id) = @_; + + return $HtmlDir . "/" . &GetPageDirectory($id) . "/$id.htm"; +} + +sub GetPageDirectory { + my ($id) = @_; + + if ($id =~ /^([a-zA-Z])/) { + return uc($1); + } + return "other"; +} + +sub T { + my ($text) = @_; + + if (defined($Translate{$text}) && ($Translate{$text} ne '')) { + return $Translate{$text}; + } + return $text; +} + +sub Ts { + my ($text, $string) = @_; + + $text = T($text); + $text =~ s/\%s/$string/; + return $text; +} + +sub Tss { + my $text = @_[0]; + + $text = T($text); + $text =~ s/\%([1-9])/$_[$1]/ge; + return $text; +} + +# == Normal page-browsing and RecentChanges code ======================= +$BrowseCode = ""; # Comment next line to always compile (slower) +#$BrowseCode = <<'#END_OF_BROWSE_CODE'; +use CGI; +use CGI::Carp qw(fatalsToBrowser); + +sub InitRequest { + my @ScriptPath = split('/', "$ENV{SCRIPT_NAME}"); + + $CGI::POST_MAX = $MaxPost; + if ($UseUpload) { + $CGI::DISABLE_UPLOADS = 0; # allow uploads + } else { + $CGI::DISABLE_UPLOADS = 1; # no uploads + } + $q = new CGI; + # Fix some issues with editing UTF8 pages (if charset specified) + if ($HttpCharset ne '') { + $q->charset($HttpCharset); + } + $Now = time; # Reset in case script is persistent + $ScriptName = pop(@ScriptPath); # Name used in links + $IndexInit = 0; # Must be reset for each request + $InterSiteInit = 0; + %InterSite = (); + $MainPage = "."; # For subpages only, the name of the top-level page + $OpenPageName = ""; # Currently open page + &CreateDir($DataDir); # Create directory if it doesn't exist + if (!-d $DataDir) { + &ReportError(Ts('Could not create %s', $DataDir) . ": $!"); + return 0; + } + &InitCookie(); # Reads in user data + return 1; +} + +sub InitCookie { + %SetCookie = (); + $TimeZoneOffset = 0; + undef $q->{'.cookies'}; # Clear cache if it exists (for SpeedyCGI) + %UserData = (); # Fix for persistent environments. + %UserCookie = $q->cookie($CookieName); + $UserID = $UserCookie{'id'}; + $UserID =~ s/\D//g; # Numeric only + if ($UserID < 200) { + $UserID = 111; + } else { + &LoadUserData($UserID); + } + if ($UserID > 199) { + if (($UserData{'id'} != $UserCookie{'id'}) || + ($UserData{'randkey'} != $UserCookie{'randkey'})) { + $UserID = 113; + %UserData = (); # Invalid. Consider warning message. + } + } + if ($UserData{'tzoffset'} != 0) { + $TimeZoneOffset = $UserData{'tzoffset'} * (60 * 60); + } +} + +sub DoBrowseRequest { + my ($id, $action, $text); + + if (!$q->param) { # No parameter + &BrowsePage($HomePage); + return 1; + } + $id = &GetParam('keywords', ''); + if ($id) { # Just script?PageName + if ($FreeLinks && (!-f &GetPageFile($id))) { + $id = &FreeToNormal($id); + } + if (($NotFoundPg ne '') && (!-f &GetPageFile($id))) { + $id = $NotFoundPg; + } + &BrowsePage($id) if &ValidIdOrDie($id); + return 1; + } + $action = lc(&GetParam('action', '')); + $id = &GetParam('id', ''); + if ($action eq 'browse') { + if ($FreeLinks && (!-f &GetPageFile($id))) { + $id = &FreeToNormal($id); + } + if (($NotFoundPg ne '') && (!-f &GetPageFile($id))) { + $id = $NotFoundPg; + } + &BrowsePage($id) if &ValidIdOrDie($id); + return 1; + } elsif ($action eq 'rc') { + &BrowsePage($RCName); + return 1; + } elsif ($action eq 'random') { + &DoRandom(); + return 1; + } elsif ($action eq 'history') { + &DoHistory($id) if &ValidIdOrDie($id); + return 1; + } + return 0; # Request not handled +} + +sub BrowsePage { + my ($id) = @_; + my ($fullHtml, $oldId, $allDiff, $showDiff, $openKept); + my ($revision, $goodRevision, $diffRevision, $newText); + + &OpenPage($id); + &OpenDefaultText(); + $openKept = 0; + $revision = &GetParam('revision', ''); + $revision =~ s/\D//g; # Remove non-numeric chars + $goodRevision = $revision; # Non-blank only if exists + if ($revision ne '') { + &OpenKeptRevisions('text_default'); + $openKept = 1; + if (!defined($KeptRevisions{$revision})) { + $goodRevision = ''; + } else { + &OpenKeptRevision($revision); + } + } + # Raw mode: just untranslated wiki text + if (&GetParam('raw', 0)) { + print &GetHttpHeader('text/plain'); + print $Text{'text'}; + return; + } + $newText = $Text{'text'}; # For differences + # Handle a single-level redirect + $oldId = &GetParam('oldid', ''); + if (($oldId eq '') && (substr($Text{'text'}, 0, 10) eq '#REDIRECT ')) { + $oldId = $id; + if (($FreeLinks) && ($Text{'text'} =~ /\#REDIRECT\s+\[\[.+\]\]/)) { + ($id) = ($Text{'text'} =~ /\#REDIRECT\s+\[\[(.+)\]\]/); + $id = &FreeToNormal($id); + } else { + ($id) = ($Text{'text'} =~ /\#REDIRECT\s+(\S+)/); + } + if (&ValidId($id) eq '') { + # Consider revision in rebrowse? + &ReBrowsePage($id, $oldId, 0); + return; + } else { # Not a valid target, so continue as normal page + $id = $oldId; + $oldId = ''; + } + } + $MainPage = $id; + $MainPage =~ s|/.*||; # Only the main page name (remove subpage) + $fullHtml = &GetHeader($id, &QuoteHtml($id), $oldId); + if ($revision ne '') { + if (($revision eq $Page{'revision'}) || ($goodRevision ne '')) { + $fullHtml .= '' . Ts('Showing revision %s', $revision) . "
"; + } else { + $fullHtml .= '' . Ts('Revision %s not available', $revision) + . ' (' . T('showing current revision instead') + . ')
'; + } + } + $allDiff = &GetParam('alldiff', 0); + if ($allDiff != 0) { + $allDiff = &GetParam('defaultdiff', 1); + } + if ((($id eq $RCName) || (T($RCName) eq $id) || (T($id) eq $RCName)) + && &GetParam('norcdiff', 1)) { + $allDiff = 0; # Only show if specifically requested + } + $showDiff = &GetParam('diff', $allDiff); + if ($UseDiff && $showDiff) { + $diffRevision = $goodRevision; + $diffRevision = &GetParam('diffrevision', $diffRevision); + # Eventually try to avoid the following keep-loading if possible? + &OpenKeptRevisions('text_default') if (!$openKept); + $fullHtml .= &GetDiffHTML($showDiff, $id, $diffRevision, + $revision, $newText); + $fullHtml .= "
\n"; + } + $fullHtml .= '
'; + $fullHtml .= &WikiToHTML($Text{'text'}); + $fullHtml .= '
'; + if (!&GetParam('embed', $EmbedWiki)) { + $fullHtml .= "
\n"; + } + if (($id eq $RCName) || (T($RCName) eq $id) || (T($id) eq $RCName)) { + print $fullHtml; + print '
'; + &DoRc(1); + print '
'; + print "
\n" if (!&GetParam('embed', $EmbedWiki)); + print &GetFooterText($id, $goodRevision); + return; + } + $fullHtml .= &GetFooterText($id, $goodRevision); + print $fullHtml; + return if ($showDiff || ($revision ne '')); # Don't cache special version + &UpdateHtmlCache($id, $fullHtml) if ($UseCache && ($oldId eq '')); +} + +sub ReBrowsePage { + my ($id, $oldId, $isEdit) = @_; + + if ($oldId ne "") { # Target of #REDIRECT (loop breaking) + print &GetRedirectPage("action=browse&id=$id&oldid=$oldId", + $id, $isEdit); + } else { + print &GetRedirectPage($id, $id, $isEdit); + } +} + +sub DoRc { + my ($rcType) = @_; # 0 = RSS, 1 = HTML + my ($fileData, $rcline, $i, $daysago, $lastTs, $ts, $idOnly); + my (@fullrc, $status, $oldFileData, $firstTs, $errorText, $showHTML); + my $starttime = 0; + my $showbar = 0; + + if (0 == $rcType) { + $showHTML = 0; + } else { + $showHTML = 1; + } + if (&GetParam("from", 0)) { + $starttime = &GetParam("from", 0); + if ($showHTML) { + print "

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

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

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

\n"; + } + # Note: must have two translations (for "day" and "days") + # Following comment line is for translation helper script + # Ts('Updates in the last %s days', ''); + } + } + if ($starttime == 0) { + if (0 == $rcType) { + $starttime = $Now - ((24*60*60)*$RssDays); + } else { + $starttime = $Now - ((24*60*60)*$RcDefault); + } + if ($showHTML) { + print "

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

\n"; + } + # Translation of above line is identical to previous version + } + # Read rclog data (and oldrclog data if needed) + ($status, $fileData) = &ReadFile($RcFile); + $errorText = ""; + if (!$status) { + # Save error text if needed. + $errorText = '

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

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

$!
\n" . '

' + . T('Note: This error is normal if no changes have been made.') . "\n"; + } + @fullrc = split(/\n/, $fileData); + $firstTs = 0; + if (@fullrc > 0) { # Only false if no lines in file + ($firstTs) = split(/$FS3/, $fullrc[0]); + } + if (($firstTs == 0) || ($starttime <= $firstTs)) { + ($status, $oldFileData) = &ReadFile($RcOldFile); + if ($status) { + @fullrc = split(/\n/, $oldFileData . $fileData); + } else { + if ($errorText ne "") { # could not open either rclog file + print $errorText; + print "

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

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

$!
\n"; + return; + } + } + } + $lastTs = 0; + if (@fullrc > 0) { # Only false if no lines in file + ($lastTs) = split(/$FS3/, $fullrc[$#fullrc]); + } + $lastTs++ if (($Now - $lastTs) > 5); # Skip last unless very recent + + $idOnly = &GetParam("rcidonly", ""); + if ($idOnly && $showHTML) { + print '(' . Ts('for %s only', &ScriptLink($idOnly, $idOnly)) + . ')
'; + } + if ($showHTML) { + foreach $i (@RcDays) { + print " | " if $showbar; + $showbar = 1; + print &ScriptLink("action=rc&days=$i", + Ts('%s day' . (($i != 1)?'s':''), $i)); + # Note: must have two translations (for "day" and "days") + # Following comment line is for translation helper script + # Ts('%s days', ''); + } + print "
" . &ScriptLink("action=rc&from=$lastTs", + T('List new changes starting from')); + print " " . &TimeToText($lastTs) . "
\n"; + } + $i = 0; + while ($i < @fullrc) { # Optimization: skip old entries quickly + ($ts) = split(/$FS3/, $fullrc[$i]); + if ($ts >= $starttime) { + $i -= 1000 if ($i > 0); + last; + } + $i += 1000; + } + $i -= 1000 if (($i > 0) && ($i >= @fullrc)); + for (; $i < @fullrc ; $i++) { + ($ts) = split(/$FS3/, $fullrc[$i]); + last if ($ts >= $starttime); + } + if ($i == @fullrc && $showHTML) { + print '
' . Ts('No updates since %s', + &TimeToText($starttime)) . "
\n"; + } else { + splice(@fullrc, 0, $i); # Remove items before index $i + # Consider an end-time limit (items older than X) + if (0 == $rcType) { + print &GetRcRss(@fullrc); + } else { + print &GetRcHtml(@fullrc); + } + } + if ($showHTML) { + print '

' . Ts('Page generated %s', &TimeToText($Now)), "
\n"; + } +} + +sub GetRc { + my $rcType = shift; + my @outrc = @_; + my ($rcline, $date, $newtop, $author, $inlist, $result); + my ($showedit, $link, $all, $idOnly, $headItem, $item); + my ($ts, $pagename, $summary, $isEdit, $host, $kind, $extraTemp); + my ($rcchangehist, $tEdit, $tChanges, $tDiff); + my ($headList, $historyPrefix, $diffPrefix); + my %extra = (); + my %changetime = (); + my %pagecount = (); + + # Slice minor edits + $showedit = &GetParam("rcshowedit", $ShowEdits); + $showedit = &GetParam("showedit", $showedit); + if ($showedit != 1) { + my @temprc = (); + foreach $rcline (@outrc) { + ($ts, $pagename, $summary, $isEdit, $host) = split(/$FS3/, $rcline); + if ($showedit == 0) { # 0 = No edits + push(@temprc, $rcline) if (!$isEdit); + } else { # 2 = Only edits + push(@temprc, $rcline) if ($isEdit); + } + } + @outrc = @temprc; + } + # Optimize param fetches out of main loop + $rcchangehist = &GetParam("rcchangehist", 1); + # Optimize translations out of main loop + $tEdit = T('(edit)'); + $tDiff = T('(diff)'); + $tChanges = T('changes'); + $diffPrefix = $QuotedFullUrl . &QuoteHtml("?action=browse\&diff=4\&id="); + $historyPrefix = $QuotedFullUrl . &QuoteHtml("?action=history\&id="); + foreach $rcline (@outrc) { + ($ts, $pagename) = split(/$FS3/, $rcline); + $pagecount{$pagename}++; + $changetime{$pagename} = $ts; + } + $date = ""; + $all = &GetParam("rcall", 0); + $all = &GetParam("all", $all); + $newtop = &GetParam("rcnewtop", $RecentTop); + $newtop = &GetParam("newtop", $newtop); + $idOnly = &GetParam("rcidonly", ""); + $inlist = 0; + $headList = ''; + $result = ''; + @outrc = reverse @outrc if ($newtop); + foreach $rcline (@outrc) { + ($ts, $pagename, $summary, $isEdit, $host, $kind, $extraTemp) + = split(/$FS3/, $rcline); + next if ((!$all) && ($ts < $changetime{$pagename})); + next if (($idOnly ne "") && ($idOnly ne $pagename)); + %extra = split(/$FS2/, $extraTemp, -1); + if ($date ne &CalcDay($ts)) { + $date = &CalcDay($ts); + if (1 == $rcType) { # HTML + # add date, properly closing lists first + if ($inlist) { + $result .= "\n"; + $inlist = 0; + } + $result .= "

" . $date . "

\n"; + if (!$inlist) { + $result .= "
    \n"; + $inlist = 1; + } + } + } + if (0 == $rcType) { # RSS + ($headItem, $item) = &GetRssRcLine($pagename, $ts, $host, + $extra{'name'}, $extra{'id'}, $summary, $isEdit, + $pagecount{$pagename}, $extra{'revision'}, + $diffPrefix, $historyPrefix); + $headList .= $headItem; + $result .= $item; + } else { # HTML + $result .= &GetHtmlRcLine($pagename, $ts, $host, $extra{'name'}, + $extra{'id'}, $summary, $isEdit, + $pagecount{$pagename}, $extra{'revision'}, + $tEdit, $tDiff, $tChanges, $all, $rcchangehist); + } + } + if (1 == $rcType) { + $result .= "
\n" if ($inlist); # Close final tag + } + return ($headList, $result); # Just ignore headList for HTML +} + +sub GetRcHtml { + my ($html, $extra); + + ($extra, $html) = &GetRc(1, @_); + return $html; +} + +sub GetHtmlRcLine { + my ($pagename, $timestamp, $host, $userName, $userID, $summary, + $isEdit, $pagecount, $revision, $tEdit, $tDiff, $tChanges, $all, + $rcchangehist) = @_; + my ($author, $sum, $edit, $count, $link, $html); + + $html = ''; + $host = &QuoteHtml($host); + if (defined($userName) && defined($userID)) { + $author = &GetAuthorLink($host, $userName, $userID); + } else { + $author = &GetAuthorLink($host, "", 0); + } + $sum = ""; + if (($summary ne "") && ($summary ne "*")) { + $summary = &QuoteHtml($summary); + $sum = "[$summary] "; + } + $edit = ""; + $edit = "$tEdit " if ($isEdit); + $count = ""; + if ((!$all) && ($pagecount > 1)) { + $count = "($pagecount "; + if ($rcchangehist) { + $count .= &GetHistoryLink($pagename, $tChanges); + } else { + $count .= $tChanges; + } + $count .= ") "; + } + $link = ""; + if ($UseDiff && &GetParam("diffrclink", 1)) { + $link .= &ScriptLinkDiff(4, $pagename, $tDiff, "") . " "; + } + $link .= &GetPageLink($pagename); + $html .= "
  • $link "; + $html .= &CalcTime($timestamp) . " $count$edit" . " $sum"; + $html .= ". . . . . $author\n"; + return $html; +} + +sub GetRcRss { + my ($rssHeader, $headList, $items); + + # Normally get URL from script, but allow override + $FullUrl = $q->url(-full=>1) if ($FullUrl eq ""); + $QuotedFullUrl = &QuoteHtml($FullUrl); + $SiteDescription = &QuoteHtml($SiteDescription); + + my $ChannelAbout = &QuoteHtml($FullUrl . &ScriptLinkChar() + . $ENV{QUERY_STRING}); + $rssHeader = < + + + ${\(&QuoteHtml($SiteName))} + ${\($QuotedFullUrl . &QuoteHtml("?$RCName"))} + ${\(&QuoteHtml($SiteDescription))} + + + $InterWikiMoniker + + + + +RSS + ($headList, $items) = &GetRc(0, @_); + $rssHeader .= $headList; + return < + + + + ${\(&QuoteHtml($SiteName))} + $RssLogoUrl + $QuotedFullUrl + +$items + +RSS +} + +sub GetRssRcLine{ + my ($pagename, $timestamp, $host, $userName, $userID, $summary, + $isEdit, $pagecount, $revision, $diffPrefix, $historyPrefix) = @_; + my ($itemID, $description, $authorLink, $author, $status, + $importance, $date, $item, $headItem); + + # Add to list of items in the + $itemID = $FullUrl . &ScriptLinkChar() + . &GetOldPageParameters('browse', $pagename, $revision); + $itemID = &QuoteHtml($itemID); + $headItem = " \n"; + # Add to list of items proper. + if (($summary ne "") && ($summary ne "*")) { + $description = &QuoteHtml($summary); + } + $host = &QuoteHtml($host); + if ($userName) { + $author = &QuoteHtml($userName); + $authorLink = "link=\"$QuotedFullUrl?$author\""; + } else { + $author = $host; + } + $status = (1 == $revision) ? 'new' : 'updated'; + $importance = $isEdit ? 'minor' : 'major'; + $timestamp += $TimeZoneOffset; + my ($sec, $min, $hour, $mday, $mon, $year) = localtime($timestamp); + $year += 1900; + $date = sprintf("%4d-%02d-%02dT%02d:%02d:%02d+%02d:00", + $year, $mon+1, $mday, $hour, $min, $sec, $TimeZoneOffset/(60*60)); + $pagename = &QuoteHtml($pagename); + # Write it out longhand + $item = < + $pagename + $QuotedFullUrl?$pagename + $description + $date + + + $author + + + $status + $importance + $diffPrefix$pagename + $revision + $historyPrefix$pagename + +RSS + return ($headItem, $item); +} + +sub DoRss { + print "Content-type: text/xml\n\n"; + &DoRc(0); +} + +sub DoRandom { + my ($id, @pageList); + + @pageList = &AllPagesList(); # Optimize? + $id = $pageList[int(rand($#pageList + 1))]; + &ReBrowsePage($id, "", 0); +} + +sub DoHistory { + my ($id) = @_; + my ($html, $canEdit, $row, $newText); + + print &GetHeader('', Ts('History of %s', $id), '') . '
    '; + &OpenPage($id); + &OpenDefaultText(); + $newText = $Text{'text'}; + $canEdit = 0; + $canEdit = &UserCanEdit($id) if ($HistoryEdit); + if ($UseDiff) { + print < + + + + +EOF + } + $html = &GetHistoryLine($id, $Page{'text_default'}, $canEdit, $row++); + &OpenKeptRevisions('text_default'); + foreach (reverse sort {$a <=> $b} keys %KeptRevisions) { + next if ($_ eq ""); # (needed?) + $html .= &GetHistoryLine($id, $KeptRevisions{$_}, $canEdit, $row++); + } + print $html; + if ($UseDiff) { + my $label = T('Compare'); + print "
      
    \n"; + print "
    \n"; + print &GetDiffHTML(&GetParam('defaultdiff', 1), $id, '', '', $newText); + } + print &GetCommonFooter(); +} + +sub GetMaskedHost { + my ($text) = @_; + my ($logText); + + if (!$MaskHosts) { + return $text; + } + $logText = T('(logged)'); + if (!($text =~ s/\d+$/$logText/)) { # IP address (ending numbers masked) + $text =~ s/^[^\.\(]+/$logText/; # Host name: mask until first . + } + return $text; +} + +sub GetHistoryLine { + my ($id, $section, $canEdit, $row) = @_; + my ($html, $expirets, $rev, $summary, $host, $user, $uid, $ts, $minor); + my (%sect, %revtext); + + %sect = split(/$FS2/, $section, -1); + %revtext = split(/$FS3/, $sect{'data'}); + $rev = $sect{'revision'}; + $summary = $revtext{'summary'}; + if ((defined($sect{'host'})) && ($sect{'host'} ne '')) { + $host = $sect{'host'}; + } else { + $host = $sect{'ip'}; + } + $host = &GetMaskedHost($host); + $user = $sect{'username'}; + $uid = $sect{'id'}; + $ts = $sect{'ts'}; + $minor = ''; + $minor = '' . T('(edit)') . ' ' if ($revtext{'minor'}); + $expirets = $Now - ($KeepDays * 24 * 60 * 60); + if ($UseDiff) { + my ($c1, $c2); + $c1 = 'checked="checked"' if 1 == $row; + $c2 = 'checked="checked"' if 0 == $row; + $html .= " "; + $html .= ""; + } + if (0 == $row) { # current revision + $html .= &GetPageLinkText($id, Ts('Revision %s', $rev)) . ' '; + if ($canEdit) { + $html .= &GetEditLink($id, T('Edit')) . ' '; + } + } else { + $html .= &GetOldPageLink('browse', $id, $rev, + Ts('Revision %s', $rev)) . ' '; + if ($canEdit) { + $html .= &GetOldPageLink('edit', $id, $rev, T('Edit')) . ' '; + } + } + $html .= ". . " . $minor . &TimeToText($ts) . " "; + $html .= T('by') . ' ' . &GetAuthorLink($host, $user, $uid) . " "; + if (defined($summary) && ($summary ne "") && ($summary ne "*")) { + $summary = &QuoteHtml($summary); # Thanks Sunir! :-) + $html .= "[$summary] "; + } + $html .= $UseDiff ? "\n" : "
    \n"; + return $html; +} + +# ==== HTML and page-oriented functions ==== +sub ScriptLinkChar { + if ($SlashLinks) { + return '/'; + } + return '?'; +} + +sub ScriptLink { + my ($action, $text) = @_; + + return "$text"; +} + +sub ScriptLinkClass { + my ($action, $text, $class) = @_; + + return "$text"; +} + +sub GetAuthorLink { + my ($host, $userName, $uid) = @_; + my ($html, $title, $userNameShow); + + $userNameShow = $userName; + if ($FreeLinks) { + $userName =~ s/ /_/g; + $userNameShow =~ s/_/ /g; + } + if (&ValidId($userName) ne "") { # Invalid under current rules + $userName = ""; # Just pretend it isn't there. + } + if (($uid > 0) && ($userName ne "")) { + $html = &ScriptLinkTitle($userName, $userNameShow, + Ts('ID %s', $uid) . ' ' . Ts('from %s', $host)); + } else { + $html = $host; + } + return $html; +} + +sub GetHistoryLink { + my ($id, $text) = @_; + + if ($FreeLinks) { + $id =~ s/ /_/g; + } + return &ScriptLink("action=history&id=$id", $text); +} + +sub GetHeader { + my ($id, $title, $oldId) = @_; + my $header = ""; + my $logoImage = ""; + my $result = ""; + my $embed = &GetParam('embed', $EmbedWiki); + my $altText = T('[Home]'); + + $result = &GetHttpHeader(''); + if ($FreeLinks) { + $title =~ s/_/ /g; # Display as spaces + } + $result .= &GetHtmlHeader("$SiteName: $title"); + return $result if ($embed); + + $result .= '
    '; + if ($oldId ne '') { + $result .= $q->h3('(' . Ts('redirected from %s', + &GetEditLink($oldId, $oldId)) . ')'); + } + if ((!$embed) && ($LogoUrl ne "")) { + $logoImage = "img src=\"$LogoUrl\" alt=\"$altText\" border=0"; + if (!$LogoLeft) { + $logoImage .= " align=\"right\""; + } + $header = &ScriptLink($HomePage, "<$logoImage>"); + } + if ($id ne '') { + $result .= $q->h1($header . &GetBackLinksSearchLink($id)); + } else { + $result .= $q->h1($header . $title); + } + if (&GetParam("toplinkbar", 1)) { + $result .= &GetGotoBar($id) . "
    "; + } + $result .= '
    '; + return $result; +} + +sub GetHttpHeader { + my ($type) = @_; + my $cookie; + + $type = 'text/html' if ($type eq ''); + if (defined($SetCookie{'id'})) { + $cookie = "$CookieName=" + . "rev&" . $SetCookie{'rev'} + . "&id&" . $SetCookie{'id'} + . "&randkey&" . $SetCookie{'randkey'}; + $cookie .= ";expires=Fri, 08-Sep-2013 19:48:23 GMT"; + if ($HttpCharset ne '') { + return $q->header(-cookie=>$cookie, + -type=>"$type; charset=$HttpCharset"); + } + return $q->header(-cookie=>$cookie); + } + if ($HttpCharset ne '') { + return $q->header(-type=>"$type; charset=$HttpCharset"); + } + return $q->header(-type=>$type); +} + +sub GetHtmlHeader { + my ($title) = @_; + my ($dtd, $html, $bodyExtra, $stylesheet); + + $html = ''; + $dtd = '-//IETF//DTD HTML//EN'; + $html = qq(\n); + $title = $q->escapeHTML($title); + $html .= "$title\n"; + if ($FavIcon ne '') { + $html .= '' + } + if ($MetaKeywords) { + my $keywords = $OpenPageName; + $keywords =~ s/([a-z])([A-Z])/$1, $2/g; + $html .= "\n" if $keywords; + } + if ($SiteBase ne "") { + $html .= qq(\n); + } + $stylesheet = &GetParam('stylesheet', $StyleSheet); + $stylesheet = $StyleSheet if ($stylesheet eq ''); + $stylesheet = '' if ($stylesheet eq '*'); # Allow removing override + if ($stylesheet ne '') { + $html .= qq(\n); + } + $html .= $UserHeader; + $bodyExtra = ''; + if ($UserBody ne '') { + $bodyExtra = ' ' . $UserBody; + } + if ($BGColor ne '') { + $bodyExtra .= qq( BGCOLOR="$BGColor"); + } + $html .= "\n"; + return $html; +} + +sub GetFooterText { + my ($id, $rev) = @_; + my $result; + + if (&GetParam('embed', $EmbedWiki)) { + return $q->end_html; + } + $result = '
    '; + $result .= &GetFormStart(); + $result .= &GetGotoBar($id); + if (&UserCanEdit($id, 0)) { + if ($rev ne '') { + $result .= &GetOldPageLink('edit', $id, $rev, + Ts('Edit revision %s of this page', $rev)); + } else { + $result .= &GetEditLink($id, T('Edit text of this page')); + } + } else { + $result .= T('This page is read-only'); + } + $result .= ' | '; + $result .= &GetHistoryLink($id, T('View other revisions')); + if ($rev ne '') { + $result .= ' | '; + $result .= &GetPageLinkText($id, T('View current revision')); + } + if ($UseMetaWiki) { + $result .= ' | ' + . T('Search MetaWiki') . ''; + } + if ($Section{'revision'} > 0) { + $result .= '
    '; + if ($rev eq '') { # Only for most current rev + $result .= T('Last edited'); + } else { + $result .= T('Edited'); + } + $result .= ' ' . &TimeToText($Section{ts}); + if ($AuthorFooter) { + $result .= ' ' . Ts('by %s', &GetAuthorLink($Section{'host'}, + $Section{'username'}, $Section{'id'})); + } + } + if ($UseDiff) { + $result .= ' ' . &ScriptLinkDiff(4, $id, T('(diff)'), $rev); + } + $result .= '
    ' . &GetSearchForm(); + if ($AdminBar && &UserIsAdmin()) { + $result .= '
    ' . &GetAdminBar($id); + } + if ($DataDir =~ m|/tmp/|) { + $result .= '
    ' . T('Warning') . ': ' + . Ts('Database is stored in temporary directory %s', + $DataDir) . '
    '; + } + if ($ConfigError ne '') { + $result .= '
    ' . T('Config file error:') . ' ' + . $ConfigError . '
    '; + } + $result .= $q->endform; + if ($FooterNote ne '') { + $result .= T($FooterNote); + } + $result .= '
    '; + $result .= &GetMinimumFooter(); + return $result; +} + +sub GetCommonFooter { + my ($html); + + $html = '
    ' . '
    ' + . &GetFormStart() . &GetGotoBar('') + . &GetSearchForm() . $q->endform; + if ($FooterNote ne '') { + $html .= T($FooterNote); + } + $html .= '
    ' . $q->end_html; + return $html; +} + +sub GetMinimumFooter { + return $q->end_html; +} + +sub GetFormStart { + return $q->startform("POST", "$ScriptName", + "application/x-www-form-urlencoded"); +} + +sub GetGotoBar { + my ($id) = @_; + my ($main, $bartext); + + $bartext = &GetPageLink($HomePage); + if ($id =~ m|/|) { + $main = $id; + $main =~ s|/.*||; # Only the main page name (remove subpage) + $bartext .= " | " . &GetPageLink($main); + } + $bartext .= " | " . &GetPageLink($RCName); + $bartext .= " | " . &GetPrefsLink(); + if ($UseUpload && &UserCanUpload()) { + $bartext .= " | " . &GetUploadLink(); + } + if (&GetParam("linkrandom", 0)) { + $bartext .= " | " . &GetRandomLink(); + } + if ($UserGotoBar ne '') { + $bartext .= " | " . $UserGotoBar; + } + $bartext .= "
    \n"; + return $bartext; +} + +sub GetSearchForm { + my ($result); + + $result = T('Search:') . ' ' . $q->textfield(-name=>'search', -size=>20); + if ($SearchButton) { + $result .= $q->submit('dosearch', T('Go!')); + } else { + $result .= &GetHiddenValue("dosearch", 1); + } + return $result; +} + +sub GetRedirectPage { + my ($newid, $name, $isEdit) = @_; + my ($url, $html); + my ($nameLink); + + # Normally get URL from script, but allow override. + $FullUrl = $q->url(-full=>1) if ($FullUrl eq ""); + $url = $FullUrl . &ScriptLinkChar() . $newid; + $nameLink = "$name"; + if ($RedirType < 3) { + if ($RedirType == 1) { # Use CGI.pm + # NOTE: do NOT use -method (does not work with old CGI.pm versions) + # Thanks to Daniel Neri for fixing this problem. + $html = $q->redirect(-uri=>$url); + } else { # Minimal header + $html = "Status: 302 Moved\n"; + $html .= "Location: $url\n"; + $html .= "Content-Type: text/html\n"; # Needed for browser failure + $html .= "\n"; + } + $html .= "\n" . Ts('Your browser should go to the %s page.', $newid); + $html .= ' ' . Ts('If it does not, click %s to continue.', $nameLink); + } else { + if ($isEdit) { + $html = &GetHeader('', T('Thanks for editing...'), ''); + $html .= Ts('Thank you for editing %s.', $nameLink); + } else { + $html = &GetHeader('', T('Link to another page...'), ''); + } + $html .= "\n

    "; + $html .= Ts('Follow the %s link to continue.', $nameLink); + $html .= &GetMinimumFooter(); + } + return $html; +} + +# ==== Common wiki markup ==== +sub RestoreSavedText { + my ($text) = @_; + + 1 while $text =~ s/$FS(\d+)$FS/$SaveUrl{$1}/ge; # Restore saved text + return $text; +} + +sub RemoveFS { + my ($text) = @_; + + # Note: must remove all $FS, and $FS may be multi-byte/char separator + $text =~ s/($FS)+(\d)/$2/g; + return $text; +} + +sub WikiToHTML { + my ($pageText) = @_; + $TableMode = 0; + + %SaveUrl = (); + %SaveNumUrl = (); + $SaveUrlIndex = 0; + $SaveNumUrlIndex = 0; + $pageText = &RemoveFS($pageText); + if ($RawHtml) { + $pageText =~ s/((.|\n)*?)<\/html>/&StoreRaw($1)/ige; + } + $pageText = &QuoteHtml($pageText); + $pageText =~ s/\\ *\r?\n/ /g; # Join lines with backslash at end + if ($ParseParas) { + # Note: The following 3 rules may span paragraphs, so they are + # copied from CommonMarkup + $pageText =~ + s/\<nowiki\>((.|\n)*?)\<\/nowiki\>/&StoreRaw($1)/ige; + $pageText =~ + s/\<pre\>((.|\n)*?)\<\/pre\>/&StorePre($1, "pre")/ige; + $pageText =~ + s/\<code\>((.|\n)*?)\<\/code\>/&StorePre($1, "code")/ige; + $pageText =~ s/((.|\n)+?\n)\s*\n/&ParseParagraph($1)/geo; + $pageText =~ s/(.*)<\/p>(.+)$/$1.&ParseParagraph($2)/seo; + } else { + $pageText = &CommonMarkup($pageText, 1, 0); # Multi-line markup + $pageText = &WikiLinesToHtml($pageText); # Line-oriented markup + } + while (@HeadingNumbers) { + pop @HeadingNumbers; + $TableOfContents .= "\n\n"; + } + $pageText =~ s/<toc>/$TableOfContents/gi; + if ($LateRules ne '') { + $pageText = &EvalLocalRules($LateRules, $pageText, 0); + } + return &RestoreSavedText($pageText); +} + +sub CommonMarkup { + my ($text, $useImage, $doLines) = @_; + local $_ = $text; + + if ($doLines < 2) { # 2 = do line-oriented only + # The tag stores text with no markup (except quoting HTML) + s/\<nowiki\>((.|\n)*?)\<\/nowiki\>/&StoreRaw($1)/ige; + # The

     tag wraps the stored text with the HTML 
     tag
    +    s/\<pre\>((.|\n)*?)\<\/pre\>/&StorePre($1, "pre")/ige;
    +    s/\<code\>((.|\n)*?)\<\/code\>/&StorePre($1, "code")/ige;
    +    if ($EarlyRules ne '') {
    +      $_ = &EvalLocalRules($EarlyRules, $_, !$useImage);
    +    }
    +    s/\[\#(\w+)\]/&StoreHref(" name=\"$1\"")/ge if $NamedAnchors;
    +    if ($HtmlTags) {
    +      my ($t);
    +      foreach $t (@HtmlPairs) {
    +        s/\<$t(\s[^<>]+?)?\>(.*?)\<\/$t\>/<$t$1>$2<\/$t>/gis;
    +      }
    +      foreach $t (@HtmlSingle) {
    +        s/\<$t(\s[^<>]+?)?\>/<$t$1>/gi;
    +      }
    +    } else {
    +      # Note that these tags are restricted to a single line
    +      s/\<b\>(.*?)\<\/b\>/$1<\/b>/gi;
    +      s/\<i\>(.*?)\<\/i\>/$1<\/i>/gi;
    +      s/\<strong\>(.*?)\<\/strong\>/$1<\/strong>/gi;
    +      s/\<em\>(.*?)\<\/em\>/$1<\/em>/gi;
    +    }
    +    s/\<tt\>(.*?)\<\/tt\>/$1<\/tt>/gis;  #  (MeatBall)
    +    s/\<br\>/
    /gi; # Allow simple line break anywhere + if ($HtmlLinks) { + s/\<A(\s[^<>]+?)\>(.*?)\<\/a\>/&StoreHref($1, $2)/gise; + } + if ($FreeLinks) { + # Consider: should local free-link descriptions be conditional? + # Also, consider that one could write [[Bad Page|Good Page]]? + s/\[\[$FreeLinkPattern\|([^\]]+)\]\]/&StorePageOrEditLink($1, $2)/geo; + s/\[\[$FreeLinkPattern\]\]/&StorePageOrEditLink($1, "")/geo; + } + if ($BracketText) { # Links like [URL text of link] + s/\[$UrlPattern\s+([^\]]+?)\]/&StoreBracketUrl($1, $2, $useImage)/geos; + s/\[$InterLinkPattern\s+([^\]]+?)\]/&StoreBracketInterPage($1, $2, + $useImage)/geos; + if ($WikiLinks && $BracketWiki) { # Local bracket-links + s/\[$LinkPattern\s+([^\]]+?)\]/&StoreBracketLink($1, $2)/geos; + s/\[$AnchoredLinkPattern\s+([^\]]+?)\]/&StoreBracketAnchoredLink($1, + $2, $3)/geos if $NamedAnchors; + } + } + s/\[$UrlPattern\]/&StoreBracketUrl($1, "", 0)/geo; + s/\[$InterLinkPattern\]/&StoreBracketInterPage($1, "", 0)/geo; + s/\b$UrlPattern/&StoreUrl($1, $useImage)/geo; + s/\b$InterLinkPattern/&StoreInterPage($1, $useImage)/geo; + if ($WikiLinks) { + s/$AnchoredLinkPattern/&StoreRaw(&GetPageOrEditAnchoredLink($1, + $2, ""))/geo if $NamedAnchors; + # CAA: Putting \b in front of $LinkPattern breaks /SubPage links + # (subpage links without the main page) + s/$LinkPattern/&GetPageOrEditLink($1, "")/geo; + } + s/\b$RFCPattern/&StoreRFC($1)/geo; + s/\b$ISBNPattern/&StoreISBN($1)/geo; + if ($UseUpload) { + s/$UploadPattern/&StoreUpload($1)/geo; + } + if ($ThinLine) { + if ($OldThinLine) { # Backwards compatible, conflicts with headers + s/====+/
    /g; + } else { # New behavior--no conflict + s/------+/
    /g; + } + s/----+/
    /g; + } else { + s/----+/
    /g; + } + } + if ($doLines) { # 0 = no line-oriented, 1 or 2 = do line-oriented + # The quote markup patterns avoid overlapping tags (with 5 quotes) + # by matching the inner quotes for the strong pattern. + s/('*)'''(.*?)'''/$1$2<\/strong>/g; + s/''(.*?)''/$1<\/em>/g; + if ($UseHeadings) { + s/(^|\n)\s*(\=+)\s+([^\n]+)\s+\=+/&WikiHeading($1, $2, $3)/geo; + } + if ($TableMode) { + s/((\|\|)+)/"<\/TD>"/ge; + } + } + return $_; +} + +sub WikiLinesToHtml { + my ($pageText) = @_; + my ($pageHtml, @htmlStack, $code, $codeAttributes, $depth, $oldCode); + + @htmlStack = (); + $depth = 0; + $pageHtml = ""; + foreach (split(/\n/, $pageText)) { # Process lines one-at-a-time + $code = ''; + $codeAttributes = ''; + $TableMode = 0; + $_ .= "\n"; + if (s/^(\;+)([^:]+\:?)\:/
    $2
    /) { + $code = "DL"; + $depth = length $1; + } elsif (s/^(\:+)/
    /) { + $code = "DL"; + $depth = length $1; + } elsif (s/^(\*+)/
  • /) { + $code = "UL"; + $depth = length $1; + } elsif (s/^(\#+)/
  • /) { + $code = "OL"; + $depth = length $1; + } elsif ($TableSyntax && + s/^((\|\|)+)(.*)\|\|\s*$/"$3<\/TD><\/TR>\n"/e) { + $code = 'TABLE'; + $codeAttributes = "BORDER='1'"; + $TableMode = 1; + $depth = 1; + } elsif (/^[ \t].*\S/) { + $code = "PRE"; + $depth = 1; + } else { + $depth = 0; + } + while (@htmlStack > $depth) { # Close tags as needed + $pageHtml .= "\n"; + } + if ($depth > 0) { + $depth = $IndentLimit if ($depth > $IndentLimit); + if (@htmlStack) { # Non-empty stack + $oldCode = pop(@htmlStack); + if ($oldCode ne $code) { + $pageHtml .= "<$code>\n"; + } + push(@htmlStack, $code); + } + while (@htmlStack < $depth) { + push(@htmlStack, $code); + $pageHtml .= "<$code $codeAttributes>\n"; + } + } + if (!$ParseParas) { + s/^\s*$/

    \n/; # Blank lines become

    tags + } + $pageHtml .= &CommonMarkup($_, 1, 2); # Line-oriented common markup + } + while (@htmlStack > 0) { # Clear stack + $pageHtml .= "\n"; + } + return $pageHtml; +} + +sub EvalLocalRules { + my ($rules, $origText, $isDiff) = @_; + my ($text, $reportError, $errorText); + + $text = $origText; + $reportError = 1; + # Basic idea: the $rules should change $text, possibly with different + # behavior if $isDiff is true (no images or color changes?) + # Note: for fun, the $rules could also change $reportError and $origText + if (!eval $rules) { + $errorText = $@; + if ($errorText eq '') { + # Search for "Unknown Error" for the reason the next line is commented +# $errorText = T('Unknown Error (no error text)'); + } + if ($errorText ne '') { + $text = $origText; # Consider: should partial results be kept? + if ($reportError) { + $text .= '


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

    $text

    \n"; +} + +sub StoreInterPage { + my ($id, $useImage) = @_; + my ($link, $extra); + + ($link, $extra) = &InterPageLink($id, $useImage); + # Next line ensures no empty links are stored + $link = &StoreRaw($link) if ($link ne ""); + return $link . $extra; +} + +sub InterPageLink { + my ($id, $useImage) = @_; + my ($name, $site, $remotePage, $url, $punct); + + ($id, $punct) = &SplitUrlPunct($id); + $name = $id; + ($site, $remotePage) = split(/:/, $id, 2); + $url = &GetSiteUrl($site); + return ("", $id . $punct) if ($url eq ""); + $remotePage =~ s/&/&/g; # Unquote common URL HTML + $url .= $remotePage; + return (&UrlLinkOrImage($url, $name, $useImage), $punct); +} + +sub StoreBracketInterPage { + my ($id, $text, $useImage) = @_; + my ($site, $remotePage, $url, $index); + + ($site, $remotePage) = split(/:/, $id, 2); + $remotePage =~ s/&/&/g; # Unquote common URL HTML + $url = &GetSiteUrl($site); + if ($text ne "") { + return "[$id $text]" if ($url eq ""); + } else { + return "[$id]" if ($url eq ""); + $text = &GetBracketUrlIndex($id); + } + $url .= $remotePage; + if ($BracketImg && $useImage && &ImageAllowed($text)) { + $text = ""; + } else { + $text = "[$text]"; + } + return &StoreRaw("$text"); +} + +sub GetBracketUrlIndex { + my ($id) = @_; + my ($index, $key); + + # Consider plain array? + if ($SaveNumUrl{$id} > 0) { + return $SaveNumUrl{$id}; + } + $SaveNumUrlIndex++; # Start with 1 + $SaveNumUrl{$id} = $SaveNumUrlIndex; + return $SaveNumUrlIndex; +} + +sub GetSiteUrl { + my ($site) = @_; + my ($data, $status); + + if (!$InterSiteInit) { + ($status, $data) = &ReadFile($InterFile); + if ($status) { + %InterSite = split(/\s+/, $data); # Consider defensive code + } + # Check for definitions to allow file to override automatic settings + if (!defined($InterSite{'LocalWiki'})) { + $InterSite{'LocalWiki'} = $ScriptName . &ScriptLinkChar(); + } + if (!defined($InterSite{'Local'})) { + $InterSite{'Local'} = $ScriptName . &ScriptLinkChar(); + } + $InterSiteInit = 1; # Init only once per request + } + return $InterSite{$site} if (defined($InterSite{$site})); + return ''; +} + +sub StoreRaw { + my ($html) = @_; + + $SaveUrl{$SaveUrlIndex} = $html; + return $FS . $SaveUrlIndex++ . $FS; +} + +sub StorePre { + my ($html, $tag) = @_; + + return &StoreRaw("<$tag>" . $html . ""); +} + +sub StoreHref { + my ($anchor, $text) = @_; + + return "$text"; +} + +sub StoreUrl { + my ($name, $useImage) = @_; + my ($link, $extra); + + ($link, $extra) = &UrlLink($name, $useImage); + # Next line ensures no empty links are stored + $link = &StoreRaw($link) if ($link ne ""); + return $link . $extra; +} + +sub UrlLink { + my ($rawname, $useImage) = @_; + my ($name, $punct); + + ($name, $punct) = &SplitUrlPunct($rawname); + if ($LimitFileUrl && ($NetworkFile && $name =~ m|^file:|)) { + # Only do remote file:// links. No file:///c|/windows. + if ($name =~ m|^file://[^/]|) { + return ("$name", $punct); + } + return ($rawname, ''); + } + return (&UrlLinkOrImage($name, $name, $useImage), $punct); +} + +sub UrlLinkOrImage { + my ($url, $name, $useImage) = @_; + + # Restricted image URLs so that mailto:foo@bar.gif is not an image + if ($useImage && &ImageAllowed($url)) { + return ""; + } + return "$name"; +} + +sub ImageAllowed { + my ($url) = @_; + my ($site, $imagePrefixes); + + $imagePrefixes = 'http:|https:|ftp:'; + $imagePrefixes .= '|file:' if (!$LimitFileUrl); + return 0 unless ($url =~ /^($imagePrefixes).+\.$ImageExtensions$/); + return 0 if ($url =~ /"/); # No HTML-breaking quotes allowed + return 1 if (@ImageSites < 1); # Most common case: () means all allowed + return 0 if ($ImageSites[0] eq 'none'); # Special case: none allowed + foreach $site (@ImageSites) { + return 1 if ($site eq substr($url, 0, length($site))); # Match prefix + } + return 0; +} + +sub StoreBracketUrl { + my ($url, $text, $useImage) = @_; + + if ($text eq "") { + $text = &GetBracketUrlIndex($url); + } + if ($BracketImg && $useImage && &ImageAllowed($text)) { + $text = ""; + } else { + $text = "[$text]"; + } + return &StoreRaw("$text"); +} + +sub StoreBracketLink { + my ($name, $text) = @_; + + return &StoreRaw(&GetPageLinkText($name, "[$text]")); +} + +sub StoreBracketAnchoredLink { + my ($name, $anchor, $text) = @_; + + return &StoreRaw(&GetPageLinkText("$name#$anchor", "[$text]")); +} + +sub StorePageOrEditLink { + my ($page, $name) = @_; + + if ($FreeLinks) { + $page =~ s/^\s+//; # Trim extra spaces + $page =~ s/\s+$//; + $page =~ s|\s*/\s*|/|; # ...also before/after subpages + } + $name =~ s/^\s+//; + $name =~ s/\s+$//; + return &StoreRaw(&GetPageOrEditLink($page, $name)); +} + +sub StoreRFC { + my ($num) = @_; + + return &StoreRaw(&RFCLink($num)); +} + +sub RFCLink { + my ($num) = @_; + + return "RFC $num"; +} + +sub StoreUpload { + my ($url) = @_; + + return &StoreRaw(&UploadLink($url)); +} + +sub UploadLink { + my ($filename) = @_; + my ($html, $url); + + return $filename if ($UploadUrl eq ''); # No bad links if misconfigured + $UploadUrl .= '/' if (substr($UploadUrl, -1, 1) ne '/'); # End with / + $url = $UploadUrl . $filename; + $html = ''; + if (&ImageAllowed($url)) { + $html .= 'upload:' . $filename . ''; + } else { + $html .= 'upload:' . $filename; + } + $html .= ''; + return $html; +} + +sub StoreISBN { + my ($num) = @_; + + return &StoreRaw(&ISBNLink($num)); +} + +sub ISBNALink { + my ($num, $pre, $post, $text) = @_; + + return '' . $text . ''; +} + +sub ISBNLink { + my ($rawnum) = @_; + my ($rawprint, $html, $num, $numSites, $i); + + $num = $rawnum; + $rawprint = $rawnum; + $rawprint =~ s/ +$//; + $num =~ s/[- ]//g; + $numSites = scalar @IsbnNames; # Number of entries + if ((length($num) != 10) || ($numSites < 1)) { + return "ISBN $rawnum"; + } + $html = &ISBNALink($num, $IsbnPre[0], $IsbnPost[0], 'ISBN ' . $rawprint); + if ($numSites > 1) { + $html .= ' ('; + $i = 1; + while ($i < $numSites) { + $html .= &ISBNALink($num, $IsbnPre[$i], $IsbnPost[$i], $IsbnNames[$i]); + if ($i < ($numSites - 1)) { # Not the last site + $html .= ', '; + } + $i++; + } + $html .= ')'; + } + $html .= " " if ($rawnum =~ / $/); # Add space if old ISBN had space. + return $html; +} + +sub SplitUrlPunct { + my ($url) = @_; + my ($punct); + + if ($url =~ s/\"\"$//) { + return ($url, ""); # Delete double-quote delimiters here + } + $punct = ""; + if ($NewFS) { + ($punct) = ($url =~ /([^a-zA-Z0-9\/\x80-\xff]+)$/); + $url =~ s/([^a-zA-Z0-9\/\xc0-\xff]+)$//; + } else { + ($punct) = ($url =~ /([^a-zA-Z0-9\/\xc0-\xff]+)$/); + $url =~ s/([^a-zA-Z0-9\/\xc0-\xff]+)$//; + } + return ($url, $punct); +} + +sub StripUrlPunct { + my ($url) = @_; + my ($junk); + + ($url, $junk) = &SplitUrlPunct($url); + return $url; +} + +sub WikiHeadingNumber { + my ($depth, $text) = @_; + my ($anchor, $number); + + return '' unless --$depth > 0; # Don't number H1s because it looks stupid + while (scalar @HeadingNumbers < ($depth-1)) { + push @HeadingNumbers, 1; + $TableOfContents .= '
    '; + } + if (scalar @HeadingNumbers < $depth) { + push @HeadingNumbers, 0; + $TableOfContents .= '
    '; + } + while (scalar @HeadingNumbers > $depth) { + pop @HeadingNumbers; + $TableOfContents .= "
    \n\n"; + } + $HeadingNumbers[$#HeadingNumbers]++; + $number = (join '.', @HeadingNumbers) . '. '; + # Remove embedded links. THIS IS FRAGILE! + $text = &RestoreSavedText($text); + $text =~ s/\]*?\>\?\<\/a\>//si; # No such page syntax + $text =~ s/\]*?\>(.*?)\<\/a\>/$1/si; + # Cook anchor by canonicalizing $text. + $anchor = $text; + $anchor =~ s/\<.*?\>//g; + $anchor =~ s/\W/_/g; + $anchor =~ s/__+/_/g; + $anchor =~ s/^_//; + $anchor =~ s/_$//; + # Last ditch effort + $anchor = '_' . (join '_', @HeadingNumbers) unless $anchor; + $TableOfContents .= $number . &ScriptLink("$OpenPageName#$anchor",$text) + . "
    \n
    "; + return &StoreHref(" name=\"$anchor\"") . $number; +} + +sub WikiHeading { + my ($pre, $depth, $text) = @_; + + $depth = length($depth); + $depth = 6 if ($depth > 6); + $text =~ s/^\s*#\s+/&WikiHeadingNumber($depth,$')/e; # $' == $POSTMATCH + return $pre . "$text\n"; +} + +# ==== Difference markup and HTML ==== +sub GetDiffHTML { + my ($diffType, $id, $revOld, $revNew, $newText) = @_; + my ($html, $diffText, $diffTextTwo, $priorName, $links, $usecomma); + my ($major, $minor, $author, $useMajor, $useMinor, $useAuthor, $cacheName); + + $links = "("; + $usecomma = 0; + $major = &ScriptLinkDiff(1, $id, T('major diff'), ""); + $minor = &ScriptLinkDiff(2, $id, T('minor diff'), ""); + $author = &ScriptLinkDiff(3, $id, T('author diff'), ""); + $useMajor = 1; + $useMinor = 1; + $useAuthor = 1; + $diffType = &GetParam("defaultdiff", 1) if ($diffType == 4); + if ($diffType == 1) { + $priorName = T('major'); + $cacheName = 'major'; + $useMajor = 0; + } elsif ($diffType == 2) { + $priorName = T('minor'); + $cacheName = 'minor'; + $useMinor = 0; + } elsif ($diffType == 3) { + $priorName = T('author'); + $cacheName = 'author'; + $useAuthor = 0; + } + if ($revOld ne "") { + # Note: OpenKeptRevisions must have been done by caller. + # Eventually optimize if same as cached revision + $diffText = &GetKeptDiff($newText, $revOld, 1); # 1 = get lock + if ($diffText eq "") { + $diffText = T('(The revisions are identical or unavailable.)'); + } + } else { + $diffText = &GetCacheDiff($cacheName); + } + $useMajor = 0 if ($useMajor && ($diffText eq &GetCacheDiff("major"))); + $useMinor = 0 if ($useMinor && ($diffText eq &GetCacheDiff("minor"))); + $useAuthor = 0 if ($useAuthor && ($diffText eq &GetCacheDiff("author"))); + $useMajor = 0 if ((!defined(&GetPageCache('oldmajor'))) || + (&GetPageCache("oldmajor") < 1)); + $useAuthor = 0 if ((!defined(&GetPageCache('oldauthor'))) || + (&GetPageCache("oldauthor") < 1)); + if ($useMajor) { + $links .= $major; + $usecomma = 1; + } + if ($useMinor) { + $links .= ", " if ($usecomma); + $links .= $minor; + $usecomma = 1; + } + if ($useAuthor) { + $links .= ", " if ($usecomma); + $links .= $author; + } + if (!($useMajor || $useMinor || $useAuthor)) { + $links .= T('no other diffs'); + } + $links .= ")"; + if ((!defined($diffText)) || ($diffText eq "")) { + $diffText = T('No diff available.'); + } + if ($revOld ne "") { + my $currentRevision = T('current revision'); + $currentRevision = Ts('revision %s', $revNew) if $revNew; + $html = '' + . Tss("Difference (from revision %1 to %2)", $revOld, $currentRevision) + . "\n" . "$links
    " . &DiffToHTML($diffText); + } else { + if (($diffType != 2) && + ((!defined(&GetPageCache("old$cacheName"))) || + (&GetPageCache("old$cacheName") < 1))) { + $html = '' + . Ts('No diff available--this is the first %s revision.', + $priorName) . "\n$links"; + } else { + $html = '' + . Ts('Difference (from prior %s revision)', $priorName) + . "\n$links
    " . &DiffToHTML($diffText); + } + } + @HeadingNumbers = (); + $TableOfContents = ''; + return $html; +} + +sub GetCacheDiff { + my ($type) = @_; + my ($diffText); + + $diffText = &GetPageCache("diff_default_$type"); + $diffText = &GetCacheDiff('minor') if ($diffText eq "1"); + $diffText = &GetCacheDiff('major') if ($diffText eq "2"); + return $diffText; +} + +# Must be done after minor diff is set and OpenKeptRevisions called +sub GetKeptDiff { + my ($newText, $oldRevision, $lock) = @_; + my (%sect, %data, $oldText); + + $oldText = ""; + if (defined($KeptRevisions{$oldRevision})) { + %sect = split(/$FS2/, $KeptRevisions{$oldRevision}, -1); + %data = split(/$FS3/, $sect{'data'}, -1); + $oldText = $data{'text'}; + } + return "" if ($oldText eq ""); # Old revision not found + return &GetDiff($oldText, $newText, $lock); +} + +sub GetDiff { + my ($old, $new, $lock) = @_; + my ($diff_out, $oldName, $newName); + + &CreateDir($TempDir); + $oldName = "$TempDir/old_diff"; + $newName = "$TempDir/new_diff"; + if ($lock) { + &RequestDiffLock() or return ""; + $oldName .= "_locked"; + $newName .= "_locked"; + } + &WriteStringToFile($oldName, $old); + &WriteStringToFile($newName, $new); + $diff_out = `diff $oldName $newName`; + &ReleaseDiffLock() if ($lock); + $diff_out =~ s/\\ No newline.*\n//g; # Get rid of common complaint. + # No need to unlink temp files--next diff will just overwrite. + return $diff_out; +} + +sub DiffToHTML { + my ($html) = @_; + my ($tChanged, $tRemoved, $tAdded); + + $tChanged = T('Changed:'); + $tRemoved = T('Removed:'); + $tAdded = T('Added:'); + $html =~ s/\n--+//g; + # Note: Need spaces before
    to be different from diff section. + $html =~ s/(^|\n)(\d+.*c.*)/$1
    $tChanged $2<\/strong>
    /g; + $html =~ s/(^|\n)(\d+.*d.*)/$1
    $tRemoved $2<\/strong>
    /g; + $html =~ s/(^|\n)(\d+.*a.*)/$1
    $tAdded $2<\/strong>
    /g; + $html =~ s/\n((<.*\n)+)/&ColorDiff($1, $DiffColor1, 0)/ge; + $html =~ s/\n((>.*\n)+)/&ColorDiff($1, $DiffColor2, 1)/ge; + return $html; +} + +sub ColorDiff { + my ($diff, $color, $type) = @_; + my ($colorHtml, $classHtml); + + $diff =~ s/(^|\n)[<>]/$1/g; + $diff = &QuoteHtml($diff); + # Do some of the Wiki markup rules: + %SaveUrl = (); + %SaveNumUrl = (); + $SaveUrlIndex = 0; + $SaveNumUrlIndex = 0; + $diff = &RemoveFS($diff); + $diff = &CommonMarkup($diff, 0, 1); # No images, all patterns + if ($LateRules ne '') { + $diff = &EvalLocalRules($LateRules, $diff, 1); + } + 1 while $diff =~ s/$FS(\d+)$FS/$SaveUrl{$1}/ge; # Restore saved text + $diff =~ s/\r?\n/
    /g; + $colorHtml = ''; + if ($color ne '') { + $colorHtml = " bgcolor=$color"; + } + if ($type) { + $classHtml = ' class=wikidiffnew'; + } else { + $classHtml = ' class=wikidiffold'; + } + return "
    \n" . $diff + . "
    \n"; +} + +# ==== Database (Page, Section, Text, Kept, User) functions ==== +sub OpenNewPage { + my ($id) = @_; + + %Page = (); + $Page{'version'} = 3; # Data format version + $Page{'revision'} = 0; # Number of edited times + $Page{'tscreate'} = $Now; # Set once at creation + $Page{'ts'} = $Now; # Updated every edit +} + +sub OpenNewSection { + my ($name, $data) = @_; + + %Section = (); + $Section{'name'} = $name; + $Section{'version'} = 1; # Data format version + $Section{'revision'} = 0; # Number of edited times + $Section{'tscreate'} = $Now; # Set once at creation + $Section{'ts'} = $Now; # Updated every edit + $Section{'ip'} = $ENV{REMOTE_ADDR}; + $Section{'host'} = ''; # Updated only for real edits (can be slow) + $Section{'id'} = $UserID; + $Section{'username'} = &GetParam("username", ""); + $Section{'data'} = $data; + $Page{$name} = join($FS2, %Section); # Replace with save? +} + +sub OpenNewText { + my ($name) = @_; # Name of text (usually "default") + %Text = (); + if ($NewText ne '') { + $Text{'text'} = T($NewText); + } else { + $Text{'text'} = T('Describe the new page here.') . "\n"; + } + $Text{'text'} .= "\n" if (substr($Text{'text'}, -1, 1) ne "\n"); + $Text{'minor'} = 0; # Default as major edit + $Text{'newauthor'} = 1; # Default as new author + $Text{'summary'} = ''; + &OpenNewSection("text_$name", join($FS3, %Text)); +} + +sub GetPageFile { + my ($id) = @_; + + return $PageDir . "/" . &GetPageDirectory($id) . "/$id.db"; +} + +sub OpenPage { + my ($id) = @_; + my ($fname, $data); + + if ($OpenPageName eq $id) { + return; + } + %Section = (); + %Text = (); + $fname = &GetPageFile($id); + if (-f $fname) { + $data = &ReadFileOrDie($fname); + %Page = split(/$FS1/, $data, -1); # -1 keeps trailing null fields + } else { + &OpenNewPage($id); + } + if ($Page{'version'} != 3) { + &UpdatePageVersion(); + } + $OpenPageName = $id; +} + +sub OpenSection { + my ($name) = @_; + + if (!defined($Page{$name})) { + &OpenNewSection($name, ""); + } else { + %Section = split(/$FS2/, $Page{$name}, -1); + } +} + +sub OpenText { + my ($name) = @_; + + if (!defined($Page{"text_$name"})) { + &OpenNewText($name); + } else { + &OpenSection("text_$name"); + %Text = split(/$FS3/, $Section{'data'}, -1); + } +} + +sub OpenDefaultText { + &OpenText('default'); +} + +# Called after OpenKeptRevisions +sub OpenKeptRevision { + my ($revision) = @_; + + %Section = split(/$FS2/, $KeptRevisions{$revision}, -1); + %Text = split(/$FS3/, $Section{'data'}, -1); +} + +sub GetPageCache { + my ($name) = @_; + + return $Page{"cache_$name"}; +} + +# Always call SavePage within a lock. +sub SavePage { + my $file = &GetPageFile($OpenPageName); + + $Page{'revision'} += 1; # Number of edited times + $Page{'ts'} = $Now; # Updated every edit + &CreatePageDir($PageDir, $OpenPageName); + &WriteStringToFile($file, join($FS1, %Page)); +} + +sub SaveSection { + my ($name, $data) = @_; + + $Section{'revision'} += 1; # Number of edited times + $Section{'ts'} = $Now; # Updated every edit + $Section{'ip'} = $ENV{REMOTE_ADDR}; + $Section{'id'} = $UserID; + $Section{'username'} = &GetParam("username", ""); + $Section{'data'} = $data; + $Page{$name} = join($FS2, %Section); +} + +sub SaveText { + my ($name) = @_; + + &SaveSection("text_$name", join($FS3, %Text)); +} + +sub SaveDefaultText { + &SaveText('default'); +} + +sub SetPageCache { + my ($name, $data) = @_; + + $Page{"cache_$name"} = $data; +} + +sub UpdatePageVersion { + &ReportError(T('Bad page version (or corrupt page).')); +} + +sub KeepFileName { + return $KeepDir . "/" . &GetPageDirectory($OpenPageName) + . "/$OpenPageName.kp"; +} + +sub SaveKeepSection { + my $file = &KeepFileName(); + my $data; + + return if ($Section{'revision'} < 1); # Don't keep "empty" revision + $Section{'keepts'} = $Now; + $data = $FS1 . join($FS2, %Section); + &CreatePageDir($KeepDir, $OpenPageName); + &AppendStringToFileLimited($file, $data, $KeepSize); +} + +sub ExpireKeepFile { + my ($fname, $data, @kplist, %tempSection, $expirets); + my ($anyExpire, $anyKeep, $expire, %keepFlag, $sectName, $sectRev); + my ($oldMajor, $oldAuthor); + + $fname = &KeepFileName(); + return if (!(-f $fname)); + $data = &ReadFileOrDie($fname); + @kplist = split(/$FS1/, $data, -1); # -1 keeps trailing null fields + return if (length(@kplist) < 1); # Also empty + shift(@kplist) if ($kplist[0] eq ""); # First can be empty + return if (length(@kplist) < 1); # Also empty + %tempSection = split(/$FS2/, $kplist[0], -1); + if (!defined($tempSection{'keepts'})) { + return; # Bad keep file + } + $expirets = $Now - ($KeepDays * 24 * 60 * 60); + return if ($tempSection{'keepts'} >= $expirets); # Nothing old enough + $anyExpire = 0; + $anyKeep = 0; + %keepFlag = (); + $oldMajor = &GetPageCache('oldmajor'); + $oldAuthor = &GetPageCache('oldauthor'); + foreach (reverse @kplist) { + %tempSection = split(/$FS2/, $_, -1); + $sectName = $tempSection{'name'}; + $sectRev = $tempSection{'revision'}; + $expire = 0; + if ($sectName eq "text_default") { + if (($KeepMajor && ($sectRev == $oldMajor)) || + ($KeepAuthor && ($sectRev == $oldAuthor))) { + $expire = 0; + } elsif ($tempSection{'keepts'} < $expirets) { + $expire = 1; + } + } else { + if ($tempSection{'keepts'} < $expirets) { + $expire = 1; + } + } + if (!$expire) { + $keepFlag{$sectRev . "," . $sectName} = 1; + $anyKeep = 1; + } else { + $anyExpire = 1; + } + } + if (!$anyKeep) { # Empty, so remove file + unlink($fname); + return; + } + return if (!$anyExpire); # No sections expired + open (OUT, ">$fname") or die (Ts('cant write %s', $fname) . ": $!"); + foreach (@kplist) { + %tempSection = split(/$FS2/, $_, -1); + $sectName = $tempSection{'name'}; + $sectRev = $tempSection{'revision'}; + if ($keepFlag{$sectRev . "," . $sectName}) { + print OUT $FS1, $_; + } + } + close(OUT); +} + +sub OpenKeptList { + my ($fname, $data); + + @KeptList = (); + $fname = &KeepFileName(); + return if (!(-f $fname)); + $data = &ReadFileOrDie($fname); + @KeptList = split(/$FS1/, $data, -1); # -1 keeps trailing null fields +} + +sub OpenKeptRevisions { + my ($name) = @_; # Name of section + my ($fname, $data, %tempSection); + + %KeptRevisions = (); + &OpenKeptList(); + foreach (@KeptList) { + %tempSection = split(/$FS2/, $_, -1); + next if ($tempSection{'name'} ne $name); + $KeptRevisions{$tempSection{'revision'}} = $_; + } +} + +sub LoadUserData { + my ($data, $status); + + %UserData = (); + ($status, $data) = &ReadFile(&UserDataFilename($UserID)); + if (!$status) { + $UserID = 112; # Could not open file. Consider warning message? + return; + } + %UserData = split(/$FS1/, $data, -1); # -1 keeps trailing null fields +} + +sub UserDataFilename { + my ($id) = @_; + + return "" if ($id < 1); + return $UserDir . "/" . ($id % 10) . "/$id.db"; +} + +# ==== Misc. functions ==== +sub ReportError { + my ($errmsg) = @_; + + print $q->header, "

    ", $errmsg, "

    ", $q->end_html; +} + +sub ValidId { + my ($id) = @_; + + if (length($id) > 120) { + return Ts('Page name is too long: %s', $id); + } + if ($id =~ m| |) { + return Ts('Page name may not contain space characters: %s', $id); + } + if ($UseSubpage) { + if ($id =~ m|.*/.*/|) { + return Ts('Too many / characters in page %s', $id); + } + if ($id =~ /^\//) { + return Ts('Invalid Page %s (subpage without main page)', $id); + } + if ($id =~ /\/$/) { + return Ts('Invalid Page %s (missing subpage name)', $id); + } + } + if ($FreeLinks) { + $id =~ s/ /_/g; + if (!$UseSubpage) { + if ($id =~ /\//) { + return Ts('Invalid Page %s (/ not allowed)', $id); + } + } + if (!($id =~ m|^$FreeLinkPattern$|)) { + return Ts('Invalid Page %s', $id); + } + if ($id =~ m|\.db$|) { + return Ts('Invalid Page %s (must not end with .db)', $id); + } + if ($id =~ m|\.lck$|) { + return Ts('Invalid Page %s (must not end with .lck)', $id); + } + return ""; + } else { + if (!($id =~ /^$LinkPattern$/)) { + return Ts('Invalid Page %s', $id); + } + } + return ""; +} + +sub ValidIdOrDie { + my ($id) = @_; + my $error; + + $error = &ValidId($id); + if ($error ne "") { + &ReportError($error); + return 0; + } + return 1; +} + +sub UserCanEdit { + my ($id, $deepCheck) = @_; + + # Optimized for the "everyone can edit" case (don't check passwords) + if (($id ne "") && (-f &GetLockedPageFile($id))) { + return 1 if (&UserIsAdmin()); # Requires more privledges + # Consider option for editor-level to edit these pages? + return 0; + } + if (!$EditAllowed) { + return 1 if (&UserIsEditor()); + return 0; + } + if (-f "$DataDir/noedit") { + return 1 if (&UserIsEditor()); + return 0; + } + if ($deepCheck) { # Deeper but slower checks (not every page) + return 1 if (&UserIsEditor()); + return 0 if (&UserIsBanned()); + } + return 1; +} + +sub UserIsBanned { + my ($host, $ip, $data, $status); + + ($status, $data) = &ReadFile("$DataDir/banlist"); + return 0 if (!$status); # No file exists, so no ban + $data =~ s/\r//g; + $ip = $ENV{'REMOTE_ADDR'}; + $host = &GetRemoteHost(0); + foreach (split(/\n/, $data)) { + next if ((/^\s*$/) || (/^#/)); # Skip empty, spaces, or comments + return 1 if ($ip =~ /$_/i); + return 1 if ($host =~ /$_/i); + } + return 0; +} + +sub UserIsAdmin { + my (@pwlist, $userPassword); + + return 0 if ($AdminPass eq ""); + $userPassword = &GetParam("adminpw", ""); + return 0 if ($userPassword eq ""); + foreach (split(/\s+/, $AdminPass)) { + next if ($_ eq ""); + return 1 if ($userPassword eq $_); + } + return 0; +} + +sub UserIsEditor { + my (@pwlist, $userPassword); + + return 1 if (&UserIsAdmin()); # Admin includes editor + return 0 if ($EditPass eq ""); + $userPassword = &GetParam("adminpw", ""); # Used for both + return 0 if ($userPassword eq ""); + foreach (split(/\s+/, $EditPass)) { + next if ($_ eq ""); + return 1 if ($userPassword eq $_); + } + return 0; +} + +sub UserCanUpload { + return 1 if (&UserIsEditor()); + return $AllUpload; +} + +sub GetLockedPageFile { + my ($id) = @_; + + return $PageDir . "/" . &GetPageDirectory($id) . "/$id.lck"; +} + +sub RequestLockDir { + my ($name, $tries, $wait, $errorDie) = @_; + my ($lockName, $n); + + &CreateDir($TempDir); + $lockName = $LockDir . $name; + $n = 0; + while (mkdir($lockName, 0555) == 0) { + if ($! != 17) { + die(Ts('can not make %s', $LockDir) . ": $!\n") if $errorDie; + return 0; + } + return 0 if ($n++ >= $tries); + sleep($wait); + } + return 1; +} + +sub ReleaseLockDir { + my ($name) = @_; + + rmdir($LockDir . $name); +} + +sub RequestLock { + # 10 tries, 3 second wait, possibly die on error + return &RequestLockDir("main", 10, 3, $LockCrash); +} + +sub ReleaseLock { + &ReleaseLockDir('main'); +} + +sub ForceReleaseLock { + my ($name) = @_; + my $forced; + + # First try to obtain lock (in case of normal edit lock) + # 5 tries, 3 second wait, do not die on error + $forced = !&RequestLockDir($name, 5, 3, 0); + &ReleaseLockDir($name); # Release the lock, even if we didn't get it. + return $forced; +} + +sub RequestCacheLock { + # 4 tries, 2 second wait, do not die on error + return &RequestLockDir('cache', 4, 2, 0); +} + +sub ReleaseCacheLock { + &ReleaseLockDir('cache'); +} + +sub RequestDiffLock { + # 4 tries, 2 second wait, do not die on error + return &RequestLockDir('diff', 4, 2, 0); +} + +sub ReleaseDiffLock { + &ReleaseLockDir('diff'); +} + +# Index lock is not very important--just return error if not available +sub RequestIndexLock { + # 1 try, 2 second wait, do not die on error + return &RequestLockDir('index', 1, 2, 0); +} + +sub ReleaseIndexLock { + &ReleaseLockDir('index'); +} + +sub ReadFile { + my ($fileName) = @_; + my ($data); + local $/ = undef; # Read complete files + + if (open(IN, "<$fileName")) { + $data=; + close IN; + return (1, $data); + } + return (0, ""); +} + +sub ReadFileOrDie { + my ($fileName) = @_; + my ($status, $data); + + ($status, $data) = &ReadFile($fileName); + if (!$status) { + die(Ts('Can not open %s', $fileName) . ": $!"); + } + return $data; +} + +sub WriteStringToFile { + my ($file, $string) = @_; + + open (OUT, ">$file") or die(Ts('cant write %s', $file) . ": $!"); + print OUT $string; + close(OUT); +} + +sub AppendStringToFile { + my ($file, $string) = @_; + + open (OUT, ">>$file") or die(Ts('cant write %s', $file) . ": $!"); + print OUT $string; + close(OUT); +} + +sub AppendStringToFileLimited { + my ($file, $string, $limit) = @_; + + if (($limit < 1) || (((-s $file) + length($string)) <= $limit)) { + &AppendStringToFile($file, $string); + } +} + +sub CreateDir { + my ($newdir) = @_; + + mkdir($newdir, 0775) if (!(-d $newdir)); +} + +sub CreatePageDir { + my ($dir, $id) = @_; + my $subdir; + + &CreateDir($dir); # Make sure main page exists + $subdir = $dir . "/" . &GetPageDirectory($id); + &CreateDir($subdir); + if ($id =~ m|([^/]+)/|) { + $subdir = $subdir . "/" . $1; + &CreateDir($subdir); + } +} + +sub UpdateHtmlCache { + my ($id, $html) = @_; + my $idFile; + + $idFile = &GetHtmlCacheFile($id); + &CreatePageDir($HtmlDir, $id); + if (&RequestCacheLock()) { + &WriteStringToFile($idFile, $html); + &ReleaseCacheLock(); + } +} + +sub GenerateAllPagesList { + my (@pages, @dirs, $id, $dir, @pageFiles, @subpageFiles, $subId); + + @pages = (); + if ($FastGlob) { + # The following was inspired by the FastGlob code by Marc W. Mengel. + # Thanks to Bob Showalter for pointing out the improvement. + opendir(PAGELIST, $PageDir); + @dirs = readdir(PAGELIST); + closedir(PAGELIST); + @dirs = sort(@dirs); + foreach $dir (@dirs) { + next if (substr($dir, 0, 1) eq '.'); # No ., .., or .dirs or files + opendir(PAGELIST, "$PageDir/$dir"); + @pageFiles = readdir(PAGELIST); + closedir(PAGELIST); + foreach $id (@pageFiles) { + next if (($id eq '.') || ($id eq '..')); + if (substr($id, -3) eq '.db') { + push(@pages, substr($id, 0, -3)); + } elsif (substr($id, -4) ne '.lck') { + opendir(PAGELIST, "$PageDir/$dir/$id"); + @subpageFiles = readdir(PAGELIST); + closedir(PAGELIST); + foreach $subId (@subpageFiles) { + if (substr($subId, -3) eq '.db') { + push(@pages, "$id/" . substr($subId, 0, -3)); + } + } + } + } + } + } else { + # Old slow/compatible method. + @dirs = qw(A B C D E F G H I J K L M N O P Q R S T U V W X Y Z other); + foreach $dir (@dirs) { + if (-e "$PageDir/$dir") { # Thanks to Tim Holt + while (<$PageDir/$dir/*.db $PageDir/$dir/*/*.db>) { + s|^$PageDir/||; + m|^[^/]+/(\S*).db|; + $id = $1; + push(@pages, $id); + } + } + } + } + return sort(@pages); +} + +sub AllPagesList { + my ($rawIndex, $refresh, $status); + + if (!$UseIndex) { + return &GenerateAllPagesList(); + } + $refresh = &GetParam("refresh", 0); + if ($IndexInit && !$refresh) { + # Note for mod_perl: $IndexInit is reset for each query + # Eventually consider some timestamp-solution to keep cache? + return @IndexList; + } + if ((!$refresh) && (-f $IndexFile)) { + ($status, $rawIndex) = &ReadFile($IndexFile); + if ($status) { + %IndexHash = split(/\s+/, $rawIndex); + @IndexList = sort(keys %IndexHash); + $IndexInit = 1; + return @IndexList; + } + # If open fails just refresh the index + } + @IndexList = (); + %IndexHash = (); + @IndexList = &GenerateAllPagesList(); + foreach (@IndexList) { + $IndexHash{$_} = 1; + } + $IndexInit = 1; # Initialized for this run of the script + # Try to write out the list for future runs + &RequestIndexLock() or return @IndexList; + &WriteStringToFile($IndexFile, join(" ", %IndexHash)); + &ReleaseIndexLock(); + return @IndexList; +} + +sub CalcDay { + my ($ts) = @_; + + $ts += $TimeZoneOffset; + my ($sec, $min, $hour, $mday, $mon, $year) = localtime($ts); + if ($NumberDates) { + return ($year + 1900) . '-' . ($mon+1) . '-' . $mday; + } + return ("January", "February", "March", "April", "May", "June", + "July", "August", "September", "October", "November", + "December")[$mon]. " " . $mday . ", " . ($year+1900); +} + +sub CalcTime { + my ($ts) = @_; + my ($ampm, $mytz); + + $ts += $TimeZoneOffset; + my ($sec, $min, $hour, $mday, $mon, $year) = localtime($ts); + $mytz = ""; + if (($TimeZoneOffset == 0) && ($ScriptTZ ne "")) { + $mytz = " " . $ScriptTZ; + } + $ampm = ""; + if ($UseAmPm) { + $ampm = " am"; + if ($hour > 11) { + $ampm = " pm"; + $hour = $hour - 12; + } + $hour = 12 if ($hour == 0); + } + $min = "0" . $min if ($min<10); + return $hour . ":" . $min . $ampm . $mytz; +} + +sub TimeToText { + my ($t) = @_; + + return &CalcDay($t) . " " . &CalcTime($t); +} + +sub GetParam { + my ($name, $default) = @_; + my $result; + + $result = $q->param($name); + if (!defined($result)) { + if (defined($UserData{$name})) { + $result = $UserData{$name}; + } else { + $result = $default; + } + } + return $result; +} + +sub GetHiddenValue { + my ($name, $value) = @_; + + $q->param($name, $value); + return $q->hidden($name); +} + +sub GetRemoteHost { + my ($doMask) = @_; + my ($rhost, $iaddr); + + $rhost = $ENV{REMOTE_HOST}; + if ($UseLookup && ($rhost eq "")) { + # Catch errors (including bad input) without aborting the script + eval 'use Socket; $iaddr = inet_aton($ENV{REMOTE_ADDR});' + . '$rhost = gethostbyaddr($iaddr, AF_INET)'; + } + if ($rhost eq "") { + $rhost = $ENV{REMOTE_ADDR}; + } + $rhost = &GetMaskedHost($rhost) if ($doMask); + return $rhost; +} + +sub FreeToNormal { + my ($id) = @_; + + $id =~ s/ /_/g; + $id = ucfirst($id) if ($UpperFirst || $FreeUpper); + if (index($id, '_') > -1) { # Quick check for any space/underscores + $id =~ s/__+/_/g; + $id =~ s/^_//; + $id =~ s/_$//; + if ($UseSubpage) { + $id =~ s|_/|/|g; + $id =~ s|/_|/|g; + } + } + if ($FreeUpper) { + # Note that letters after ' are *not* capitalized + if ($id =~ m|[-_.,\(\)/][a-z]|) { # Quick check for non-canonical case + $id =~ s|([-_.,\(\)/])([a-z])|$1 . uc($2)|ge; + } + } + return $id; +} +#END_OF_BROWSE_CODE + +# == Page-editing and other special-action code ======================== +$OtherCode = ""; # Comment next line to always compile (slower) +#$OtherCode = <<'#END_OF_OTHER_CODE'; + +sub DoOtherRequest { + my ($id, $action, $text, $search); + + $action = &GetParam("action", ""); + $id = &GetParam("id", ""); + if ($action ne "") { + $action = lc($action); + if ($action eq "edit") { + &DoEdit($id, 0, 0, "", 0) if &ValidIdOrDie($id); + } elsif ($action eq "unlock") { + &DoUnlock(); + } elsif ($action eq "index") { + &DoIndex(); + } elsif ($action eq "links") { + &DoLinks(); + } elsif ($action eq "maintain") { + &DoMaintain(); + } elsif ($action eq "pagelock") { + &DoPageLock(); + } elsif ($action eq "editlock") { + &DoEditLock(); + } elsif ($action eq "editprefs") { + &DoEditPrefs(); + } elsif ($action eq "editbanned") { + &DoEditBanned(); + } elsif ($action eq "editlinks") { + &DoEditLinks(); + } elsif ($action eq "login") { + &DoEnterLogin(); + } elsif ($action eq "newlogin") { + $UserID = 0; + &DoEditPrefs(); # Also creates new ID + } elsif ($action eq "version") { + &DoShowVersion(); + } elsif ($action eq "rss") { + &DoRss(); + } elsif ($action eq "delete") { + &DoDeletePage($id); + } elsif ($UseUpload && ($action eq "upload")) { + &DoUpload(); + } elsif ($action eq "maintainrc") { + &DoMaintainRc(); + } elsif ($action eq "convert") { + &DoConvert(); + } elsif ($action eq "trimusers") { + &DoTrimUsers(); + } else { + &ReportError(Ts('Invalid action parameter %s', $action)); + } + return; + } + if (&GetParam("edit_prefs", 0)) { + &DoUpdatePrefs(); + return; + } + if (&GetParam("edit_ban", 0)) { + &DoUpdateBanned(); + return; + } + if (&GetParam("enter_login", 0)) { + &DoLogin(); + return; + } + if (&GetParam("edit_links", 0)) { + &DoUpdateLinks(); + return; + } + if ($UseUpload && (&GetParam("upload", 0))) { + &SaveUpload(); + return; + } + $search = &GetParam("search", ""); + if (($search ne "") || (&GetParam("dosearch", "") ne "")) { + &DoSearch($search); + return; + } else { + $search = &GetParam("back",""); + if ($search ne "") { + &DoBackLinks($search); + return; + } + } + # Handle posted pages + if (&GetParam("oldtime", "") ne "") { + $id = &GetParam("title", ""); + &DoPost() if &ValidIdOrDie($id); + return; + } + &ReportError(T('Invalid URL.')); +} + +sub DoEdit { + my ($id, $isConflict, $oldTime, $newText, $preview) = @_; + my ($header, $editRows, $editCols, $userName, $revision, $oldText); + my ($summary, $isEdit, $pageTime); + + if ($FreeLinks) { + $id = &FreeToNormal($id); # Take care of users like Markus Lude :-) + } + if (!&UserCanEdit($id, 1)) { + print &GetHeader("", T('Editing Denied'), ""); + if (&UserIsBanned()) { + print T('Editing not allowed: user, ip, or network is blocked.'); + print "

    "; + print T('Contact the wiki administrator for more information.'); + } else { + print Ts('Editing not allowed: %s is read-only.', $SiteName); + } + print &GetCommonFooter(); + return; + } + # Consider sending a new user-ID cookie if user does not have one + &OpenPage($id); + &OpenDefaultText(); + $pageTime = $Section{'ts'}; + $header = Ts('Editing %s', $id); + # Old revision handling + $revision = &GetParam('revision', ''); + $revision =~ s/\D//g; # Remove non-numeric chars + if ($revision ne '') { + &OpenKeptRevisions('text_default'); + if (!defined($KeptRevisions{$revision})) { + $revision = ''; + # Consider better solution like error message? + } else { + &OpenKeptRevision($revision); + $header = Ts('Editing revision %s of ', $revision ) . $id; + } + } + $oldText = $Text{'text'}; + if ($preview && !$isConflict) { + $oldText = $newText; + } + $editRows = &GetParam("editrows", 20); + $editCols = &GetParam("editcols", 65); + print &GetHeader('', &QuoteHtml($header), ''); + if ($revision ne '') { + print "\n" + . Ts('Editing old revision %s.', $revision) . " " + . T('Saving this page will replace the latest revision with this text.') + . '
    ' + } + if ($isConflict) { + $editRows -= 10 if ($editRows > 19); + print "\n

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

    \n"; + if ($isConflict>1) { + # The main purpose of a new warning is to display more text + # and move the save button down from its old location. + print "\n

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

    \n"; + } + print "

    ", + T('Someone saved this page after you started editing.'), " ", + T('The top textbox contains the saved text.'), " ", + T('Only the text in the top textbox will be saved.'), + "
    \n", + T('Scroll down to see your edited text.'), "
    \n"; + print T('Last save time:'), ' ', &TimeToText($oldTime), + " (", T('Current time is:'), ' ', &TimeToText($Now), ")
    \n"; + } + print &GetFormStart(); + print &GetHiddenValue("title", $id), "\n", + &GetHiddenValue("oldtime", $pageTime), "\n", + &GetHiddenValue("oldconflict", $isConflict), "\n"; + if ($revision ne "") { + print &GetHiddenValue("revision", $revision), "\n"; + } + print &GetTextArea('text', $oldText, $editRows, $editCols); + $summary = &GetParam("summary", "*"); + print "

    ", T('Summary:'), + $q->textfield(-name=>'summary', + -default=>$summary, -override=>1, + -size=>60, -maxlength=>200); + if (&GetParam("recent_edit") eq "on") { + print "
    ", $q->checkbox(-name=>'recent_edit', -checked=>1, + -label=>T('This change is a minor edit.')); + } else { + print "
    ", $q->checkbox(-name=>'recent_edit', + -label=>T('This change is a minor edit.')); + } + if ($EmailNotify) { + print "   " . + $q->checkbox(-name=> 'do_email_notify', + -label=>Ts('Send email notification that %s has been changed.', $id)); + } + print "
    "; + if ($EditNote ne '') { + print T($EditNote) . '
    '; # Allow translation + } + print $q->submit(-name=>'Save', -value=>T('Save')), "\n"; + $userName = &GetParam("username", ""); + if ($userName ne "") { + print ' (', T('Your user name is'), ' ', + &GetPageLink($userName) . ') '; + } else { + print ' (', Ts('Visit %s to set your user name.', &GetPrefsLink()), ') '; + } + print $q->submit(-name=>'Preview', -value=>T('Preview')), "\n"; + if ($isConflict) { + print "\n


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

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

    \n"; + } + print "


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

    ", T('Preview:'), "

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

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

    \n"; + print '
    '; + } + print '
    '; + print &GetHistoryLink($id, T('View other revisions')) . "
    \n"; + print &GetGotoBar($id); + print $q->endform; + print '
    '; + print &GetMinimumFooter(); +} + +sub GetTextArea { + my ($name, $text, $rows, $cols) = @_; + + if (&GetParam("editwide", 1)) { + return $q->textarea(-name=>$name, -default=>$text, + -rows=>$rows, -columns=>$cols, -override=>1, + -style=>'width:100%', -wrap=>'virtual'); + } + return $q->textarea(-name=>$name, -default=>$text, + -rows=>$rows, -columns=>$cols, -override=>1, + -wrap=>'virtual'); +} + +sub DoEditPrefs { + my ($check, $recentName, %labels); + + $recentName = $RCName; + $recentName =~ s/_/ /g; + &DoNewLogin() if ($UserID < 400); + print &GetHeader('', T('Editing Preferences'), ""); + print '
    '; + print &GetFormStart(); + print GetHiddenValue("edit_prefs", 1), "\n"; + print '' . T('User Information:') . "\n"; + print '
    ' . Ts('Your User ID number: %s', $UserID) . "\n"; + print '
    ' . T('UserName:') . ' ', &GetFormText('username', "", 20, 50); + print ' ' . T('(blank to remove, or valid page name)'); + print '
    ' . T('Set Password:') . ' ', + $q->password_field(-name=>'p_password', -value=>'*', + -size=>15, -maxlength=>50), + ' ', T('(blank to remove password)'), '
    (', + T('Passwords allow sharing preferences between multiple systems.'), + ' ', T('Passwords are completely optional.'), ')'; + if (($AdminPass ne '') || ($EditPass ne '')) { + print '
    ', T('Administrator Password:'), ' ', + $q->password_field(-name=>'p_adminpw', -value=>'*', + -size=>15, -maxlength=>50), + ' ', T('(blank to remove password)'), '
    ', + T('(Administrator passwords are used for special maintenance.)'); + } + if ($EmailNotify) { + print "
    "; + print &GetFormCheck('notify', 1, + T('Include this address in the site email list.')), ' ', + T('(Uncheck the box to remove the address.)'); + print '
    ', T('Email Address:'), ' ', + &GetFormText('email', "", 30, 60); + } + print "
    $recentName:\n"; + print '
    ', T('Default days to display:'), ' ', + &GetFormText('rcdays', $RcDefault, 4, 9); + print "
    ", &GetFormCheck('rcnewtop', $RecentTop, + T('Most recent changes on top')); + print "
    ", &GetFormCheck('rcall', 0, + T('Show all changes (not just most recent)')); + %labels = (0=>T('Hide minor edits'), 1=>T('Show minor edits'), + 2=>T('Show only minor edits')); + print '
    ', T('Minor edit display:'), ' '; + print $q->popup_menu(-name=>'p_rcshowedit', + -values=>[0,1,2], -labels=>\%labels, + -default=>&GetParam("rcshowedit", $ShowEdits)); + print "
    ", &GetFormCheck('rcchangehist', 1, + T('Use "changes" as link to history')); + if ($UseDiff) { + print '
    ', T('Differences:'), "\n"; + print "
    ", &GetFormCheck('diffrclink', 1, + Ts('Show (diff) links on %s', $recentName)); + print "
    ", &GetFormCheck('alldiff', 0, + T('Show differences on all pages')); + print " (", &GetFormCheck('norcdiff', 1, + Ts('No differences on %s', $recentName)), ")"; + %labels = (1=>T('Major'), 2=>T('Minor'), 3=>T('Author')); + print '
    ', T('Default difference type:'), ' '; + print $q->popup_menu(-name=>'p_defaultdiff', + -values=>[1,2,3], -labels=>\%labels, + -default=>&GetParam("defaultdiff", 1)); + } + print '
    ', T('Misc:'), "\n"; + # Note: TZ offset is added by TimeToText, so pre-subtract to cancel. + print '
    ', T('Server time:'), ' ', &TimeToText($Now-$TimeZoneOffset); + print '
    ', T('Time Zone offset (hours):'), ' ', + &GetFormText('tzoffset', 0, 4, 9); + print '
    ', &GetFormCheck('editwide', 1, + T('Use 100% wide edit area (if supported)')); + print '
    ', + T('Edit area rows:'), ' ', &GetFormText('editrows', 20, 4, 4), + ' ', T('columns:'), ' ', &GetFormText('editcols', 65, 4, 4); + + print '
    ', &GetFormCheck('toplinkbar', 1, + T('Show link bar on top')); + print '
    ', &GetFormCheck('linkrandom', 0, + T('Add "Random Page" link to link bar')); + print '
    ' . T('StyleSheet URL:') . ' ', + &GetFormText('stylesheet', "", 30, 150); + print '
    ', $q->submit(-name=>'Save', -value=>T('Save')), "\n"; + print '
    '; + print "
    \n"; + print '
    '; + print &GetGotoBar(''); + print $q->endform; + print '
    '; + print &GetMinimumFooter(); +} + +sub GetFormText { + my ($name, $default, $size, $max) = @_; + my $text = &GetParam($name, $default); + + return $q->textfield(-name=>"p_$name", -default=>$text, + -override=>1, -size=>$size, -maxlength=>$max); +} + +sub GetFormCheck { + my ($name, $default, $label) = @_; + my $checked = (&GetParam($name, $default) > 0); + + return $q->checkbox(-name=>"p_$name", -override=>1, -checked=>$checked, + -label=>$label); +} + +sub DoUpdatePrefs { + my ($username, $password, $stylesheet); + + # All link bar settings should be updated before printing the header + &UpdatePrefCheckbox("toplinkbar"); + &UpdatePrefCheckbox("linkrandom"); + print &GetHeader('',T('Saving Preferences'), ''); + print '
    '; + if ($UserID < 1001) { + print '', + Ts('Invalid UserID %s, preferences not saved.', $UserID), ''; + if ($UserID == 111) { + print '
    ', + T('(Preferences require cookies, but no cookie was sent.)'); + } + print &GetCommonFooter(); + return; + } + $username = &GetParam("p_username", ""); + if ($FreeLinks) { + $username =~ s/^\[\[(.+)\]\]/$1/; # Remove [[ and ]] if added + $username = &FreeToNormal($username); + $username =~ s/_/ /g; + } + if ($username eq "") { + print T('UserName removed.'), '
    '; + undef $UserData{'username'}; + } elsif ((!$FreeLinks) && (!($username =~ /^$LinkPattern$/))) { + print Ts('Invalid UserName %s: not saved.', $username), "
    \n"; + } elsif ($FreeLinks && (!($username =~ /^$FreeLinkPattern$/))) { + print Ts('Invalid UserName %s: not saved.', $username), "
    \n"; + } elsif (length($username) > 50) { # Too long + print T('UserName must be 50 characters or less. (not saved)'), "
    \n"; + } else { + print Ts('UserName %s saved.', $username), '
    '; + $UserData{'username'} = $username; + } + $password = &GetParam("p_password", ""); + if ($password eq "") { + print T('Password removed.'), '
    '; + undef $UserData{'password'}; + } elsif ($password ne "*") { + print T('Password changed.'), '
    '; + $UserData{'password'} = $password; + } + if (($AdminPass ne "") || ($EditPass ne "")) { + $password = &GetParam("p_adminpw", ""); + if ($password eq "") { + print T('Administrator password removed.'), '
    '; + undef $UserData{'adminpw'}; + } elsif ($password ne "*") { + print T('Administrator password changed.'), '
    '; + $UserData{'adminpw'} = $password; + if (&UserIsAdmin()) { + print T('User has administrative abilities.'), '
    '; + } elsif (&UserIsEditor()) { + print T('User has editor abilities.'), '
    '; + } else { + print T('User does not have administrative abilities.'), ' ', + T('(Password does not match administrative password(s).)'), + '
    '; + } + } + } + if ($EmailNotify) { + &UpdatePrefCheckbox("notify"); + &UpdateEmailList(); + } + &UpdatePrefNumber("rcdays", 0, 0, 999999); + &UpdatePrefCheckbox("rcnewtop"); + &UpdatePrefCheckbox("rcall"); + &UpdatePrefCheckbox("rcchangehist"); + &UpdatePrefCheckbox("editwide"); + if ($UseDiff) { + &UpdatePrefCheckbox("norcdiff"); + &UpdatePrefCheckbox("diffrclink"); + &UpdatePrefCheckbox("alldiff"); + &UpdatePrefNumber("defaultdiff", 1, 1, 3); + } + &UpdatePrefNumber("rcshowedit", 1, 0, 2); + &UpdatePrefNumber("tzoffset", 0, -999, 999); + &UpdatePrefNumber("editrows", 1, 1, 999); + &UpdatePrefNumber("editcols", 1, 1, 999); + print T('Server time:'), ' ', &TimeToText($Now-$TimeZoneOffset), '
    '; + $TimeZoneOffset = &GetParam("tzoffset", 0) * (60 * 60); + print T('Local time:'), ' ', &TimeToText($Now), '
    '; + $stylesheet = &GetParam('p_stylesheet', ''); + if ($stylesheet eq '') { + if (&GetParam('stylesheet', '') ne '') { + print T('StyleSheet URL removed.'), '
    '; + } + undef $UserData{'stylesheet'}; + } else { + $stylesheet =~ s/[">]//g; # Remove characters that would cause problems + $UserData{'stylesheet'} = $stylesheet; + print T('StyleSheet setting saved.'), '
    '; + } + &SaveUserData(); + print '', T('Preferences saved.'), ''; + print &GetCommonFooter(); +} + +# add or remove email address from preferences to $EmailFile +sub UpdateEmailList { + my (@old_emails); + + local $/ = "\n"; # don't slurp whole files in this sub. + if (my $new_email = $UserData{'email'} = &GetParam("p_email", "")) { + my $notify = $UserData{'notify'}; + if (-f $EmailFile) { + open(NOTIFY, $EmailFile) + or die(Ts('Could not read from %s:', $EmailFile) . " $!\n"); + @old_emails = ; + close(NOTIFY); + } else { + @old_emails = (); + } + my $already_in_list = grep /$new_email/, @old_emails; + if ($notify and (not $already_in_list)) { + &RequestLock() or die(T('Could not get mail lock')); + if (!open(NOTIFY, ">>$EmailFile")) { + &ReleaseLock(); # Don't leave hangling locks + die(Ts('Could not append to %s:', $EmailFile) . " $!\n"); + } + print NOTIFY $new_email, "\n"; + close(NOTIFY); + &ReleaseLock(); + } + elsif ((not $notify) and $already_in_list) { + &RequestLock() or die(T('Could not get mail lock')); + if (!open(NOTIFY, ">$EmailFile")) { + &ReleaseLock(); + die(Ts('Could not overwrite %s:', "$EmailFile") . " $!\n"); + } + foreach (@old_emails) { + print NOTIFY "$_" unless /$new_email/; + } + close(NOTIFY); + &ReleaseLock(); + } + } +} + +sub UpdatePrefCheckbox { + my ($param) = @_; + my $temp = &GetParam("p_$param", "*"); + + $UserData{$param} = 1 if ($temp eq "on"); + $UserData{$param} = 0 if ($temp eq "*"); + # It is possible to skip updating by using another value, like "2" +} + +sub UpdatePrefNumber { + my ($param, $integer, $min, $max) = @_; + my $temp = &GetParam("p_$param", "*"); + + return if ($temp eq "*"); + $temp =~ s/[^-\d\.]//g; + $temp =~ s/\..*// if ($integer); + return if ($temp eq ""); + return if (($temp < $min) || ($temp > $max)); + $UserData{$param} = $temp; +} + +sub DoIndex { + print &GetHeader('', T('Index of all pages'), ''); + print '
    '; + &PrintPageList(&AllPagesList()); + print &GetCommonFooter(); +} + +# Create a new user file/cookie pair +sub DoNewLogin { + # Consider warning if cookie already exists + # (maybe use "replace=1" parameter) + &CreateUserDir(); + $SetCookie{'id'} = &GetNewUserId(); + $SetCookie{'randkey'} = int(rand(1000000000)); + $SetCookie{'rev'} = 1; + %UserCookie = %SetCookie; + $UserID = $SetCookie{'id'}; + # The cookie will be transmitted in the next header + %UserData = %UserCookie; + $UserData{'createtime'} = $Now; + $UserData{'createip'} = $ENV{REMOTE_ADDR}; + &SaveUserData(); +} + +sub DoEnterLogin { + print &GetHeader('', T('Login'), ""); + print &GetFormStart(); + print &GetHiddenValue('enter_login', 1), "\n"; + print '
    ', T('User ID number:'), ' ', + $q->textfield(-name=>'p_userid', -value=>'', + -size=>15, -maxlength=>50); + print '
    ', T('Password:'), ' ', + $q->password_field(-name=>'p_password', -value=>'', + -size=>15, -maxlength=>50); + print '
    ', $q->submit(-name=>'Login', -value=>T('Login')), "\n"; + print "
    \n"; + print &GetGotoBar(''); + print $q->endform; + print &GetMinimumFooter(); +} + +sub DoLogin { + my ($uid, $password, $success); + + $success = 0; + $uid = &GetParam("p_userid", ""); + $uid =~ s/\D//g; + $password = &GetParam("p_password", ""); + if (($uid > 199) && ($password ne "") && ($password ne "*")) { + $UserID = $uid; + &LoadUserData(); + if ($UserID > 199) { + if (defined($UserData{'password'}) && + ($UserData{'password'} eq $password)) { + $SetCookie{'id'} = $uid; + $SetCookie{'randkey'} = $UserData{'randkey'}; + $SetCookie{'rev'} = 1; + $success = 1; + } + } + } + print &GetHeader('', T('Login Results'), ''); + if ($success) { + print Ts('Login for user ID %s complete.', $uid); + } else { + print Ts('Login for user ID %s failed.', $uid); + } + print "
    \n"; + print &GetGotoBar(''); + print $q->endform; + print &GetMinimumFooter(); +} + +sub GetNewUserId { + my ($id); + + $id = $StartUID; + while (-f &UserDataFilename($id+1000)) { + $id += 1000; + } + while (-f &UserDataFilename($id+100)) { + $id += 100; + } + while (-f &UserDataFilename($id+10)) { + $id += 10; + } + &RequestLock() or die(T('Could not get user-ID lock')); + while (-f &UserDataFilename($id)) { + $id++; + } + &WriteStringToFile(&UserDataFilename($id), "lock"); # reserve the ID + &ReleaseLock(); + return $id; +} + +# Consider user-level lock? +sub SaveUserData { + my ($userFile, $data); + + &CreateUserDir(); + $userFile = &UserDataFilename($UserID); + $data = join($FS1, %UserData); + &WriteStringToFile($userFile, $data); +} + +sub CreateUserDir { + my ($n, $subdir); + + if (!(-d "$UserDir/0")) { + &CreateDir($UserDir); + + foreach $n (0..9) { + $subdir = "$UserDir/$n"; + &CreateDir($subdir); + } + } +} + +sub DoSearch { + my ($string) = @_; + + if ($string eq '') { + &DoIndex(); + return; + } + print &GetHeader('', &QuoteHtml(Ts('Search for: %s', $string)), ''); + print '
    '; + &PrintPageList(&SearchTitleAndBody($string)); + print &GetCommonFooter(); +} + +sub DoBackLinks { + my ($string) = @_; + + print &GetHeader('', &QuoteHtml(Ts('Backlinks for: %s', $string)), ''); + print '
    '; + # At this time the backlinks are mostly a renamed search. + # An initial attempt to match links only failed on subpages and free links. + # Escape some possibly problematic characters: + $string =~ s/([-'().,])/\\$1/g; + &PrintPageList(&SearchTitleAndBody($string)); + print &GetCommonFooter(); +} + +sub PrintPageList { + my $pagename; + + print "

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

    \n"; + foreach $pagename (@_) { + print ".... " if ($pagename =~ m|/|); + print &GetPageLink($pagename), "
    \n"; + } +} + +sub DoLinks { + print &GetHeader('', &QuoteHtml(T('Full Link List')), ''); + print "
    \n\n\n\n\n";  # Extra lines to get below the logo
    +  &PrintLinkList(&GetFullLinkList());
    +  print "
    \n"; + print &GetMinimumFooter(); +} + +sub PrintLinkList { + my ($pagelines, $page, $names, $editlink); + my ($link, $extra, @links, %pgExists); + + %pgExists = (); + foreach $page (&AllPagesList()) { + $pgExists{$page} = 1; + } + $names = &GetParam("names", 1); + $editlink = &GetParam("editlink", 0); + foreach $pagelines (@_) { + @links = (); + foreach $page (split(' ', $pagelines)) { + if ($page =~ /\:/) { # URL or InterWiki form + if ($page =~ /$UrlPattern/) { + ($link, $extra) = &UrlLink($page, 0); # No images + } else { + ($link, $extra) = &InterPageLink($page, 0); # No images + } + } else { + if ($pgExists{$page}) { + $link = &GetPageLink($page); + } else { + $link = $page; + if ($editlink) { + $link .= &GetEditLink($page, "?"); + } + } + } + push(@links, $link); + } + if (!$names) { + shift(@links); + } + print join(' ', @links), "\n"; + } +} + +sub GetFullLinkList { + my ($name, $unique, $sort, $exists, $empty, $link, $search); + my ($pagelink, $interlink, $urllink); + my (@found, @links, @newlinks, @pglist, %pgExists, %seen); + + $unique = &GetParam("unique", 1); + $sort = &GetParam("sort", 1); + $pagelink = &GetParam("page", 1); + $interlink = &GetParam("inter", 0); + $urllink = &GetParam("url", 0); + $exists = &GetParam("exists", 2); + $empty = &GetParam("empty", 0); + $search = &GetParam("search", ""); + if (($interlink == 2) || ($urllink == 2)) { + $pagelink = 0; + } + %pgExists = (); + @pglist = &AllPagesList(); + foreach $name (@pglist) { + $pgExists{$name} = 1; + } + %seen = (); + foreach $name (@pglist) { + @newlinks = (); + if ($unique != 2) { + %seen = (); + } + @links = &GetPageLinks($name, $pagelink, $interlink, $urllink); + foreach $link (@links) { + $seen{$link}++; + if (($unique > 0) && ($seen{$link} != 1)) { + next; + } + if (($exists == 0) && ($pgExists{$link} == 1)) { + next; + } + if (($exists == 1) && ($pgExists{$link} != 1)) { + next; + } + if (($search ne "") && !($link =~ /$search/)) { + next; + } + push(@newlinks, $link); + } + @links = @newlinks; + if ($sort) { + @links = sort(@links); + } + unshift (@links, $name); + if ($empty || ($#links > 0)) { # If only one item, list is empty. + push(@found, join(' ', @links)); + } + } + return @found; +} + +sub GetPageLinks { + my ($name, $pagelink, $interlink, $urllink) = @_; + my ($text, @links); + + @links = (); + &OpenPage($name); + &OpenDefaultText(); + $text = $Text{'text'}; + $text =~ s/((.|\n)*?)<\/html>/ /ig; + $text =~ s/(.|\n)*?\<\/nowiki>/ /ig; + $text =~ s/
    (.|\n)*?\<\/pre>/ /ig;
    +  $text =~ s/(.|\n)*?\<\/code>/ /ig;
    +  if ($interlink) {
    +    $text =~ s/''+/ /g;  # Quotes can adjacent to inter-site links
    +    $text =~ s/$InterLinkPattern/push(@links, &StripUrlPunct($1)), ' '/ge;
    +  } else {
    +    $text =~ s/$InterLinkPattern/ /g;
    +  }
    +  if ($urllink) {
    +    $text =~ s/''+/ /g;  # Quotes can adjacent to URLs
    +    $text =~ s/$UrlPattern/push(@links, &StripUrlPunct($1)), ' '/ge;
    +  } else {
    +    $text =~ s/$UrlPattern/ /g;
    +  }
    +  if ($pagelink) {
    +    if ($FreeLinks) {
    +      my $fl = $FreeLinkPattern;
    +      $text =~ s/\[\[$fl\|[^\]]+\]\]/push(@links, &FreeToNormal($1)), ' '/ge;
    +      $text =~ s/\[\[$fl\]\]/push(@links, &FreeToNormal($1)), ' '/ge;
    +    }
    +    if ($WikiLinks) {
    +      $text =~ s/$LinkPattern/push(@links, &StripUrlPunct($1)), ' '/ge;
    +    }
    +  }
    +  return @links;
    +}
    +
    +sub DoPost {
    +  my ($editDiff, $old, $newAuthor, $pgtime, $oldrev, $preview, $user);
    +  my $string = &GetParam("text", undef);
    +  my $id = &GetParam("title", "");
    +  my $summary = &GetParam("summary", "");
    +  my $oldtime = &GetParam("oldtime", "");
    +  my $oldconflict = &GetParam("oldconflict", "");
    +  my $isEdit = 0;
    +  my $editTime = $Now;
    +  my $authorAddr = $ENV{REMOTE_ADDR};
    +
    +  if (!&UserCanEdit($id, 1)) {
    +    # This is an internal interface--we don't need to explain
    +    &ReportError(Ts('Editing not allowed for %s.', $id));
    +    return;
    +  }
    +  if (($id eq   'SampleUndefinedPage')    ||
    +      ($id eq T('SampleUndefinedPage'))   ||
    +      ($id eq   'Sample_Undefined_Page')  ||
    +      ($id eq T('Sample_Undefined_Page'))) {
    +    &ReportError(Ts('%s cannot be defined.', $id));
    +    return;
    +  }
    +  $string  = &RemoveFS($string);
    +  $summary = &RemoveFS($summary);
    +  $summary =~ s/[\r\n]//g;
    +  if (length($summary) > 300) {  # Too long (longer than form allows)
    +    $summary = substr($summary, 0, 300);
    +  }
    +  # Add a newline to the end of the string (if it doesn't have one)
    +  $string .= "\n"  if (!($string =~ /\n$/));
    +  # Lock before getting old page to prevent races
    +  # Consider extracting lock section into sub, and eval-wrap it?
    +  # (A few called routines can die, leaving locks.)
    +  if ($LockCrash) {
    +    &RequestLock() or die(T('Could not get editing lock'));
    +  } else {
    +    if (!&RequestLock()) {
    +      &ForceReleaseLock('main');
    +    }
    +    # Clear all other locks.
    +    &ForceReleaseLock('cache');
    +    &ForceReleaseLock('diff');
    +    &ForceReleaseLock('index');
    +  }
    +  &OpenPage($id);
    +  &OpenDefaultText();
    +  $old = $Text{'text'};
    +  $oldrev = $Section{'revision'};
    +  $pgtime = $Section{'ts'};
    +  $preview = 0;
    +  $preview = 1  if (&GetParam("Preview", "") ne "");
    +  if (!$preview && ($old eq $string)) {  # No changes (ok for preview)
    +    &ReleaseLock();
    +    &ReBrowsePage($id, "", 1);
    +    return;
    +  }
    +  if (($UserID > 399) || ($Section{'id'} > 399))  {
    +    $newAuthor = ($UserID ne $Section{'id'});       # known user(s)
    +  } else {
    +    $newAuthor = ($Section{'ip'} ne $authorAddr);  # hostname fallback
    +  }
    +  $newAuthor = 1  if ($oldrev == 0);  # New page
    +  $newAuthor = 0  if (!$newAuthor);   # Standard flag form, not empty
    +  # Detect editing conflicts and resubmit edit
    +  if (($oldrev > 0) && ($newAuthor && ($oldtime != $pgtime))) {
    +    &ReleaseLock();
    +    if ($oldconflict > 0) {  # Conflict again...
    +      &DoEdit($id, 2, $pgtime, $string, $preview);
    +    } else {
    +      &DoEdit($id, 1, $pgtime, $string, $preview);
    +    }
    +    return;
    +  }
    +  if ($preview) {
    +    &ReleaseLock();
    +    &DoEdit($id, 0, $pgtime, $string, 1);
    +    return;
    +  }
    +  $user = &GetParam("username", "");
    +  # If the person doing editing chooses, send out email notification
    +  if ($EmailNotify) {
    +    &EmailNotify($id, $user) if &GetParam("do_email_notify", "") eq 'on';
    +  }
    +  if (&GetParam("recent_edit", "") eq 'on') {
    +    $isEdit = 1;
    +  }
    +  if (!$isEdit) {
    +    &SetPageCache('oldmajor', $Section{'revision'});
    +  }
    +  if ($newAuthor) {
    +    &SetPageCache('oldauthor', $Section{'revision'});
    +  }
    +  &SaveKeepSection();
    +  &ExpireKeepFile();
    +  if ($UseDiff) {
    +    &UpdateDiffs($id, $editTime, $old, $string, $isEdit, $newAuthor);
    +  }
    +  $Text{'text'} = $string;
    +  $Text{'minor'} = $isEdit;
    +  $Text{'newauthor'} = $newAuthor;
    +  $Text{'summary'} = $summary;
    +  $Section{'host'} = &GetRemoteHost(1);
    +  &SaveDefaultText(); 
    +  &SavePage();
    +  &WriteRcLog($id, $summary, $isEdit, $editTime, $Section{'revision'},
    +              $user, $Section{'host'});
    +  if ($UseCache) {
    +    &UnlinkHtmlCache($id);         # Old cached copy is invalid
    +    if ($Page{'revision'} < 2) {   # If this is a new page...
    +      &NewPageCacheClear($id);     # ...uncache pages linked to this one.
    +    }
    +  }
    +  if ($UseIndex && ($Page{'revision'} == 1)) {
    +    unlink($IndexFile);  # Regenerate index on next request
    +  }
    +  &ReleaseLock();
    +  &ReBrowsePage($id, "", 1);
    +}
    +
    +sub UpdateDiffs {
    +  my ($id, $editTime, $old, $new, $isEdit, $newAuthor) = @_;
    +  my ($editDiff, $oldMajor, $oldAuthor);
    +
    +  $editDiff  = &GetDiff($old, $new, 0);     # 0 = already in lock
    +  $oldMajor  = &GetPageCache('oldmajor');
    +  $oldAuthor = &GetPageCache('oldauthor');
    +  if ($UseDiffLog) {
    +    &WriteDiff($id, $editTime, $editDiff);
    +  }
    +  &SetPageCache('diff_default_minor', $editDiff);
    +  if ($isEdit || !$newAuthor) {
    +    &OpenKeptRevisions('text_default');
    +  }
    +  if (!$isEdit) {
    +    &SetPageCache('diff_default_major', "1");
    +  } else {
    +    &SetPageCache('diff_default_major', &GetKeptDiff($new, $oldMajor, 0));
    +  }
    +  if ($newAuthor) {
    +    &SetPageCache('diff_default_author', "1");
    +  } elsif ($oldMajor == $oldAuthor) {
    +    &SetPageCache('diff_default_author', "2");
    +  } else {
    +    &SetPageCache('diff_default_author', &GetKeptDiff($new, $oldAuthor, 0));
    +  }
    +}
    +
    +# Translation note: the email messages are still sent in English
    +# Send an email message.
    +sub SendEmail {
    +  my ($to, $from, $reply, $subject, $message) = @_;
    +
    +  # sendmail options:
    +  #    -odq : send mail to queue (i.e. later when convenient)
    +  #    -oi  : do not wait for "." line to exit
    +  #    -t   : headers determine recipient.
    +  open (SENDMAIL, "| $SendMail -oi -t ") or die "Can't send email: $!\n";
    +  print SENDMAIL <<"EOF";
    +From: $from
    +To: $to
    +Reply-to: $reply
    +Subject: $subject\n
    +$message
    +EOF
    +  close(SENDMAIL) or warn "sendmail didn't close nicely";
    +}
    +
    +## Email folks who want to know a note that a page has been modified. - JimM.
    +sub EmailNotify {
    +  local $/ = "\n";   # don't slurp whole files in this sub.
    +
    +  if ($EmailNotify) {
    +    my ($id, $user) = @_;
    +    if ($user) {
    +      $user = " by $user";
    +    }
    +    my $address;
    +    return  if (!-f $EmailFile);  # No notifications yet
    +    open(EMAIL, $EmailFile)
    +      or die "Can't open $EmailFile: $!\n";
    +    $address = join ",", ;
    +    $address =~ s/\n//g;
    +    close(EMAIL);
    +    my $home_url = $q->url();
    +    my $page_url = $home_url . "?$id";
    +    my $editors_summary = $q->param("summary");
    +    if (($editors_summary eq "*") or ($editors_summary eq "")){
    +      $editors_summary = "";
    +    }
    +    else {
    +      $editors_summary = "\n Summary: $editors_summary";
    +    }
    +    my $content = <<"END_MAIL_CONTENT";
    +
    + The $SiteName page $id at
    +   $page_url
    + has been changed$user to revision $Page{revision}. $editors_summary
    +
    + (Replying to this notification will
    +  send email to the entire mailing list,
    +  so only do that if you mean to.
    +
    +  To remove yourself from this list, visit
    +  ${home_url}?action=editprefs .)
    +END_MAIL_CONTENT
    +    my $subject = "The $id page at $SiteName has been changed.";
    +    # I'm setting the "reply-to" field to be the same as the "to:" field
    +    # which seems appropriate for a mailing list, especially since the
    +    # $EmailFrom string needn't be a real email address.
    +    &SendEmail($address, $EmailFrom, $address, $subject, $content);
    +  }
    +}
    +
    +sub SearchTitleAndBody {
    +  my ($string) = @_;
    +  my ($name, $freeName, @found);
    +
    +  foreach $name (&AllPagesList()) {
    +    &OpenPage($name);
    +    &OpenDefaultText();
    +    if (($Text{'text'} =~ /$string/i) || ($name =~ /$string/i)) {
    +      push(@found, $name);
    +    } elsif ($FreeLinks && ($name =~ m/_/)) {
    +      $freeName = $name;
    +      $freeName =~ s/_/ /g;
    +      if ($freeName =~ /$string/i) {
    +        push(@found, $name);
    +      }
    +    }
    +  }
    +  return @found;
    +}
    +
    +sub SearchBody {
    +  my ($string) = @_;
    +  my ($name, @found);
    +
    +  foreach $name (&AllPagesList()) {
    +    &OpenPage($name);
    +    &OpenDefaultText();
    +    if ($Text{'text'} =~ /$string/i){
    +      push(@found, $name);
    +    }
    +  }
    +  return @found;
    +}
    +
    +sub UnlinkHtmlCache {
    +  my ($id) = @_;
    +  my $idFile;
    +
    +  $idFile = &GetHtmlCacheFile($id);
    +  if (-f $idFile) {
    +    unlink($idFile);
    +  }
    +}
    +
    +sub NewPageCacheClear {
    +  my ($id) = @_;
    +  my $name;
    +
    +  return if (!$UseCache);
    +  $id =~ s|.+/|/|;  # If subpage, search for just the subpage
    +  # The following code used to search the body for the $id
    +  foreach $name (&AllPagesList()) {  # Remove all to be safe
    +    &UnlinkHtmlCache($name);
    +  }
    +}
    +
    +# Note: all diff and recent-list operations should be done within locks.
    +sub DoUnlock {
    +  my $LockMessage = T('Normal Unlock.');
    +
    +  print &GetHeader('', T('Removing edit lock'), '');
    +  print '

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

    $LockMessage

    "; + print &GetCommonFooter(); +} + +# Note: all diff and recent-list operations should be done within locks. +sub WriteRcLog { + my ($id, $summary, $isEdit, $editTime, $revision, $name, $rhost) = @_; + my ($extraTemp, %extra); + + %extra = (); + $extra{'id'} = $UserID if ($UserID > 0); + $extra{'name'} = $name if ($name ne ""); + $extra{'revision'} = $revision if ($revision ne ""); + $extraTemp = join($FS2, %extra); + # The two fields at the end of a line are kind and extension-hash + my $rc_line = join($FS3, $editTime, $id, $summary, + $isEdit, $rhost, "0", $extraTemp); + if (!open(OUT, ">>$RcFile")) { + die(Ts('%s log error:', $RCName) . " $!"); + } + print OUT $rc_line . "\n"; + close(OUT); +} + +sub WriteDiff { + my ($id, $editTime, $diffString) = @_; + + open (OUT, ">>$DataDir/diff_log") or die(T('can not write diff_log')); + print OUT "------\n" . $id . "|" . $editTime . "\n"; + print OUT $diffString; + close(OUT); +} + +# Actions are vetoable if someone edits the page before +# the keep expiry time. For example, page deletion. If +# no one edits the page by the time the keep expiry time +# elapses, then no one has vetoed the last action, and the +# action is accepted. +# See http://www.usemod.com/cgi-bin/mb.pl?PageDeletion +sub ProcessVetos { + my ($expirets); + + $expirets = $Now - ($KeepDays * 24 * 60 * 60); + return (0, T('(done)')) unless $Page{'ts'} < $expirets; + if ($DeletedPage && $Text{'text'} =~ /^\s*$DeletedPage\W*?(\n|$)/o) { + &DeletePage($OpenPageName, 1, 1); + return (1, T('(deleted)')); + } + if ($ReplaceFile && $Text{'text'} =~ /^\s*$ReplaceFile\:\s*(\S+)/o) { + my $fname = $1; + # Only replace an allowed, existing file. + if ((grep {$_ eq $fname} @ReplaceableFiles) && -e $fname) { + if ($Text{'text'} =~ /.*
    .*?\n(.*?)\s*<\/pre>/ims)
    +       {
    +         my $string = $1;
    +         $string =~ s/\r\n/\n/gms;
    +         open (OUT, ">$fname") or return 0;
    +         print OUT $string;
    +         close OUT;
    +         return (0, T('(replaced)'));
    +      }
    +    }
    +  }
    +  return (0, T('(done)'));
    +}
    +
    +sub DoMaintain {
    +  my ($name, $fname, $data, $message, $status);
    +  print &GetHeader('', T('Maintenance on all pages'), '');
    +  print "
    "; + $fname = "$DataDir/maintain"; + if (!&UserIsAdmin()) { + if ((-f $fname) && ((-M $fname) < 0.5)) { + print T('Maintenance not done.'), ' '; + print T('(Maintenance can only be done once every 12 hours.)'); + print ' ', T('Remove the "maintain" file or wait.'); + print &GetCommonFooter(); + return; + } + } + &RequestLock() or die(T('Could not get maintain-lock')); + foreach $name (&AllPagesList()) { + &OpenPage($name); + &OpenDefaultText(); + ($status, $message) = &ProcessVetos(); + &ExpireKeepFile() unless $status; + print ".... " if ($name =~ m|/|); + print &GetPageLink($name); + print " $message
    \n"; + } + &WriteStringToFile($fname, Ts('Maintenance done at %s', &TimeToText($Now))); + &ReleaseLock(); + # Do any rename/deletion commands + # (Must be outside lock because it will grab its own lock) + $fname = "$DataDir/editlinks"; + if (-f $fname) { + $data = &ReadFileOrDie($fname); + print '
    ', T('Processing rename/delete commands:'), "
    \n"; + &UpdateLinksList($data, 1, 1); # Always update RC and links + unlink("$fname.old"); + rename($fname, "$fname.old"); + } + if ($MaintTrimRc) { + &RequestLock() or die(T('Could not get lock for RC maintenance')); + $status = &TrimRc(); # Consider error messages? + &ReleaseLock(); + } + print &GetCommonFooter(); +} + +# Must be called within a lock. +# Thanks to Alex Schroeder for original code +sub TrimRc { + my (@rc, @temp, $starttime, $days, $status, $data, $i, $ts); + + # Determine the number of days to go back + $days = 0; + foreach (@RcDays) { + $days = $_ if $_ > $days; + } + $starttime = $Now - $days * 24 * 60 * 60; + return 1 if (!-f $RcFile); # No work if no file exists + ($status, $data) = &ReadFile($RcFile); + if (!$status) { + print '

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

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

    $!\n" . '

    '; + return 0; + } + # Move the old stuff from rc to temp + @rc = split(/\n/, $data); + for ($i = 0; $i < @rc; $i++) { + ($ts) = split(/$FS3/, $rc[$i]); + last if ($ts >= $starttime); + } + return 1 if ($i < 1); # No lines to move from new to old + @temp = splice(@rc, 0, $i); + # Write new files and backups + if (!open(OUT, ">>$RcOldFile")) { + print '

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

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

    $!\n" . '

    '; + return 0; + } + print OUT join("\n", @temp) . "\n"; + close(OUT); + &WriteStringToFile($RcFile . '.old', $data); + $data = join("\n", @rc); + $data .= "\n" if ($data ne ''); # If no entries, don't add blank line + &WriteStringToFile($RcFile, $data); + return 1; +} + +sub DoMaintainRc { + print &GetHeader('', T('Maintaining RC log'), ''); + return if (!&UserIsAdminOrError()); + &RequestLock() or die(T('Could not get lock for RC maintenance')); + if (&TrimRc()) { + print '
    ' . T('RC maintenance done.') . '
    '; + } else { + print '
    ' . T('RC maintenance not done.') . '
    '; + } + &ReleaseLock(); + print &GetCommonFooter(); +} + +sub UserIsEditorOrError { + if (!&UserIsEditor()) { + print '

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

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

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

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

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

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

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

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

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

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


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

    Empty banned list or error."; + print "

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

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

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

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


    \n"; + print &GetGotoBar(""); + print $q->endform; + print &GetMinimumFooter(); +} + +sub UpdateLinksList { + my ($commandList, $doRC, $doText) = @_; + + if ($doText) { + &BuildLinkIndex(); + } + &RequestLock() or die T('UpdateLinksList could not get main lock'); + unlink($IndexFile) if ($UseIndex); + foreach (split(/\n/, $commandList)) { + s/\s+$//g; + next if (!(/^[=!|]/)); # Only valid commands. + print "Processing $_
    \n"; + if (/^\!(.+)/) { + &DeletePage($1, $doRC, $doText); + } elsif (/^\=(?:\[\[)?([^]=]+)(?:\]\])?\=(?:\[\[)?([^]=]+)(?:\]\])?/) { + &RenamePage($1, $2, $doRC, $doText); + } elsif (/^\|(?:\[\[)?([^]|]+)(?:\]\])?\|(?:\[\[)?([^]|]+)(?:\]\])?/) { + &RenameTextLinks($1, $2); + } + } + &NewPageCacheClear("."); # Clear cache (needs testing?) + unlink($IndexFile) if ($UseIndex); + &ReleaseLock(); +} + +sub BuildLinkIndex { + my (@pglist, $page, @links, $link, %seen); + + @pglist = &AllPagesList(); + %LinkIndex = (); + foreach $page (@pglist) { + &BuildLinkIndexPage($page); + } +} + +sub BuildLinkIndexPage { + my ($page) = @_; + my (@links, $link, %seen); + + @links = &GetPageLinks($page, 1, 0, 0); + %seen = (); + foreach $link (@links) { + if (defined($LinkIndex{$link})) { + if (!$seen{$link}) { + $LinkIndex{$link} .= " " . $page; + } + } else { + $LinkIndex{$link} .= " " . $page; + } + $seen{$link} = 1; + } +} + +sub DoUpdateLinks { + my ($commandList, $doRC, $doText); + + print &GetHeader("", T('Updating Links'), ""); + if ($AdminDelete) { + return if (!&UserIsAdminOrError()); + } else { + return if (!&UserIsEditorOrError()); + } + $commandList = &GetParam("commandlist", ""); + $doRC = &GetParam("p_changerc", "0"); + $doRC = 1 if ($doRC eq "on"); + $doText = &GetParam("p_changetext", "0"); + $doText = 1 if ($doText eq "on"); + if ($commandList eq "") { + print "

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

    Finished command list."; + } + print &GetCommonFooter(); +} + +sub EditRecentChanges { + my ($action, $old, $new) = @_; + + &EditRecentChangesFile($RcFile, $action, $old, $new, 1); + &EditRecentChangesFile($RcOldFile, $action, $old, $new, 0); +} + +sub EditRecentChangesFile { + my ($fname, $action, $old, $new, $printError) = @_; + my ($status, $fileData, $errorText, $rcline, @rclist); + my ($outrc, $ts, $page, $junk); + + ($status, $fileData) = &ReadFile($fname); + if (!$status) { + # Save error text if needed. + $errorText = "

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

    Error was:\n

    $!
    \n"; + print $errorText if ($printError); + return; + } + $outrc = ""; + @rclist = split(/\n/, $fileData); + foreach $rcline (@rclist) { + ($ts, $page, $junk) = split(/$FS3/, $rcline); + if ($page eq $old) { + if ($action == 1) { # Delete + ; # Do nothing (don't add line to new RC) + } elsif ($action == 2) { + $junk = $rcline; + $junk =~ s/^(\d+$FS3)$old($FS3)/"$1$new$2"/ge; + $outrc .= $junk . "\n"; + } + } else { + $outrc .= $rcline . "\n"; + } + } + &WriteStringToFile($fname . ".old", $fileData); # Backup copy + &WriteStringToFile($fname, $outrc); +} + +# Delete and rename must be done inside locks. +sub DeletePage { + my ($page, $doRC, $doText) = @_; + my ($fname, $status); + + $page =~ s/ /_/g; + $page =~ s/\[+//; + $page =~ s/\]+//; + $status = &ValidId($page); + if ($status ne "") { + print "Delete-Page: page $page is invalid, error is: $status
    \n"; + return; + } + $fname = &GetPageFile($page); + unlink($fname) if (-f $fname); + $fname = $KeepDir . "/" . &GetPageDirectory($page) . "/$page.kp"; + unlink($fname) if (-f $fname); + unlink($IndexFile) if ($UseIndex); + &EditRecentChanges(1, $page, "") if ($doRC); # Delete page + # Currently don't do anything with page text +} + +# Given text, returns substituted text +sub SubstituteTextLinks { + my ($old, $new, $text) = @_; + + # Much of this is taken from the common markup + %SaveUrl = (); + $SaveUrlIndex = 0; + $text =~ s/$FS(\d)/$1/g; # Remove separators (paranoia) + if ($RawHtml) { + $text =~ s/(((.|\n)*?)<\/html>)/&StoreRaw($1)/ige; + } + $text =~ s/(
    ((.|\n)*?)<\/pre>)/&StoreRaw($1)/ige;
    +  $text =~ s/(((.|\n)*?)<\/code>)/&StoreRaw($1)/ige;
    +  $text =~ s/(((.|\n)*?)<\/nowiki>)/&StoreRaw($1)/ige;
    +  if ($FreeLinks) {
    +    $text =~
    +     s/\[\[$FreeLinkPattern\|([^\]]+)\]\]/&SubFreeLink($1,$2,$old,$new)/geo;
    +    $text =~ s/\[\[$FreeLinkPattern\]\]/&SubFreeLink($1,"",$old,$new)/geo;
    +  }
    +  if ($BracketText) {  # Links like [URL text of link]
    +    $text =~ s/(\[$UrlPattern\s+([^\]]+?)\])/&StoreRaw($1)/geo;
    +    $text =~ s/(\[$InterLinkPattern\s+([^\]]+?)\])/&StoreRaw($1)/geo;
    +  }
    +  $text =~ s/(\[?$UrlPattern\]?)/&StoreRaw($1)/geo;
    +  $text =~ s/(\[?$InterLinkPattern\]?)/&StoreRaw($1)/geo;
    +  if ($WikiLinks) {
    +    $text =~ s/$LinkPattern/&SubWikiLink($1, $old, $new)/geo;
    +  }
    +  # Thanks to David Claughton for the following fix
    +  1 while $text =~ s/$FS(\d+)$FS/$SaveUrl{$1}/ge;   # Restore saved text
    +  return $text;
    +}
    +
    +sub SubFreeLink {
    +  my ($link, $name, $old, $new) = @_;
    +  my ($oldlink);
    +
    +  $oldlink = $link;
    +  $link =~ s/^\s+//;
    +  $link =~ s/\s+$//;
    +  if (($link eq $old) || (&FreeToNormal($old) eq &FreeToNormal($link))) {
    +    $link = $new;
    +  } else {
    +    $link = $oldlink;  # Preserve spaces if no match
    +  }
    +  $link = "[[$link";
    +  if ($name ne "") {
    +    $link .= "|$name";
    +  }
    +  $link .= "]]";
    +  return &StoreRaw($link);
    +}
    +
    +sub SubWikiLink {
    +  my ($link, $old, $new) = @_;
    +  my ($newBracket);
    +
    +  $newBracket = 0;
    +  if ($link eq $old) {
    +    $link = $new;
    +    if (!($new =~ /^$LinkPattern$/)) {
    +      $link = "[[$link]]";
    +    }
    +  }
    +  return &StoreRaw($link);
    +}
    +
    +# Rename is mostly copied from expire
    +sub RenameKeepText {
    +  my ($page, $old, $new) = @_;
    +  my ($fname, $status, $data, @kplist, %tempSection, $changed);
    +  my ($sectName, $newText);
    +
    +  $fname = $KeepDir . "/" . &GetPageDirectory($page) .  "/$page.kp";
    +  return  if (!(-f $fname));
    +  ($status, $data) = &ReadFile($fname);
    +  return  if (!$status);
    +  @kplist = split(/$FS1/, $data, -1);  # -1 keeps trailing null fields
    +  return  if (length(@kplist) < 1);  # Also empty
    +  shift(@kplist)  if ($kplist[0] eq "");  # First can be empty
    +  return  if (length(@kplist) < 1);  # Also empty
    +  %tempSection = split(/$FS2/, $kplist[0], -1);
    +  if (!defined($tempSection{'keepts'})) {
    +    return;
    +  }
    +  # First pass: optimize for nothing changed
    +  $changed = 0;
    +  foreach (@kplist) {
    +    %tempSection = split(/$FS2/, $_, -1);
    +    $sectName = $tempSection{'name'};
    +    if ($sectName =~ /^(text_)/) {
    +      %Text = split(/$FS3/, $tempSection{'data'}, -1);
    +      $newText = &SubstituteTextLinks($old, $new, $Text{'text'});
    +      $changed = 1  if ($Text{'text'} ne $newText);
    +    }
    +  }
    +  return  if (!$changed);  # No sections changed
    +  open (OUT, ">$fname") or return;
    +  foreach (@kplist) {
    +    %tempSection = split(/$FS2/, $_, -1);
    +    $sectName = $tempSection{'name'};
    +    if ($sectName =~ /^(text_)/) {
    +      %Text = split(/$FS3/, $tempSection{'data'}, -1);
    +      $newText = &SubstituteTextLinks($old, $new, $Text{'text'});
    +      $Text{'text'} = $newText;
    +      $tempSection{'data'} = join($FS3, %Text);
    +      print OUT $FS1, join($FS2, %tempSection);
    +    } else {
    +      print OUT $FS1, $_;
    +    }
    +  }
    +  close(OUT);
    +}
    +
    +sub RenameTextLinks {
    +  my ($old, $new) = @_;
    +  my ($changed, $file, $page, $section, $oldText, $newText, $status);
    +  my ($oldCanonical, @pageList);
    +
    +  $old =~ s/ /_/g;
    +  $oldCanonical = &FreeToNormal($old);
    +  $new =~ s/ /_/g;
    +  $status = &ValidId($old);
    +  if ($status ne "") {
    +    print "Rename-Text: old page $old is invalid, error is: $status
    \n"; + return; + } + $status = &ValidId($new); + if ($status ne "") { + print "Rename-Text: new page $new is invalid, error is: $status
    \n"; + return; + } + $old =~ s/_/ /g; + $new =~ s/_/ /g; + # Note: the LinkIndex must be built prior to this routine + return if (!defined($LinkIndex{$oldCanonical})); + @pageList = split(' ', $LinkIndex{$oldCanonical}); + foreach $page (@pageList) { + $changed = 0; + &OpenPage($page); + foreach $section (keys %Page) { + if ($section =~ /^text_/) { + &OpenSection($section); + %Text = split(/$FS3/, $Section{'data'}, -1); + $oldText = $Text{'text'}; + $newText = &SubstituteTextLinks($old, $new, $oldText); + if ($oldText ne $newText) { + $Text{'text'} = $newText; + $Section{'data'} = join($FS3, %Text); + $Page{$section} = join($FS2, %Section); + $changed = 1; + } + } elsif ($section =~ /^cache_diff/) { + $oldText = $Page{$section}; + $newText = &SubstituteTextLinks($old, $new, $oldText); + if ($oldText ne $newText) { + $Page{$section} = $newText; + $changed = 1; + } + } + # Add other text-sections (categories) here + } + if ($changed) { + $file = &GetPageFile($page); + &WriteStringToFile($file, join($FS1, %Page)); + } + &RenameKeepText($page, $old, $new); + } +} + +sub RenamePage { + my ($old, $new, $doRC, $doText) = @_; + my ($oldfname, $newfname, $oldkeep, $newkeep, $status); + + $old =~ s/ /_/g; + $new = &FreeToNormal($new); + $status = &ValidId($old); + if ($status ne "") { + print "Rename: old page $old is invalid, error is: $status
    \n"; + return; + } + $status = &ValidId($new); + if ($status ne "") { + print "Rename: new page $new is invalid, error is: $status
    \n"; + return; + } + $newfname = &GetPageFile($new); + if (-f $newfname) { + print "Rename: new page $new already exists--not renamed.
    \n"; + return; + } + $oldfname = &GetPageFile($old); + if (!(-f $oldfname)) { + print "Rename: old page $old does not exist--nothing done.
    \n"; + return; + } + &CreatePageDir($PageDir, $new); # It might not exist yet + rename($oldfname, $newfname); + &CreatePageDir($KeepDir, $new); + $oldkeep = $KeepDir . "/" . &GetPageDirectory($old) . "/$old.kp"; + $newkeep = $KeepDir . "/" . &GetPageDirectory($new) . "/$new.kp"; + unlink($newkeep) if (-f $newkeep); # Clean up if needed. + rename($oldkeep, $newkeep); + unlink($IndexFile) if ($UseIndex); + &EditRecentChanges(2, $old, $new) if ($doRC); + if ($doText) { + &BuildLinkIndexPage($new); # Keep index up-to-date + &RenameTextLinks($old, $new); + } +} + +sub DoShowVersion { + print &GetHeader("", "Displaying Wiki Version", ""); + print "

    UseModWiki version 1.0

    \n"; + print &GetCommonFooter(); +} + +# Admin bar contributed by ElMoro (with some changes) +sub GetPageLockLink { + my ($id, $status, $name) = @_; + + if ($FreeLinks) { + $id = &FreeToNormal($id); + } + return &ScriptLink("action=pagelock&set=$status&id=$id", $name); +} + +sub GetAdminBar { + my ($id) = @_; + my ($result); + + $result = T('Administration') . ': '; + if (-f &GetLockedPageFile($id)) { + $result .= &GetPageLockLink($id, 0, T('Unlock page')); + } + else { + $result .= &GetPageLockLink($id, 1, T('Lock page')); + } + $result .= " | " . &GetDeleteLink($id, T('Delete this page'), 0); + $result .= " | " . &ScriptLink("action=editbanned", T("Edit Banned List")); + $result .= " | " . &ScriptLink("action=maintain", T("Run Maintenance")); + $result .= " | " . &ScriptLink("action=editlinks", T("Edit/Rename pages")); + if (-f "$DataDir/noedit") { + $result .= " | " . &ScriptLink("action=editlock&set=0", T("Unlock site")); + } else { + $result .= " | " . &ScriptLink("action=editlock&set=1", T("Lock site")); + } + return $result; +} + +# Thanks to Phillip Riley for original code +sub DoDeletePage { + my ($id) = @_; + + return if (!&ValidIdOrDie($id)); + return if (!&UserIsAdminOrError()); + if ($ConfirmDel && !&GetParam('confirm', 0)) { + print &GetHeader('', Ts('Confirm Delete %s', $id), ''); + print '

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

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

    '; + if ($id eq $HomePage) { + print Ts('%s can not be deleted.', $HomePage); + } else { + if (-f &GetLockedPageFile($id)) { + print Ts('%s can not be deleted because it is locked.', $id); + } else { + # Must lock because of RC-editing + &RequestLock() or die(T('Could not get editing lock')); + DeletePage($id, 1, 1); + &ReleaseLock(); + print Ts('%s has been deleted.', $id); + } + } + print '

    '; + print &GetCommonFooter(); +} + +# Thanks to Ross Kowalski and Iliyan Jeliazkov for original uploading code +sub DoUpload { + print &GetHeader('', T('File Upload Page'), ''); + if (!$AllUpload) { + return if (!&UserIsEditorOrError()); + } + print '

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


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

    '; + print ''; + print '
    '; + print &GetCommonFooter(); +} + +sub SaveUpload { + my ($filename, $printFilename, $uploadFilehandle); + + print &GetHeader('', T('Upload Finished'), ''); + if (!$AllUpload) { + return if (!&UserIsEditorOrError()); + } + $UploadDir .= '/' if (substr($UploadDir, -1, 1) ne '/'); # End with / + $UploadUrl .= '/' if (substr($UploadUrl, -1, 1) ne '/'); # End with / + $filename = $q->param('file'); + $filename =~ s/.*[\/\\](.*)/$1/; # Only name after last \ or / + $uploadFilehandle = $q->upload('file'); + open UPLOADFILE, ">$UploadDir$filename"; + while (<$uploadFilehandle>) { print UPLOADFILE; } + close UPLOADFILE; + print T('The wiki link to your file is:') . "\n

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

    \n"; + if ($filename =~ /${ImageExtensions}$/) { + print '
    ' . "\n"; + } + print &GetCommonFooter(); +} + +sub ConvertFsFile { + my ($oldFS, $newFS, $fname) = @_; + my ($oldData, $newData, $status); + + return if (!-f $fname); # Convert only existing regular files + ($status, $oldData) = &ReadFile($fname); + if (!$status) { + print '
    ' . Ts('Could not open file %s', $fname) + . ':' . T('Error was') . ":\n
    $!
    \n" . '
    '; + return; + } + $newData = $oldData; + $newData =~ s/$oldFS(\d)/$newFS . $1/ge; + return if ($oldData eq $newData); # Do not write if the same + &WriteStringToFile($fname, $newData); +# print $fname . '
    '; # progress report +} + +# Converts up to 3 dirs deep (like page/A/Apple/subpage.db) +# Note that top level directory (page/keep/user) contains only dirs +sub ConvertFsDir { + my ($oldFS, $newFS, $topDir) = @_; + my (@dirs, @files, @subFiles, $dir, $file, $subFile, $fname, $subFname); + + opendir(DIRLIST, $topDir); + @dirs = readdir(DIRLIST); + closedir(DIRLIST); + @dirs = sort(@dirs); + foreach $dir (@dirs) { + next if (substr($dir, 0, 1) eq '.'); # No ., .., or .dirs + next if (!-d "$topDir/$dir"); # Top level directories only + next if (-f "$topDir/$dir.cvt"); # Skip if already converted + opendir(DIRLIST, "$topDir/$dir"); + @files = readdir(DIRLIST); + closedir(DIRLIST); + foreach $file (@files) { + next if (($file eq '.') || ($file eq '..')); + $fname = "$topDir/$dir/$file"; + if (-f $fname) { +# print $fname . '
    '; # progress + &ConvertFsFile($oldFS, $newFS, $fname); + } elsif (-d $fname) { + opendir(DIRLIST, $fname); + @subFiles = readdir(DIRLIST); + closedir(DIRLIST); + foreach $subFile (@subFiles) { + next if (($subFile eq '.') || ($subFile eq '..')); + $subFname = "$fname/$subFile"; + if (-f $subFname) { +# print $subFname . '
    '; # progress + &ConvertFsFile($oldFS, $newFS, $subFname); + } + } + } + } + &WriteStringToFile("$topDir/$dir.cvt", 'converted'); + } +} + +sub ConvertFsCleanup { + my ($topDir) = @_; + my (@dirs, $dir); + + opendir(DIRLIST, $topDir); + @dirs = readdir(DIRLIST); + closedir(DIRLIST); + foreach $dir (@dirs) { + next if (substr($dir, 0, 1) eq '.'); # No ., .., or .dirs + next if (!-f "$topDir/$dir"); # Remove only files... + next unless ($dir =~ m/\.cvt$/); # ...that end with .cvt + unlink "$topDir/$dir"; + } +} + +sub DoConvert { + my $oldFS = "\xb3"; + my $newFS = "\x1e\xff\xfe\x1e"; + + print &GetHeader('', T('Convert wiki DB'), ''); + return if (!&UserIsAdminOrError()); + if ($FS ne $newFS) { + print Ts('You must change the %s option before converting the wiki DB.', + '$NewFS') . '
    '; + return; + } + &WriteStringToFile("$DataDir/noedit", 'editing locked.'); + print T('Wiki DB locked for conversion.') . '
    '; + print T('Converting Wiki DB...') . '
    '; + &ConvertFsFile($oldFS, $newFS, "$DataDir/rclog"); + &ConvertFsFile($oldFS, $newFS, "$DataDir/rclog.old"); + &ConvertFsFile($oldFS, $newFS, "$DataDir/oldrclog"); + &ConvertFsFile($oldFS, $newFS, "$DataDir/oldrclog.old"); + &ConvertFsDir($oldFS, $newFS, $PageDir); + &ConvertFsDir($oldFS, $newFS, $KeepDir); + &ConvertFsDir($oldFS, $newFS, $UserDir); + &ConvertFsCleanup($PageDir); + &ConvertFsCleanup($KeepDir); + &ConvertFsCleanup($UserDir); + print T('Finished converting wiki DB.') . '
    '; + print Ts('Remove file %s to unlock wiki for editing.', "$DataDir/noedit") + . '
    '; + print &GetCommonFooter(); +} + +# Remove user-id files if no useful preferences set +sub DoTrimUsers { + my (%Data, $status, $data, $maxID, $id, $removed, $keep); + my (@dirs, @files, $dir, $file, $item); + + print &GetHeader('', T('Trim wiki users'), ''); + return if (!&UserIsAdminOrError()); + $removed = 0; + $maxID = 1001; + opendir(DIRLIST, $UserDir); + @dirs = readdir(DIRLIST); + closedir(DIRLIST); + foreach $dir (@dirs) { + next if (substr($dir, 0, 1) eq '.'); # No ., .., or .dirs + next if (!-d "$UserDir/$dir"); # Top level directories only + opendir(DIRLIST, "$UserDir/$dir"); + @files = readdir(DIRLIST); + closedir(DIRLIST); + foreach $file (@files) { + if ($file =~ m/(\d+).db/) { # Only numeric ID files + $id = $1; + $maxID = $id if ($id > $maxID); + %Data = (); + ($status, $data) = &ReadFile("$UserDir/$dir/$file"); + if ($status) { + %Data = split(/$FS1/, $data, -1); # -1 keeps trailing null fields + $keep = 0; + foreach $item (qw(username password adminpw stylesheet)) { + $keep = 1 if (defined($Data{$item}) && ($Data{$item} ne '')); + } + if (!$keep) { + unlink "$UserDir/$dir/$file"; +# print "$UserDir/$dir/$file" . '
    '; # progress + $removed += 1; + } + } + } + } + } + print Ts('Removed %s files.', $removed) . '
    '; + print Ts('Recommended $StartUID setting is %s.', $maxID + 100) . '
    '; + print &GetCommonFooter(); +} +#END_OF_OTHER_CODE + +&DoWikiRequest() if ($RunCGI && ($_ ne 'nocgi')); # Do everything. +1; # In case we are loaded from elsewhere +# == End of UseModWiki script. ===========================================