K:\TWiki Leo\Leo DBSoft6:OPT#8#67100656GWD#1#0GCL#11#-2147483633WRC#1#0IDS#1#4WRO#3#>|:FON#11#Courier NewFOS#1#9STC#8#16777215STB#7#6956042TBC#0#TBD#1#4EFF#297#17,0,0,16777215,;3,0,16777215,;4,8421504,16777215,;5,0,16777215,;6,255,16777215,;10,16711680,16777215,;11,0,16777215,;12,16711680,16777215,;20,16711680,16777215,;21,255,16777215,;22,255,16777215,;23,16711680,16777215,;40,255,16777215,;42,0,16777215,;43,255,16777215,;45,0,16777215,;46,0,16777215,;GDF#1#0MDF#1#0SDF#1#0BDF#1#0FOC#1#0RMG#1#0LNN#13#MS Sans SerifLNS#1#8LNC#11#-2147483640LNT#1#1LNE#0##END# @@ TWiki 20010901 read (or skim) me first Introduction Intro to Leo <<Literate programming in 10 words or less>> <<How Leo approaches Literate Programming>> <<How to change the font>> <<Use a fixed width font>> <<Use a gray left border>> <<Double angle brackets>> <<Outline order confusion>> <<Tangling, Weaving, Untangling>> <<Use Leo 1 markup>> <<Leo Bugs>> <<Keywords>> Using Leo for TWiki Development Alternative Approaches <<Store Leo file (only) in CVS, always derive Perl files by tangling>> <<Store Leo file and Perl files in CVS>> <<Store Perl files (only) in CVS>> <<Recommendation>> Importing TWiki Intro to TWiki <<"Browsing" a URL invokes a TWiki program>> <<explanation of a typical twiki url>> <<ways for twiki to remember>> Perl Reference @ $ # a b c d e f g h i j k l m n o p package parameter passing idiom q r s subroutine calling idiom t tie u use v w x y z programs view old annotated view.mine introductory notes URL Explanation <<license and all copyrights>> <<uses>> Perl newbie <<call main>> <> <> <> <<new query>> TWiki newbie Perl newbie modules TWiki.cfg <<license and PT copyright>> <<developers notes>> <<Variables that can be accessed from topics>> TWiki newbie <<variables that need to be changed when installing on a new server>> <<FIGURE OUT THE OS WE'RE RUNNING UNDER>> <<variables that might need to be changed>> <<variables that probably do not change>> <<flag variables that could change>> <<Administration notes>> TWiki.pm old annotated TWiki.pm.mine <<license and all copyrights>> <<developer comments>> <<declarations>> <> <> <> <> <> <> <> <> <> <> <> Perl newbie TWiki newbie <> <> <> <> <> <> <> <> <> <> <> <> <> <> <> <> <> <> <> <> <> <> <> <> <> <> <> <> <> <> <> <> <> <> <> <> <> <> <> <> <> <> <> <> <> <> <> <> <> <> <> <> <> lib modules Access.pm old annotated Access.pm.mine <<license and PT copyright>> <<developer comments>> <<declarations>> <> <> <> <> <> <> <> <> Store.pm old annotated Store.pm.mine <<license and PT copyright>> <<developer comments>> <<declarations>> <> <> <> <> <> <> <> <> <> <> <> <> <> <> <> <> <> <> <> <> <> <> <> <> <> <> <> <> <> <> <> <> <> <> <> <> <> <> <> <> <> <> <> <> <> <> <> <> <> <> <> <> <> <> @nocolor This is an experimental attempt to improve the documentation of TWiki to serve my needs as a newbie to Perl and TWiki. Before you do anything else: * Select Edit --> Font Panel from the menu, and then choose a (preferably fixed width) font that is readable for you * Select Edit --> Syntax Coloring --> Options then set a "Visible gutter" at about 10 (units?), and uncheck the checkbox for "Mark wrapped lines" Unfortunately, this version of Leo will not save those preferences -- they may even get lost as you navigate this Leo outline. This early iteration of the experiment has these goals: * Provide a sample that TWiki developers can look at, and consider whether using Leo to add additional documentation is a promising approach, and whether they would one day consider developing in Leo. * Start documenting the Sept. 1, 2001 version of TWiki by capturing the documentation I had already added to portions of the 20010315beta. (I had added notes to portions of view, TWiki.pm, Access.pm, and Store.pm.) I may issue a version of this for developer review after incorporating my (old) comments for portions of view and TWiki.pm, only. It does not have as an immediate goal: * Creating finished or accurate documentation. Certainly that is a longer term goal, but recognize that I am learning Perl, CGI, and TWiki, and this is one way of advancing my learning. Many of my comments are poorly written, and some are inaccurate or plain wrong. I expect to correct these as I learn more, or, others may correct them if they'd like to help (deleting incorrect comments without providing correct comments in their place will not be helpful -- I'm sure most of the TWiki developers don't need many comments -- I do, at least during a learning phase). My goal in trying to document TWiki in Leo is to provide a means to add excessively verbose and comments not needed by experienced developers in a way that is unobtrusive to the developers. This is one of the two most promising approaches I have found so far. (The other is a folding editor.) Either approach requires changes to developer practices, which I will discuss elsewhere <later>. As far as reviewing the code, my intent is that an experienced developer should be able to go to, for example, a node like "view", read it, and then read the nodes labeled with headings in <<double angle brackets>> to view the remainder of the code. (Unfortunately, the headings in <<double angle brackets>> do not create hyperlinks.) If the developers ignore all other links (with headings like "introductory notes", "Perl newbie", "TWiki newbie", and so forth) they will never see those verbose notes. A developer can make changes to the code and produce revised Perl files from Leo by pressing <ctrl><shift>A which "tangles" (all) the code. As you learn more, there are other approaches which can tangle a single file, but you must have the node containing the @root directive for that file selected. The tangled Perl files look very much like the current Perl files with only a few comment "sentinels" to mark the location of sections. Sentinels enclose portions of the code and look like this: # <<section name>> Perl code and comments # -- end -- <<section name>> Development should usually be done in the .leo file. Because it will become a big file (probably, although we could consider having separate .leo files for each program), updating to/from CVS may become more cumbersome. And, should manual merging be required, it may be more difficult because of the XML tags in the .leo files. (.leo files are XML, but there aren't that many XML tags, so it may not be too aggravating. The toughest part relates to (outline) nodes, their numbering, and sequence.) Some development and debugging can be done in the Perl files and then those changes "untangled" to update the .leo files. There are limitations on the changes that Leo can untangle, which I don't fully understand at this time, but I think they relate mainly to adding, deleting, or moving outline nodes. If Leo were adopted for development and we discovered insurmountable problems, there is an escape hatch. If things got so messed up (or proved so cumbersome) that development could not continue in Leo, we can always checkout the last known good version of the .leo files, tangle them to get the Perl files, and continue development with the Perl files. (If we adopted this approach, we could consider whether to delete the sentinels from the Perl files, or leave them for a short period of time with hopes of getting back to development in Leo.) (Once I learned more about CVS and felt more comfortable, I could volunteer to (manually) remove those sentinels if we made a consensus decision to do so.) Leo is being developed for Windows, Linux, and the Mac. The version I'm using is Leo2 for Windows. I am intentionally using only Leo1 markup for reasons that will be explained elsewhere. I don't know how well the Linux and Mac versions work. (They may only be at the Leo 1 level at this point in time, but that should be OK because I'm using only the Leo 1 markup.) (The documentation for Leo, especially Leo 2, is not the best. I may have used a few Leo2 markup features by accident, or there may be some oddities about the way I've used Leo 1 markup that don't work in the Leo 1 versions of the program.) (The developer is Ed Ream, http://www.sourceforge.net/projects/leo/ -- he also has his own web page which I've lost for the moment.) One of the primary focuses of current Leo development is creating a wxWindows (and or wxPython) version. (wxWindows is a cross platform development library (my words).) I think a few releases have occurred. As it is perfected, it "automatically" provides versions for Windows, Linux, and the Mac, so the issue of having the same tool on different platforms goes away. As I mentioned, this is one of the two most promising approaches I see to accomplish what I'd like to accomplish. The other promising approach is to use a "folding" editor, but again, this requires changes to developer practices (all developers would have to use a folding editor or suffer through verbose comments). Aside: my first thought is to suggest a folding editor that folds on the basis of the indentation level. Providing a mechanism to do this documentation in TWiki would be cumbersome and require some development work. (For example, a tool to "tangle" the files from TWiki topics -- presumably Ward Cunningham has such a thing for his wiki.) In addition, TWiki is just too slow and cumbersome for fast review and editing. If we wanted this documentation migrated to TWiki at some point in time, that would be fine, but I would develop it in Leo or a folding editor. Reminder: I am creating this documentation for my own benefit in learning Perl and TWiki. If no one is interested in adopting this approach for TWiki development, I will still continue to develop it to whatever extent seems useful to me. One intent would be to make this documentation available on WikiLearn, as a learning tool for Perl. If the documentation is never perfected or finished, that is not a problem. If someone else uses it, and finds things to add or fix, that's the wiki way, isn't it. Aside: I would eventually like the newbie documentation to be well written, concise, to the point, correct, etc. On the other hand, the newbie documentation is intended to help a ... newbie, and, as such, will have a tendency to be more verbose than documentation intended for an experienced developer. (I can't quite specify the final product I'm looking for, but like someone said about pornography, I'll know it when I see it.) Part of what I'm saying is that I will welcome all help in perfecting the documentation, but I'd prefer that you be very cautious about deleting anything. Make a note if you think something should be deleted or moved somewhere else. Even move it somewhere else, as long as there is a clear navigational path for the newbie to get to it if he needs it. For the time being, I'd like to review any such deletions or movements. And, now clearly, it's time to stop -- I wrote too much (again). PS: Leo is not a finished product -- see <<Intro to Leo>> for some hints to make it easier to use (and read). This is a short intro to Leo. Before I get anyone else to review this document, I should expand this introduction. Here are some things I want to cover: <<Literate programming in 10 words or less>> <<How to change the font>> <<Use a fixed width font>> at least while editing <<Use a gray left border>> to improve readability <<Double angle brackets>> <<Outline order confusion>> <<Tangling, Weaving, Untangling>> <<Use Leo 1 markup>> <<Leo Bugs>> <<Keywords>> (@ignore, @doc, @code, @ <comment>, @root, @file) Enclosing the heading name in double angle brackets is handy when creating the outline (this Leo document), and necessary for proper tangling of code, but not really necessary in cases where the named node and subnodes contain documentation only and will not be tangled into a file for compiling. I could establish a different convention for node names that are documentation only and won't be tangled -- I'll think about it. The reason the double angle brackets are handy while creating the Leo document is because they can be used with the Edit | Edit Body | Extract commands to automatically create new named nodes. For example, the Extract Section (<ctrl><shift>e) command will automatically create a new (sub)node containing the selected text, with the text enclosed in double angle brackets as the heading of the node, and with a copy of the text in double angle brackets remaining in the original node. Note also that the text in double angle brackets is not an aid to automatic navigation -- it is not a link to the named node. That would be nice as a future enhancement, and would be a reason to maintain the double angle brackets. The double angle brackets do help highligh a node name in the midst of other text on a page. Leo for Windows, version 2.1, Aug. 3, 2001, under Windows 95, the OEM (last) version. I've now upgraded to version 2.3, and will confirm whether the older bugs exist or not. Here are new ones (recorded since 2.3., but they may have existed in 2.1 or 2.2): * Editor options and font size changess are not saved between invocations of Leo. * @isoMonth and @publicWebList are variables in TWiki.pm. Leo considers them to be SWEB directives and will not tangle that file. Oops, no problem. Use @@ if in first column, otherwise OK. (Clarify in Leo documentation.) Here are older bugs, to be reconfirmed in 2.2: * Currently a showstopper, but shouldn't be too hard to fix. When Leo tangles files, it puts a few comments before the first line of the file. This interferes with the "shebang" line that is required for Perl and keeps Perl from executing. This includes both the "# Created by Leo from: K:\TWiki Leo\Leo\TWiki20010901" line and the first "sentry"( # <<license>>). Update: Oops, I was wrong -- use the @first directive in Leo1. This was a problem with Leo2 markup until the 2.3 release. * Fixed in 2.2: When I visit a node with text longer than the text pane, the scrollbar starts out positioned at the bottom -- I have to scroll up to start reading from the beginning. * Update: Seems to be OK in 2.2 (might even have been a problem with my system, although it was consistent except for the last time I tried it before upgrading to 2.2.): If I quit Leo and attempt to restart it, I cannot unless I reboot. Error message <later>. * The text pane normally includes no left border, so black text tends to merge with the black border around the screen, making it more difficult to read. * A workaround is to use Edit | Syntax Coloring | Options and set the Visible Gutter to about 10 and uncheck Mark Wrapped Lines. * However, various things happen to cause those settings to be "lost", for example: * Sometimes when a new node is created by one of the Edit | Edit Body | Extract commands * Those preferences are not saved between invocations of Leo * If a proportional font is chosen, there is strange behavior near the end of a line. Basically as you are typing and approach the end of a line, the text "jumps" (I think the width of the line is being recalculated or something related.) * A workaround is to choose a fixed width font, like TT Courier New. * However, various things happen to cause a font setting (face or size) to be "lost", for example: * Those preferences are not saved between invocations of Leo * <Later, haven't pinned any down so far> The issues here relate to how to use Leo in a collaborative environment, using CVS as a code repository. To some extent, it could be easier if we used Leo 2 markup, but for various reasons I've chosen to use Leo 1 markup. See <<Use Leo 1 markup>>. I'm going to list some alternatives here, then discuss the pros and cons of each in subnodes, then try to decide which makes the most sense. <<Store Leo file (only) in CVS, always derive Perl files by tangling>> <<Store Leo file and Perl files in CVS>> <<Store Perl files (only) in CVS>> <<Recommendation>> One advantage of using Leo is, by using cloned nodes, we might be able to maintain only one copy of the license and copyright notices in the .leo file, but have it tangled into each Perl file. (Need to test and confirm.) Storing the .leo file in CVS is feasible, because, after all, it is just an XML file. It may become a rather big file, because it contain all the Perl files (in "untangled" form), all the literate programming comments, and the necessary XML markup. As long as there are no CVS checkin conflicts, or CVS can resolve them automatically, things might not be too bad. But, when changes conflict and must be resolved manually, I think it will be a little more difficult because of the XML markup in the .leo file. It may not be too bad, there is not that much XML markup. Where I'm most worried is in the node lists and the associated numbering and ordering. I can imagine some things getting confused in this area, especially as the node count increases. Perhaps the most straightforward way to see if it will be a problem is to start developing in Leo and see what kind of problems we run into. Since CVS maintains all previous revisions, if a problem occurs that we can't solve, we can drop back one revision to a leo file that will untangle properly, and consider what to do at that point. (One option at that point is to drop the leo file and just maintain the Perl files (declaring this experiment a failure). But, if Leo proves helpful to other people, maybe we can continue the experiment.) So, when you checkout CVS, can you arrange to get just the changed lines? Yes, of course, that would be a diff? As an alternative, the checkout could occur on the SourceForge CVS host, and then developers could get the file using rsync to minimize the data transmitted. Cumbersome as this approach seems, I think it is the best alternative I've thought of so far. If we used Leo 2 markup, this part could be easier, but there are enough problems with Leo 2 that I don't recommend this. See <<Use Leo 1 markup>> This does not sound like a good idea. First of all, we're storing redundant information, the Perl files themselves, and the untangled version of them incorporated in the .leo file. Then we're just begging for people to modify the Perl files without untangling the changes into the .leo file. It's conceivable that a variant of this would be to untangle the files on the SourceForge server, but it just adds an extra step, an extra chance for confusion or failure. (My passing thought here was that only the Perl files would be transmitted back to SourceForge, saving some bandwidth. But this means changes to the .leo file are not maintained, which I don't consider acceptable.) Another variant could be that developer's only work on the tangled Perl files, and they are periodically untangled, and the .leo file is only updated after the fact, when somebody recognizes the need for documentation changes after some number of changes to the Perl files. I consider this unacceptable for the obvious reason (documentation not kept up to date) and because some changes to the Perl files will be significant enough that untangling cannot successfully update the .leo file -- then we have a real mess. Unacceptable for reasons I've already mentioned. Faced with the choices I've identified so far, I'd recommend that we store only the .leo file in CVS, and always derive the Perl files by tangling. Other alternatives for the future could include: * Redesign Leo 2 to overcome the disadvantages (primary problem is that it is not easy to document the program out of the order required for the compiler, secondary is poor documentation). (Actually, in the particular case of twiki where I am documenting the program after the fact, the requirement to maintain the program documentation in the order required for the compiler might not initially be a big drawback, because I will initially almost certainly document in program order.) * Fix Leo1 so it can untangle anything. (Well, that's not far from making it into Leo2 and fixing the disadvantages.) * Find another tool * Try to do this in TWiki, providing extra tools as required. (My first complaint about TWiki, without even thinking, is just the slowness of the view, edit, preview, save cycle. Especially over a dial up connection. More especially when that dial up connection is subject to disconnects. But, even when I edit on my home TWiki, the cycle is too slow.) < This is far from finished, and in any case requires a major rewrite.> This should become a description of TWiki from the users point of view, segueing into an overview description from the programmer's point of view. Some things I want to cover: From the user's point of view: <later> From the programmer's point of view: If you are not familiar with CGI: <<"Browsing" a URL invokes a TWiki program>> TWiki is written in Perl, and uses the CGI (Common Gateway Interface) module and programming convention to invoke programs on the hosting web server when a TWiki URL is "browsed". See the <<explanation of a typical twiki url>> Each time you browse or call a different URL, you invoke a different (or a different instance of) a TWiki program. In general, the program has no memory of what you might have done before. (Aside: There are some <<ways for twiki to remember>>.) This has several implications. Each time a twiki program is called, it must assume that it has no prior knowledge of any interaction with this particular user. Although it is conceivable that some different design decisions could be made (especially if performance problems occur), in the current design, each twiki program is invoked and initializes itself each time it is invoked. (I need to revise this paragraph to be a little clearer.) In a TWiki URL that looks like this: http://www.twiki.org/cgi-bin/view/TWiki/ManagingTopics?skin=print * "www.twiki.org" is the twiki host name * "cgi-bin" is the path to the host directory containing the twiki Perl/CGI programs. ("cgi-bin" is actually a ScriptAlias for the full path to the cgi-bin directory, defined in the Apache httpd.conf file.) * "view" is the name of the program file in cgi-bin that is invoked by this URL * Things after this point are parameters to the view program. In this case: * "TWiki" is the name of the web where the page to be viewed is found. A web is a directory under the <later> ("home" directory of this twiki, specified by ???) * "ManagingTopics" is the name of the web page to be displayed. It is also a file in the TWiki directory with the extension ".txt". * Another file with the same name but with the extension ".txt,v" is present in the same directory (except in abnormal circumstances) -- this file stores the revision history for the page, and if missing, the revision history is missing. * If another file with the same name but with the extension ".lock" is present, it indicates that the file has been locked for editing by another user. (The lock includes a time stamp, and may exist in the directory even if the lockout time is expired. Lock files are removed only by the cron job that also handles the email notification of changes.) * "skin" is a named parameter to the view program, its value is "print". In this case the page will be displayed with a special print "skin" which formats the display for printing -- it may include special headers and footers, and may exclude extraneous material to allow for more concise printing. TWiki has various ways of remembering what you've done before, and other optional methods exist: * As a matter of policy, until now, TWiki has not used cookies. There is now a plugin that makes use of cookies for some purposes. * There are ways for a CGI program to remember previous state, somehow -- maybe they are all instances of what I describe next. * Storing data in the local browser and returning that data to the server with the next URL call. (This may be a very incorrect understanding -- I'm thinking first of all of the page data from an edit or preview.) Some examples of this include: * The edited data from an edit or preview * ??? * There is an option that can be set so that twiki will remember the IP address that you originally logged in on, and then assume that anybody who logs in from that IP is you. (Clearly, you need to consider whether this is a good thing to do or not.) * On a LAN, twiki can remember / recognize you by the Remote User Id, in other words, whatever method you use to log in the the LAN. ToDo: Adjust @root paths so files are tangled to the proper directory. (Should not be difficult, just need to think about where this .leo file is (will be) and where the files should be tangled relative to it (or, use absolute paths). @silent @root "view" #!/usr/bin/perl -wT <<license and all copyrights>> <<uses>> <<call main>> <> <> <> # EOF @ignore View (view) is the Twiki program which displays a TWiki page. In a TWiki URL like http://localhost/twiki/bin/view/Codev/WebChanges, the word "view" is an invocation of the view program, and everything after "view" is parameters to the view program. The /Codev/WebChanges parameter represents a request to view the page WebChanges from web Codev. The page data is stored in file WebChanges.txt stored in a directory in the TWiki directory hierarchy named .../twiki/data/Codev. For every TWiki .txt file there is a file by the same name but with the extension .txt, v which stores the revision history for the page. There is another file with the same name and the extension .lock which is the lock file for this TWiki page. Both of these will be discussed elsewhere. Aside: The translation from the URL to the directory containing the file is based partially on an alias established in the configuration file for the web server running this TWiki. @ Note: I removed the "shebang" line from this node to put it in the same node as the @root, so that for Perl, it is not after a Leo "sentry". @ Note: Not sure which of the first two lines below is most correct. Maybe $wikiversion is in TWiki.cfg. @code # # TWiki WikiClone (see TWiki.pm for $wikiversion and other info) # TWiki WikiClone ($wikiversion has version info) # # Based on parts of Ward Cunninghams original Wiki and JosWiki. # Copyright (C) 1998 Markus Peter - SPiN GmbH (warpi@spin.de) # Some changes by Dave Harris (drh@bhresearch.co.uk) incorporated # Copyright (C) 1999-2001 Peter Thoeny, peter@thoeny.com # # 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, published at # http://www.gnu.org/copyleft/gpl.html @code use CGI::Carp qw( fatalsToBrowser ); use CGI; use lib ( '.' ); use lib ( '../lib' ); use TWiki; use strict; "use" statements" declare modules so Perl can use them. use CGI::Carp qw( fatalsToBrowser ); CGI::Carp is a standard Perl module that reports an error. It is like warn except it reports the error at a line in the calling module rather than where the code with the error is actually invoked. use CGI; CGI is a standard Perl module to handle the Common Gateway Interface interaction. A good source of information is available at http://stein.cshl.org/WWW/software/CGI/. CGI is the thing that gets information from the web browser. use lib ( '.' ); lib adds directories to Perl's standard search path so use or require statements can find them. This adds the current directory to the path. (Whose / which current directory? Is this the Apache users current directory? Is this "data" or "bin"? Clearly, based on the next statement and the assumption that it can find the modules like TWiki.pm, this must refer to "bin", which is the current directory where view is running from.) use lib ( '../lib' ); This adds a sibling to the current directory named lib to the Perl standard search path. use TWiki; TWiki is a custom Perl module written for TWiki. I believe it is in file TWiki.pm in the .../bin directory. use strict; Restricts use of unsafe Perl constructs for variables (must be declared, fully qualified, or imported), references (must not be symbolic), and subroutines (can't use a bareword identifier that's not a predeclared subroutine) -- I need to do more reading about this. @ These are some comments written just to aggravate anyone who might be reading ;-) I'm kidding. Actually they are just to show that arbitrary text can be inserted in the same node as the code and not appear in the tangled Perl files. Real newbie comments are in subnodes. @ Each paragraph (of comments) must start with "@"<space> @code writeDebugTimes( "view:start" ); ##### for debug only: Remove next 2 comments (but redirect does not work) #print "Content-type: text/html\n\n"; #open(STDERR,'>&STDOUT'); # redirect error to browser #$| = 1; # no buffering &main(); @code sub writeDebug { my( $text ) = @_; # TWiki::writeDebug( $text ); } @code sub writeDebugTimes { my( $text ) = @_; # TWiki::writeDebugTimes( $text ); } @code sub main { @ Now can I add a comment here? Apparently! @code <<new query>> my $tmpl = ""; my $text = ""; my $meta = ""; my $rev = $query->param( "rev" ); my $maxrev = 1; my $extra = ""; my $wikiUserName = &TWiki::userToWikiName( $userName ); my $revdate = ""; my $revuser = ""; my $viewRaw = $query->param( "raw" ) || ""; my $unlock = $query->param( "unlock" ) || ""; my $skin = $query->param( "skin" ) || &TWiki::Prefs::getPreferencesValue( "SKIN" ); # get view template, standard view or a view with a different skin $tmpl = &TWiki::Store::readTemplate( "view", $skin ); if( ! $tmpl ) { TWiki::writeHeader( $query ); print "<html><body>\n" . "<h1>TWiki Installation Error</h1>\n" . "Template file view.tmpl not found or template directory \n" . "$TWiki::templateDir not found.\n" . "Check the \$templateDir variable in TWiki.cfg.\n" . "</body></html>\n"; return; } writeDebugTimes( "view - readTemplate" ); if( ! &TWiki::Store::webExists( $webName ) ) { my $url = &TWiki::getOopsUrl( $webName, $topic, "oopsnoweb" ); TWiki::redirect( $query, $url ); return; } writeDebugTimes( "view - webExists" ); if( $unlock eq "on" ) { # unlock topic, user cancelled out of edit &TWiki::Store::lockTopic( $topic, "on" ); } # Most recent topic read in even if earlier topic requested - makes code simpler and performance impact should be minimal my $topicExists = &TWiki::Store::topicExists( $webName, $topic ); if( $topicExists ) { if( $viewRaw ) { $text = &TWiki::Store::readTopicRaw( $webName, $topic ); } else { ( $meta, $text ) = &TWiki::Store::readTopic( $webName, $topic ); } ( $revdate, $revuser, $maxrev ) = &TWiki::Store::getRevisionInfoFromMeta( $webName, $topic, $meta, "isoFormat" ); writeDebug( "maxrev = $maxrev" ); if( $rev ) { $rev =~ s/1\.//go; # cut major if( $rev < 1 ) { $rev = 1; } if( $rev > $maxrev ) { $rev = $maxrev; } } else { $rev = $maxrev; } if( $rev < $maxrev ) { if( $viewRaw ) { $text = &TWiki::Store::readTopicRaw( $webName, $topic, "1.$rev" ); } else { ( $meta, $text ) = &TWiki::Store::readTopicVersion( $webName, $topic, "1.$rev" ); } ( $revdate, $revuser ) = &TWiki::Store::getRevisionInfoFromMeta( $webName, $topic, $meta ); $extra .= "r1.$rev"; } } else { $rev = 1; if( &TWiki::isWikiName( $topic ) ) { ( $meta, $text ) = &TWiki::Store::readTemplateTopic( "WebTopicViewTemplate" ); } else { ( $meta, $text ) = &TWiki::Store::readTemplateTopic( "WebTopicNonWikiTemplate" ); } $extra .= " (not exist)"; } if( $viewRaw ) { my $vtext = "<form><textarea readonly=\"readonly\" wrap=\"virtual\" rows=\"%EDITBOXHEIGHT%\" cols=\"%EDITBOXWIDTH%\">"; $vtext = &TWiki::handleCommonTags( $vtext, $topic ); $text = "$vtext$text</textarea></form>"; if( $viewRaw !~ /debug/i ) { $text =~ s/%META[\:A-Z]*{[^\}]*}%[\n\r]*//gos; } } writeDebugTimes( "view - get rev info" ); # check access permission # To Do: Need to protect also %INCLUDE% and search my $viewAccessOK = &TWiki::Access::checkAccessPermission( "view", $wikiUserName, $text, $topic, $webName ); if( ! $viewAccessOK ) { # user could not be authenticated, may be not logged in yet? my $viewauthFile = $ENV{'SCRIPT_FILENAME'}; $viewauthFile =~ s|/view|/viewauth|o; if( ( ! $theRemoteUser ) && (-e $viewauthFile ) ) { # try again with authenticated viewauth script # instead of non authenticated view script my $url = $ENV{"REQUEST_URI"}; if( $url ) { # $url i.e. is "twiki/bin/view.cgi/Web/Topic?cms1=val1&cmd2=val2" $url =~ s|/view|/viewauth|o; $url = "$TWiki::urlHost$url"; } else { $url = "$TWiki::urlHost$scriptUrlPath/$viewauthFile/$webName/$topic"; } TWiki::redirect( $query, $url ); return; } } if( ! $viewAccessOK ) { my $url = &TWiki::getOopsUrl( $webName, $topic, "oopsaccessview" ); TWiki::redirect( $query, $url ); return; } writeDebugTimes( "view - checked access permissions" ); if( ! $viewRaw ) { $text = &TWiki::handleCommonTags( $text, $topic ); writeDebugTimes( "view - handleCommonTags done" ); $text = &TWiki::getRenderedVersion( $text ); writeDebugTimes( "view - getRendereredVersion done" ); } if( $TWiki::doLogTopicView ) { # write log entry &TWiki::Store::writeLog( "view", "$webName.$topic", $extra ); } my( $mirrorSiteName, $mirrorViewURL, $mirrorLink, $mirrorNote ) = &TWiki::readOnlyMirrorWeb( $webName ); if( $mirrorSiteName ) { # disable edit and attach $tmpl =~ s/%EDITTOPIC%/$mirrorLink | <strike>Edit<\/strike>/o; $tmpl =~ s/<a [^>]*?>Attach<\/a>/<strike>Attach<\/strike>/oi; if( $topicExists ) { # remove the NOINDEX meta tag $tmpl =~ s/<meta name="robots"[^>]*>//goi; } else { $text = ""; } $tmpl =~ s/%REVTITLE%//go; } elsif( $rev < $maxrev ) { # disable edit of previous revisions - FIXME consider change to use two templates $tmpl =~ s/%EDITTOPIC%/<strike>Edit<\/strike>/o; $tmpl =~ s/<a [^>]*?>Attach<\/a>/<strike>Attach<\/strike>/oi; $tmpl =~ s|<a [^>]*?>Rename/move<\/a>|<strike>Rename/move<\/strike>|oi; $tmpl =~ s/%REVTITLE%/$r1.$rev$/go; $tmpl =~ s/%REVARG%/&rev=1.$rev/go; } else { if( $topicExists ) { $tmpl =~ s/%EDITTOPIC%/<a href=\"$scriptUrlPath\/edit%SCRIPTSUFFIX%\/%WEB%\/%TOPIC%\">Edit<\/b><\/a>/go; # remove the NOINDEX meta tag $tmpl =~ s/<meta name="robots"[^>]*>//goi; } else { $tmpl =~ s/%EDITTOPIC%/<a href=\"$scriptUrlPath\/edit%SCRIPTSUFFIX%\/%WEB%\/%TOPIC%\">Create<\/b><\/a>/go; } $tmpl =~ s/%REVTITLE%//go; $tmpl =~ s/%REVARG%//go; } my $i = $maxrev; my $j = $maxrev; my $revisions = ""; my $breakRev = 0; if( ( $TWiki::numberOfRevisions > 0 ) && ( $TWiki::numberOfRevisions < $maxrev ) ) { $breakRev = $maxrev - $TWiki::numberOfRevisions + 1; } while( $i > 0 ) { if( $i eq $rev) { $revisions = "$revisions | r1.$i"; } else { $revisions = "$revisions | <a href=\"$scriptUrlPath/view%SCRIPTSUFFIX%/%WEB%/%TOPIC%?rev=1.$i\">r1.$i</a>"; } if( $i != 1 ) { if( $i == $breakRev ) { # Now obsolete because of 'More' link # $revisions = "$revisions | <a href=\"$scriptUrlPath/oops%SCRIPTSUFFIX%/%WEB%/%TOPIC%?template=oopsrev&param1=1.$maxrev\">>...</a>"; $i = 1; } else { $j = $i - 1; $revisions = "$revisions | <a href=\"$scriptUrlPath/rdiff%SCRIPTSUFFIX%/%WEB%/%TOPIC%?rev1=1.$i&rev2=1.$j\">></a>"; } } $i = $i - 1; } $tmpl =~ s/%REVISIONS%/$revisions/go; if( $topicExists ) { $revuser = &TWiki::userToWikiName( $revuser ); my $temp = &TWiki::getRenderedVersion( "r1.$rev - $revdate GMT - $revuser" ); $tmpl =~ s/%REVINFO%/$temp$mirrorNote/go; } else { $tmpl =~ s/%REVINFO%/$mirrorNote/go; } $tmpl = &TWiki::handleCommonTags( $tmpl, $topic ); if( $viewRaw ) { $tmpl =~ s/%META{[^}]*}%//go; } else { $tmpl = &TWiki::handleMetaTags( $webName, $topic, $tmpl, $meta ); } writeDebugTimes( "view - handleCommonTags for template done" ); $tmpl = &TWiki::getRenderedVersion( $tmpl, "", $meta ); ## better to use meta rendering? $tmpl =~ s/%TEXT%/$text/go; $tmpl =~ s/%MAXREV%/1.$maxrev/go; $tmpl =~ s/%CURRREV%/1.$rev/go; $tmpl =~ s|</*nop/*>||goi; # remove <nop> tags (PTh 06 Nov 2000) TWiki::writeHeader( $query ); print $tmpl; writeDebugTimes( "view - done" ); } @code my $query= new CGI; my $thePathInfo = $query->path_info(); my $theRemoteUser = $query->remote_user(); my $theTopic = $query->param( 'topic' ); my $theUrl = $query->url; my( $topic, $webName, $scriptUrlPath, $userName ) = &TWiki::initialize( $thePathInfo, $theRemoteUser, $theTopic, $theUrl, $query ); writeDebugTimes( "view - initialized" ); Unfortunately, I'm not sure the comments on this page are accurate. It was my best attempt a few months ago -- looking at some of them now I don't feel very comfortable. When I learn how, it would be educational to "print" these variables to my browser to see the actual contents during a "real" view. (Or maybe run the Perl debugger, which would have to be done at the server -- Ok on my home LAN.) Aside: I tried to insert statements like: print $thePathInfo; sleep 30; -- the sleep seemed to work (I had to wait), but I never saw anything on my browser before the page finally appeared. It looks like the ptkdb debugger might be the trick, trying to download it now. I think Mandrake 7.2 has the Perl Tk module installed. I tried ptkdb, but so far it hasn't worked with TWiki. You need to add these statements to the beginning of the Perl file to be debugged, and, so far, ptkdb hasn't been able to access the display. #!/usr/bin/perl -d:ptkdb sub BEGIN { $ENV{DISPLAY} = "yourmachine:0.0"; } my $query= new CGI; The object oriented form of invoking CGI -- I don't understand very much yet, but see below. Here is the most useful link I found (search for "path_info"): http://stein.cshl.org/WWW/software/CGI/cgi_docs.html my $thePathInfo = $query->path_info(); $thePathInfo gets the path info from the CGI "query object". In the case of the example given earlier, the path would be /Codev/WebChanges. my $theRemoteUser = $query->remote_user(); $theRemoteUser gets the name of the remote user -- the user of the browser. This is not the WikiName, but the name used to log on to your LAN, if this is on a LAN (if the TWiki is authenticated). If the TWiki is not authenticated, I'm not sure what is returned -- maybe "". my $theTopic = $query->param( 'topic' ); The query object checks to see if there is a named parameter in the URL named "topic" -- if so it returns the value specified in the URL, if not it returns "" (?) (This doesn't sound right -- a named parameter??) my $theUrl = $query->url; The query object returns the URL -- I'm not sure what that would be in the example given above -- would it be everything before the "view"? my( $topic, $webName, $scriptUrlPath, $userName ) = &TWiki::initialize( $thePathInfo, $theRemoteUser, $theTopic, $theUrl, $query ); The function initialize in the module TWiki (in file TWiki.pm) is invoked with the five parameters in parenthesis after the function invocation, returning the four parameters in the first set of parenthesis. writeDebugTimes( "view - initialized" ); "my" variables are local to a subroutine, they are being initialized in this early portion of sub main. ToDo: Adjust @root paths so files are tangled to the proper directory. (Should not be difficult, just need to think about where this .leo file is (will be) and where the files should be tangled relative to it (or, use absolute paths). @root TWiki.cfg <<license and PT copyright>> <<developers notes>> <<Variables that can be accessed from topics>> <<variables that need to be changed when installing on a new server>> <<FIGURE OUT THE OS WE'RE RUNNING UNDER>> <<variables that might need to be changed>> <<variables that probably do not change>> <<flag variables that could change>> <<Administration notes>> @root TWiki.pm # TWiki WikiClone ($wikiversion has version info) <<license and all copyrights>> <<developer comments>> <<declarations>> <> <> <> <> <> <> <> <> <> <> <> <> <> <> <> <> <> <> <> <> <> <> <> <> <> <> <> <> <> <> <> <> <> <> <> <> <> <> <> <> <> <> <> <> <> <> <> <> <> <> <> <> <> <> <> <> <> <> <> <> <> <> <> <> 1; ToDo: Adjust @root paths so files are tangled to the proper directory. (Should not be difficult, just need to think about where this .leo file is (will be) and where the files should be tangled relative to it (or, use absolute paths). @root Access.pm <<license and PT copyright>> <<developer comments>> <<declarations>> <> <> <> <> <> <> <> <> # ========================= 1; # EOF <<license and PT copyright>> <<developer comments>> <<declarations>> <> <> <> <> <> <> <> <> <> <> <> <> <> <> <> <> <> <> <> <> <> <> <> <> <> <> <> <> <> <> <> <> <> <> <> <> <> <> <> <> <> <> <> <> <> <> <> <> <> <> <> <> <> <> # ========================= 1; # EOF @code # Notes: # - Latest version at http://twiki.org/ # - Installation instructions in $dataDir/TWiki/TWikiDocumentation.txt # - Customize variables in TWiki.cfg when installing TWiki. # - Optionally create a new plugin or customize DefaultPlugin.pm for # custom rendering rules. # - Upgrading TWiki is easy as long as you only customize DefaultPlugin.pm. # - Check web server error logs for errors, i.e. % tail /var/log/httpd/error_log # # 20000501 Kevin Kinnell : changed beta0404 to have many new search # capabilities. This file had a new hash added # for month name-to-number look-ups, a slight # change in the parameter list for the search # script call in &handleSearchWeb, and a new # sub -- &revDate2EpSecs -- for calculating the # epoch seconds from a rev date (the only way # to sort dates.) @code package TWiki; ## 0501 kk : vvv Added for revDate2EpSecs use Time::Local; use strict; # =========================== # TWiki config variables: use vars qw( $webName $topicName $includingWebName $includingTopicName $defaultUserName $userName $wikiName $wikiUserName $wikiHomeUrl $defaultUrlHost $urlHost $scriptUrlPath $pubUrlPath $pubDir $templateDir $dataDir $twikiLibDir $siteWebTopicName $wikiToolName $securityFilter $uploadFilter $debugFilename $warningFilename $htpasswdFilename $logFilename $remoteUserFilename $wikiUsersTopicname $userListFilename %userToWikiList %wikiToUserList $twikiWebname $mainWebname $mainTopicname $notifyTopicname $wikiPrefsTopicname $webPrefsTopicname $statisticsTopicname $statsTopViews $statsTopContrib $numberOfRevisions $editLockTime $attachAsciiPath $scriptSuffix $wikiversion $safeEnvPath $mailProgram $noSpamPadding $mimeTypesFilename $doKeepRevIfEditLock $doGetScriptUrlFromCgi $doRemovePortNumber $doRememberRemoteUser $doPluralToSingular $doHidePasswdInRegistration $doSecureInclude $doLogTopicView $doLogTopicEdit $doLogTopicSave $doLogRename $doLogTopicAttach $doLogTopicUpload $doLogTopicRdiff $doLogTopicChanges $doLogTopicSearch $doLogRegistration $disableAllPlugins @isoMonth $TranslationToken $code @code $depth %mon2num $newTopicFontColor $newTopicBgColor $headerPatternDa $headerPatternSp $headerPatternHt $debugUserTime $debugSystemTime $viewableAttachmentCount $noviewableAttachmentCount $superAdminGroup $doSuperAdminGroup $cgiQuery @publicWebList $formatVersion $OS ); # TWiki::Store config: use vars qw( $useRcsDir $revInitBinaryCmd $revCoCmd $revCiCmd $revCiDateCmd $revHistCmd $revInfoCmd $revDiffCmd $revDelRevCmd $revUnlockCmd $revLockCmd $nullDev $rcsArg ); # TWiki::Search config: use vars qw( $cmdQuote $lsCmd $egrepCmd $fgrepCmd ); # =========================== # TWiki version: $wikiversion = "01 Sep 2001"; # =========================== # read the configuration part do "TWiki.cfg"; # =========================== # use TWiki and other modules use TWiki::Prefs; # preferences use TWiki::Search; # search engine use TWiki::Access; # access control use TWiki::Meta; # Meta class - topic meta data use TWiki::Store; # file I/O and rcs related functions use TWiki::Attach; # file attachment functions use TWiki::Form; # forms for topics use TWiki::Func; # official TWiki functions for plugins use TWiki::Plugins; # plugins handler #AS use TWiki::Net; # SMTP, get URL use Cwd; # =========================== # variables: (new variables must be declared in "use vars qw(..)" above) @@isoMonth = ( "Jan", "Feb", "Mar", "Apr", "May", "Jun", "Jul", "Aug", "Sep", "Oct", "Nov", "Dec" ); { my $count = 0; %mon2num = map { $_ => $count++ } @isoMonth; } # The following are also initialized in initialize, here for cases where # initialize not called. $cgiQuery = 0; @@publicWebList = (); # Header patterns based on '+++'. The '###' are reserved for numbered headers $headerPatternDa = '^---+(\++|\#+)\s+(.+)\s*$'; # '---++ Header', '---## Header' $headerPatternSp = '^\t(\++|\#+)\s+(.+)\s*$'; # ' ++ Header', ' + Header' $headerPatternHt = '^<h([1-6])>\s*(.+?)\s*</h[1-6]>'; # '<h6>Header</h6> $debugUserTime = 0; $debugSystemTime = 0; $formatVersion = "1.0"; @code # ========================= sub initialize { my ( $thePathInfo, $theRemoteUser, $theTopic, $theUrl, $theQuery ) = @_; ##writeDebug( "\n---------------------------------" ); $cgiQuery = $theQuery; # Initialise vars here rather than at start of module, so compatible with modPerl @publicWebList = (); &TWiki::Store::initialize(); # Make %ENV safer for CGI if( $safeEnvPath ) { $ENV{'PATH'} = $safeEnvPath; } delete @ENV{ qw( IFS CDPATH ENV BASH_ENV ) }; # initialize lib directory early because of later 'cd's getTWikiLibDir(); # initialize access control &TWiki::Access::initializeAccess(); # initialize user name and user to WikiName list userToWikiListInit(); $userName = &TWiki::Plugins::initializeUser( $theRemoteUser, $theUrl, $thePathInfo ); # e.g. "jdoe" $wikiName = userToWikiName( $userName, 1 ); # i.e. "JonDoe" $wikiUserName = userToWikiName( $userName ); # i.e. "Main.JonDoe" # initialize $webName and $topicName $topicName = ""; $webName = ""; if( $theTopic ) { if( $theTopic =~ /(.*)\.(.*)/ ) { # is "bin/script?topic=Webname.SomeTopic" $webName = $1 || ""; $topicName = $2 || ""; } else { # is "bin/script/Webname?topic=SomeTopic" $topicName = $theTopic; } } if( $thePathInfo =~ /\/(.*)\/(.*)/ ) { # is "bin/script/Webname/SomeTopic" or "bin/script/Webname/" $webName = $1 || "" if( ! $webName ); $topicName = $2 || "" if( ! $topicName ); } elsif( $thePathInfo =~ /\/(.*)/ ) { # is "bin/script/Webname" or "bin/script/" $webName = $1 || "" if( ! $webName ); } ( $topicName =~ /\.\./ ) && ( $topicName = $mainTopicname ); # filter out dangerous or unwanted characters: $topicName =~ s/$securityFilter//go; $topicName =~ /(.*)/; $topicName = $1 || $mainTopicname; # untaint variable $webName =~ s/$securityFilter//go; $webName =~ /(.*)/; $webName = $1 || $mainWebname; # untaint variable $includingTopicName = $topicName; $includingWebName = $webName; # initialize $urlHost and $scriptUrlPath if( ( $theUrl ) && ( $theUrl =~ /^([^\:]*\:\/\/[^\/]*)(.*)\/.*$/ ) && ( $2 ) ) { if( $doGetScriptUrlFromCgi ) { $scriptUrlPath = $2; } $urlHost = $1; if( $doRemovePortNumber ) { $urlHost =~ s/\:[0-9]+$//; } } else { $urlHost = $defaultUrlHost; } # PTh 15 Jul 2001: Removed init of $scriptUrlPath based on $theUrl because # $theUrl has incorrect URI after failed authentication # initialize preferences &TWiki::Prefs::initializePrefs( $wikiUserName, $webName ); # some remaining init $TranslationToken= "\263"; $code=""; @code= (); # Add background color and font color (AlWilliams - 18 Sep 2000) # PTh: Moved from interalLink to initialize ('cause of performance) $newTopicBgColor = &TWiki::Prefs::getPreferencesValue("NEWTOPICBGCOLOR"); if ($newTopicBgColor eq "") { $newTopicBgColor="#FFFFCE"; } $newTopicFontColor = &TWiki::Prefs::getPreferencesValue("NEWTOPICFONTCOLOR"); if ($newTopicFontColor eq "") { $newTopicFontColor="#0000FF"; } #AS if( !$disableAllPlugins ) { &TWiki::Plugins::initialize( $topicName, $webName, $userName ); } #/AS return ( $topicName, $webName, $scriptUrlPath, $userName, $dataDir ); } @code # ========================= # Can save cookies if required sub writeHeader { my( $query ) = @_; if( ! &TWiki::Plugins::writeHeaderHandler( $query ) ) { print $query->header(); } } @code # ========================= sub getCgiQuery { return $cgiQuery; } @code # ========================= sub redirect { my( $query, $url ) = @_; if( ! &TWiki::Plugins::redirectCgiQueryHandler( $query, $url ) ) { print $query->redirect( $url ); } } @code # ========================= # Warning and errors that may require admin intervention # Not using store writeLog and log file is more of an audit/usage file sub writeWarning { my( $text ) = @_; if( $warningFilename ) { my ( $sec, $min, $hour, $mday, $mon, $year ) = localtime( time() ); my( $tmon) = $isoMonth[$mon]; $year = sprintf( "%.4u", $year + 1900 ); # Y2K fix my $time = sprintf( "%.2u ${tmon} %.2u - %.2u:%.2u", $mday, $year, $hour, $min ); open( FILE, ">>$warningFilename" ); print FILE "$time $text\n"; close( FILE ); } } @code # ========================= sub writeDebug { my( $text ) = @_; open( FILE, ">>$debugFilename" ); my ( $sec, $min, $hour, $mday, $mon, $year ) = localtime( time() ); my( $tmon) = $isoMonth[$mon]; $year = sprintf( "%.4u", $year + 1900 ); # Y2K fix my $time = sprintf( "%.2u ${tmon} %.2u - %.2u:%.2u", $mday, $year, $hour, $min ); print FILE "$time $text\n"; close( FILE); } @code # ========================= sub writeDebugTimes { my( $text ) = @_; if( ! $debugUserTime ) { writeDebug( "===== sec: (delta:) sec: (delta:) function:" ); } my( $puser, $psystem, $cuser, $csystem ) = times(); my $duser = $puser - $debugUserTime; my $dsystem = $psystem - $debugSystemTime; my $times = sprintf( "user: %1.2f (%1.2f), system: %1.2f (%1.2f)", $puser, $duser, $psystem, $dsystem ); $debugUserTime = $puser; $debugSystemTime = $psystem; writeDebug( "===== $times, $text" ); } @code # ========================= sub getEmailNotifyList { my( $web, $topicname ) = @_; $topicname |= $TWiki::notifyTopicname; return undef unless &TWiki::Store::topicExists( $web, $topicname ); my @list = (); foreach ( split( /\n/, &TWiki::Store::readWebTopic( $web, $topicname ) ) ) { next unless /^\s\*\s[A-Za-z0-9\.]+\s+\-\s+/; push @list, $1 if (/([\w\-\.\+]+\@[\w\-\.\+]+)/); } return (scalar @list ? @list : undef); } @code # ========================= sub initializeRemoteUser { my( $theRemoteUser ) = @_; my $remoteUser = $theRemoteUser || $defaultUserName; $remoteUser =~ s/$securityFilter//go; $remoteUser =~ /(.*)/; $remoteUser = $1; # untaint variable my $remoteAddr = $ENV{'REMOTE_ADDR'} || ""; if( ( ! $doRememberRemoteUser ) || ( ! $remoteAddr ) ) { # do not remember IP address return $remoteUser; } my $text = &TWiki::Store::readFile( $remoteUserFilename ); my %AddrToName = map { split( /\|/, $_ ) } grep { /[^\|]*\|[^\|]*\|$/ } split( /\n/, $text ); my $rememberedUser = ""; if( exists( $AddrToName{ $remoteAddr } ) ) { $rememberedUser = $AddrToName{ $remoteAddr }; } if( $theRemoteUser ) { if( $theRemoteUser ne $rememberedUser ) { $AddrToName{ $remoteAddr } = $theRemoteUser; # create file as "$remoteAddr|$theRemoteUser|" lines $text = "# This is a generated file, do not modify.\n"; foreach my $usrAddr ( sort keys %AddrToName ) { my $usrName = $AddrToName{ $usrAddr }; # keep $userName unique if( ( $usrName ne $theRemoteUser ) || ( $usrAddr eq $remoteAddr ) ) { $text .= "$usrAddr|$usrName|\n"; } } &TWiki::Store::saveFile( $remoteUserFilename, $text ); } } else { # get user name from AddrToName table $remoteUser = $rememberedUser || $defaultUserName; } return $remoteUser; } @code # ========================= sub userToWikiListInit { my $text = &TWiki::Store::readFile( $userListFilename ); my @list = split( /\n/, $text ); @list = grep { /^\s*\* [A-Za-z0-9]*\s*\-\s*[^\-]*\-/ } @list; %userToWikiList = (); %wikiToUserList = (); my $wUser; my $lUser; foreach( @list ) { if( ( /^\s*\* ([A-Za-z0-9]*)\s*\-\s*([^\s]*).*/ ) && ( isWikiName( $1 ) ) && ( $2 ) ) { $wUser = $1; $lUser = $2; $lUser =~ s/$securityFilter//go; $userToWikiList{ $lUser } = $wUser; $wikiToUserList{ $wUser } = $lUser; } } } @code # ========================= sub userToWikiName { my( $loginUser, $dontAddWeb ) = @_; if( !$loginUser ) { return ""; } $loginUser =~ s/$securityFilter//go; my $wUser = $userToWikiList{ $loginUser } || $loginUser; if( $dontAddWeb ) { return $wUser; } return "$mainWebname.$wUser"; } @code # ========================= sub wikiToUserName { my( $wikiUser ) = @_; $wikiUser =~ s/^.*\.//go; my $userName = $wikiToUserList{"$wikiUser"} || $wikiUser; #TWiki::writeDebug( "TWiki::wikiToUserName: $wikiUser->$userName" ); return $userName; } @code # ========================= sub isGuest { return ( $userName eq $defaultUserName ); } @code # ========================= sub getWikiUserTopic { # Topic without Web name return $wikiName; } @code # ========================= sub readOnlyMirrorWeb { my( $theWeb ) = @_; my @mirrorInfo = ( "", "", "", "" ); if( $siteWebTopicName ) { my $mirrorSiteName = &TWiki::Prefs::getPreferencesValue( "MIRRORSITENAME", $theWeb ); if( $mirrorSiteName && $mirrorSiteName ne $siteWebTopicName ) { my $mirrorViewURL = &TWiki::Prefs::getPreferencesValue( "MIRRORVIEWURL", $theWeb ); my $mirrorLink = &TWiki::Store::readTemplate( "mirrorlink" ); $mirrorLink =~ s/%MIRRORSITENAME%/$mirrorSiteName/go; $mirrorLink =~ s/%MIRRORVIEWURL%/$mirrorViewURL/go; $mirrorLink =~ s/\s*$//go; my $mirrorNote = &TWiki::Store::readTemplate( "mirrornote" ); $mirrorNote =~ s/%MIRRORSITENAME%/$mirrorSiteName/go; $mirrorNote =~ s/%MIRRORVIEWURL%/$mirrorViewURL/go; $mirrorNote = getRenderedVersion( $mirrorNote, $theWeb ); $mirrorNote =~ s/\s*$//go; @mirrorInfo = ( $mirrorSiteName, $mirrorViewURL, $mirrorLink, $mirrorNote ); } } return @mirrorInfo; } @code # ========================= sub getDataDir { return $dataDir; } @code # ========================= sub getPubDir { return $pubDir; } @code # ========================= sub getPubUrlPath { return $pubUrlPath; } @code # ========================= sub getTWikiLibDir { if( $twikiLibDir ) { return $twikiLibDir; } my $dir = ""; foreach $dir ( @INC ) { if( -e "$dir/TWiki.pm" ) { $twikiLibDir = $dir; last; } } # fix relative path if( $twikiLibDir =~ /^\./ ) { my $curr = getcwd(); $twikiLibDir = "$curr/$twikiLibDir/"; # normalize "/../" and "/./" $twikiLibDir =~ s|([\\/])[^\\/]+[\\/]\.\.[\\/]|$1|go; $twikiLibDir =~ s|([\\/])\.[\\/]|$1|go; } $twikiLibDir =~ s|([\\/])[\\/]*|$1|go; # reduce "//" to "/" $twikiLibDir =~ s|[\\/]$||o; # cut trailing "/" return $twikiLibDir; } @code # ========================= sub getLocaldate { my( $sec, $min, $hour, $mday, $mon, $year) = localtime(time()); $year = sprintf("%.4u", $year + 1900); # Y2K fix my( $tmon) = $isoMonth[$mon]; my $date = sprintf("%.2u ${tmon} %.2u", $mday, $year); return $date; } @code # ========================= sub formatGmTime { my( $time ) = @_; my( $sec, $min, $hour, $mday, $mon, $year) = gmtime( $time ); my( $tmon) = $isoMonth[$mon]; $year = sprintf( "%.4u", $year + 1900 ); # Y2K fix $time = sprintf( "%.2u ${tmon} %.2u - %.2u:%.2u", $mday, $year, $hour, $min ); return $time; } @code # ========================= sub revDate2EpSecs { # This routine *will break* if formatGMTime changes output format. my ($day, $mon, $year, $hyph, $hrmin, @junk) = split(" ",$_[0]); my ($hr, $min) = split(/:/, $hrmin); #my $mon = $mon2num{$monstr}; return timegm(0, $min, $hr, $day, $mon2num{$mon}, $year - 1900); } @code # ========================= sub getSessionValue { # my( $key ) = @_; return &TWiki::Plugins::getSessionValueHandler( @_ ); } @code # ========================= sub setSessionValue { # my( $key, $value ) = @_; return &TWiki::Plugins::setSessionValueHandler( @_ ); } @code # ========================= sub getSkin { my $skin = ""; $skin = $cgiQuery->param( 'skin' ) if( $cgiQuery ); $skin = &TWiki::Prefs::getPreferencesValue( "SKIN" ) unless( $skin ); return $skin; } @code # ========================= sub getViewUrl { my( $theWeb, $theTopic ) = @_; # PTh 20 Jun 2000: renamed sub viewUrl to getViewUrl, added $theWeb my $web = $webName; # current web if( $theWeb ) { $web = $theWeb; } $theTopic =~ s/\s*//gos; # Illedal URL, remove space # PTh 24 May 2000: added $urlHost, needed for some environments # see also Codev.PageRedirectionNotWorking return "$urlHost$scriptUrlPath/view$scriptSuffix/$web/$theTopic"; } @code # ========================= sub getScriptUrl { my( $theWeb, $theTopic, $theScript ) = @_; my $url = "$urlHost$scriptUrlPath/$theScript$scriptSuffix/$theWeb/$theTopic"; # FIXME consider a plugin call here - useful for certificated logon environment return $url; } @code # ========================= sub getOopsUrl { my( $theWeb, $theTopic, $theTemplate, $theParam1, $theParam2, $theParam3, $theParam4 ) = @_; # PTh 20 Jun 2000: new sub my $web = $webName; # current web if( $theWeb ) { $web = $theWeb; } my $url = ""; # $urlHost is needed, see Codev.PageRedirectionNotWorking $url = getScriptUrl( $web, $theTopic, "oops" ); $url .= "\?template=$theTemplate"; if( $theParam1 ) { # PTh, Stanley Knutson 03 Feb 2001: Proper URL encoding $theParam1 =~ s/[\n\r]/\%3Cbr\%3E/go; $theParam1 =~ s/\s+/\%20/go; $theParam1 =~ s/\&/\%26/go; $theParam1 =~ s/\</\%3C/go; $theParam1 =~ s/\>/\%3E/go; $url .= "\&param1=$theParam1"; } if( $theParam2 ) { $theParam2 =~ s/[\n\r]/\%3Cbr\%3E/go; $theParam2 =~ s/\s+/\%20/go; $theParam2 =~ s/\&/\%26/go; $theParam2 =~ s/\</\%3C/go; $theParam2 =~ s/\>/\%3E/go; $url .= "\&param2=$theParam2"; } if( $theParam3 ) { $theParam3 =~ s/[\n\r]/\%3Cbr\%3E/go; $theParam3 =~ s/\s+/\%20/go; $theParam3 =~ s/\&/\%26/go; $theParam3 =~ s/\</\%3C/go; $theParam3 =~ s/\>/\%3E/go; $url .= "\&param3=$theParam3"; } if( $theParam4 ) { $theParam4 =~ s/[\n\r]/\%3Cbr\%3E/go; $theParam4 =~ s/\s+/\%20/go; $theParam4 =~ s/\&/\%26/go; $theParam4 =~ s/\</\%3C/go; $theParam4 =~ s/\>/\%3E/go; $url .= "\&param4=$theParam4"; } return $url; } @code # ========================= sub makeTopicSummary { my( $theText, $theTopic, $theWeb ) = @_; # called by search, mailnotify & changes after calling readFileHead my $htext = $theText; $htext =~ s/<\!\-\-.*?\-\->//gos; # remove all HTML comments $htext =~ s/<\!\-\-.*$//os; # remove cut HTML comment $htext =~ s/<[^>]*>//go; # remove all HTML tags $htext =~ s/%WEB%/$theWeb/go; # resolve web $htext =~ s/%TOPIC%/$theTopic/go; # resolve topic $htext =~ s/%WIKITOOLNAME%/$wikiToolName/go; # resolve TWiki tool name $htext =~ s/%META:.*?%//go; # Remove meta data variables $htext =~ s/[\%\[\]\*\|=_]/ /go; # remove Wiki formatting chars & defuse %VARS% $htext =~ s/\-\-\-+\+*/ /go; # remove heading formatting $htext =~ s/\s+[\+\-]*/ /go; # remove newlines and special chars # inline search renders text, # so prevent linking of external and internal links: $htext =~ s/([\-\*\s])((http|ftp|gopher|news|file|https)\:)/$1<nop>$2/go; $htext =~ s/([\*\s][\(\-\*\s]*)([A-Z]+[a-z0-9]*\.[A-Z]+[a-z]+[A-Z]+[a-zA-Z0-9]*)/$1<nop>$2/go; $htext =~ s/([\*\s][\(\-\*\s]*)([A-Z]+[a-z]+[A-Z]+[a-zA-Z0-9]*)/$1<nop>$2/go; $htext =~ s/([\*\s][\-\*\s]*)([A-Z]{3,})/$1<nop>$2/go; $htext =~ s/@([a-zA-Z0-9\-\_\.]+)/@<nop>$1/go; # limit to 162 chars $htext =~ s/(.{162})([a-zA-Z0-9]*)(.*?)$/$1$2 \.\.\./go; return $htext; } @code # ========================= sub extractNameValuePair { my( $str, $name ) = @_; if( $name ) { # format is: %VAR{ ... name = "value" }% if( ( $str =~ /(^|[^\S])$name\s*=\s*\"([^\"]*)\"/ ) && ( $2 ) ) { return $2; } } else { # test if format: { "value" ... } if( ( $str =~ /(^|\=\s*\"[^\"]*\")\s*\"([^\"]*)\"/ ) && ( $2 ) ) { # is: { "value" ... } return $2; } elsif( ( $str =~ /^\s*\w+\s*=\s*\"([^\"]*)/ ) && ( $1 ) ) { # value in double quotes (") # is not a standalone var, but: %VAR{ name = "value" }% return ""; } else { # format is: %VAR{ value }% return $1; } } return ""; } @code # ========================= sub fixN { my( $theTag ) = @_; $theTag =~ s/[\r\n]+//gos; return $theTag; } @code # ========================= sub fixURL { my( $theHost, $theAbsPath, $theUrl ) = @_; my $url = $theUrl; if( $url =~ /^\// ) { # fix absolute URL $url = "$theHost$url"; } elsif( $url =~ /^\./ ) { # fix relative URL $url = "$theHost/$theAbsPath$url"; } elsif( $url =~ /^(http|ftp|gopher|news|file|https)\:/ ) { # full qualified URL, do nothing } elsif( $url ) { # FIXME: is this test enough to detect relative URLs? $url = "$theHost/$theAbsPath$url"; } return $url; } @code # ========================= sub handleIncludeUrl { my( $theUrl, $thePattern ) = @_; my $text = ""; my $host = ""; my $port = 80; my $path = ""; if( $theUrl =~ /http\:\/\/([^\:]+)\:([0-9]+)(\/.*)/ ) { $host = $1; $port = $2; $path = $3; } elsif( $theUrl =~ /http\:\/\/([^\/]+)(\/.*)/ ) { $host = $1; $path = $2; } else { $text = showError( "Error: Unsupported protocol. (Must be 'http://domain/...')" ); return $text; } $text = &TWiki::Net::getUrl( $host, $port, $path ); $text =~ s/\r\n/\n/gos; $text =~ s/\r/\n/gos; $text =~ s/^(.*?\n)\n(.*)/$2/os; my $httpHeader = $1; my $contentType = ""; if( $httpHeader =~ /content\-type\:\s*([^\n]*)/ois ) { $contentType = $1; } if( $contentType =~ /^text\/html/ ) { $path =~ s/(.*)\/.*/$1/o; # build path for relative address $host = "http://$host"; # build host for absolute address if( $port != 80 ) { $host .= ":$port"; } # FIXME: Make aware of <base> tag $text =~ s/^.*?<\/head>//ois; # remove all HEAD $text =~ s/<script.*?<\/script>//gois; # remove all SCRIPTs $text =~ s/^.*?<body[^>]*>//ois; # remove all to <BODY> $text =~ s/<\/body>.*//ois; # remove </BODY> to end $text =~ s/<\/html>.*//ois; # remove </HTML> to end $text =~ s/(<[^>]*>)/&fixN($1)/geos; # join tags to one line each $text =~ s/(\s(href|src|action)\=\"?)([^\"\>\s]*)/$1 . &fixURL( $host, $path, $3 )/geois; } elsif( $contentType =~ /^text\/plain/ ) { # do nothing } else { $text = showError( "Error: Unsupported content type: $contentType." . " (Must be text/html or text/plain)" ); } if( $thePattern ) { $thePattern =~ s/([^\\])([\$\@\%\&\#\'\`\/])/$1\\$2/go; # escape some special chars $thePattern =~ /(.*)/; # untaint $thePattern = $1; $text =~ s/$thePattern/$1/is; } return $text; } @code # ========================= sub handleIncludeFile { my( $theAttributes, $theTopic, $theWeb, @theProcessedTopics ) = @_; my $incfile = extractNameValuePair( $theAttributes ); my $pattern = extractNameValuePair( $theAttributes, "pattern" ); if( $incfile =~ /^http\:/ ) { # include web page return handleIncludeUrl( $incfile, $pattern ); } # CrisBailiff, PeterThoeny 12 Jun 2000: Add security $incfile =~ s/$securityFilter//go; # zap anything suspicious $incfile =~ s/passwd//goi; # filter out passwd filename if( $doSecureInclude ) { # Filter out ".." from filename, this is to # prevent includes of "../../file" $incfile =~ s/\.+/\./g; } # test for different usage my $fileName = "$dataDir/$theWeb/$incfile"; # TopicName.txt if( ! -e $fileName ) { $fileName = "$dataDir/$theWeb/$incfile.txt"; # TopicName if( ! -e $fileName ) { $fileName = "$dataDir/$incfile"; # Web/TopicName.txt if( ! -e $fileName ) { $incfile =~ s/\.([^\.]*)$/\/$1/go; $fileName = "$dataDir/$incfile.txt"; # Web.TopicName if( ! -e $fileName ) { # give up, file not found return ""; } } } } # prevent recursive loop if( ( @theProcessedTopics ) && ( grep { /^$fileName$/ } @theProcessedTopics ) ) { # file already included return ""; } else { # remember for next time push( @theProcessedTopics, $fileName ); } my $text = ""; my $meta = ""; # set include web/filenames and current web/filenames $includingWebName = $theWeb; $includingTopicName = $theTopic; $fileName =~ s/\/([^\/]*)\/([^\/]*)(\.txt)$/$1/go; if( $3 ) { # identified "/Web/TopicName.txt" filename, e.g. a Wiki topic # so save the current web and topic name $theWeb = $1; $theTopic = $2; ( $meta, $text ) = &TWiki::Store::readTopic( $theWeb, $theTopic ); # remove everything before %STARTINCLUDE% and after %STOPINCLUDE% $text =~ s/.*?%STARTINCLUDE%//os; $text =~ s/%STOPINCLUDE%.*//os; } # FIXME what if it's not a topic, is this possible given only dataDir above? if( $pattern ) { $pattern =~ s/([^\\])([\$\@\%\&\#\'\`\/])/$1\\$2/go; # escape some special chars $pattern =~ /(.*)/; # untaint $pattern = $1; $text =~ s/$pattern/$1/is; } # handle all preferences and internal tags (for speed: call by reference) &TWiki::Prefs::handlePreferencesTags( $text ); handleInternalTags( $text, $theTopic, $theWeb ); # FIXME What about attachments? # recursively process multiple embeded %INCLUDE% statements and prefs $text =~ s/%INCLUDE{(.*?)}%/&handleIncludeFile($1, $theTopic, $theWeb, @theProcessedTopics )/geo; return $text; } @code # ========================= # Only does simple search for topicmoved at present, can be expanded when required sub handleMetaSearch { my( $attributes ) = @_; my $attrWeb = extractNameValuePair( $attributes, "web" ); my $attrTopic = extractNameValuePair( $attributes, "topic" ); my $attrType = extractNameValuePair( $attributes, "type" ); my $attrTitle = extractNameValuePair( $attributes, "title" ); my $searchVal = "XXX"; if( ! $attrType ) { $attrType = ""; } my $searchWeb = "all"; if( $attrType eq "topicmoved" ) { $searchVal = "%META:TOPICMOVED\{.*from=\\\"$attrWeb\.$attrTopic\\\".*\}%"; } elsif ( $attrType eq "parent" ) { $searchWeb = $attrWeb; $searchVal = "%META:TOPICPARENT\{.*name=\\\"($attrWeb\\.)?$attrTopic\\\".*\}%"; } my $text = &TWiki::Search::searchWeb( "1", $searchWeb, $searchVal, "", "", "on", "", "", "", "on", "on", "on", "on", "", "", "", "on", "searchmeta" ); if( $text !~ /^\s*$/ ) { $text = "$attrTitle$text"; } return $text; } @code # ========================= sub handleSearchWeb { my( $attributes ) = @_; my $searchVal = extractNameValuePair( $attributes ); if( ! $searchVal ) { # %SEARCH{"string" ...} not found, try # %SEARCH{search="string" ...} $searchVal = extractNameValuePair( $attributes, "search" ); } my $attrWeb = extractNameValuePair( $attributes, "web" ); my $attrScope = extractNameValuePair( $attributes, "scope" ); my $attrOrder = extractNameValuePair( $attributes, "order" ); my $attrRegex = extractNameValuePair( $attributes, "regex" ); my $attrLimit = extractNameValuePair( $attributes, "limit" ); my $attrReverse = extractNameValuePair( $attributes, "reverse" ); my $attrCasesensitive = extractNameValuePair( $attributes, "casesensitive" ); my $attrNosummary = extractNameValuePair( $attributes, "nosummary" ); my $attrNosearch = extractNameValuePair( $attributes, "nosearch" ); my $attrNoheader = extractNameValuePair( $attributes, "noheader" ); my $attrNototal = extractNameValuePair( $attributes, "nototal" ); my $attrBookview = extractNameValuePair( $attributes, "bookview" ); my $attrRenameview = extractNameValuePair( $attributes, "renameview" ); my $attrShowlock = extractNameValuePair( $attributes, "showlock" ); my $attrNoEmpty = extractNameValuePair( $attributes, "noempty" ); return &TWiki::Search::searchWeb( "1", $attrWeb, $searchVal, $attrScope, $attrOrder, $attrRegex, $attrLimit, $attrReverse, $attrCasesensitive, $attrNosummary, $attrNosearch, $attrNoheader, $attrNototal, $attrBookview, $attrRenameview, $attrShowlock, $attrNoEmpty, "" ); } @code # ========================= sub handleTime { my( $theAttributes, $theZone ) = @_; # format examples: # 28 Jul 2000 15:33:59 is "$day $month $year $hour:$min:$sec" # 001128 is "$ye$mo$day" my $format = extractNameValuePair( $theAttributes ); my $value = ""; my $time = time(); if( $format ) { my( $sec, $min, $hour, $day, $mon, $year ) = gmtime( $time ); ( $sec, $min, $hour, $day, $mon, $year ) = localtime( $time ) if( $theZone eq "servertime" ); $value = $format; $value =~ s/\$sec[o]?[n]?[d]?[s]?/sprintf("%.2u",$sec)/geoi; $value =~ s/\$min[u]?[t]?[e]?[s]?/sprintf("%.2u",$min)/geoi; $value =~ s/\$hou[r]?[s]?/sprintf("%.2u",$hour)/geoi; $value =~ s/\$day/sprintf("%.2u",$day)/geoi; $value =~ s/\$mon[t]?[h]?/$isoMonth[$mon]/goi; $value =~ s/\$mo/sprintf("%.2u",$mon+1)/geoi; $value =~ s/\$yea[r]?/sprintf("%.4u",$year+1900)/geoi; $value =~ s/\$ye/sprintf("%.2u",$year%100)/geoi; } else { if( $theZone eq "gmtime" ) { $value = gmtime( $time ); } elsif( $theZone eq "servertime" ) { $value = localtime( $time ); } } return $value; } @code #AS # ========================= sub showError { my( $errormessage ) = @_; return "$errormessage" ; } @code #AS # ========================= sub handleToc { # Andrea Sterbini 22-08-00 / PTh 28 Feb 2001 # Routine to create a TOC bulleted list linked to the section headings # of a topic. A section heading is entered in one of the following forms: # $headingPatternSp : \t++... spaces section heading # $headingPatternDa : ---++... dashes section heading # $headingPatternHt : <h[1-6]> HTML section heading </h[1-6]> # Parameters: # $_[0] : the text of the current topic # $_[1] : the topic we are in # $_[2] : the web we are in # $_[3] : attributes = "Topic" [web="Web"] [depth="N"] ## $_[0] $_[1] $_[2] $_[3] ## my( $theText, $theTopic, $theWeb, $attributes ) = @_; # get the topic name attribute my $topicname = extractNameValuePair( $_[3] ) || $_[1]; # get the web name attribute my $web = extractNameValuePair( $_[3], "web" ) || $_[2]; $web =~ s/\//\./go; my $webPath = $web; $webPath =~ s/\./\//go; # get the depth limit attribute my $depth = extractNameValuePair( $_[3], "depth" ) || 6; my $result = ""; my $line = ""; my $level = ""; my @list = (); if( "$web.$topicname" eq "$_[2].$_[1]" ) { # use text from parameter @list = split( /\n/, $_[0] ); } else { # read text from file if ( ! &TWiki::Store::topicExists( $web, $topicname ) ) { return showError( "TOC: Cannot find topic \"$web.$topicname\"" ); } @list = split( /\n/, handleCommonTags( &TWiki::Store::readWebTopic( $web, $topicname ), $topicname, $web ) ); } @list = grep { /(<\/?[pP][rR][eE]>)|($headerPatternDa)|($headerPatternSp)|($headerPatternHt)/ } @list; my $insidePre = 0; my $i = 0; my $tabs = ""; my $anchor = ""; my $highest = 99; foreach $line ( @list ) { if( $line =~ /^.*<[pP][rR][eE]>.*$/ ) { $insidePre = 1; $line = ""; } if( $line =~ /^.*<\/[pP][rR][eE]>.*$/ ) { $insidePre = 0; $line = ""; } if (!$insidePre) { $level = $line ; if ( $line =~ /$headerPatternDa/ ) { $level =~ s/$headerPatternDa/$1/go ; $level = length $level; $line =~ s/$headerPatternDa/$2/go ; $anchor = makeAnchorName( $line ); } elsif ( $line =~ /$headerPatternSp/ ) { $level =~ s/$headerPatternSp/$1/go ; $level = length $level; $line =~ s/$headerPatternSp/$2/go ; $anchor = makeAnchorName( $line ); } elsif ( $line =~ /$headerPatternHt/ ) { $level =~ s/$headerPatternHt/$1/go ; $line =~ s/$headerPatternHt/$2/go ; $anchor = makeAnchorName( $line ); } if( ( $line ) && ( $level <= $depth ) ) { $highest = $level if( $level < $highest ); $tabs = ""; for( $i=0 ; $i<$level ; $i++ ) { $tabs = "\t$tabs"; } # Remove *bold* and _italic_ formatting $line =~ s/(^|[\s$])\*([^\s]+?|[^\s].*?[^\s])\*($|[\s\,\.\;\:\!\?$])/$1$2$3/go; $line =~ s/(^|[\s$])_+([^\s]+?|[^\s].*?[^\s])_+($|[\s\,\.\;\:\!\?$])/$1$2$3/go; # Prevent WikiLinks $line =~ s/\[\[.*\]\[(.*?)\]\]/$1/go; # '[[...][...]]' $line =~ s/\[\[(.*?)\]\]/$1/geo; # '[[...]]' $line =~ s/([\*\s][\(\-\*\s]*)([A-Z]+[a-z0-9]*)\.([A-Z]+[a-z]+[A-Z]+[a-zA-Z0-9]*)/$1<nop>$3/go; # 'Web.TopicName' $line =~ s/([\*\s][\(\-\*\s]*)([A-Z]+[a-z]+[A-Z]+[a-zA-Z0-9]*)/$1<nop>$2/go; # 'TopicName' $line =~ s/([\*\s][\-\*\s]*)([A-Z]{3,})/$1<nop>$2/go; # 'TLA' # create linked bullet item $line = "$tabs* <a href=\"$scriptUrlPath/view$scriptSuffix/$webPath/$topicname#$anchor\">$line</a>"; $result .= "\n$line"; } } } if( $result ) { if( $highest > 1 ) { # left shift TOC $highest--; $result =~ s/^\t{$highest}//gm; } return $result; } else { return showError("TOC: No TOC in \"$web.$topicname\""); } } @code # ========================= sub getPublicWebList { # FIXME: Should this go elsewhere? # (Not in Store because Store should not be dependent on Prefs.) if( ! @publicWebList ) { # build public web list, e.g. exclude hidden webs, but include current web my @list = &TWiki::Store::getAllWebs( "" ); my $item = ""; my $hidden = ""; foreach $item ( @list ) { $hidden = &TWiki::Prefs::getPreferencesValue( "NOSEARCHALL", $item ); # exclude topics that are hidden or start with . or _ unless current web if( ( $item eq $TWiki::webName ) || ( ( ! $hidden ) && ( $item =~ /^[^\.\_]/ ) ) ) { push( @publicWebList, $item ); } } } return @publicWebList; } @code # ========================= sub handleWebAndTopicList { my( $theAttr, $isWeb ) = @_; my $format = extractNameValuePair( $theAttr ); $format = extractNameValuePair( $theAttr, "format" ) if( ! $format ); my $separator = extractNameValuePair( $theAttr, "separator" ) || "\n"; $format .= '$name' if( ! ( $format =~ /\$name/ ) ); my $web = extractNameValuePair( $theAttr, "web" ) || ""; my $webs = extractNameValuePair( $theAttr, "webs" ) || "public"; my $selection = extractNameValuePair( $theAttr, "selection" ) || ""; my $marker = extractNameValuePair( $theAttr, "marker" ) || "selected"; my @list = (); if( $isWeb ) { my @webslist = split( /,/, $webs ); foreach my $aweb ( @webslist ) { if( $aweb eq "public" ) { push( @list, getPublicWebList() ); } else{ push( @list, $aweb ) if( &TWiki::Store::webExists( $aweb ) ); } } } else { $web = $webName if( ! $web ); my $hidden = &TWiki::Prefs::getPreferencesValue( "NOSEARCHALL", $web ); if( ( $web eq $TWiki::webName ) || ( ! $hidden ) ) { @list = &TWiki::Store::getTopicNames( $web ); } } my $text = ""; my $item = ""; my $line = ""; my $mark = ""; foreach $item ( @list ) { $line = $format; $line =~ s/\$web/$web/goi; $line =~ s/\$name/$item/goi; $line =~ s/\$qname/"$item"/goi; $mark = ( $item eq $selection ) ? $marker : ""; $line =~ s/\$marker/$mark/goi; $text .= "$line$separator"; } $text =~ s/$separator$//s; # remove last separator return $text; } @code # ========================= sub handleUrlParam { my( $theParam ) = @_; $theParam = extractNameValuePair( $theParam ); my $value = ""; if( $cgiQuery ) { $value = $cgiQuery->param( $theParam ) || ""; } return $value; } @code # ========================= sub handleEnvVariable { my( $theVar ) = @_; my $value = $ENV{$theVar} || ""; return $value; } @code # ========================= sub handleTmplP { my( $theParam ) = @_; $theParam = extractNameValuePair( $theParam ); my $value = &TWiki::Store::handleTmplP( $theParam ); return $value; } @code # ========================= sub handleSpacedTopic { my( $theTopic ) = @_; my $spacedTopic = $theTopic; $spacedTopic =~ s/([a-z]+)([A-Z0-9]+)/$1%20*$2/go; # "%20*" is " *" return $spacedTopic; } @code # ========================= sub handleInternalTags { # modify arguments directly, e.g. call by reference # $_[0] is text # $_[1] is topic # $_[2] is web $_[0] =~ s/%TMPL\:P{(.*?)}%/&handleTmplP($1)/geo; $_[0] =~ s/%SEP%/&handleTmplP('"sep"')/geo; $_[0] =~ s/%HTTP_HOST%/&handleEnvVariable('HTTP_HOST')/geo; $_[0] =~ s/%REMOTE_ADDR%/&handleEnvVariable('REMOTE_ADDR')/geo; $_[0] =~ s/%REMOTE_PORT%/&handleEnvVariable('REMOTE_PORT')/geo; $_[0] =~ s/%REMOTE_USER%/&handleEnvVariable('REMOTE_USER')/geo; $_[0] =~ s/%TOPIC%/$_[1]/go; $_[0] =~ s/%BASETOPIC%/$topicName/go; $_[0] =~ s/%INCLUDINGTOPIC%/$includingTopicName/go; $_[0] =~ s/%SPACEDTOPIC%/&handleSpacedTopic($_[1])/geo; $_[0] =~ s/%WEB%/$_[2]/go; $_[0] =~ s/%BASEWEB%/$webName/go; $_[0] =~ s/%INCLUDINGWEB%/$includingWebName/go; $_[0] =~ s/%TOPICLIST{(.*?)}%/&handleWebAndTopicList($1,'0')/geo; $_[0] =~ s/%WEBLIST{(.*?)}%/&handleWebAndTopicList($1,'1')/geo; $_[0] =~ s/%WIKIHOMEURL%/$wikiHomeUrl/go; $_[0] =~ s/%SCRIPTURL%/$urlHost$scriptUrlPath/go; $_[0] =~ s/%SCRIPTURLPATH%/$scriptUrlPath/go; $_[0] =~ s/%SCRIPTSUFFIX%/$scriptSuffix/go; $_[0] =~ s/%PUBURL%/$urlHost$pubUrlPath/go; $_[0] =~ s/%PUBURLPATH%/$pubUrlPath/go; $_[0] =~ s/%ATTACHURL%/$urlHost$pubUrlPath\/$_[2]\/$_[1]/go; $_[0] =~ s/%ATTACHURLPATH%/$pubUrlPath\/$_[2]\/$_[1]/go; $_[0] =~ s/%URLPARAM{(.*?)}%/&handleUrlParam($1)/geo; $_[0] =~ s/%DATE%/&getLocaldate()/geo; # depreciated $_[0] =~ s/%GMTIME%/&handleTime("","gmtime")/geo; $_[0] =~ s/%GMTIME{(.*?)}%/&handleTime($1,"gmtime")/geo; $_[0] =~ s/%SERVERTIME%/&handleTime("","servertime")/geo; $_[0] =~ s/%SERVERTIME{(.*?)}%/&handleTime($1,"servertime")/geo; $_[0] =~ s/%WIKIVERSION%/$wikiversion/go; $_[0] =~ s/%USERNAME%/$userName/go; $_[0] =~ s/%WIKINAME%/$wikiName/go; $_[0] =~ s/%WIKIUSERNAME%/$wikiUserName/go; $_[0] =~ s/%WIKITOOLNAME%/$wikiToolName/go; $_[0] =~ s/%MAINWEB%/$mainWebname/go; $_[0] =~ s/%TWIKIWEB%/$twikiWebname/go; $_[0] =~ s/%HOMETOPIC%/$mainTopicname/go; $_[0] =~ s/%WIKIUSERSTOPIC%/$wikiUsersTopicname/go; $_[0] =~ s/%WIKIPREFSTOPIC%/$wikiPrefsTopicname/go; $_[0] =~ s/%WEBPREFSTOPIC%/$webPrefsTopicname/go; $_[0] =~ s/%NOTIFYTOPIC%/$notifyTopicname/go; $_[0] =~ s/%STATISTICSTOPIC%/$statisticsTopicname/go; $_[0] =~ s/%STARTINCLUDE%//go; $_[0] =~ s/%STOPINCLUDE%//go; $_[0] =~ s/%SEARCH{(.*?)}%/&handleSearchWeb($1)/geo; $_[0] =~ s/%METASEARCH{(.*?)}%/&handleMetaSearch($1)/geo; } @code # ========================= sub handleCommonTags { my( $text, $theTopic, $theWeb, @theProcessedTopics ) = @_; # PTh 22 Jul 2000: added $theWeb for correct handling of %INCLUDE%, %SEARCH% if( !$theWeb ) { $theWeb = $webName; } # handle all preferences and internal tags (for speed: call by reference) $includingWebName = $theWeb; $includingTopicName = $theTopic; &TWiki::Prefs::handlePreferencesTags( $text ); handleInternalTags( $text, $theTopic, $theWeb ); # recursively process multiple embeded %INCLUDE% statements and prefs $text =~ s/%INCLUDE{(.*?)}%/&handleIncludeFile($1, $theTopic, $theWeb, @theProcessedTopics )/geo; # Wiki Plugin Hook &TWiki::Plugins::commonTagsHandler( $text, $theTopic, $theWeb ); # handle tags again because of plugin hook &TWiki::Prefs::handlePreferencesTags( $text ); handleInternalTags( $text, $theTopic, $theWeb ); $text =~ s/%TOC{([^}]*)}%/&handleToc($text,$theTopic,$theWeb,$1)/geo; $text =~ s/%TOC%/&handleToc($text,$theTopic,$theWeb,"")/geo; return $text; } @code # ========================= sub handleMetaTags { my( $theWeb, $theTopic, $text, $meta ) = @_; $text =~ s/%META{\s*"form"\s*}%/&renderFormData( $theWeb, $theTopic, $meta )/goe; $text =~ s/%META{\s*"attachments"\s*(.*)}%/&TWiki::Attach::renderMetaData( $theWeb, $theTopic, $meta, $1 )/goe; $text =~ s/%META{\s*"moved"\s*}%/&renderMoved( $theWeb, $theTopic, $meta )/goe; $text =~ s/%META{\s*"parent"\s*(.*)}%/&renderParent( $theWeb, $theTopic, $meta, $1 )/goe; return $text; } @code # ======================== sub renderParent { my( $web, $topic, $meta, $args ) = @_; my $text = ""; my $dontRecurse; my $prefix; my $usesep; if( $args ) { $dontRecurse = extractNameValuePair( $args, "dontrecurse" ); $prefix = extractNameValuePair( $args, "prefix" ); $usesep = extractNameValuePair( $args, "separator" ); } if( ! $usesep ) { $usesep = " > "; } my %visited = (); $visited{"$web.$topic"} = 1; my $sep = ""; my $cWeb = $web; while( 1 ) { my %parent = $meta->findOne( "TOPICPARENT" ); if( %parent ) { my $name = $parent{"name"}; my $pWeb = $cWeb; my $pTopic = $name; if( $name =~ /^(.*)\.(.*)$/ ) { $pWeb = $1; $pTopic = $2; } $text = "$pWeb.$pTopic$sep$text"; $sep = $usesep; if( $dontRecurse || ! $name ) { last; } else { my $dummy; if( $visited{"$pWeb.$pTopic"} ) { last; } else { $visited{"$pWeb.$pTopic"} = 1; } if( TWiki::Store::topicExists( $pWeb, $pTopic ) ) { ( $meta, $dummy ) = TWiki::Store::readTopMeta( $pWeb, $pTopic ); } else { last; } $cWeb = $pWeb; } } else { last; } } if( $text && $prefix ) { $text = "$prefix$text"; } $text = handleCommonTags( $text, $topic, $web ); $text = getRenderedVersion( $text, $web ); return $text; } @code # ======================== sub renderMoved { my( $web, $topic, $meta ) = @_; my $text = ""; my %moved = $meta->findOne( "TOPICMOVED" ); if( %moved ) { my $from = $moved{"from"}; $from =~ /(.*)\.(.*)/; my $fromWeb = $1; my $fromTopic = $2; my $to = $moved{"to"}; $to =~ /(.*)\.(.*)/; my $toWeb = $1; my $toTopic = $2; my $by = $moved{"by"}; $by = userToWikiName( $by ); my $date = $moved{"date"}; $date = formatGmTime( $date ); # Only allow put back, if current web and topic match stored to information my $putBack = ""; if( $web eq $toWeb && $topic eq $toTopic ) { $putBack = " - <a title=\"Click to move topic back to previous location, with option to change references.\""; $putBack .= " href=\"$scriptUrlPath/rename/$web/$topic?newweb=$fromWeb&newtopic=$fromTopic&"; $putBack .= "confirm=on\">put it back</a>"; } $text = "<nop>$to moved from <nop>$from on $date by $by $putBack"; } $text = handleCommonTags( $text, $topic, $web ); $text = getRenderedVersion( $text, $web ); return $text; } @code # ========================= sub renderFormData { my( $web, $topic, $meta ) = @_; my $metaText = ""; my %form = $meta->findOne( "FORM" ); if( %form ) { my $name = $form{"name"}; $metaText = "<table border=\"1\" cellspacing=\"0\" cellpadding=\"0\">\n <tr>"; $metaText .= "<th colspan=\"2\" align=\"center\" bgcolor=\"#99CCCC\"> $name </th></tr>\n"; my @fields = $meta->find( "FIELD" ); foreach my $field ( @fields ) { my $title = $field->{"title"}; my $value = $field->{"value"}; $metaText .= "<tr><th bgcolor=\"#99CCCC\" align=\"right\"> $title:</th><td align=\"left\"> $value </td></tr>\n"; } $metaText .= "</table>\n"; $metaText = getRenderedVersion( $metaText, $web ); } return $metaText; } @code # ========================= sub encodeSpecialChars { my( $text ) = @_; $text =~ s/&/%_A_%/go; $text =~ s/\"/%_Q_%/go; $text =~ s/>/%_G_%/go; $text =~ s/</%_L_%/go; # PTh 10 Apr 2001: Fix for Codev.OperaBrowserDoublesEndOfLines $text =~ s/\r\r\n/%_N_%/go; # PTh 21 Jun 2000: Fix for Codev.KfmBrowserSupportForEditing $text =~ s/\r\n/%_N_%/go; $text =~ s/\n\r/%_N_%/go; $text =~ s/\r/%_N_%/go; $text =~ s/\n/%_N_%/go; return $text; } @code sub decodeSpecialChars { my( $text ) = @_; $text =~ s/%_N_%/\r\n/go; $text =~ s/%_L_%/</go; $text =~ s/%_G_%/>/go; $text =~ s/%_Q_%/\"/go; $text =~ s/%_A_%/&/go; return $text; } @code # ========================= sub emitCode { ( $code, $depth ) = @_; my $result=""; while( @code > $depth ) { local($_) = pop @code; $result= "$result</$_>\n" } while( @code < $depth ) { push( @code, ($code) ); $result= "$result<$code>\n" } if( ( $#code > -1 ) && ( $code[$#code] ne $code ) ) { $result= "$result</$code[$#code]><$code>\n"; $code[$#code] = $code; } return $result; } @code # ========================= sub emitTR { my ( $thePre, $theRow, $insideTABLE ) = @_; my $text = ""; my $attr = ""; my $l1 = 0; my $l2 = 0; if( $insideTABLE ) { $text = "$thePre<tr>"; } else { $text = "$thePre<table border=\"1\" cellspacing=\"0\" cellpadding=\"1\"> <tr>"; } $theRow =~ s/\t/ /go; # change tabs to space $theRow =~ s/\s*$//o; # remove trailing spaces $theRow =~ s/(\|\|+)/$TranslationToken . length($1) . "\|"/geo; # calc COLSPAN foreach( split( /\|/, $theRow ) ) { $attr = ""; #AS 25-5-01 Fix to avoid matching also single columns if ( s/$TranslationToken([0-9]+)// ) { # No o flag for mod-perl compatibility $attr = " colspan=\"$1\"" ; } s/^\s+$/   /o; /^(\s*).*?(\s*)$/; $l1 = length( $1 || "" ); $l2 = length( $2 || "" ); if( $l1 >= 2 ) { if( $l2 <= 1 ) { $attr .= ' align="right"'; } else { $attr .= ' align="center"'; } } if( /^\s*(\*.*\*)\s*$/ ) { $text .= "<th$attr bgcolor=\"#99CCCC\"> $1 </th>"; } else { $text .= "<td$attr> $_ </td>"; } } $text .= "</tr>"; return $text; } @code # ========================= sub fixedFontText { my( $theText, $theDoBold ) = @_; # preserve white space, so replace it by "  " patterns $theText =~ s/\t/ /go; $theText =~ s|((?:[\s]{2})+)([^\s])|'  ' x (length($1) / 2) . "$2"|eg; if( $theDoBold ) { return "<code>$theText</code>"; } else { return "<code>$theText</code>"; } } @code # ========================= sub makeAnchorHeading { my( $theText, $theLevel ) = @_; # - Need to build '<nop><h1><a name="atext"> text </a></h1>' # type markup. # - Initial '<nop>' is needed to prevent subsequent matches. # - Need to make sure that <a> tags are not nested, i.e. in # case heading has a WikiName that gets linked my $text = $theText; my $anchorName = &makeAnchorName( $text ); my $hasAnchor = 0; # text contains potential anchor $hasAnchor = 1 if( $text =~ m/<a /i ); $hasAnchor = 1 if( $text =~ m/\[\[/ ); $hasAnchor = 1 if( $text =~ m/(^|[\*\s][\-\*\s]*)([A-Z]{3,})/ ); $hasAnchor = 1 if( $text =~ m/(^|[\*\s][\(\-\*\s]*)([A-Z]+[a-z0-9]*)\.([A-Z]+[a-z]+[A-Z]+[a-zA-Z0-9]*)/ ); $hasAnchor = 1 if( $text =~ m/(^|[\*\s][\(\-\*\s]*)([A-Z]+[a-z]+[A-Z]+[a-zA-Z0-9]*)/ ); if( $hasAnchor ) { # FIXME: '<h1><a name="atext"></a></h1> WikiName' has an # empty <a> tag, which is not HTML conform $text = "<nop><h$theLevel><a name =\"$anchorName\"> </a> $theText <\/h$theLevel>"; } else { $text = "<nop><h$theLevel><a name =\"$anchorName\"> $theText <\/a><\/h$theLevel>"; } return $text; } @code # ========================= sub makeAnchorName { my( $theName ) = @_; my $anchorName = $theName; $anchorName =~ s/^[\s\#\_]*//o; # no leading space nor '#', '_' $anchorName =~ s/[\s\_]*$//o; # no trailing space, nor '_' $anchorName =~ s/<\w[^>]*>//goi; # remove HTML tags $anchorName =~ s/[^a-zA-Z0-9]/_/go; # only allowed chars $anchorName =~ s/__+/_/go; # remove excessive '_' $anchorName =~ s/^(.{32})(.*)$/$1/o; # limit to 32 chars return $anchorName; } @code # ========================= sub internalLink { my( $thePreamble, $theWeb, $theTopic, $theLinkText, $theAnchor, $doLink ) = @_; # $thePreamble is heading space # $doLink is boolean, false suppress link for non-existing pages # kill spaces and Wikify page name (ManpreetSingh - 15 Sep 2000) $theTopic =~ s/^\s*//; $theTopic =~ s/\s*$//; $theTopic =~ s/^(.)/\U$1/; $theTopic =~ s/\s([a-zA-Z0-9])/\U$1/g; # Add <nop> before WikiWord inside text to prevent double links $theLinkText =~ s/(\s)([A-Z]+[a-z]+[A-Z])/$1<nop>$2/go; my $exist = &TWiki::Store::topicExists( $theWeb, $theTopic ); if( ( $doPluralToSingular ) && ( $theTopic =~ /s$/ ) && ! ( $exist ) ) { # page is a non-existing plural my $tmp = $theTopic; $tmp =~ s/ies$/y/; # plurals like policy / policies $tmp =~ s/sses$/ss/; # plurals like address / addresses $tmp =~ s/([Xx])es$/$1/; # plurals like box / boxes $tmp =~ s/([A-Za-rt-z])s$/$1/; # others, excluding ending ss like address(es) if( &TWiki::Store::topicExists( $theWeb, $tmp ) ) { $theTopic = $tmp; $exist = 1; } } my $text = $thePreamble; if( $exist) { if( $theAnchor ) { my $anchor = makeAnchorName( $theAnchor ); $text .= "<a href=\"$scriptUrlPath/view$scriptSuffix/" . "$theWeb/$theTopic\#$anchor\">$theLinkText<\/a>"; return $text; } else { $text .= "<a href=\"$scriptUrlPath/view$scriptSuffix/" . "$theWeb/$theTopic\">$theLinkText<\/a>"; return $text; } } elsif( $doLink ) { $text .= "" . "$theLinkText" . "<a href=\"$scriptUrlPath/edit$scriptSuffix/$theWeb/$theTopic?topicparent=$webName.$topicName\">?</a>"; return $text; } else { $text .= $theLinkText; return $text; } } @code # ========================= sub specificLink { my( $thePreamble, $theWeb, $theTopic, $theText, $theLink ) = @_; # format: $thePreamble[[$theText]] # format: $thePreamble[[$theText][$theLink]] $theLink =~ s/^\s*//o; $theLink =~ s/\s*$//o; if( $theLink =~ /^(http|ftp|gopher|news|file|https)\:/ ) { # found external link return "$thePreamble<a href=\"$theLink\" target=\"_top\">$theText</a>"; } $theLink =~ s/^([A-Z]+[a-z0-9]*)\.//o; my $web = $1 || $theWeb; # extract 'Web.' (my $baz = "foo") =~ s/foo//; # reset $1, defensive coding $theLink =~ s/(\#[a-zA-Z_0-9\-]*$)//o; my $anchor = $1 || ""; # extract '#anchor' my $topic = $theLink || $theTopic; # remaining is topic $topic =~ s/\&[a-z]+\;//goi; # filter out &any; entities $topic =~ s/\&\#[0-9]+\;//go; # filter out { entities $topic =~ s/[\\\/\#\&\{\}\[\]\<\>\!\=\:\,\.]//go; $topic =~ s/$securityFilter//go; # filter out suspicious chars if( ! $topic ) { return "$thePreamble$theText"; # no link if no topic } return internalLink( $thePreamble, $web, $topic, $theText, $anchor, 1 ); } @code # ========================= sub externalLink { my( $pre, $url ) = @_; if( $url =~ /\.(gif|jpg|jpeg|png)$/i ) { my $filename = $url; $filename =~ s@.*/([^/]*)@$1@go; return "$pre<img src=\"$url\" alt=\"$filename\" />"; } return "$pre<a href=\"$url\" target=\"_top\">$url</a>"; } @code # ========================= sub mailtoLink { my( $theAccount, $theSubDomain, $theTopDomain ) = @_; my $addr = "$theAccount\@$theSubDomain$TWiki::noSpamPadding\.$theTopDomain"; return "<a href=\"mailto\:$addr\">$addr</a>"; } @code # ========================= sub isWikiName { my( $name ) = @_; if( ! $name ) { $name = ""; } if ( $name =~ /^[A-Z]+[a-z]+[A-Z]+[a-zA-Z0-9]*$/ ) { return "1"; } return ""; } @code # ========================= sub getRenderedVersion { my( $text, $theWeb, $meta ) = @_; my( $head, $result, $insidePRE, $insideVERBATIM, $insideTABLE, $noAutoLink, $blockquote ); # FIXME: Get $theTopic from parameter to handle [[#anchor]] correctly # (fails in %INCLUDE%, %SEARCH%) my $theTopic = $topicName; # PTh 22 Jul 2000: added $theWeb for correct handling of %INCLUDE%, %SEARCH% if( !$theWeb ) { $theWeb = $webName; } $head = ""; $result = ""; $insidePRE = 0; $insideVERBATIM = 0; # PTh 31 Jan 2001: Added Codev.VerbatimModeForSourceCodes $insideTABLE = 0; $noAutoLink = 0; # PTh 02 Feb 2001: Added Codev.DisableWikiWordLinks $blockquote = 0; $code = ""; $text =~ s/\r//go; $text =~ s/\\\n//go; # Join lines ending in "\" # do not render HTML head, style sheets and scripts if( $text =~ m/<body[\s\>]/i ) { my $bodyTag = ""; my $bodyText = ""; ( $head, $bodyTag, $bodyText ) = split( /(<body)/i, $text, 3 ); $text = $bodyTag . $bodyText; } # Wiki Plugin Hook &TWiki::Plugins::startRenderingHandler( $text, $theWeb, $meta ); foreach( split( /\n/, $text ) ) { # change state: m|<pre>|i && ( $insidePRE = 1 ); m|</pre>|i && ( $insidePRE = 0 ); if( m|<verbatim>|i ) { s|<verbatim>|<pre>|goi; $insideVERBATIM = 1; } if( m|</verbatim>|i ) { s|</verbatim>|</pre>|goi; $insideVERBATIM = 0; } m|<noautolink>|i && ( $noAutoLink = 1 ); m|</noautolink>|i && ( $noAutoLink = 0 ); if( $insidePRE || $insideVERBATIM ) { # inside <PRE> or <VERBATIM> # close list tags if any if( @code ) { $result .= &emitCode( "", 0 ); $code = ""; } if( $insideVERBATIM ) { s/\&/&/go; s/\</</go; s/\>/>/go; s/\<pre\>/<pre>/go; # fix escaped <pre> } # Wiki Plugin Hook &TWiki::Plugins::insidePREHandler( $_ ); s/(.*)/$1\n/o; } else { # normal state, do Wiki rendering # Wiki Plugin Hook &TWiki::Plugins::outsidePREHandler( $_ ); # Blockquote s/^>(.*?)$/> <cite> $1 <\/cite> /go; # Embedded HTML s/\<(\!\-\-)/$TranslationToken$1/go; # Allow standalone "" s/\<(\S.*?)\>/$TranslationToken$1$TranslationToken/go; s/</&lt\;/go; s/>/&gt\;/go; s/$TranslationToken(\S.*?)$TranslationToken/\<$1\>/go; s/(\-\-)$TranslationToken/$1\>/go; s/$TranslationToken(\!\-\-)/\<$1/go; # Handle embedded URLs s@(^|[\-\*\s])((http|ftp|gopher|news|file|https)\:(\S+[^\s\.,!\?;:]))@&externalLink($1,$2)@geo; # Entities s/&(\w+?)\;/$TranslationToken$1\;/go; # "&abc;" s/&(\#[0-9]+)\;/$TranslationToken$1\;/go; # "{" s/&/&/go; # escape standalone "&" s/$TranslationToken/&/go; # Headings # '<h6>...</h6>' HTML rule s/$headerPatternHt/&makeAnchorHeading($2,$1)/geoi; # '\t+++++++' rule s/$headerPatternSp/&makeAnchorHeading($2,(length($1)))/geo; # '----+++++++' rule s/$headerPatternDa/&makeAnchorHeading($2,(length($1)))/geo; # Horizontal rule s/^---+/<hr \/>/o; s@^([a-zA-Z0-9]+)----*@<table width=\"100%\"><tr><td valign=\"bottom\"><h2>$1</h2></td><td width=\"98%\" valign=\"middle\"><hr /></td></tr></table>@o; # Table of format: | cell | cell | # PTh 25 Jan 2001: Forgiving syntax, allow trailing white space if( $_ =~ /^(\s*)\|.*\|\s*$/ ) { s/^(\s*)\|(.*)/&emitTR($1,$2,$insideTABLE)/eo; $insideTABLE = 1; } elsif( $insideTABLE ) { $result .= "</table>\n"; $insideTABLE = 0; } # Lists etc. s/^\s*$//o && ( $code = 0 ); m/^(\S+?)/o && ( $code = 0 ); s/^(\t+)(\S+?):\s/<dt> $2<dd> /o && ( $result .= &emitCode( "dl", length $1 ) ); s/^(\t+)\* /<li> /o && ( $result .= &emitCode( "ul", length $1 ) ); s/^(\t+)\d+\.?/<li> /o && ( $result .= &emitCode( "ol", length $1 ) ); if( !$code ) { $result .= &emitCode( "", 0 ); $code = ""; } # '#WikiName' anchors s/^(\#)([A-Z]+[a-z]+[A-Z]+[a-zA-Z0-9]*)/ '<a name="' . &makeAnchorName( $2 ) . '"><\/a>'/geo; # enclose in white space for the regex that follow s/(.*)/\n$1\n/o; # Emphasizing # PTh 25 Sep 2000: More relaxing rules, allow leading '(' and trailing ',.;:!?)' s/([\s$])==([^\s]+?|[^\s].*?[^\s])==([\s\,\.\;\:\!\?$])/$1 . &fixedFontText( $2, 1 ) . $3/geo; s/([\s$])__([^\s]+?|[^\s].*?[^\s])__([\s\,\.\;\:\!\?$])/$1$2<\/em><\/strong>$3/go; s/([\s$])\*([^\s]+?|[^\s].*?[^\s])\*([\s\,\.\;\:\!\?$])/$1$2<\/strong>$3/go; s/([\s$])_([^\s]+?|[^\s].*?[^\s])_([\s\,\.\;\:\!\?$])/$1$2<\/em>$3/go; s/([\s$])=([^\s]+?|[^\s].*?[^\s])=([\s\,\.\;\:\!\?$])/$1 . &fixedFontText( $2, 0 ) . $3/geo; # Mailto s/([\s$])(?:mailto\:)*([a-zA-Z0-9\-\_\.\+]+)\@([a-zA-Z0-9\-\_\.]+)\.([a-zA-Z0-9\-\_]+)(?=[\s\.\,\;\:\!\?$])/$1 . &mailtoLink( $2, $3, $4 )/geo; # Make internal links # '[[Web.odd wiki word#anchor][display text]]' link: s/\[\[([^\]]+)\]\[([^\]]+)\]\]/&specificLink("",$theWeb,$theTopic,$2,$1)/geo; # '[[Web.odd wiki word#anchor]]' link: s/\[\[([^\]]+)\]\]/&specificLink("",$theWeb,$theTopic,$1,$1)/geo; # do normal WikiWord link if not disabled by <noautolink> if( ! ( $noAutoLink ) ) { # 'Web.TopicName#anchor' link: s/([\*\s][\(\-\*\s]*)([A-Z]+[a-z0-9]*)\.([A-Z]+[a-z]+[A-Z]+[a-zA-Z0-9]*)(\#[a-zA-Z0-9_]*)/&internalLink($1,$2,$3,"$TranslationToken$3$4$TranslationToken",$4,1)/geo; # 'Web.TopicName' link: s/([\*\s][\(\-\*\s]*)([A-Z]+[a-z0-9]*)\.([A-Z]+[a-z]+[A-Z]+[a-zA-Z0-9]*)/&internalLink($1,$2,$3,"$TranslationToken$3$TranslationToken","",1)/geo; # 'TopicName#anchor' link: s/([\*\s][\(\-\*\s]*)([A-Z]+[a-z]+[A-Z]+[a-zA-Z0-9]*)(\#[a-zA-Z0-9_]*)/&internalLink($1,$theWeb,$2,"$TranslationToken$2$3$TranslationToken",$3,1)/geo; # 'TopicName' link: s/([\*\s][\(\-\*\s]*)([A-Z]+[a-z]+[A-Z]+[a-zA-Z0-9]*)/&internalLink($1,$theWeb,$2,$2,"",1)/geo; # 'Web.ABBREV' link: s/([\*\s][\-\*\s]*)([A-Z]+[a-z0-9]*)\.([A-Z]{3,})/&internalLink($1,$2,$3,$3,"",0)/geo; # 'ABBREV' link: s/([\*\s][\-\*\s]*)([A-Z]{3,})/&internalLink($1,$theWeb,$2,$2,"",0)/geo; # depreciated link: s/<link>(.*?)<\/link>/&internalLink("",$theWeb,$1,$1,"",1)/geo; s/$TranslationToken(\S.*?)$TranslationToken/$1/go; } s/^\n//o; } s/\t/ /go; $result .= $_; } if( $insideTABLE ) { $result .= "</table>\n"; } $result .= &emitCode( "", 0 ); if( $insidePRE || $insideVERBATIM ) { $result .= "</pre>\n"; } # Wiki Plugin Hook &TWiki::Plugins::endRenderingHandler( $result ); return "$head$result"; } @code # TWiki WikiClone (see wiki.pm for $wikiversion and other info) # # Copyright (C) 2000 Peter Thoeny, Peter@Thoeny.com # # 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, published at # http://www.gnu.org/copyleft/gpl.html # # Notes: # - Latest version at http://twiki.org/ # - Installation instructions in $dataDir/TWiki/TWikiDocumentation.txt # - Customize variables in wikicfg.pm when installing TWiki. # - Optionally change wikicfg.pm for custom extensions of rendering rules. # - Files wiki[a-z]+.pm are included by wiki.pm # - Upgrading TWiki is easy as long as you only customize wikicfg.pm. # - Check web server error logs for errors, i.e. % tail /var/log/httpd/error_log @code package TWiki::Access; use strict; use vars qw( %allGroups @processedGroups ); @code # ========================= sub initializeAccess { %allGroups = (); @processedGroups = (); } @code # ========================= # Are there any security restrictions for this Web # (ignoring settings on individual pages). sub permissionsSet { my( $web ) = @_; my $permSet = 0; my @types = qw/ALLOW DENY/; my @actions = qw/CHANGE VIEW RENAME/; OUT: foreach my $type ( @types ) { foreach my $action ( @actions ) { my $pref = $type . "WEB" . $action; my $prefValue = TWiki::Prefs::getPreferencesValue( $pref, $web ) || ""; if( $prefValue !~ /^\s*$/ ) { $permSet = 1; last OUT; } } } return $permSet; } @code # ========================= sub checkAccessPermission { my( $theAccessType, $theUserName, $theTopicText, $theTopicName, $theWebName ) = @_; #AS 2001-11-04 see Codev.UnchangeableTopicBug if ( $TWiki::doSuperAdminGroup && $TWiki::superAdminGroup ) { if ( &userIsInGroup( $theUserName, $TWiki::superAdminGroup ) ) { return 1; } } #/AS # $theAccessType "VIEW", "CHANGE", "CREATE", e.t.c. # $theUserName Remote WikiName, i.e. "Main.PeterThoeny" # $theTopicText If empty: Read "$theWebName.$theTopicName" # $theTopicName Topic name to check, i.e. "SomeTopic" # $theWebName Web, i.e. "Know" $theAccessType = uc( $theAccessType ); # upper case if( ! $theWebName ) { $theWebName = $TWiki::webName; } if( ! $theTopicText ) { # text not supplied as parameter, so read topic $theTopicText = &TWiki::Store::readWebTopic( $theWebName, $theTopicName ); } ##&TWiki::writeDebug( "checkAccessPermission: Type $theAccessType, user $theUserName, topic $theTopicName" ); # parse the " * Set (ALLOWTOPIC|DENYTOPIC)$theAccessType = " in body text my @denyList = (); my @allowList = (); foreach( split( /\n/, $theTopicText ) ) { if( /^\s+\*\sSet\s(ALLOWTOPIC|DENYTOPIC)$theAccessType\s*\=\s*(.*)/ ) { if( $2 ) { my $allowOrDeny = $1; # "ALLOWTOPIC" or "DENYTOPIC" my @tmpList = map { getUsersOfGroup( $_ ) } prvGetUserList( $2 ); ##my $tmp = join( ', ', @tmpList ); ##&TWiki::writeDebug( " Topic $allowOrDeny$theAccessType: {$tmp}" ); if( $allowOrDeny eq "DENYTOPIC" ) { @denyList = @tmpList; } else { @allowList = @tmpList; } } } } # if empty, get access permissions from preferences if( ! @denyList ) { my $tmpVal = &TWiki::Prefs::getPreferencesValue( "DENYWEB$theAccessType" ); @denyList = map { getUsersOfGroup( $_ ) } prvGetUserList( $tmpVal ); ##my $tmp = join( ', ', @denyList ); ##&TWiki::writeDebug( " Prefs DENYWEB$theAccessType: {$tmp}" ); } if( ! @allowList ) { my $tmpVal = &TWiki::Prefs::getPreferencesValue( "ALLOWWEB$theAccessType" ); @allowList = map { getUsersOfGroup( $_ ) } prvGetUserList( $tmpVal ); ##my $tmp = join( ', ', @allowList ); ##&TWiki::writeDebug( " Prefs ALLOWWEB$theAccessType: {$tmp}" ); } # access permission logic if( @denyList ) { if( grep { /^$theUserName$/ } @denyList ) { # user is on deny list ##&TWiki::writeDebug( " return 0, user is on deny list" ); return 0; } } if( @allowList ) { if( grep { /^$theUserName$/ } @allowList ) { # user is on allow list ##&TWiki::writeDebug( " return 1, user is on allow list" ); return 1; } else { # user is not on allow list ##&TWiki::writeDebug( " return 0, user is not on allow list" ); return 0; } } # allow is undefined, so grant access ##&TWiki::writeDebug( " return 1, allow is undefined" ); return 1; } @code # ========================= sub userIsInGroup { my( $theUserName, $theGroupTopicName ) = @_; my $usrTopic = prvGetWebTopicName( $TWiki::mainWebname, $theUserName ); my $grpTopic = prvGetWebTopicName( $TWiki::mainWebname, $theGroupTopicName ); my @grpMembers = (); if( $grpTopic !~ /.*Group$/ ) { # not a group, so compare user to user push( @grpMembers, $grpTopic ); } elsif( ( %allGroups ) && ( exists $allGroups{ $grpTopic } ) ) { # group is allready known @grpMembers = @{ $allGroups{ $grpTopic } }; } else { @grpMembers = prvGetUsersOfGroup( $grpTopic, 1 ); } my $isInGroup = grep { /^$usrTopic$/ } @grpMembers; return $isInGroup; } @code # ========================= sub getUsersOfGroup { my( $theGroupTopicName ) = @_; return prvGetUsersOfGroup( $theGroupTopicName, 1 ); } @code # ========================= sub prvGetUsersOfGroup { my( $theGroupTopicName, $theFirstCall ) = @_; my @resultList = (); # extract web and topic name my $topic = $theGroupTopicName; my $web = $TWiki::mainWebname; $topic =~ /^([^\.]*)\.(.*)$/; if( $2 ) { $web = $1; $topic = $2; } if( $topic !~ /.*Group$/ ) { # return user, is not a group return ( "$web.$topic" ); } # check if group topic is already processed if( $theFirstCall ) { @processedGroups = (); } elsif( grep { /^$web\.$topic$/ } @processedGroups ) { # do nothing, already processed return (); } push( @processedGroups, "$web\.$topic" ); # read topic my $text = &TWiki::Store::readWebTopic( $web, $topic ); # reset variables, defensive coding needed for recursion (my $baz = "foo") =~ s/foo//; # extract users my $user = ""; my @glist = (); foreach( split( /\n/, $text ) ) { if( /^\s+\*\sSet\sGROUP\s*\=\s*(.*)/ ) { if( $1 ) { @glist = prvGetUserList( $1 ); } } } foreach( @glist ) { if( /.*Group$/ ) { # $user is actually a group my $group = $_; if( ( %allGroups ) && ( exists $allGroups{ $group } ) ) { # allready known, so add to list push( @resultList, @{ $allGroups{ $group } } ); } else { # call recursively my @userList = prvGetUsersOfGroup( $group, 0 ); # add group to allGroups hash $allGroups{ $group } = [ @userList ]; push( @resultList, @userList ); } } else { # add user to list push( @resultList, $_ ); } } return @resultList; } @code # ========================= sub prvGetWebTopicName { my( $theWebName, $theTopicName ) = @_; $theTopicName =~ s/%MAINWEB%/$theWebName/go; $theTopicName =~ s/%TWIKIWEB%/$theWebName/go; if( $theTopicName =~ /[\.]/ ) { $theWebName = ""; # to suppress warning } else { $theTopicName = "$theWebName\.$theTopicName"; } return $theTopicName; } @code # ========================= sub prvGetUserList { my( $theItems ) = @_; # comma delimited list of users or groups # i.e.: "%MAINWEB%.UserA, UserB, Main.UserC # something else" $theItems =~ s/(<[^>]*>)//go; # Remove HTML tags $theItems =~ s/\s*([a-zA-Z0-9_\.\,\s\%]*)\s*(.*)/$1/go; # Limit list my @list = map { prvGetWebTopicName( $TWiki::mainWebname, $_ ) } split( /[\,\s]+/, $theItems ); return @list; } @code # Notes: # - Latest version at http://twiki.org/ # - Installation instructions in $dataDir/Main/TWikiDocumentation.txt # - Customize variables in TWiki.cfg when installing TWiki. # - Optionally change TWiki.pm for custom extensions of rendering rules. # - Upgrading TWiki is easy as long as you do not customize TWiki.pm. # - Check web server error logs for errors, i.e. % tail /var/log/httpd/error_log # # 20000917 - NicholasLee : Split file/storage related functions from wiki.pm # 200105 - JohnTalintyre : AttachmentsUnderRevisionControl & meta data in topics # 200106 - JohnTalintyre : Added Form capability (replaces Category tables) @code package TWiki::Store; use File::Copy; use Time::Local; use strict; # FIXME: Move elsewhere? # template variable hash: (built from %TMPL:DEF{"key"}% ... %TMPL:END%) use vars qw( %templateVars ); # init in TWiki.pm so okay for modPerl @code # =========================== sub initialize { %templateVars = (); } @code # =========================== # Normally writes no output, uncomment writeDebug line to get output of all RCS etc command to debug file sub _traceExec { my( $cmd, $result ) = @_; #TWiki::writeDebug( "Store exec: $cmd -> $result" ); } @code sub writeDebug { #TWiki::writeDebug( "Store: $_[0]" ); } @code # ========================= # Given a full topic name, split into Web and Topic # e.g. Test.TestTopic1 -> ("Test", "TestTopic1") sub getWebTopic { my( $fullTopic ) = @_; $fullTopic =~ m|^([^.]+)[./](.*)$|; my $web = $1; my $topic = $2; return ($web, $topic ); } @code # ========================= # Get full filename for attachment or topic, untaint # Extension can be: # If $attachment is blank # blank or .txt - topic data file # ,v - topic history file # lock - topic lock file # If $attachment # blank - attachment file # ,v - attachment history file sub getFileName { my( $web, $topic, $attachment, $extension ) = @_; if( ! $attachment ) { $attachment = ""; } if( ! $extension ) { $extension = ""; } my $file = ""; my $extra = ""; if( ! $attachment ) { if( ! $extension ) { $extension = ".txt"; } else { if( $extension eq ",v" ) { $extension = ".txt$extension"; if( $TWiki::useRcsDir && -d "$TWiki::dataDir/$web/RCS" ) { $extra = "/RCS"; } } } $file = "$TWiki::dataDir/$web$extra/$topic$extension"; } else { if ( $extension eq ",v" && $TWiki::useRcsDir && -d "$TWiki::dataDir/$web/RCS" ) { $extra = "/RCS"; } $file = "$TWiki::pubDir/$web/$topic$extra/$attachment$extension"; } # FIXME: Dangerous, need to make sure that parameters are not tainted # Shouldn't really need to untaint here - done to be sure $file =~ /(.*)/; $file = $1; # untaint return $file; } @code # ========================= # Get directory that topic or attachment lives in # Leave topic blank if you want the web directory rather than the topic directory sub getFileDir { my( $web, $topic, $attachment, $extension) = @_; $extension = "" if( ! $extension ); my $dir = ""; if( ! $attachment ) { if( $extension eq ",v" && $TWiki::useRcsDir && -d "$TWiki::dataDir/$web/RCS" ) { $dir = "$TWiki::dataDir/$web/RCS"; } else { $dir = "$TWiki::dataDir/$web"; } } else { my $suffix = ""; if ( $extension eq ",v" && $TWiki::useRcsDir && -d "$TWiki::dataDir/$web/RCS" ) { $suffix = "/RCS"; } $dir = "$TWiki::pubDir/$web/$topic$suffix"; } # FIXME: Dangerous, need to make sure that parameters are not tainted # Shouldn't really need to untaint here - done to be sure $dir =~ /(.*)/; $dir = $1; # untaint return $dir; } @code # ========================= # Get public web directory, where topic attachment dirs live in sub getPubWebDir { my( $web ) = @_; # FIXME: Dangerous, need to make sure that parameters are not tainted my $dir = "$TWiki::pubDir/$web"; $dir =~ /(.*)/; $dir = $1; # untaint return $dir; } @code # ========================= # Get rid a topic and its attachments completely # Intended for TEST purposes. # Use with GREAT CARE as file will be gone, including RCS history sub erase { my( $web, $topic ) = @_; my $file = getFileName( $web, $topic ); my $rcsDirFile = "$TWiki::dataDir/$web/RCS/$topic,v"; # Because test switches between using/not-using RCS dir, do both my @files = ( $file, "$file,v", $rcsDirFile ); unlink( @files ); # Delete all attachments and the attachment directory my $attDir = getFileDir( $web, $topic, 1, "" ); if( -e $attDir ) { opendir( DIR, $attDir ); my @attachments = readdir( DIR ); closedir( DIR ); my $attachment; foreach $attachment ( @attachments ) { if( ! -d "$attDir/$attachment" ) { unlink( "$attDir/$attachment" ) || warn "Couldn't remove $attDir/$attachment"; if( $attachment !~ /,v$/ ) { writeLog( "erase", "$web.$topic.$attachment" ); } } } # Deal with RCS dir if it exists my $attRcsDir = "$attDir/RCS"; if( -e $attRcsDir ) { opendir( DIR, $attRcsDir ); my @attachments = readdir( DIR ); closedir( DIR ); my $attachment; foreach $attachment ( @attachments ) { if( ! -d "$attRcsDir/$attachment" ) { unlink( "$attRcsDir/$attachment" ) || warn "Couldn't remove $attDir/$attachment"; } } rmdir( "$attRcsDir" ) || warn "Couldn't remove directory $attRcsDir"; } rmdir( "$attDir" ) || warn "Couldn't remove directory $attDir"; } writeLog( "erase", "$web.$topic", "" ); } @code # ========================= # Move an attachment from one topic to another. # If there is a problem an error string is returned. # The caller to this routine check that all topics are valid and # to lock the topics. sub moveAttachment { my( $oldWeb, $oldTopic, $newWeb, $newTopic, $theAttachment ) = @_; my $error = ""; my $what = "$oldWeb.$oldTopic.$theAttachment -> $newWeb.$newTopic"; # Make sure pub directory exists for web my $newPubDir = getPubWebDir( $newWeb ); if ( ! -e $newPubDir ) { umask( 0 ); mkdir( $newPubDir, 0777 ); } # Make sure directory exists to move to - FIMXE might want to delete old one if empty? $newPubDir = getFileDir( $newWeb, $newTopic, $theAttachment, "" ); if ( ! -e $newPubDir ) { umask( 0 ); mkdir( $newPubDir, 0777 ); } # Move attachment my $oldAttachment = getFileName( $oldWeb, $oldTopic, $theAttachment ); my $newAttachment = getFileName( $newWeb, $newTopic, $theAttachment ); if( ! move( $oldAttachment, $newAttachment ) ) { $error = "Failed to move attachment; $what ($!)"; return $error; } # Make sure rcs directory exists my $newRcsDir = getFileDir( $newWeb, $newTopic, $theAttachment, ",v" ); if ( ! -e $newRcsDir ) { umask( 0 ); mkdir( $newRcsDir, 0777 ); } # Move attachment history my $oldAttachmentRcs = getFileName( $oldWeb, $oldTopic, $theAttachment, ",v" ); my $newAttachmentRcs = getFileName( $newWeb, $newTopic, $theAttachment, ",v" ); if( -e $oldAttachmentRcs ) { if( ! move( $oldAttachmentRcs, $newAttachmentRcs ) ) { $error .= "Failed to move attachment history; $what ($!)"; # Don't return here as attachment file has already been moved } } # Remove file attachment from old topic my( $meta, $text ) = readTopic( $oldWeb, $oldTopic ); my %fileAttachment = $meta->findOne( "FILEATTACHMENT", $theAttachment ); $meta->remove( "FILEATTACHMENT", $theAttachment ); $error .= saveNew( $oldWeb, $oldTopic, $text, $meta, "", "", "", "doUnlock", "dont notify", "" ); # Remove lock file lockTopicNew( $oldWeb, $oldTopic, 1 ); # Add file attachment to new topic ( $meta, $text ) = readTopic( $newWeb, $newTopic ); $fileAttachment{"movefrom"} = "$oldWeb.$oldTopic"; $fileAttachment{"moveby"} = $TWiki::userName; $fileAttachment{"movedto"} = "$newWeb.$newTopic"; $fileAttachment{"movedwhen"} = time(); $meta->put( "FILEATTACHMENT", %fileAttachment ); $error .= saveNew( $newWeb, $newTopic, $text, $meta, "", "", "", "doUnlock", "dont notify", "" ); # Remove lock file lockTopicNew( $newWeb, $newTopic, 1 ); writeLog( "move", "$oldWeb.$oldTopic", "Attachment $theAttachment moved to $newWeb.$newTopic" ); return $error; } @code # ========================= # Change refs out of a topic, I have a feeling this shouldn't be in Store.pm sub changeRefTo { my( $text, $oldWeb, $oldTopic ) = @_; my $preTopic = '^|[\*\s\[][-\(\s]*'; my $postTopic = '$|[^A-Za-z0-9_.]|\.\s'; my $metaPreTopic = '"|[\s[,\(-]'; my $metaPostTopic = '[^A-Za-z0-9_.]|\.\s'; my $out = ""; # Get list of topics in $oldWeb, replace local refs topic, with full web.topic my @topics = getTopicNames( $oldWeb ); my $insidePRE = 0; my $insideVERBATIM = 0; my $noAutoLink = 0; foreach( split( /\n/, $text ) ) { if( /^%META:TOPIC(INFO|MOVED)/ ) { $out .= "$_\n"; next; } # change state: m|<pre>|i && ( $insidePRE = 1 ); m|</pre>|i && ( $insidePRE = 0 ); if( m|<verbatim>|i ) { $insideVERBATIM = 1; } if( m|</verbatim>|i ) { $insideVERBATIM = 0; } m|<noautolink>|i && ( $noAutoLink = 1 ); m|</noautolink>|i && ( $noAutoLink = 0 ); if( ! ( $insidePRE || $insideVERBATIM || $noAutoLink ) ) { # Fairly inefficient, time will tell if this should be changed. foreach my $topic ( @topics ) { if( $topic ne $oldTopic ) { if( /^%META:/ ) { s/($metaPreTopic)\Q$topic\E(?=$metaPostTopic)/$1$oldWeb.$topic/g; } else { s/($preTopic)\Q$topic\E(?=$postTopic)/$1$oldWeb.$topic/g; } } } } $out .= "$_\n"; } return $out; } @code # ========================= # Rename a Web, allow for transfer between Webs # It is the responsibility of the caller to check: exstance webs & topics, lock taken for topic sub renameTopic { my( $oldWeb, $oldTopic, $newWeb, $newTopic, $doChangeRefTo ) = @_; my $error = ""; # Change data file my $from = getFileName( $oldWeb, $oldTopic ); my $to = getFileName( $newWeb, $newTopic ); if( ! move( $from, $to ) ) { $error .= "data file move failed. "; } # Change data file history my $oldHistory = getFileName( $oldWeb, $oldTopic, "", ",v" ); if( ! $error && -e $oldHistory ) { if( ! move( $oldHistory, getFileName( $newWeb, $newTopic, "", ",v" ) ) ) { $error .= "history file move failed. "; } } if( ! $error ) { my $time = time(); my $user = $TWiki::userName; my @args = ( "from" => "$oldWeb.$oldTopic", "to" => "$newWeb.$newTopic", "date" => "$time", "by" => "$user" ); my $fullText = readTopicRaw( $newWeb, $newTopic ); if( ( $oldWeb ne $newWeb ) && $doChangeRefTo ) { $fullText = changeRefTo( $fullText, $oldWeb, $oldTopic ); } my ( $meta, $text ) = _extractMetaData( $newWeb, $newTopic, $fullText ); $meta->put( "TOPICMOVED", @args ); saveNew( $newWeb, $newTopic, $text, $meta, "", "", "", "unlock" ); } # Make sure pub directory exists for new web my $newPubWebDir = getPubWebDir( $newWeb ); if ( ! -e $newPubWebDir ) { umask( 0 ); mkdir( $newPubWebDir, 0777 ); } # Rename the attachment directory if there is one my $oldAttachDir = getFileDir( $oldWeb, $oldTopic, 1, ""); my $newAttachDir = getFileDir( $newWeb, $newTopic, 1, ""); if( ! $error && -e $oldAttachDir ) { if( ! move( $oldAttachDir, $newAttachDir ) ) { $error .= "attach move failed"; } } # Log rename if( $TWiki::doLogRename ) { writeLog( "rename", "$oldWeb.$oldTopic", "moved to $newWeb.$newTopic $error" ); } # Remove old lock file lockTopicNew( $oldWeb, $oldTopic, 1 ); return $error; } @code # ========================= # Read a specific version of a topic # view: $text= &TWiki::Store::readTopicVersion( $topic, "1.$rev" ); sub readTopicVersion { my( $theWeb, $theTopic, $theRev ) = @_; my $text = _readVersionNoMeta( $theWeb, $theTopic, $theRev ); my $meta = ""; ( $meta, $text ) = _extractMetaData( $theWeb, $theTopic, $text ); return( $meta, $text ); } @code # ========================= # Read a specific version of a topic sub _readVersionNoMeta { my( $theWeb, $theTopic, $theRev ) = @_; my $tmp= $TWiki::revCoCmd; my $fileName = "$TWiki::dataDir/$theWeb/$theTopic.txt"; $tmp =~ s/%FILENAME%/$fileName/; $tmp =~ s/%REVISION%/$theRev/; $tmp =~ /(.*)/; $tmp = $1; # now safe, so untaint variable my $text = `$tmp`; _traceExec( $tmp, $text ); return $text; } @code # ========================= sub readAttachmentVersion { my ( $theWeb, $theTopic, $theAttachment, $theRev ) = @_; my $tmp = $TWiki::revCoCmd; my $fileName = getFileName( $theWeb, $theTopic, $theAttachment, ",v" ); $tmp =~ s/%FILENAME%/$fileName/; $tmp =~ s/%REVISION%/$theRev/; $tmp =~ /(.*)/; $tmp = $1; # now safe, so untaint variable my $text = `$tmp`; _traceExec( $tmp, $text ); return $text; } @code # ========================= # Use meta information if available ... sub getRevisionNumber { my( $theWebName, $theTopic, $attachment ) = @_; my $ret = getRevisionNumberX( $theWebName, $theTopic, $attachment ); TWiki::writeDebug( "Store: rev = $ret" ); if( ! $ret ) { $ret = "1.1"; # Temporary } return $ret; } @code # ========================= # Latest revision number # Returns "" if there is no revision sub getRevisionNumberX { my( $theWebName, $theTopic, $attachment ) = @_; if( ! $theWebName ) { $theWebName = $TWiki::webName; } if( ! $attachment ) { $attachment = ""; } my $tmp= $TWiki::revHistCmd; my $fileName = getFileName( $theWebName, $theTopic, $attachment ); my $rcsfilename = getFileName( $theWebName, $theTopic, $attachment, ",v" ); if( ! -e $rcsfilename ) { return ""; } $tmp =~ s/%FILENAME%/$rcsfilename/; $tmp =~ /(.*)/; my $cmd = $1; # now safe, so untaint variable $tmp = `$cmd`; _traceExec( $cmd, $tmp ); $tmp =~ /head: (.*?)\n/; if( ( $tmp ) && ( $1 ) ) { return $1; } else { return ""; } } @code # ========================= # rdiff: $text = &TWiki::Store::getRevisionDiff( $webName, $topic, "1.$r2", "1.$r1" ); sub getRevisionDiff { my( $web, $topic, $rev1, $rev2 ) = @_; my $tmp= ""; if ( $rev1 eq "1.1" && $rev2 eq "1.1" ) { my $text = _readVersionNoMeta( $web, $topic, 1.1); # bug fix 19 Feb 1999 $tmp = "1a1\n"; foreach( split( /\n/, $text ) ) { $tmp = "$tmp> $_\n"; } } else { $tmp= $TWiki::revDiffCmd; $tmp =~ s/%REVISION1%/$rev1/; $tmp =~ s/%REVISION2%/$rev2/; my $fileName = "$TWiki::dataDir/$TWiki::webName/$topic.txt"; $fileName =~ s/$TWiki::securityFilter//go; $tmp =~ s/%FILENAME%/$fileName/; $tmp =~ /(.*)/; my $cmd = $1; # now safe, so untaint variable $tmp = `$cmd`; _traceExec( $cmd, $tmp ); # Avoid showing change in revision number! # I'm not too happy with this implementation, I think it may be better to filter before sending to diff command, # possibly using Algorithm::Diff from CPAN. $tmp =~ s/[0-9]+c[0-9]+\n[<>]\s*%META:TOPICINFO{[^}]*}%\s*\n---\n[<>]\s*%META:TOPICINFO{[^}]*}%\s*\n//go; $tmp =~ s/[<>]\s*%META:TOPICINFO{[^}]*}%\s*//go; TWiki::writeDebug( "and now $tmp" ); } return "$tmp"; } @code # ========================= # Call getRevisionInfoFromMeta for faster response for topics sub getRevisionInfo { my( $theWebName, $theTopic, $theRev, $changeToIsoDate, $attachment ) = @_; if( ! $theWebName ) { $theWebName = $TWiki::webName; } if( ! $theRev ) { # PTh 03 Nov 2000: comment out for performance ### $theRev = getRevisionNumber( $theTopic, $theWebName ); $theRev = ""; # do a "rlog -r filename" to get top revision info } my $tmp= $TWiki::revInfoCmd; $theRev =~ s/$TWiki::securityFilter//go; $theRev =~ /(.*)/; $theRev = $1; # now safe, so untaint variable $tmp =~ s/%REVISION%/$theRev/; my $fileName = getFileName( $theWebName, $theTopic, $attachment ); $fileName =~ s/$TWiki::securityFilter//go; $fileName =~ /(.*)/; $fileName = $1; # now safe, so untaint variable my $rcsFile = getFileName( $theWebName, $theTopic, $attachment, ",v" ); $tmp =~ s/%FILENAME%/$rcsFile/; if ( -e $rcsFile ) { my $cmd = $tmp; $tmp = `$cmd`; _traceExec( $cmd, $tmp ); } else { $tmp = ""; } $tmp =~ /date: (.*?); author: (.*?);.*\n(.*)\n/; my $date = $1; my $user = $2; my $comment = $3; $tmp =~ /revision 1.([0-9]*)/; my $rev = $1 || ""; #AS 25-5-01 added default value writeDebug( "rev = $rev" ); return _tidyRevInfo( $theWebName, $theTopic, $date, $user, $rev, $comment, $changeToIsoDate ); } @code sub _tidyRevInfo { my( $web, $topic, $date, $user, $rev, $comment, $changeToIsoDate ) = @_; if( ! $user ) { writeDebug( "no user" ); # repository file is missing or corrupt, use file timestamp $user = $TWiki::defaultUserName; my $fileName = getFileName( $web, $topic ); $date = (stat "$fileName")[9] || 600000000; my @arr = gmtime( $date ); # format to RCS date "2000.12.31.23.59.59" $date = sprintf( "%.4u.%.2u.%.2u.%.2u.%.2u.%.2u", $arr[5] + 1900, $arr[4] + 1, $arr[3], $arr[2], $arr[1], $arr[0] ); $rev = 1; } if( $changeToIsoDate ) { # change date to ISO format my $tmp = $date; # try "2000.12.31.23.59.59" format $tmp =~ /(.*?)\.(.*?)\.(.*?)\.(.*?)\.(.*?)\.[0-9]/; if( $5 ) { $date = "$3 $TWiki::isoMonth[$2-1] $1 - $4:$5"; } else { # try "2000/12/31 23:59:59" format $tmp =~ /(.*?)\/(.*?)\/(.*?) (.*?):[0-9][0-9]$/; if( $4 ) { $date = "$3 $TWiki::isoMonth[$2-1] $1 - $4"; } } } return( $date, $user, $rev, $comment ); } @code # ========================= sub topicIsLockedBy { my( $theWeb, $theTopic ) = @_; # pragmatic approach: Warn user if somebody else pressed the # edit link within one hour my $lockFilename = "$TWiki::dataDir/$theWeb/$theTopic.lock"; if( ( -e "$lockFilename" ) && ( $TWiki::editLockTime > 0 ) ) { my $tmp = readFile( $lockFilename ); my( $lockUser, $lockTime ) = split( /\n/, $tmp ); if( $lockUser ne $TWiki::userName ) { # time stamp of lock within one hour of current time? my $systemTime = time(); # calculate remaining lock time in seconds $lockTime = $lockTime + $TWiki::editLockTime - $systemTime; if( $lockTime > 0 ) { # must warn user that it is locked return( $lockUser, $lockTime ); } } } return( "", 0 ); } @code # ====================== sub keyValue2list { my( $args ) = @_; my @res = (); # Format of data is name="value" name1="value1" [...] while( $args =~ s/\s*([^=]+)=\"([^"]*)\"//o ) { push @res, $1; push @res, $2; } return @res; } @code # ======================== sub metaAddTopicData { my( $web, $topic, $rev, $meta, $forceDate ) = @_; my $time; if( $forceDate ) { $time = $forceDate; } else { $time = time(); } my $user = $TWiki::userName; my @args = ( "version" => "$rev", "date" => "$time", "author" => "$user", "format" => $TWiki::formatVersion ); $meta->put( "TOPICINFO", @args ); } @code # ========================= sub savePreview { my( $theWeb, $theTopic, $theText ) = @_; my $fileName = getFileName( $theWeb, $theTopic, "", ".tmp" ); saveFile( $fileName, $theText ); } @code # ========================= sub readRemovePreview { my( $theWeb, $theTopic ) = @_; my $fileName = getFileName( $theWeb, $theTopic, "", ".tmp" ); my $text = readFile( $fileName ); unlink( $fileName ); return $text; } @code # ========================= sub saveTopicNew { my( $web, $topic, $text, $metaData, $saveCmd, $doUnlock, $dontNotify, $dontLogSave ) = @_; my $attachment = ""; my $meta = TWiki::Meta->new(); $meta->readArray( @$metaData ); saveNew( $web, $topic, $text, $meta, $saveCmd, $attachment, $dontLogSave, $doUnlock, $dontNotify ); } @code # ========================= sub saveTopic { my( $web, $topic, $text, $meta, $saveCmd, $doUnlock, $dontNotify, $dontLogSave, $forceDate ) = @_; my $attachment = ""; my $comment = ""; saveNew( $web, $topic, $text, $meta, $saveCmd, $attachment, $dontLogSave, $doUnlock, $dontNotify, $comment, $forceDate ); } @code # ========================= sub saveAttachment { my( $web, $topic, $text, $saveCmd, $attachment, $dontLogSave, $doUnlock, $dontNotify, $theComment, $theTmpFilename, $forceDate) = @_; # before save, create directories if they don't exist my $tempPath = getFileDir( $web, "", $attachment ); if( ! -e "$tempPath" ) { umask( 0 ); mkdir( $tempPath, 0777 ); } $tempPath = getFileDir( $web, $topic, $attachment ); if( ! -e "$tempPath" ) { umask( 0 ); mkdir( $tempPath, 0777 ); } # save uploaded file my $newFile = "$tempPath/$attachment"; copy($theTmpFilename, $newFile) or warn "copy($theTmpFilename, $newFile) failed: $!"; umask( 0027 ); chmod( 0644, $newFile ); # Update RCS my $error = save($web, $topic, $text, $saveCmd, $attachment, $dontLogSave, $doUnlock, $dontNotify, $theComment, $forceDate ); return $error; } @code #========================== sub isBinary { my( $filename, $theWeb ) = @_; if( $filename =~ /$TWiki::attachAsciiPath/ ) { return ""; } else { return "binary"; } } @code sub save { my( $web, $topic, $text, $saveCmd, $attachment, $dontLogSave, $doUnlock, $dontNotify, $theComment, $forceDate ) = @_; # FIXME get rid of this routine my $meta = TWiki::Meta->new(); return saveNew( $web, $topic, $text, $meta, $saveCmd, $attachment, $dontLogSave, $doUnlock, $dontNotify, $theComment, $forceDate ); } @code # ======================== sub _saveWithMeta { my( $web, $topic, $text, $attachment, $doUnlock, $nextRev, $meta, $forceDate ) = @_; if( ! $attachment ) { my $name = getFileName( $web, $topic, $attachment ); if( ! $nextRev ) { $nextRev = "1.1"; } metaAddTopicData( $web, $topic, $nextRev, $meta, $forceDate ); $text = $meta->write( $text ); # save file saveFile( $name, $text ); # reset lock time, this is to prevent contention in case of a long edit session lockTopicNew( $web, $topic, $doUnlock ); } return $text; } @code # ========================= # return non-null string if there is an (RCS) error. sub saveNew { my( $web, $topic, $text, $meta, $saveCmd, $attachment, $dontLogSave, $doUnlock, $dontNotify, $theComment, $forceDate ) = @_; my $name = getFileName( $web, $topic, $attachment ); my $dir = getFileDir( $web, $topic, $attachment, "" ); my $time = time(); my $tmp = ""; my $rcsError = ""; my $currentRev = getRevisionNumberX( $web, $topic ); my $nextRev = ""; if( ! $currentRev ) { $nextRev = "1.1"; } if( !$attachment ) { # RCS requires a newline for the last line, # so add newline if needed $text =~ s/([^\n\r])$/$1\n/os; } if( ! $theComment ) { $theComment = "none"; } my $rcsFile = ""; if( $attachment ) { $rcsFile = getFileName( $web, $topic, $attachment, ",v"); } #### Normal Save if( ! $saveCmd ) { $saveCmd = ""; # get time stamp of existing file my $mtime1 = 0; my $mtime2 = 0; if( -e $name ) { my( $tmp1,$tmp2,$tmp3,$tmp4,$tmp5,$tmp6,$tmp7,$tmp8,$tmp9, $tmp10,$tmp11,$tmp12,$tmp13 ) = stat $name; $mtime1 = $tmp10; } # how close time stamp of existing file to now? $mtime2 = time(); if( abs( $mtime2 - $mtime1 ) < $TWiki::editLockTime ) { my $rev = getRevisionNumberX( $web, $topic, $attachment ); my( $date, $user ) = getRevisionInfo( $web, $topic, $rev, "", $attachment ); # same user? if( ( $TWiki::doKeepRevIfEditLock ) && ( $user eq $TWiki::userName ) && $rev ) { # replace last repository entry $saveCmd = "repRev"; if( $attachment ) { $saveCmd = ""; # cmd option not supported for attachments. } } } if( ! $nextRev ) { # If content hasn't changed we still get a new version, with revised META:TOPICINFO writeDebug( "currentRev = $currentRev" ); $currentRev =~ /1\.([0-9]+)/; my $num = $1; $num++; $nextRev = "1.$num"; } if( $saveCmd ne "repRev" ) { $text = _saveWithMeta( $web, $topic, $text, $attachment, $doUnlock, $nextRev, $meta, $forceDate ); # If attachment and RCS file doesn't exist, initialise things if( $attachment ) { # Make sure directory for rcs history file exists my $rcsDir = getFileDir( $web, $topic, $attachment, ",v" ); my $tempPath = "&TWiki::dataDir/$web"; if( ! -e "$tempPath" ) { umask( 0 ); mkdir( $tempPath, 0777 ); } $tempPath = $rcsDir; if( ! -e "$tempPath" ) { umask( 0 ); mkdir( $tempPath, 0777 ); } if( ! -e $rcsFile && $TWiki::revInitBinaryCmd && isBinary( $attachment, $web ) ) { $tmp = $TWiki::revInitBinaryCmd; $tmp =~ s/%FILENAME%/$rcsFile/go; $tmp =~ /(.*)/; $tmp = "$1 2>&1 1>$TWiki::nullDev"; # safe, so untaint variable $rcsError = `$tmp`; _traceExec( $tmp, $rcsError ); if( $rcsError ) { # oops, stderr was not empty, return error $rcsError = "$tmp\n$rcsError"; return $rcsError; } # Sometimes (on Windows?) rcs file not formed, so check for it if( ! -e $rcsFile ) { return "Failed to create history file $rcsFile"; } } } $tmp = $TWiki::revCiCmd; if( $forceDate ) { $tmp = $TWiki::revCiDateCmd; my( $sec, $min, $hour, $mday, $mon, $year) = gmtime( $forceDate ); $forceDate = sprintf( "%.4u/%.2u/%.2u %.2u:%.2u:%.2u", $year + 1900, $mon, $mday, $hour, $min, $sec ); $tmp =~ s/%DATE%/$forceDate/o; } $tmp =~ s/%USERNAME%/$TWiki::userName/; $tmp =~ s/%FILENAME%/$name/; $tmp =~ s/%COMMENT%/$theComment/; $tmp =~ /(.*)/; $tmp = $1; # safe, so untaint variable $tmp .= " 2>&1 1>$TWiki::nullDev"; $rcsError = `$tmp`; # capture stderr (S.Knutson) _traceExec( $tmp, $rcsError ); $rcsError =~ s/^Warning\: missing newline.*//os; # forget warning if( $rcsError =~ /no lock set by/ ) { # Try and break lock, setting new one and doing ci again my $cmd = $TWiki::revBreakLockCmd; $cmd =~ s/%FILENAME%/$name/go; $cmd =~ /(.*)/; $cmd = "$1 2>&1 1>$TWiki::nullDev"; my $out = `$cmd`; _traceExec( $cmd, $out ); # Assume it worked, as not sure how to trap failure $tmp= $TWiki::revCiCmd; $rcsError = `$tmp`; # capture stderr (S.Knutson) _traceExec( $tmp, $rcsError ); $rcsError = ""; } if( $rcsError ) { # oops, stderr was not empty, return error $rcsError = "$tmp\n$rcsError"; return $rcsError; } if( ! $dontNotify ) { # update .changes my( $fdate, $fuser, $frev ) = getRevisionInfo( $web, $topic, "" ); $fdate = ""; # suppress warning $fuser = ""; # suppress warning my @foo = split( /\n/, &readFile( "$TWiki::dataDir/$TWiki::webName/.changes" ) ); if( $#foo > 100 ) { shift( @foo); } push( @foo, "$topic\t$TWiki::userName\t$time\t$frev" ); open( FILE, ">$TWiki::dataDir/$TWiki::webName/.changes" ); print FILE join( "\n", @foo )."\n"; close(FILE); } if( ( $TWiki::doLogTopicSave ) && ! ( $dontLogSave ) ) { # write log entry writeLog( "save", "$TWiki::webName.$topic", "" ); } } } #### Replace Revision Save if( $saveCmd eq "repRev" ) { # fix topic by replacing last revision $nextRev = $currentRev; $text = _saveWithMeta( $web, $topic, $text, $attachment, $doUnlock, $nextRev, $meta ); # update repository with same userName and date, but do not update .changes my $rev = getRevisionNumber( $web, $topic, $attachment ); my( $date, $user ) = getRevisionInfo( $web, $topic, $rev, "", $attachment ); if( $rev eq "1.1" ) { # initial revision, so delete repository file and start again unlink "$name,v"; } else { # delete latest revision (unlock, delete revision, lock) $tmp= $TWiki::revUnlockCmd; $tmp =~ s/%FILENAME%/$name $rcsFile/go; $tmp =~ /(.*)/; $tmp = "$1 2>&1 1>$TWiki::nullDev"; # safe, so untaint variable $rcsError = `$tmp`; # capture stderr (S.Knutson) _traceExec( $tmp, $rcsError ); $rcsError =~ s/^Warning\: missing newline.*//os; # forget warning if( $rcsError ) { # oops, stderr was not empty, return error $rcsError = "$tmp\n$rcsError"; return $rcsError; } $tmp= $TWiki::revDelRevCmd; $tmp =~ s/%REVISION%/$rev/go; $tmp =~ s/%FILENAME%/$name $rcsFile/go; $tmp =~ /(.*)/; $tmp = "$1 2>&1 1>$TWiki::nullDev"; # safe, so untaint variable $rcsError = `$tmp`; # capture stderr (S.Knutson) _traceExec( $tmp, $rcsError ); $rcsError =~ s/^Warning\: missing newline.*//os; # forget warning if( $rcsError ) { # oops, stderr was not empty, return error $rcsError = "$tmp\n$rcsError"; return $rcsError; } $tmp= $TWiki::revLockCmd; $tmp =~ s/%REVISION%/$rev/go; $tmp =~ s/%FILENAME%/$name $rcsFile/go; $tmp =~ /(.*)/; $tmp = "$1 2>&1 1>$TWiki::nullDev"; # safe, so untaint variable $rcsError = `$tmp`; # capture stderr (S.Knutson) _traceExec( $tmp, $rcsError ); $rcsError =~ s/^Warning\: missing newline.*//os; # forget warning if( $rcsError ) { # oops, stderr was not empty, return error $rcsError = "$tmp\n$rcsError"; return $rcsError; } } $tmp = $TWiki::revCiDateCmd; $tmp =~ s/%DATE%/$date/; $tmp =~ s/%USERNAME%/$user/; $tmp =~ s/%FILENAME%/$name $rcsFile/; $tmp =~ /(.*)/; $tmp = "$1 2>&1 1>$TWiki::nullDev"; # safe, so untaint variable $rcsError = `$tmp`; # capture stderr (S.Knutson) _traceExec( $tmp, $rcsError ); $rcsError =~ s/^Warning\: missing newline.*//os; # forget warning if( $rcsError ) { # oops, stderr was not empty, return error $rcsError = "$tmp\n$rcsError"; return $rcsError; } if( ( $TWiki::doLogTopicSave ) && ! ( $dontLogSave ) ) { # write log entry $tmp = &TWiki::userToWikiName( $user ); writeLog( "save", "$TWiki::webName.$topic", "repRev $rev $tmp $date" ); } } #### Delete Revision if( $saveCmd eq "delRev" ) { # delete last revision # delete last entry in repository (unlock, delete revision, lock operation) my $rev = getRevisionNumber( $web, $topic ); if( $rev eq "1.1" ) { # can't delete initial revision return; } $tmp= $TWiki::revUnlockCmd; $tmp =~ s/%FILENAME%/$name $rcsFile/go; $tmp =~ /(.*)/; $tmp = "$1 2>&1 1>$TWiki::nullDev"; # safe, so untaint variable $rcsError = `$tmp`; # capture stderr (S.Knutson) _traceExec( $tmp, $rcsError ); $rcsError =~ s/^Warning\: missing newline.*//os; # forget warning if( $rcsError ) { # oops, stderr was not empty, return error $rcsError = "$tmp\n$rcsError"; return $rcsError; } $tmp= $TWiki::revDelRevCmd; $tmp =~ s/%REVISION%/$rev/go; $tmp =~ s/%FILENAME%/$name $rcsFile/go; $tmp =~ /(.*)/; $tmp = "$1 2>&1 1>$TWiki::nullDev"; # safe, so untaint variable $rcsError = `$tmp`; # capture stderr (S.Knutson) _traceExec( $tmp, $rcsError ); $rcsError =~ s/^Warning\: missing newline.*//os; # forget warning if( $rcsError ) { # oops, stderr was not empty, return error $rcsError = "$tmp\n$rcsError"; return $rcsError; } $tmp= $TWiki::revLockCmd; $tmp =~ s/%REVISION%/$rev/go; $tmp =~ s/%FILENAME%/$name $rcsFile/go; $tmp =~ /(.*)/; $tmp = "$1 2>&1 1>$TWiki::nullDev"; # safe, so untaint variable $rcsError = `$tmp`; # capture stderr (S.Knutson) _traceExec( $tmp, $rcsError ); $rcsError =~ s/^Warning\: missing newline.*//os; # forget warning if( $rcsError ) { # oops, stderr was not empty, return error $rcsError = "$tmp\n$rcsError"; return $rcsError; } # restore last topic from repository $rev = getRevisionNumber( $web, $topic ); $tmp = _readVersionNoMeta( $web, $topic, $rev ); saveFile( $name, $tmp ); lockTopic( $topic, $doUnlock ); # delete entry in .changes : FIXME if( $TWiki::doLogTopicSave ) { # write log entry writeLog( "cmd", "$TWiki::webName.$topic", "delRev $rev" ); } } return ""; # all is well } @code # ========================= sub writeLog { my( $action, $webTopic, $extra, $user ) = @_; # use local time for log, not UTC (gmtime) my ( $sec, $min, $hour, $mday, $mon, $year ) = localtime( time() ); my( $tmon) = $TWiki::isoMonth[$mon]; $year = sprintf( "%.4u", $year + 1900 ); # Y2K fix my $time = sprintf( "%.2u ${tmon} %.2u - %.2u:%.2u", $mday, $year, $hour, $min ); my $yearmonth = sprintf( "%.4u%.2u", $year, $mon+1 ); my $wuserName = $user || $TWiki::userName; $wuserName = &TWiki::userToWikiName( $wuserName ); my $remoteAddr = $ENV{'REMOTE_ADDR'} || ""; my $text = "| $time | $wuserName | $action | $webTopic | $extra | $remoteAddr |"; my $filename = $TWiki::logFilename; $filename =~ s/%DATE%/$yearmonth/go; open( FILE, ">>$filename"); print FILE "$text\n"; close( FILE); } @code # ========================= sub saveFile { my( $name, $text ) = @_; open( FILE, ">$name" ) or warn "Can't create file $name\n"; print FILE $text; close( FILE); } @code # ========================= sub lockTopic { my ( $name, $doUnlock ) = @_; lockTopicNew( $TWiki::webName, $name, $doUnlock ); } @code # ========================= sub lockTopicNew { my( $web, $name, $doUnlock ) = @_; my $lockFilename = getFileName( $web, $name, "", ".lock" ); if( $doUnlock ) { unlink "$lockFilename"; } else { my $lockTime = time(); saveFile( $lockFilename, "$TWiki::userName\n$lockTime" ); } } @code # ========================= sub removeObsoleteTopicLocks { my( $web ) = @_; # Clean all obsolete .lock files in a web. # This should be called regularly, best from a cron job (called from mailnotify) my $webDir = "$TWiki::dataDir/$web"; opendir( DIR, "$webDir" ); my @fileList = grep /\.lock$/, readdir DIR; closedir DIR; my $file = ""; my $pathFile = ""; my $lockUser = ""; my $lockTime = 0; my $systemTime = time(); foreach $file ( @fileList ) { $pathFile = "$webDir/$file"; $pathFile =~ /(.*)/; $pathFile = $1; # untaint file ( $lockUser, $lockTime ) = split( /\n/, readFile( "$pathFile" ) ); $lockTime = 0 unless( $lockTime ); # time stamp of lock over one hour of current time? if( abs( $systemTime - $lockTime ) > $TWiki::editLockTime ) { # obsolete, so delete file unlink "$pathFile"; } } } @code # ========================= sub webExists { my( $theWeb ) = @_; return -e "$TWiki::dataDir/$theWeb"; } @code # ========================= sub topicExists { my( $theWeb, $theName ) = @_; return -e "$TWiki::dataDir/$theWeb/$theName.txt"; } @code # ========================= # Try and get from meta information in topic, if this can't be done then use RCS # Note there is no "1." prefix to this data sub getRevisionInfoFromMeta { my( $web, $topic, $meta, $changeToIsoDate ) = @_; my( $date, $author, $rev ); my %topicinfo = (); if( $meta ) { %topicinfo = $meta->findOne( "TOPICINFO" ); } if( %topicinfo ) { # Stored as meta data in topic for faster access $date = TWiki::formatGmTime( $topicinfo{"date"} ); # FIXME deal with changeToIsoDate $author = $topicinfo{"author"}; my $tmp = $topicinfo{"version"}; $tmp =~ /1\.(.*)/o; $rev = $1; } else { # Get data from RCS ( $date, $author, $rev ) = getRevisionInfo( $web, $topic, "", 1 ); ( $date, $author, $rev ) = _tidyRevInfo( $web, $topic, $date, $author, $rev, "", $changeToIsoDate ); } writeDebug( "rev = $rev" ); return( $date, $author, $rev ); } @code # ========================= sub convert2metaFormat { my( $web, $topic, $text ) = @_; my $meta = TWiki::Meta->new(); $text = $meta->read( $text ); if ( $text =~ // ) { $text = TWiki::Attach::migrateToFileAttachmentMacro( $meta, $text ); } if ( $text =~ // ) { $text = TWiki::Form::upgradeCategoryTable( $web, $topic, $meta, $text ); } return( $meta, $text ); } @code # ========================= # Expect meta data at top of file, but willing to accept it anywhere # If we have an old file format without meta data, then convert sub _extractMetaData { my( $web, $topic, $fulltext ) = @_; my $meta = TWiki::Meta->new(); my $text = $meta->read( $fulltext ); # If there is no meta data then convert if( ! $meta->count( "TOPICINFO" ) ) { ( $meta, $text ) = convert2metaFormat( $web, $topic, $text ); } else { my %topicinfo = $meta->findOne( "TOPICINFO" ); if( $topicinfo{"format"} eq "1.0beta" ) { # This format used live at DrKW for a few months if( $text =~ // ) { $text = TWiki::Form::upgradeCategoryTable( $web, $topic, $meta, $text ); } TWiki::Attach::upgradeFrom1v0beta( $meta ); if( $meta->count( "TOPICMOVED" ) ) { my %moved = $meta->findOne( "TOPICMOVED" ); $moved{"by"} = TWiki::wikiToUserName( $moved{"by"} ); $meta->put( "TOPICMOVED", %moved ); } } } return( $meta, $text ); } @code # ====================== # Just read the meta data at the top of the topic sub readTopMeta { my( $theWeb, $theTopic ) = @_; my $filename = getFileName( $theWeb, $theTopic ); my $data = ""; my $line; $/ = "\n"; # read line by line open( IN_FILE, "<$filename" ) || return ""; while( ( $line = <IN_FILE> ) ) { if( $line !~ /^%META:/ ) { last; } else { $data .= $line; } } my( $meta, $text ) = _extractMetaData( $theWeb, $theTopic, $data ); close( IN_FILE ); return $meta; } @code # ========================= sub readTopic { my( $theWeb, $theTopic ) = @_; my $fullText = readTopicRaw( $theWeb, $theTopic ); my ( $meta, $text ) = _extractMetaData( $theWeb, $theTopic, $fullText ); return( $meta, $text ); } @code # ========================= sub readWebTopic { my( $theWeb, $theName ) = @_; my $text = &readFile( "$TWiki::dataDir/$theWeb/$theName.txt" ); return $text; } @code # ========================= # Optional version in format 1.x sub readTopicRaw { my( $theWeb, $theTopic, $theVersion ) = @_; my $text = ""; if( ! $theVersion ) { $text = &readFile( "$TWiki::dataDir/$theWeb/$theTopic.txt" ); } else { $text = _readVersionNoMeta( $theWeb, $theTopic, $theVersion); } return $text; } @code # ========================= sub readTemplateTopic { my( $theTopicName ) = @_; $theTopicName =~ s/$TWiki::securityFilter//go; # zap anything suspicious # try to read in current web, if not read from TWiki web my $web = $TWiki::twikiWebname; if( topicExists( $TWiki::webName, $theTopicName ) ) { $web = $TWiki::webName; } return readTopic( $web, $theTopicName ); } @code # ========================= sub _readTemplateFile { my( $theName, $theSkin ) = @_; $theSkin = "" unless $theSkin; # prevent 'uninitialized value' warnings # CrisBailiff, PeterThoeny 13 Jun 2000: Add security $theName =~ s/$TWiki::securityFilter//go; # zap anything suspicious $theName =~ s/\.+/\./g; # Filter out ".." from filename $theSkin =~ s/$TWiki::securityFilter//go; # zap anything suspicious $theSkin =~ s/\.+/\./g; # Filter out ".." from filename my $tmplFile = ""; # search first in twiki/templates/Web dir # for file script(.skin).tmpl my $tmplDir = "$TWiki::templateDir/$TWiki::webName"; if( opendir( DIR, $tmplDir ) ) { # for performance use readdir, not a row of ( -e file ) my @filelist = grep /^$theName\..*tmpl$/, readdir DIR; closedir DIR; $tmplFile = "$theName.$theSkin.tmpl"; if( ! grep { /^$tmplFile$/ } @filelist ) { $tmplFile = "$theName.tmpl"; if( ! grep { /^$tmplFile$/ } @filelist ) { $tmplFile = ""; } } if( $tmplFile ) { $tmplFile = "$tmplDir/$tmplFile"; } } # if not found, search in twiki/templates dir $tmplDir = $TWiki::templateDir; if( ( ! $tmplFile ) && ( opendir( DIR, $tmplDir ) ) ) { my @filelist = grep /^$theName\..*tmpl$/, readdir DIR; closedir DIR; $tmplFile = "$theName.$theSkin.tmpl"; if( ! grep { /^$tmplFile$/ } @filelist ) { $tmplFile = "$theName.tmpl"; if( ! grep { /^$tmplFile$/ } @filelist ) { $tmplFile = ""; } } if( $tmplFile ) { $tmplFile = "$tmplDir/$tmplFile"; } } # read the template file if( -e $tmplFile ) { return &readFile( $tmplFile ); } return ""; } @code # ========================= sub handleTmplP { # Print template variable, called by %TMPL:P{"$theVar"}% my( $theVar ) = @_; my $val = ""; if( ( %templateVars ) && ( exists $templateVars{ $theVar } ) ) { $val = $templateVars{ $theVar }; $val =~ s/%TMPL\:P{[\s\"]*(.*?)[\"\s]*}%/&handleTmplP($1)/geo; # recursion } if( ( $theVar eq "sep" ) && ( ! $val ) ) { # set separator explicitely if not set $val = " | "; } return $val; } @code # ========================= sub readTemplate { my( $theName, $theSkin ) = @_; if( ! defined($theSkin) ) { $theSkin = &TWiki::getSkin(); } # recursively read template file(s) my $text = _readTemplateFile( $theName, $theSkin ); while( $text =~ /%TMPL\:INCLUDE{[\s\"]*(.*?)[\"\s]*}%/s ) { $text =~ s/%TMPL\:INCLUDE{[\s\"]*(.*?)[\"\s]*}%/&_readTemplateFile( $1, $theSkin )/geo; } if( ! ( $text =~ /%TMPL\:/s ) ) { # no template processing $text =~ s|^(( {3})+)|"\t" x (length($1)/3)|geom; # leading spaces to tabs return $text; } my $result = ""; my $key = ""; my $val = ""; my $delim = ""; foreach( split( /(%TMPL\:)/, $text ) ) { if( /^(%TMPL\:)$/ ) { $delim = $1; } elsif( ( /^DEF{[\s\"]*(.*?)[\"\s]*}%[\n\r]*(.*)/s ) && ( $1 ) ) { # handle %TMPL:DEF{"key"}% if( $key ) { $templateVars{ $key } = $val; } $key = $1; $val = $2 || ""; } elsif( /^END%[\n\r]*(.*)/s ) { # handle %TMPL:END% $templateVars{ $key } = $val; $key = ""; $val = ""; $result .= $1 || ""; } elsif( $key ) { $val .= "$delim$_"; } else { $result .= "$delim$_"; } } # handle %TMPL:P{"..."}% recursively $result =~ s/%TMPL\:P{[\s\"]*(.*?)[\"\s]*}%/&handleTmplP($1)/geo; $result =~ s|^(( {3})+)|"\t" x (length($1)/3)|geom; # leading spaces to tabs return $result; } @code # ========================= sub readFile { my( $name ) = @_; my $data = ""; undef $/; # set to read to EOF open( IN_FILE, "<$name" ) || return ""; $data = <IN_FILE>; $/ = "\n"; close( IN_FILE ); return $data; } @code # ========================= sub readFileHead { my( $name, $maxLines ) = @_; my $data = ""; my $line; my $l = 0; $/ = "\n"; # read line by line open( IN_FILE, "<$name" ) || return ""; while( ( $l < $maxLines ) && ( $line = <IN_FILE> ) ) { $data .= $line; $l += 1; } close( IN_FILE ); return $data; } @code # ========================= #AS 5 Dec 2000 collect all Web's topic names sub getTopicNames { my( $web ) = @_ ; if( !defined $web ) { $web=""; } #FIXME untaint web name? # get list of all topics by scanning $dataDir opendir DIR, "$TWiki::dataDir/$web" ; my @tmpList = readdir( DIR ); closedir( DIR ); # this is not magic, it just looks like it. my @topicList = sort grep { s#^.+/([^/]+)\.txt$#$1# } grep { ! -d } map { "$TWiki::dataDir/$web/$_" } grep { ! /^\.\.?$/ } @tmpList; return @topicList ; } #/AS @code # ========================= #AS 5 Dec 2000 collect immediate subWeb names sub getSubWebs { my( $web ) = @_ ; if( !defined $web ) { $web=""; } #FIXME untaint web name? # get list of all subwebs by scanning $dataDir opendir DIR, "$TWiki::dataDir/$web" ; my @tmpList = readdir( DIR ); closedir( DIR ); # this is not magic, it just looks like it. my @webList = sort grep { s#^.+/([^/]+)$#$1# } grep { -d } map { "$TWiki::dataDir/$web/$_" } grep { ! /^\.\.?$/ } @tmpList; return @webList ; } #/AS @code # ========================= #AS 26 Dec 2000 recursively collects all Web names #FIXME: move var to TWiki.cfg ? use vars qw ($subWebsAllowedP); $subWebsAllowedP = 0; # 1 = subwebs allowed, 0 = flat webs sub getAllWebs { # returns a list of subweb names my( $web ) = @_ ; if( !defined $web ) { $web=""; } my @webList = map { s/^\///o; $_ } map { "$web/$_" } &getSubWebs( $web ); my $subWeb = ""; if( $subWebsAllowedP ) { my @subWebs = @webList; foreach $subWeb ( @webList ) { push @subWebs, &getAllWebs( $subWeb ); } return @subWebs; } return @webList ; } #/AS # 20000501 Kevin Kinnell : changed beta0404 to have many new search # capabilities. This file had a new hash added # for month name-to-number look-ups, a slight # change in the parameter list for the search # script call in &handleSearchWeb, and a new # sub -- &revDate2EpSecs -- for calculating the # epoch seconds from a rev date (the only way # to sort dates.) # # 15 May 2000 PeterFokkinga : # With this patch each topic can have its own template. TWiki::Store::readTemplate() # has been modified to search for the following templates (in this order): # # 1.$templateDir/$webName/$name.$topic.tmpl # 2.$templateDir/$webName/$name.tmpl # 3.$templateDir/$name.$topic.tmpl # 4.$templateDir/$name.tmpl # # $name is the name of the script, e.g. ``view''. The current # TWiki version uses steps 2 and 4. # # See http://twiki.org/cgi-bin/view/Codev/UniqueTopicTemplates # for further details package TWiki; # rhk: Declares that the "rest of the innermost enclosing block, subroutine, eval, or file belongs to the indicated namespace." (And I wholeheartedly agree ;-) (I think this was quoted from one of the Wall books.) ## 0501 kk : vvv Added for revDate2EpSecs use Time::Local; Perl standard functions for computing time, using either GMT or local time. Based on number of seconds since 1/1/70 (overflow on 1/1/2038 on most machines). use strict; Restricts use of unsafe Perl constructs for variables (must be declared, fully qualified, or imported), references (must not be symbolic), and subroutines (can't use a bareword identifier that's not a predeclared subroutine) -- I need to do more reading about this. # =========================== # TWiki config variables: # rhk: use vars predeclares the variables in the following list so that you can use them under "use strict" -- it also disables any typo warnings. May have something to do with delayed loading of subroutines. use vars qw( $webName $topicName $includingWebName $includingTopicName $defaultUserName $userName $wikiUserName $wikiHomeUrl $defaultUrlHost $urlHost $scriptUrlPath $pubUrlPath $pubDir $templateDir $dataDir $wikiToolName $securityFilter $debugFilename $htpasswdFilename $logFilename $remoteUserFilename $wikiUsersTopicname $userListFilename %userToWikiList $twikiWebname $mainWebname $mainTopicname $notifyTopicname $wikiPrefsTopicname $webPrefsTopicname $statisticsTopicname $statsTopViews $statsTopContrib $numberOfRevisions $editLockTime $scriptSuffix $safeEnvPath $mailProgram $wikiversion $doKeepRevIfEditLock $doRemovePortNumber $doRememberRemoteUser $doPluralToSingular $doHidePasswdInRegistration $doSecureInclude $doLogTopicView $doLogTopicEdit $doLogTopicSave $doLogRename $doLogTopicAttach $doLogTopicUpload $doLogTopicRdiff $doLogTopicChanges $doLogTopicSearch $doLogRegistration @isoMonth $TranslationToken $code @code $depth %mon2num $newTopicFontColor $newTopicBgColor $headerPatternDa $headerPatternSp $headerPatternHt $debugUserTime $debugSystemTime ); # TWiki::Store config: use vars qw( $revInitBinaryCmd $revCoCmd $revCiCmd $revCiDateCmd $revHistCmd $revInfoCmd $revDiffCmd $revDelRevCmd $revUnlockCmd $revLockCmd ); # TWiki::Search config: use vars qw( $lsCmd $egrepCmd $fgrepCmd ); # =========================== # read the configuration part do "TWiki.cfg"; # rhk: The file TWiki.cfg contains initial configuration information -- assignment statements and so forth. I.e., I think it is executable. # =========================== # use TWiki modules use TWiki::Prefs; # preferences use TWiki::Search; # search engine use TWiki::Access; # access control use TWiki::Store; # file I/O and rcs related functions use TWiki::Plugins; # plugins handler #AS # =========================== # variables: (new variables must be declared in "use vars qw(..)" above) @isoMonth = ( "Jan", "Feb", "Mar", "Apr", "May", "Jun", "Jul", "Aug", "Sep", "Oct", "Nov", "Dec" ); { my $count = 0; %mon2num = map { $_ => $count++ } @isoMonth; } # Header patterns based on '+++'. The '###' are reserved for numbered headers # rhk: TWiki will recognize certain patterns of text as denoting headers -- when HTML is generated, the appropriate markup is generated. $headerPatternDa = '^---+(\++|\#+)\s+(.+)\s*$'; # '---++ Header', '---## Header' $headerPatternSp = '^\t(\++|\#+)\s+(.+)\s*$'; # ' ++ Header', ' + Header' $headerPatternHt = '^<h([1-6])>\s*(.+?)\s*</h[1-6]>'; # '<h6>Header</h6> # rhk: Aha! Note that the header pattern does not look for the capital H form # rhk: Not sure what these will be used for -- will have to watch. $debugUserTime = 0; $debugSystemTime = 0; # ========================= # rhk: initialize sub initialize { my ( $thePathInfo, $theRemoteUser, $theTopic, $theUrl ) = @_; # rhk: All parameters to a subroutine are passed in the array @_ -- this statement assigns the first four parameters to the local variables within parenthesis. # Make %ENV safer for CGI # rhk: %ENV gives access to the environment variables # rhk: Deletes some variables from the environment which might be dangerous for CGI (?) # rhk: $safeEnvPath comes from TWiki.cfg -- the default value is /bin:/usr/bin. # rhk: Are we setting up the environment for the "Apache user" (nobody, apache, or whoever) # rhk: TWiki.cfg also says the path is not changed if $safeEnvPath is set to "", so thats what the first two lines of code are doing. # rhk: Rewrite the preceding comments now that you have some understanding. if( $safeEnvPath ) { $ENV{'PATH'} = $safeEnvPath; } delete @ENV{ qw( IFS CDPATH ENV BASH_ENV ) }; # initialize access control # rhk: OK, now go to module Access.pm and figure out what's going on there. I'll be back. &TWiki::Access::initializeAccess(); # initialize user name and user to WikiName list $userName = initializeRemoteUser( $theRemoteUser ); userToWikiListInit(); $wikiUserName = userToWikiName( $userName ); # initialize $webName and $topicName # test if $thePathInfo is "/Webname/SomeTopic" or "/Webname/" if( ( $thePathInfo =~ /[\/](.*)\/(.*)/ ) && ( $1 ) ) { $webName = $1; } else { # test if $thePathInfo is "/Webname" or "/" $thePathInfo =~ /[\/](.*)/; $webName = $1 || $mainWebname; } if( $2 ) { $topicName = $2; } else { if( $theTopic ) { $topicName = $theTopic; } else { $topicName = $mainTopicname; } } ( $topicName =~ /\.\./ ) && ( $topicName = $mainTopicname ); # filter out dangerous or unwanted characters: $topicName =~ s/$securityFilter//go; $topicName =~ /(.*)/; $topicName = $1; # untaint variable $webName =~ s/$securityFilter//go; $webName =~ /(.*)/; $webName = $1; # untaint variable $includingTopicName = $topicName; $includingWebName = $webName; # initialize $urlHost and $scriptUrlPath if( ( $theUrl ) && ( $theUrl =~ /^([^\:]*\:\/\/[^\/]*)(.*)\/.*$/ ) && ( $2 ) ) { $urlHost = $1; $scriptUrlPath = $2; if( $doRemovePortNumber ) { $urlHost =~ s/\:[0-9]+$//; } } else { $urlHost = $defaultUrlHost; # $scriptUrlPath does not change } # initialize preferences &TWiki::Prefs::initializePrefs( $wikiUserName, $webName ); # some remaining init $TranslationToken= "\263"; $code=""; @code= (); # Add background color and font color (AlWilliams - 18 Sep 2000) # PTh: Moved from interalLink to initialize ('cause of performance) $newTopicBgColor = &TWiki::Prefs::getPreferencesValue("NEWTOPICBGCOLOR"); if ($newTopicBgColor eq "") { $newTopicBgColor="#FFFFCE"; } $newTopicFontColor = &TWiki::Prefs::getPreferencesValue("NEWTOPICFONTCOLOR"); if ($newTopicFontColor eq "") { $newTopicFontColor="#0000FF"; } #AS &TWiki::Plugins::initialize( $topicName, $webName, $userName ); #/AS return ( $topicName, $webName, $scriptUrlPath, $userName, $dataDir ); } # ========================= sub writeDebug { my( $text) = @_; open( FILE, ">>$debugFilename"); print FILE "$text\n"; close( FILE); } # ========================= sub writeDebugTimes { my( $text ) = @_; if( ! $debugUserTime ) { writeDebug( "===== sec: (delta:) sec: (delta:) function:" ); } my( $puser, $psystem, $cuser, $csystem ) = times(); my $duser = $puser - $debugUserTime; my $dsystem = $psystem - $debugSystemTime; my $times = sprintf( "user: %1.3f (%1.3f), system: %1.3f (%1.3f)", $puser, $duser, $psystem, $dsystem ); $debugUserTime = $puser; $debugSystemTime = $psystem; writeDebug( "===== $times, $text" ); } # ========================= sub getEmailNotifyList { my( $web, $topicname ) = @_; $topicname |= $TWiki::notifyTopicname; return undef unless &TWiki::Store::topicExists( $web, $topicname ); my @list = (); foreach ( split( /\n/, &TWiki::Store::readWebTopic( $web, $topicname ) ) ) { next unless /^\s\*\s[A-Za-z0-9\.]+\s+\-\s+/; push @list, $1 if (/([\w\-\.\+]+\@[\w\-\.\+]+)/); } return (scalar @list ? @list : undef); } # ========================= sub initializeRemoteUser { my( $theRemoteUser ) = @_; my $remoteUser = $theRemoteUser || $defaultUserName; $remoteUser =~ s/$securityFilter//go; $remoteUser =~ /(.*)/; $remoteUser = $1; # untaint variable my $remoteAddr = $ENV{'REMOTE_ADDR'} || ""; if( ( ! $doRememberRemoteUser ) || ( ! $remoteAddr ) ) { # do not remember IP address return $remoteUser; } my $text = &TWiki::Store::readFile( $remoteUserFilename ); my %AddrToName = map { split( /\|/, $_ ) } grep { /[^\|]*\|[^\|]*\|$/ } split( /\n/, $text ); my $rememberedUser = ""; if( exists( $AddrToName{ $remoteAddr } ) ) { $rememberedUser = $AddrToName{ $remoteAddr }; } if( $theRemoteUser ) { if( $theRemoteUser ne $rememberedUser ) { $AddrToName{ $remoteAddr } = $theRemoteUser; # create file as "$remoteAddr|$theRemoteUser|" lines $text = "# This is a generated file, do not modify.\n"; foreach my $usrAddr ( sort keys %AddrToName ) { my $usrName = $AddrToName{ $usrAddr }; # keep $userName unique if( ( $usrName ne $theRemoteUser ) || ( $usrAddr eq $remoteAddr ) ) { $text .= "$usrAddr|$usrName|\n"; } } &TWiki::Store::saveFile( $remoteUserFilename, $text ); } } else { # get user name from AddrToName table $remoteUser = $rememberedUser || $defaultUserName; } return $remoteUser; } # ========================= sub userToWikiListInit { my $text = &TWiki::Store::readFile( $userListFilename ); my @list = split( /\n/, $text ); @list = grep { /^\s*\* [A-Za-z0-9]*\s*\-\s*[^\-]*\-/ } @list; %userToWikiList = (); my $wUser; my $lUser; foreach( @list ) { if( ( /^\s*\* ([A-Za-z0-9]*)\s*\-\s*([^\s]*).*/ ) && ( isWikiName( $1 ) ) && ( $2 ) ) { $wUser = $1; $lUser = $2; $lUser =~ s/$securityFilter//go; $userToWikiList{ $lUser } = $wUser; } } } # ========================= sub userToWikiName { my( $loginUser ) = @_; $loginUser =~ s/$securityFilter//go; my $wUser = $userToWikiList{ $loginUser }; if( $wUser ) { return "$mainWebname.$wUser"; } return "$mainWebname.$loginUser"; } # ========================= sub getDataDir { return $dataDir; } # ========================= sub getPubDir { return $pubDir; } # ========================= sub getPubUrlPath { return $pubUrlPath; } # ========================= sub getLocaldate { my( $sec, $min, $hour, $mday, $mon, $year) = localtime(time()); $year = sprintf("%.4u", $year + 1900); # Y2K fix my( $tmon) = $isoMonth[$mon]; my $date = sprintf("%.2u ${tmon} %.2u", $mday, $year); return $date; } # ========================= sub formatGmTime { my( $time ) = @_; my( $sec, $min, $hour, $mday, $mon, $year) = gmtime( $time ); my( $tmon) = $isoMonth[$mon]; $year = sprintf( "%.4u", $year + 1900 ); # Y2K fix $time = sprintf( "%.2u ${tmon} %.2u - %.2u:%.2u", $mday, $year, $hour, $min ); return $time; } # ========================= sub revDate2EpSecs { # This routine *will break* if formatGMTime changes output format. my ($day, $mon, $year, $hyph, $hrmin, @junk) = split(" ",$_[0]); my ($hr, $min) = split(/:/, $hrmin); #my $mon = $mon2num{$monstr}; return timegm(0, $min, $hr, $day, $mon2num{$mon}, $year - 1900); } # ========================= sub getViewUrl { my( $theWeb, $theTopic ) = @_; # PTh 20 Jun 2000: renamed sub viewUrl to getViewUrl, added $theWeb my $web = $webName; # current web if( $theWeb ) { $web = $theWeb; } # PTh 24 May 2000: added $urlHost, needed for some environments # see also Codev.PageRedirectionNotWorking return "$urlHost$scriptUrlPath/view$scriptSuffix/$web/$theTopic"; } # ========================= sub getOopsUrl { my( $theWeb, $theTopic, $theTemplate, $theParam1, $theParam2, $theParam3, $theParam4 ) = @_; # PTh 20 Jun 2000: new sub my $web = $webName; # current web if( $theWeb ) { $web = $theWeb; } # $urlHost is needed, see Codev.PageRedirectionNotWorking my $url = "$urlHost$scriptUrlPath/oops$scriptSuffix/$web/$theTopic"; $url .= "\?template=$theTemplate"; if( $theParam1 ) { # PTh, Stanley Knutson 03 Feb 2001: Proper URL encoding $theParam1 =~ s/[\n\r]/\%3Cbr\%3E/go; $theParam1 =~ s/\s+/\%20/go; $theParam1 =~ s/\&/\%26/go; $theParam1 =~ s/\</\%3C/go; $theParam1 =~ s/\>/\%3E/go; $url .= "\&param1=$theParam1"; } if( $theParam2 ) { $theParam2 =~ s/[\n\r]/\%3Cbr\%3E/go; $theParam2 =~ s/\s+/\%20/go; $theParam2 =~ s/\&/\%26/go; $theParam2 =~ s/\</\%3C/go; $theParam2 =~ s/\>/\%3E/go; $url .= "\&param2=$theParam2"; } if( $theParam3 ) { $theParam3 =~ s/[\n\r]/\%3Cbr\%3E/go; $theParam3 =~ s/\s+/\%20/go; $theParam3 =~ s/\&/\%26/go; $theParam3 =~ s/\</\%3C/go; $theParam3 =~ s/\>/\%3E/go; $url .= "\&param3=$theParam3"; } if( $theParam4 ) { $theParam4 =~ s/[\n\r]/\%3Cbr\%3E/go; $theParam4 =~ s/\s+/\%20/go; $theParam4 =~ s/\&/\%26/go; $theParam4 =~ s/\</\%3C/go; $theParam4 =~ s/\>/\%3E/go; $url .= "\&param4=$theParam4"; } return $url; } # ========================= sub makeTopicSummary { my( $theText, $theTopic, $theWeb ) = @_; # called by search, mailnotify & changes after calling readFileHead my $htext = $theText; $htext =~ s/<[^>]*>//go; # remove all HTML tags $htext =~ s/%WEB%/$theWeb/go; # resolve web $htext =~ s/%TOPIC%/$theTopic/go; # resolve topic $htext =~ s/%WIKITOOLNAME%/$wikiToolName/go; # resolve TWiki tool name $htext =~ s/[\%\[\]\*\|=_]/ /go; # remove Wiki formatting chars & defuse %VARS% $htext =~ s/\-\-\-+\+*/ /go; # remove heading formatting $htext =~ s/\s+[\+\-]*/ /go; # remove newlines and special chars # inline search renders text, # so prevent linking of external and internal links: $htext =~ s/([\-\*\s])((http|ftp|gopher|news|file|https)\:)/$1<nop>$2/go; $htext =~ s/([\*\s][\(\-\*\s]*)([A-Z]+[a-z]*\.[A-Z]+[a-z]+[A-Z]+[a-zA-Z0-9]*)/$1<nop>$2/go; $htext =~ s/([\*\s][\(\-\*\s]*)([A-Z]+[a-z]+[A-Z]+[a-zA-Z0-9]*)/$1<nop>$2/go; $htext =~ s/([\*\s][\-\*\s]*)([A-Z]{3,})/$1<nop>$2/go; $htext =~ s/@([a-zA-Z0-9\-\_\.]+)/@<nop>$1/go; # limit to 162 chars $htext =~ s/(.{162})([a-zA-Z0-9]*)(.*?)$/$1$2 \.\.\./go; return $htext; } # ========================= sub extractNameValuePair { my( $str, $name ) = @_; if( $name ) { # format is: %VAR{ ... name = "value" }% if( ( $str =~ /(^|[^\S])$name\s*=\s*\"([^\"]*)\"/ ) && ( $2 ) ) { return $2; } } else { # test if format: { "value" ... } if( ( $str =~ /(^|\=\s*\"[^\"]*\")\s*\"([^\"]*)\"/ ) && ( $2 ) ) { # is: { "value" ... } return $2; } elsif( ( $str =~ /^\s*\w+\s*=\s*\"([^\"]*)/ ) && ( $1 ) ) { # is not a standalone var, but: %VAR{ name = "value" }% return ""; } else { # format is: %VAR{ value }% return $1; } } return ""; } # ========================= sub handleIncludeFile { my( $theAttributes, $theTopic, $theWeb, @theProcessedTopics ) = @_; my $incfile = extractNameValuePair( $theAttributes ); # CrisBailiff, PeterThoeny 12 Jun 2000: Add security $incfile =~ s/$securityFilter//go; # zap anything suspicious $incfile =~ s/passwd//goi; # filter out passwd filename if( $doSecureInclude ) { # Filter out ".." from filename, this is to # prevent includes of "../../file" $incfile =~ s/\.+/\./g; } # test for different usage my $fileName = "$dataDir/$theWeb/$incfile"; # TopicName.txt if( ! -e $fileName ) { $fileName = "$dataDir/$theWeb/$incfile.txt"; # TopicName if( ! -e $fileName ) { $fileName = "$dataDir/$incfile"; # Web/TopicName.txt if( ! -e $fileName ) { $incfile =~ s/\.([^\.]*)$/\/$1/go; $fileName = "$dataDir/$incfile.txt"; # Web.TopicName if( ! -e $fileName ) { # give up, file not found return ""; } } } } # prevent recursive loop if( ( @theProcessedTopics ) && ( grep { /^$fileName$/ } @theProcessedTopics ) ) { # file already included return ""; } else { # remember for next time push( @theProcessedTopics, $fileName ); } # finally include file my $text = &TWiki::Store::readFile( $fileName ); # set include web/filenames and current web/filenames $includingWebName = $theWeb; $includingTopicName = $theTopic; $fileName =~ s/\/([^\/]*)\/([^\/]*)(\.txt)$/$1/go; if( $3 ) { # identified "/Web/TopicName.txt" filename, e.g. a Wiki topic # so save the current web and topic name $theWeb = $1; $theTopic = $2; # remove everything before %STARTINCLUDE% and after %STOPINCLUDE% $text =~ s/.*?%STARTINCLUDE%//os; $text =~ s/%STOPINCLUDE%.*//os; } # handle all preferences and internal tags (for speed: call by reference) &TWiki::Prefs::handlePreferencesTags( $text ); handleInternalTags( $text, $theTopic, $theWeb ); # recursively process multiple embeded %INCLUDE% statements and prefs $text =~ s/%INCLUDE{(.*?)}%/&handleIncludeFile($1, $theTopic, $theWeb, @theProcessedTopics )/geo; return $text; } # ========================= sub handleSearchWeb { my( $attributes ) = @_; my $searchVal = extractNameValuePair( $attributes ); if( ! $searchVal ) { # %SEARCH{"string" ...} not found, try # %SEARCH{search="string" ...} $searchVal = extractNameValuePair( $attributes, "search" ); } my $attrWeb = extractNameValuePair( $attributes, "web" ); my $attrScope = extractNameValuePair( $attributes, "scope" ); my $attrOrder = extractNameValuePair( $attributes, "order" ); my $attrRegex = extractNameValuePair( $attributes, "regex" ); my $attrLimit = extractNameValuePair( $attributes, "limit" ); my $attrReverse = extractNameValuePair( $attributes, "reverse" ); my $attrCasesensitive = extractNameValuePair( $attributes, "casesensitive" ); my $attrNosummary = extractNameValuePair( $attributes, "nosummary" ); my $attrNosearch = extractNameValuePair( $attributes, "nosearch" ); my $attrNoheader = extractNameValuePair( $attributes, "noheader" ); my $attrNototal = extractNameValuePair( $attributes, "nototal" ); my $attrBookview = extractNameValuePair( $attributes, "bookview" ); my $attrRenameview = extractNameValuePair( $attributes, "renameview" ); my $attrShowlock = extractNameValuePair( $attributes, "showlock" ); return &TWiki::Search::searchWeb( "1", $attrWeb, $searchVal, $attrScope, $attrOrder, $attrRegex, $attrLimit, $attrReverse, $attrCasesensitive, $attrNosummary, $attrNosearch, $attrNoheader, $attrNototal, $attrBookview, $attrRenameview, $attrShowlock ); } # ========================= sub handleTime { my( $theAttributes, $theZone ) = @_; # format examples: # 28 Jul 2000 15:33:59 is "$day $month $year $hour:$min:$sec" # 001128 is "$ye$mo$day" my $format = extractNameValuePair( $theAttributes ); my $value = ""; my $time = time(); if( $format ) { if( $theZone eq "gmtime" ) { my( $sec, $min, $hour, $day, $mon, $year) = gmtime( $time ); $value = $format; $value =~ s/\$sec[a-z]*/sprintf("%.2u",$sec)/geoi; $value =~ s/\$min[a-z]*/sprintf("%.2u",$min)/geoi; $value =~ s/\$hou[a-z]*/sprintf("%.2u",$hour)/geoi; $value =~ s/\$day[a-z]*/sprintf("%.2u",$day)/geoi; $value =~ s/\$mon[a-z]*/$isoMonth[$mon]/goi; $value =~ s/\$mo/sprintf("%.2u",$mon+1)/geoi; $value =~ s/\$yea[a-z]*/sprintf("%.4u",$year+1900)/geoi; $value =~ s/\$ye/sprintf("%.2u",$year%100)/geoi; } elsif( $theZone eq "servertime" ) { my( $sec, $min, $hour, $day, $mon, $year) = localtime( $time ); $value = $format; $value =~ s/\$sec[a-z]*/sprintf("%.2u",$sec)/geoi; $value =~ s/\$min[a-z]*/sprintf("%.2u",$min)/geoi; $value =~ s/\$hou[a-z]*/sprintf("%.2u",$hour)/geoi; $value =~ s/\$day[a-z]*/sprintf("%.2u",$day)/geoi; $value =~ s/\$mon[a-z]*/$isoMonth[$mon]/goi; $value =~ s/\$mo/sprintf("%.2u",$mon+1)/geoi; $value =~ s/\$yea[a-z]*/sprintf("%.4u",$year+1900)/geoi; $value =~ s/\$ye/sprintf("%.2u",$year%100)/geoi; } } else { if( $theZone eq "gmtime" ) { $value = gmtime( $time ); } elsif( $theZone eq "servertime" ) { $value = localtime( $time ); } } return $value; } #AS # ========================= sub showError { my( $errormessage ) = @_; return "$errormessage" ; } #AS # ========================= sub handleToc { # Andrea Sterbini 22-08-00 / PTh 28 Feb 2001 # Routine to create a TOC bulleted list linked to the section headings # of a topic. A section heading is entered in one of the following forms: # $headingPatternSp : \t++... spaces section heading # $headingPatternDa : ---++... dashes section heading # $headingPatternHt : <h[1-6]> HTML section heading </h[1-6]> # Parameters: # $_[0] : the text of the current topic # $_[1] : the topic we are in # $_[2] : the web we are in # $_[3] : attributes = "Topic" [web="Web"] [depth="N"] ## $_[0] $_[1] $_[2] $_[3] ## my( $theText, $theTopic, $theWeb, $attributes ) = @_; # get the topic name attribute my $topicname = extractNameValuePair( $_[3] ) || $_[1]; # get the web name attribute my $web = extractNameValuePair( $_[3], "web" ) || $_[2]; $web =~ s/\//\./go; my $webPath = $web; $webPath =~ s/\./\//go; # get the depth limit attribute my $depth = extractNameValuePair( $_[3], "depth" ) || 6; my $result = ""; my $line = ""; my $level = ""; my @list = (); if( "$web.$topicname" eq "$_[2].$_[1]" ) { # use text from parameter @list = split( /\n/, $_[0] ); } else { # read text from file if ( ! &TWiki::Store::topicExists( $web, $topicname ) ) { return showError( "TOC: Cannot find topic \"$web.$topicname\"" ); } @list = split( /\n/, handleCommonTags( &TWiki::Store::readWebTopic( $web, $topicname ), $topicname, $web ) ); } @list = grep { /(<\/?[pP][rR][eE]>)|($headerPatternDa)|($headerPatternSp)|($headerPatternHt)/ } @list; my $insidePre = 0; my $i = 0; my $tabs = ""; my $anchor = ""; foreach $line ( @list ) { if( $line =~ /^.*<[pP][rR][eE]>.*$/ ) { $insidePre = 1; $line = ""; } if( $line =~ /^.*<\/[pP][rR][eE]>.*$/ ) { $insidePre = 0; $line = ""; } if (!$insidePre) { $level = $line ; if ( $line =~ /$headerPatternDa/ ) { $level =~ s/$headerPatternDa/$1/go ; $level = length $level; $line =~ s/$headerPatternDa/$2/go ; $anchor = makeAnchorName( $line ); } elsif ( $line =~ /$headerPatternSp/ ) { $level =~ s/$headerPatternSp/$1/go ; $level = length $level; $line =~ s/$headerPatternSp/$2/go ; $anchor = makeAnchorName( $line ); } elsif ( $line =~ /$headerPatternHt/ ) { $level =~ s/$headerPatternHt/$1/go ; $line =~ s/$headerPatternHt/$2/go ; $anchor = makeAnchorName( $line ); } if( ( $line ) && ( $level <= $depth ) ) { $tabs = ""; for( $i=0 ; $i<$level ; $i++ ) { $tabs = "\t$tabs"; } $line = "$tabs* <a href=\"$scriptUrlPath/view$scriptSuffix/$webPath/$topicname#$anchor\">$line</a>"; $result .= "\n$line"; } } } if( $result ) { return $result; } else { return showError("TOC: No TOC in \"$web.$topicname\""); } } # ========================= sub handleEnvVariable { my( $theVar ) = @_; my $value = $ENV{$theVar} || ""; return $value; } # ========================= sub handleSpacedTopic { my( $theTopic ) = @_; my $spacedTopic = $theTopic; $spacedTopic =~ s/([a-z]+)([A-Z0-9]+)/$1%20*$2/go; # "%20*" is " *" return $spacedTopic; } # ========================= sub handleInternalTags { # modify arguments directly, e.g. call by reference # $_[0] is text # $_[1] is topic # $_[2] is web $_[0] =~ s/%HTTP_HOST%/&handleEnvVariable('HTTP_HOST')/geo; $_[0] =~ s/%REMOTE_ADDR%/&handleEnvVariable('REMOTE_ADDR')/geo; $_[0] =~ s/%REMOTE_PORT%/&handleEnvVariable('REMOTE_PORT')/geo; $_[0] =~ s/%REMOTE_USER%/&handleEnvVariable('REMOTE_USER')/geo; $_[0] =~ s/%TOPIC%/$_[1]/go; $_[0] =~ s/%BASETOPIC%/$topicName/go; $_[0] =~ s/%INCLUDINGTOPIC%/$includingTopicName/go; $_[0] =~ s/%SPACEDTOPIC%/&handleSpacedTopic($_[1])/geo; $_[0] =~ s/%WEB%/$_[2]/go; $_[0] =~ s/%BASEWEB%/$webName/go; $_[0] =~ s/%INCLUDINGWEB%/$includingWebName/go; $_[0] =~ s/%WIKIHOMEURL%/$wikiHomeUrl/go; $_[0] =~ s/%SCRIPTURL%/$urlHost$scriptUrlPath/go; $_[0] =~ s/%SCRIPTURLPATH%/$scriptUrlPath/go; $_[0] =~ s/%SCRIPTSUFFIX%/$scriptSuffix/go; $_[0] =~ s/%PUBURL%/$urlHost$pubUrlPath/go; $_[0] =~ s/%PUBURLPATH%/$pubUrlPath/go; $_[0] =~ s/%ATTACHURL%/$urlHost$pubUrlPath\/$_[2]\/$_[1]/go; $_[0] =~ s/%ATTACHURLPATH%/$pubUrlPath\/$_[2]\/$_[1]/go; $_[0] =~ s/%DATE%/&getLocaldate()/geo; # depreciated $_[0] =~ s/%GMTIME%/&handleTime("","gmtime")/geo; $_[0] =~ s/%GMTIME{(.*?)}%/&handleTime($1,"gmtime")/geo; $_[0] =~ s/%SERVERTIME%/&handleTime("","servertime")/geo; $_[0] =~ s/%SERVERTIME{(.*?)}%/&handleTime($1,"servertime")/geo; $_[0] =~ s/%WIKIVERSION%/$wikiversion/go; $_[0] =~ s/%USERNAME%/$userName/go; $_[0] =~ s/%WIKIUSERNAME%/$wikiUserName/go; $_[0] =~ s/%WIKITOOLNAME%/$wikiToolName/go; $_[0] =~ s/%MAINWEB%/$mainWebname/go; $_[0] =~ s/%TWIKIWEB%/$twikiWebname/go; $_[0] =~ s/%HOMETOPIC%/$mainTopicname/go; $_[0] =~ s/%WIKIUSERSTOPIC%/$wikiUsersTopicname/go; $_[0] =~ s/%WIKIPREFSTOPIC%/$wikiPrefsTopicname/go; $_[0] =~ s/%WEBPREFSTOPIC%/$webPrefsTopicname/go; $_[0] =~ s/%NOTIFYTOPIC%/$notifyTopicname/go; $_[0] =~ s/%STATISTICSTOPIC%/$statisticsTopicname/go; $_[0] =~ s/%STARTINCLUDE%//go; $_[0] =~ s/%STOPINCLUDE%//go; $_[0] =~ s/%SEARCH{(.*?)}%/&handleSearchWeb($1)/geo; } # ========================= sub handleCommonTags { my( $text, $theTopic, $theWeb, @theProcessedTopics ) = @_; # PTh 22 Jul 2000: added $theWeb for correct handling of %INCLUDE%, %SEARCH% if( !$theWeb ) { $theWeb = $webName; } # handle all preferences and internal tags (for speed: call by reference) $includingWebName = $theWeb; $includingTopicName = $theTopic; &TWiki::Prefs::handlePreferencesTags( $text ); handleInternalTags( $text, $theTopic, $theWeb ); # recursively process multiple embeded %INCLUDE% statements and prefs $text =~ s/%INCLUDE{(.*?)}%/&handleIncludeFile($1, $theTopic, $theWeb, @theProcessedTopics )/geo; # Wiki Plugin Hook &TWiki::Plugins::commonTagsHandler( $text, $theTopic, $theWeb ); # handle tags again because of extend &TWiki::Prefs::handlePreferencesTags( $text ); handleInternalTags( $text, $theTopic, $theWeb ); $text =~ s/%TOC{([^}]*)}%/&handleToc($text,$theTopic,$theWeb,$1)/geo; $text =~ s/%TOC%/&handleToc($text,$theTopic,$theWeb,"")/geo; return $text; } # ========================= sub emitCode { ( $code, $depth ) = @_; my $result=""; while( @code > $depth ) { local($_) = pop @code; $result= "$result</$_>\n" } while( @code < $depth ) { push( @code, ($code) ); $result= "$result<$code>\n" } if( ( $#code > -1 ) && ( $code[$#code] ne $code ) ) { $result= "$result</$code[$#code]><$code>\n"; $code[$#code] = $code; } return $result; } # ========================= sub emitTR { my ( $pre, $cells, $insideTABLE ) = @_; if( $insideTABLE ) { $cells = "$pre<TR><TD> $cells"; } else { $cells = "$pre<TABLE border=\"1\"><TR><TD> $cells"; } $cells =~ s@\|\s*$@ </TD></TR>@go; $cells =~ s@\|@ </TD><TD> @go; return $cells; } # ========================= sub fixedFontText { my( $theText, $theDoBold ) = @_; # preserve white space, so replace it by "  " patterns $theText =~ s/\t/ /go; $theText =~ s|((?:[\s]{2})+)([^\s])|'  ' x (length($1) / 2) . "$2"|eg; if( $theDoBold ) { return "<code>$theText</code>"; } else { return "<code>$theText</code>"; } } # ========================= sub makeAnchorName { my( $theName ) = @_; my $anchorName = $theName; $anchorName =~ s/^\s*\#?//o; # no leading space nor '#' $anchorName =~ s/\s*$//o; # no trailing space $anchorName =~ s/[^a-zA-Z0-9]/_/go; # only allowed chars $anchorName =~ s/__+/_/go; # remove excessive _ $anchorName =~ s/^(.{32})(.*)$/$1/o; # limit to 32 chars return $anchorName; } # ========================= sub internalLink { my( $thePreamble, $theWeb, $theTopic, $theLinkText, $theAnchor, $doLink ) = @_; # $thePreamble is heading space # $doLink is boolean, false suppress link for non-existing pages # kill spaces and Wikify page name (ManpreetSingh - 15 Sep 2000) $theTopic =~ s/^\s*//; $theTopic =~ s/\s*$//; $theTopic =~ s/^(.)/\U$1/; $theTopic =~ s/\s([a-zA-Z0-9])/\U$1/g; # Add <nop> before WikiWord inside text to prevent double links $theLinkText =~ s/(\s)([A-Z]+[a-z]+[A-Z])/$1<nop>$2/go; my $exist = &TWiki::Store::topicExists( $theWeb, $theTopic ); if( ( $doPluralToSingular ) && ( $theTopic =~ /s$/ ) && ! ( $exist ) ) { # page is a non-existing plural my $tmp = $theTopic; $tmp =~ s/ies$/y/; # plurals like policy / policies $tmp =~ s/sses$/ss/; # plurals like address / addresses $tmp =~ s/xes$/x/; # plurals like box / boxes $tmp =~ s/([A-Za-rt-z])s$/$1/; # others, excluding ending ss like address(es) if( &TWiki::Store::topicExists( $theWeb, $tmp ) ) { $theTopic = $tmp; $exist = 1; } } my $text = $thePreamble; if( $exist) { if( $theAnchor ) { my $anchor = makeAnchorName( $theAnchor ); $text .= "<a href=\"$scriptUrlPath/view$scriptSuffix/" . "$theWeb/$theTopic\#$anchor\">$theLinkText<\/a>"; return $text; } else { $text .= "<a href=\"$scriptUrlPath/view$scriptSuffix/" . "$theWeb/$theTopic\">$theLinkText<\/a>"; return $text; } } elsif( $doLink ) { $text .= "" . "$theLinkText" . "<a href=\"$scriptUrlPath/edit$scriptSuffix/$theWeb/$theTopic\">?</a>"; return $text; } else { $text .= $theLinkText; return $text; } } # ========================= sub specificLink { my( $thePreamble, $theWeb, $theTopic, $theText, $theLink ) = @_; # format: $thePreamble[[$theText]] # format: $thePreamble[[$theText][$theLink]] $theLink =~ s/^\s*//o; $theLink =~ s/\s*$//o; if( $theLink =~ /^(http|ftp|gopher|news|file|https)\:/ ) { # found external link return "$thePreamble<a href=\"$theLink\" target=\"_top\">$theText</a>"; } $theLink =~ s/^([A-Z]+[a-z]*)\.//o; my $web = $1 || $theWeb; # extract 'Web.' (my $baz = "foo") =~ s/foo//; # reset $1, defensive coding $theLink =~ s/(\#[a-zA-Z_0-9\-]*$)//o; my $anchor = $1 || ""; # extract '#anchor' my $topic = $theLink || $theTopic; # remaining is topic $topic =~ s/\&[a-z]+\;//goi; # filter out &any; entities $topic =~ s/\&\#[0-9]+\;//go; # filter out { entities $topic =~ s/[\\\/\#\&\{\}\[\]\<\>\!\=\:\,\.]//go; $topic =~ s/$securityFilter//go; # filter out suspicious chars if( ! $topic ) { return "$thePreamble$theText"; # no link if no topic } return internalLink( $thePreamble, $web, $topic, $theText, $anchor, 1 ); } # ========================= sub externalLink { my( $pre, $url ) = @_; if( $url =~ /\.(gif|jpg|jpeg|png)$/i ) { my $filename = $url; $filename =~ s@.*/([^/]*)@$1@go; return "$pre<IMG src=\"$url\" alt=\"$filename\">"; } return "$pre<A href=\"$url\" target=\"_top\">$url</A>"; } # ========================= sub isWikiName { my( $name ) = @_; if ( $name =~ /^[A-Z]+[a-z]+[A-Z]+[a-zA-Z0-9]*$/ ) { return "1"; } return ""; } # ========================= sub getRenderedVersion { my( $text, $theWeb ) = @_; my( $result, $insidePRE, $insideVERBATIM, $insideTABLE, $noAutoLink, $blockquote ); # FIXME: Get $theTopic from parameter to handle [[#anchor]] correctly # (fails in %INCLUDE%, %SEARCH%) my $theTopic = $topicName; # PTh 22 Jul 2000: added $theWeb for correct handling of %INCLUDE%, %SEARCH% if( !$theWeb ) { $theWeb = $webName; } $result = ""; $insidePRE = 0; $insideVERBATIM = 0; # PTh 31 Jan 2001: Added Codev.VerbatimModeForSourceCodes $insideTABLE = 0; $noAutoLink = 0; # PTh 02 Feb 2001: Added Codev.DisableWikiWordLinks $blockquote = 0; $code = ""; $text =~ s/\r//go; $text =~ s/\\\n//go; # Join lines ending in "\" # Wiki Plugin Hook &TWiki::Plugins::startRenderingHandler( $text, $theWeb ); foreach( split( /\n/, $text ) ) { # change state: m|<pre>|i && ( $insidePRE = 1 ); m|</pre>|i && ( $insidePRE = 0 ); if( m|<verbatim>|i ) { s|<verbatim>|<pre>|goi; $insideVERBATIM = 1; } if( m|</verbatim>|i ) { s|</verbatim>|</pre>|goi; $insideVERBATIM = 0; } m|<noautolink>|i && ( $noAutoLink = 1 ); m|</noautolink>|i && ( $noAutoLink = 0 ); if( $insidePRE || $insideVERBATIM ) { # inside <PRE> or <VERBATIM> if( $insideVERBATIM ) { s/\&/&/go; s/\</</go; s/\>/>/go; s/\<pre\>/<pre>/go; # fix escaped <pre> } # Wiki Plugin Hook &TWiki::Plugins::insidePREHandler( $_ ); s/(.*)/$1\n/o; } else { # normal state, do Wiki rendering # Wiki Plugin Hook &TWiki::Plugins::outsidePREHandler( $_ ); # Blockquote s/^>(.*?)$/> <cite> $1 <\/cite> /go; # Embedded HTML s/\<(\!\-\-)/$TranslationToken$1/go; # Allow standalone "" s/\<(\S.*?)\>/$TranslationToken$1$TranslationToken/go; s/</&lt\;/go; s/>/&gt\;/go; s/$TranslationToken(\S.*?)$TranslationToken/\<$1\>/go; s/(\-\-)$TranslationToken/$1\>/go; s/$TranslationToken(\!\-\-)/\<$1/go; # Handle embedded URLs s@(^|[\-\*\s])((http|ftp|gopher|news|https)\:(\S+[^\s\.,!\?;:]))@&externalLink($1,$2)@geo; # Entities s/&(\w+?)\;/$TranslationToken$1\;/go; # "&abc;" s/&(\#[0-9]+)\;/$TranslationToken$1\;/go; # "{" s/&/&/go; # escape standalone "&" s/$TranslationToken/&/go; # Headings # '<h6>...</h6>' HTML rule (to prepend anchor) s/$headerPatternHt/"<a name =\"" . &makeAnchorName($2) . "\"><h$1> $2 <\/h$1><\/h$1>"/geoi; # '\t+++++++' rule s/$headerPatternSp/"<a name =\"" . &makeAnchorName( $2 ) . "\"><h" . (length $1) . "> $2 <\/h" . (length $1) ."><\/a>"/geo; # '----+++++++' rule s/$headerPatternDa/"<a name =\"" . &makeAnchorName( $2 ) . "\"><h" . (length $1) . "> $2 <\/h" . (length $1) ."><\/a>"/geo; # Horizontal rule s/^---+/<HR>/o; s@^([a-zA-Z0-9]+)----*@<table width=\"100%\"><tr><td valign=\"bottom\"><h2>$1</h2></td><td width=\"98%\" valign=\"middle\"><HR></td></tr></table>@o; # Table of format: | cell | cell | # PTh 25 Jan 2001: Forgiving syntax, allow trailing white space if( $_ =~ /^(\s*)\|.*\|\s*$/ ) { s/^(\s*)\|(\s*)(.*)/&emitTR($1,$3,$insideTABLE)/eo; $insideTABLE = 1; } elsif( $insideTABLE ) { $result .= "</TABLE>\n"; $insideTABLE = 0; } # Lists etc. s/^\s*$/ /o && ( $code = 0 ); m/^(\S+?)/o && ( $code = 0 ); s/^(\t+)(\S+?):\s/<DT> $2<DD> /o && ( $result .= &emitCode( "DL", length $1 ) ); s/^(\t+)\* /<LI> /o && ( $result .= &emitCode( "UL", length $1 ) ); s/^(\t+)\d+\.?/<LI> /o && ( $result .= &emitCode( "OL", length $1 ) ); if( !$code ) { $result .= &emitCode( "", 0 ); $code = ""; } # '#WikiName' anchors s/^(\#)([A-Z]+[a-z]+[A-Z]+[a-zA-Z0-9]*)/ '<a name="' . &makeAnchorName( $2 ) . '"><\/a>'/geo; # enclose in white space for the regex that follow s/(.*)/\n$1\n/o; # Emphasizing # PTh 25 Sep 2000: More relaxing rules, allow leading '(' and trailing ',.;:!?)' s/([\s$])==([^\s]+?|[^\s].*?[^\s])==([\s\,\.\;\:\!\?$])/$1 . &fixedFontText( $2, 1 ) . $3/geo; s/([\s$])__([^\s]+?|[^\s].*?[^\s])__([\s\,\.\;\:\!\?$])/$1$2<\/EM><\/STRONG>$3/go; s/([\s$])\*([^\s]+?|[^\s].*?[^\s])\*([\s\,\.\;\:\!\?$])/$1$2<\/STRONG>$3/go; s/([\s$])_([^\s]+?|[^\s].*?[^\s])_([\s\,\.\;\:\!\?$])/$1$2<\/EM>$3/go; s/([\s$])=([^\s]+?|[^\s].*?[^\s])=([\s\,\.\;\:\!\?$])/$1 . &fixedFontText( $2, 0 ) . $3/geo; # Mailto s#(^|[\s$])(?:mailto\:)*([a-zA-Z0-9\-\_\.\+]+@[a-zA-Z0-9\-\_\.]+\.[a-zA-Z0-9\-\_\.]*[a-zA-Z0-9\-\_])(?=[\s\.\,\;\:\!\?$])#$1<a href=\"mailto\:$2">$2</a>#go; # Make internal links # '[[Web.odd wiki word#anchor][display text]]' link: s/\[\[(.*?)\]\[(.*?)\]\]/&specificLink("",$theWeb,$theTopic,$2,$1)/geo; # '[[Web.odd wiki word#anchor]]' link: s/\[\[(.*?)\]\]/&specificLink("",$theWeb,$theTopic,$1,$1)/geo; # do normal WikiWord link if not disabled by <noautolink> if( ! ( $noAutoLink ) ) { # 'Web.TopicName#anchor' link: s/([\*\s][\(\-\*\s]*)([A-Z]+[a-z]*)\.([A-Z]+[a-z]+[A-Z]+[a-zA-Z0-9]*)(\#[a-zA-Z0-9_]*)/&internalLink($1,$2,$3,"$TranslationToken$3$4$TranslationToken",$4,1)/geo; # 'Web.TopicName' link: s/([\*\s][\(\-\*\s]*)([A-Z]+[a-z]*)\.([A-Z]+[a-z]+[A-Z]+[a-zA-Z0-9]*)/&internalLink($1,$2,$3,"$TranslationToken$3$TranslationToken","",1)/geo; # 'TopicName#anchor' link: s/([\*\s][\(\-\*\s]*)([A-Z]+[a-z]+[A-Z]+[a-zA-Z0-9]*)(\#[a-zA-Z0-9_]*)/&internalLink($1,$theWeb,$2,"$TranslationToken$2$3$TranslationToken",$3,1)/geo; # 'TopicName' link: s/([\*\s][\(\-\*\s]*)([A-Z]+[a-z]+[A-Z]+[a-zA-Z0-9]*)/&internalLink($1,$theWeb,$2,$2,"",1)/geo; # 'TLA' link if exist: s/([\*\s][\-\*\s]*)([A-Z]{3,})/&internalLink($1,$theWeb,$2,$2,"",0)/geo; # depreciated link: s/<link>(.*?)<\/link>/&internalLink("",$theWeb,$1,$1,"",1)/geo; s/$TranslationToken(\S.*?)$TranslationToken/$1/go; } s/^\n//o; } s/\t/ /go; $result .= $_; } if( $insideTABLE ) { $result .= "</TABLE>\n"; } $result .= &emitCode( "", 0 ); if( $insidePRE || $insideVERBATIM ) { $result .= "</pre>\n"; } # Wiki Plugin Hook &TWiki::Plugins::endRenderingHandler( $result ); return $result; } 1; # NOTE: I HAVE COMMENTED OUT SOME LINES OF CODE BECAUSE OF DIFFICULTIES # WITH SYNTAX HIGHLIGHTING -- THESE MUST BE UNCOMMENTED BEFORE # PERMANENTLY SAVING THIS FILE, ESPECIALLY IF SAVING IT AS THE # "REAL" FILE RATHER THAN AN ANNOTATED VERSION!!!!!! # # The lines in question are marked with ### # # TWiki WikiClone (see wiki.pm for $wikiversion and other info) # # Copyright (C) 2000 Peter Thoeny, Peter@Thoeny.com # # 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, published at # http://www.gnu.org/copyleft/gpl.html # # Notes: # - Latest version at http://twiki.org/ # - Installation instructions in $dataDir/TWiki/TWikiDocumentation.txt # - Customize variables in wikicfg.pm when installing TWiki. # - Optionally change wikicfg.pm for custom extensions of rendering rules. # - Files wiki[a-z]+.pm are included by wiki.pm # - Upgrading TWiki is easy as long as you only customize wikicfg.pm. # - Check web server error logs for errors, i.e. % tail /var/log/httpd/error_log package TWiki::Access; use strict; # rhk: described in TWiki.pm # rhk: % denotes a hash (an associative array), @ denotes an array # rhk: use vars is described in TWiki.pm use vars qw( %allGroups @processedGroups ); # ========================= sub initializeAccess # Clear the hash %allGroups and the array @processedGroups { %allGroups = (); @processedGroups = (); } # ========================= sub checkAccessPermission { my( $theAccessType, $theUserName, $theTopicText, $theTopicName, $theWebName ) = @_; # $theAccessType "VIEW", "CHANGE", "CREATE", e.t.c. # $theUserName Remote WikiName, i.e. "Main.PeterThoeny" # rhk: Maybe "fully qualified WikiName" is better than "Remote WikiName"? (Also, "e.g." instead of "i.e."?) # $theTopicText If empty: Read "$theWebName.$theTopicName" # $theTopicName Topic name to check, i.e. "SomeTopic" # $theWebName Web, i.e. "Know" # rhk: Change string $theAccessType to all upper case. $theAccessType = uc( $theAccessType ); # upper case # rhk: If the web name of the topic has not been supplied as a parameter, get it from function webName in module TWiki if( ! $theWebName ) { $theWebName = $TWiki::webName; } # rhk: If the body text of the topic has not been supplied as a parameter, get it from function readWebTopic in module TWiki::Store to get it. (Store is in ...bin/TWiki/Store.pm.) if( ! $theTopicText ) { # text not supplied as parameter, so read topic $theTopicText = &TWiki::Store::readWebTopic( $theWebName, $theTopicName ); } ##&TWiki::writeDebug( "checkAccessPermission: Type $theAccessType, user $theUserName, topic $theTopicName" ); # parse the " * Set (ALLOWTOPIC|DENYTOPIC)$theAccessType = " in body text my @denyList = (); my @allowList = (); # rhk: The $ in the next line messes up the syntax highlighting in kwrite for some reason -- if I delete it or comment it out, the highlighting is OK. # rhk: In addition, comments that start on a line that ends with an open parenthesis are shown in red by KWrite -- try inserting a comment above after "use vars qw( ". # rhk: Next line splits $theTopicText (which contains the body text of the topic) into separate lines and then processes each line as described in the following lines. ### rhk: Uncomment this line! foreach( split( /\n/, $theTopicText ) ) { # rhk: The thing in parenthesis in the following line is a pattern matching operator, normally written m//, but the m can be omitted if the delimiters are slashes. # rhk: \s matches a single character of white space, ^ means start the match at the beginning of the line # rhk: + means repeat the match 1 or more times, * means repeat the match 0 or more times, ? means repeat the match 0 or 1 times # rhk: The \* is an escaped character (the asterisk) rather than a repetition -- the ^\s+\*\s is requiring that the match occur on a bulleted line (" * ", " * ", etc. is the TWiki markup for a bulleted line) # rhk: The . matches any character # rhk: Parenthesis around a regular expression remember the matched substring for use in a backreference (\1, etc.) in the match or substitution operator or local variable ($1, etc.) after the match or substitution operator # rhk: Hey, I might be able to get my PhD in regular expressions after all (as long as I have a good reference) # rhk: So, the following match is looking for a line like: " * Set [ALLOWTOPIC|DENYTOPIC][VIEW|CHANGE|CREATE|...] = [something]". # rhk: When it finds such a line, it sets: # rhk: $1 to ALLOWTOPIC or DENYTOPIC # rhk: $theAccessType to VIEW, CHANGE, CREATE, or ??? (With respect to this, note that patterns are processed as double-quoted strings, so normal double quoted-interpolations will work (I hate that word in the Perl context), so $theAccessType is interpreted as a variable name. (A $ "followed by a vertical bar, a closing parenthesis, or the end of the string" is "interpreted as an end-of-line assertion". # rhk: $2 to something (The string matched by (.*) after the =\s) -- this should be a username, groupname, (or list of user and group names ??). # rhk: Is this a significant drag on TWiki response? Will ALLOWTOPIC and DENYTOPIC become metadata? (Would that help?) # rhk: (I don't know, but I am surprised by the poor response I get at home from my local server -- it seems no faster, and maybe even slower than access to TWiki and WikiLearn on SourceForge -- is this one of the causes? Maybe not -- the slowest operation seems to be saving a topic after a preview.) # rhk: Not only do I think I might qualify for a PhD in regular expressions, but I might be able to use my comments to one regular expression as my thesis. if( /^\s+\*\sSet\s(ALLOWTOPIC|DENYTOPIC)$theAccessType\s*\=\s*(.*)/ ) { # rhk: If (the match is successful and) $2 is set (not "") if( $2 ) { my $allowOrDeny = $1; # "ALLOWTOPIC" or "DENYTOPIC" # rhk: This next line is interesting -- where and how did $_ (the default variable??) get set to a list of users? (Or initialized to a null list of users?) Or is this done in the function getUsersOfGroup? my @tmpList = map { getUsersOfGroup( $_ ) } prvGetUserList( $2 ); ##my $tmp = join( ', ', @tmpList ); ##&TWiki::writeDebug( " Topic $allowOrDeny$theAccessType: {$tmp}" ); if( $allowOrDeny eq "DENYTOPIC" ) { @denyList = @tmpList; } else { @allowList = @tmpList; } } } } # if empty, get access permissions from preferences if( ! @denyList ) { my $tmpVal = &TWiki::Prefs::getPreferencesValue( "DENYWEB$theAccessType" ); @denyList = map { getUsersOfGroup( $_ ) } prvGetUserList( $tmpVal ); ##my $tmp = join( ', ', @denyList ); ##&TWiki::writeDebug( " Prefs DENYWEB$theAccessType: {$tmp}" ); } if( ! @allowList ) { my $tmpVal = &TWiki::Prefs::getPreferencesValue( "ALLOWWEB$theAccessType" ); @allowList = map { getUsersOfGroup( $_ ) } prvGetUserList( $tmpVal ); ##my $tmp = join( ', ', @allowList ); ##&TWiki::writeDebug( " Prefs ALLOWWEB$theAccessType: {$tmp}" ); } # access permission logic if( @denyList ) { if( grep { /^$theUserName$/ } @denyList ) { # user is on deny list ##&TWiki::writeDebug( " return 0, user is on deny list" ); return 0; } } if( @allowList ) { if( grep { /^$theUserName$/ } @allowList ) { # user is on allow list ##&TWiki::writeDebug( " return 1, user is on allow list" ); return 1; } else { # user is not on allow list ##&TWiki::writeDebug( " return 0, user is not on allow list" ); return 0; } } # allow is undefined, so grant access ##&TWiki::writeDebug( " return 1, allow is undefined" ); return 1; } # ========================= sub userIsInGroup { my( $theUserName, $theGroupTopicName ) = @_; my $usrTopic = prvGetWebTopicName( $TWiki::mainWebname, $theUserName ); my $grpTopic = prvGetWebTopicName( $TWiki::mainWebname, $theGroupTopicName ); my @grpMembers = (); if( $grpTopic !~ /.*Group$/ ) { # not a group, so compare user to user push( @grpMembers, $grpTopic ); } elsif( ( %allGroups ) && ( exists $allGroups{ $grpTopic } ) ) { # group is allready known @grpMembers = @{ $allGroups{ $grpTopic } }; } else { @grpMembers = prvGetUsersOfGroup( $grpTopic, 1 ); } my $isInGroup = grep { /^$usrTopic$/ } @grpMembers; return $isInGroup; } # ========================= sub getUsersOfGroup { my( $theGroupTopicName ) = @_; return prvGetUsersOfGroup( $theGroupTopicName, 1 ); } # ========================= sub prvGetUsersOfGroup { my( $theGroupTopicName, $theFirstCall ) = @_; my @resultList = (); # extract web and topic name my $topic = $theGroupTopicName; my $web = $TWiki::mainWebname; $topic =~ /^([^\.]*)\.(.*)$/; if( $2 ) { $topic = $2; $web = $1; } if( $topic !~ /.*Group$/ ) { # return user, is not a group return ( "$web.$topic" ); } # check if group topic is already processed if( $theFirstCall ) { @processedGroups = (); } elsif( grep { /^$web\.$topic$/ } @processedGroups ) { # do nothing, already processed return (); } push( @processedGroups, "$web\.$topic" ); # read topic my $text = &TWiki::Store::readWebTopic( $web, $topic ); # reset variables, defensive coding needed for recursion (my $baz = "foo") =~ s/foo//; # extract users my $user = ""; my @glist = (); ### rhk: Uncomment the next line -- again, the $ in the next line messes up KWrite's syntax highlighting. # foreach( split( /\n/, $text ) ) { if( /^\s+\*\sSet\sGROUP\s*\=\s*(.*)/ ) { if( $1 ) { @glist = prvGetUserList( $1 ); } } } foreach( @glist ) { if( /.*Group$/ ) { # $user is actually a group my $group = $_; if( ( %allGroups ) && ( exists $allGroups{ $group } ) ) { # allready known, so add to list push( @resultList, @{ $allGroups{ $group } } ); } else { # call recursively my @userList = prvGetUsersOfGroup( $group, 0 ); # add group to allGroups hash $allGroups{ $group } = [ @userList ]; push( @resultList, @userList ); } } else { # add user to list push( @resultList, $_ ); } } return @resultList; } # ========================= sub prvGetWebTopicName { my( $theWebName, $theTopicName ) = @_; $theTopicName =~ s/%MAINWEB%/$theWebName/go; $theTopicName =~ s/%TWIKIWEB%/$theWebName/go; if( $theTopicName =~ /[\.]/ ) { $theWebName = ""; # to suppress warning } else { $theTopicName = "$theWebName\.$theTopicName"; } return $theTopicName; } # ========================= sub prvGetUserList { my( $theItems ) = @_; # comma delimited list of users or groups # i.e.: "%MAINWEB%.UserA, UserB, Main.UserC # something else" $theItems =~ s/(<[^>]*>)//go; # Remove HTML tags $theItems =~ s/\s*([a-zA-Z0-9_\.\,\s\%]*)\s*(.*)/$1/go; # Limit list my @list = map { prvGetWebTopicName( $TWiki::mainWebname, $_ ) } split( /[\,\s]+/, $theItems ); return @list; } # ========================= 1; # EOF # # TWiki WikiClone (see wiki.pm for $wikiversion and other info) # # Copyright (C) 1999, 2000 Peter Thoeny, peter@thoeny.com # # 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, published at # http://www.gnu.org/copyleft/gpl.html # # Notes: # - Latest version at http://twiki.org/ # - Installation instructions in $dataDir/Main/TWikiDocumentation.txt # - Customize variables in TWiki.cfg when installing TWiki. # - Optionally change TWiki.cfg for custom extensions of rendering rules. # - Files wiki[a-z]+.pm are included by TWiki.pm # - Upgrading TWiki is easy as long as you do not customize TWiki.pm. # - Check web server error logs for errors, i.e. % tail /var/log/httpd/error_log # # 20000917 - NicholasLee : Split file/storage related functions from wiki.pm # package TWiki::Store; use strict; ##use vars qw( ## $revCoCmd $revCiCmd $revCiDateCmd $revHistCmd $revInfoCmd ## $revDiffCmd $revDelRevCmd $revUnlockCmd $revLockCmd ##); # ========================= # Given a full topic name, split into Web and Topic # e.g. Test.TestTopic1 -> ("Test", "TestTopic1") # rhk: Too easy, Drill Seargent! sub getWebTopic { my( $fullTopic ) = @_; $fullTopic =~ m|^([^.]+)[./](.*)$|; my $web = $1; my $topic = $2; return ($web, $topic ); } # ========================= # Get full filename for attachment or topic, untaint sub getFileName { my( $web, $topic, $attachment, $extension ) = @_; if( ! $attachment ) { $attachment = ""; } my $file = ""; if( ! $attachment ) { if( ! $extension ) { $extension = ".txt"; } $file = "$TWiki::dataDir/$web/$topic$extension"; # rhk: What does $TWiki::dataDir refer to? # rhk: Is it the variable $dataDir in TWiki.pm, the one listed in the "use vars" statement? -- Yeah, I bet it is! } else { $file = "$TWiki::pubDir/$web/$topic/$attachment$extension"; } ## !!! clean up an ..s etc in $web and $topic # rhk: What is "an ..s"? # rhk: and, I don't really understand tainting other than it tries to avoid hazardous user input (from the 'net). $file =~ /(.*)/; $file = $1; # untaint return $file; } # ========================= # Get directory that topic or attachment lives in sub getFileDir { my( $web, $topic, $attachment ) = @_; my $dir = ""; if( ! $attachment ) { $dir = "$TWiki::dataDir/$web"; } else { $dir = "$TWiki::pubDir/$web/$topic"; } ## !!! clean up an ..s etc in $web and $topic $dir =~ /(.*)/; $dir = $1; # untaint return $dir; } # ========================= # List Webs - JohnTalintyre 26 Feb 2001 # Sub webs returned in format Top.Sub sub listWebs { my $baseDir = &TWiki::getDataDir(); # Directories within this opendir( DIR, $baseDir ) || warn "can't opendir $baseDir: $!"; my @dirs = grep { /^[^.]/ && -d "$baseDir/$_" } readdir( DIR ); closedir DIR; return @dirs; } # ========================= # Get rid a topic and its attachments completely # Use with GREAT CARE as file will be gone, including RCS history sub erase { my( $web, $topic ) = @_; my $file = getFileName( $web, $topic ); my $rcsFile = "$file,v"; my @files = ( $file, $rcsFile ); unlink( @files ); # Delete all attachments and the attachment directory my $attDir = "$TWiki::pubDir/$web/$topic"; if( -e $attDir ) { opendir( DIR, $attDir ); my @attachments = readdir( DIR ); closedir( DIR ); my $attachment; foreach $attachment ( @attachments ) { if( $attachment !~ /^\./ ) { unlink( "$attDir/$attachment" ) || warn "Couldn't remove $attDir/$attachment"; if( $attachment !~ /,v$/ ) { writeLog( "erase", "$web.$topic.$attachment" ); } } } rmdir( "$attDir" ) || warn "Couldn't remove directory $attDir"; } writeLog( "erase", "$web.$topic", "" ); } # ========================= # Rename a Web, allow for transfer between Webs sub renameTopic { my( $oldWeb, $oldTopic, $newWeb, $newTopic ) = @_; #!!!check lock # Change data file my $from = getFileName( $oldWeb, $oldTopic ); my $to = getFileName( $newWeb, $newTopic ); rename( $from, $to ); # Remove lock file lockTopicNew( $oldWeb, $oldTopic, 1 ); # Change data file history rename( getFileName( $oldWeb, $oldTopic, "", ".txt,v" ), getFileName( $newWeb, $newTopic, "", ".txt,v" ) ); # Rename the attachment directory if there is one my $oldAttachDir = getFileDir( $oldWeb, $oldTopic, 1 ); if( $oldAttachDir ) { rename( $oldAttachDir, getFileDir( $newWeb, $newTopic, 1 ) ); } # Log rename if( $TWiki::doLogRename ) { writeLog( "rename", "$oldWeb.$oldTopic -> $newWeb.$newTopic", "" ); } } # ========================= # Read a specific version of a topic # view: $text= &TWiki::Store::readVersion( $topic, "1.$rev" ); sub readVersion { my( $theTopic, $theRev ) = @_; my $tmp= $TWiki::revCoCmd; my $fileName = "$TWiki::dataDir/$TWiki::webName/$theTopic.txt"; $tmp =~ s/%FILENAME%/$fileName/; $tmp =~ s/%REVISION%/$theRev/; $tmp =~ /(.*)/; $tmp = $1; # now safe, so untaint variable return `$tmp`; } # ========================= # rdiff: $maxrev = &TWiki::Store::getRevisionNumber( $topic ); # view: $maxrev = &TWiki::Store::getRevisionNumber( $topic ); sub getRevisionNumber { my( $theTopic, $theWebName ) = @_; return getRevisionNumberNew( $theWebName, $theTopic, "" ); } # ========================= # Latest reviewion number sub getRevisionNumberNew { my( $theWebName, $theTopic, $attachment ) = @_; if( ! $theWebName ) { $theWebName = $TWiki::webName; } my $tmp= $TWiki::revHistCmd; my $fileName = ""; if( ! $attachment ) { $fileName = "$TWiki::dataDir/$theWebName/$theTopic.txt"; } else { $fileName = "$TWiki::pubDir/$theWebName/$theTopic/$attachment"; } &TWiki::writeDebug( "getRevisionNumberNew: fileName: $fileName" ); if( ! -e "$fileName,v" ) { return ""; # JET !!! previously 1.1, why? } $tmp =~ s/%FILENAME%/$fileName/; $tmp =~ /(.*)/; $tmp = $1; # now safe, so untaint variable $tmp = `$tmp`; $tmp =~ /head: (.*?)\n/; if( ( $tmp ) && ( $1 ) ) { return $1; } else { return "1.1"; # !!!ever get here? } } # ========================= # rdiff: $text = &TWiki::Store::getRevisionDiff( $topic, "1.$r2", "1.$r1" ); sub getRevisionDiff { my( $topic, $rev1, $rev2 ) = @_; my $tmp= ""; if ( $rev1 eq "1.1" && $rev2 eq "1.1" ) { my $text = readVersion($topic, 1.1); # bug fix 19 Feb 1999 $tmp = "1a1\n"; foreach( split( /\n/, $text ) ) { $tmp = "$tmp> $_\n"; } } else { $tmp= $TWiki::revDiffCmd; $tmp =~ s/%REVISION1%/$rev1/; $tmp =~ s/%REVISION2%/$rev2/; my $fileName = "$TWiki::dataDir/$TWiki::webName/$topic.txt"; $fileName =~ s/$TWiki::securityFilter//go; $tmp =~ s/%FILENAME%/$fileName/; $tmp =~ /(.*)/; $tmp = $1; # now safe, so untaint variable $tmp = `$tmp`; } return "$tmp"; } # ========================= # rdiff: my( $date, $user ) = &TWiki::Store::getRevisionInfo( $topic, "1.$rev", 1 ); # view: my( $date, $user ) = &TWiki::Store::getRevisionInfo( $topic, "1.$rev", 1 ); # wikisearch.pm: my ( $revdate, $revuser, $revnum ) = &TWiki::Store::getRevisionInfo( $filename, "", 1, $thisWebName ); sub getRevisionInfo { my( $theTopic, $theRev, $changeToIsoDate, $theWebName) = @_; return getRevisionInfoNew($theTopic, $theRev, $changeToIsoDate, $theWebName, ""); } # ========================= sub getRevisionInfoNew { my( $theTopic, $theRev, $changeToIsoDate, $theWebName, $attachment ) = @_; if( ! $theWebName ) { $theWebName = $TWiki::webName; } if( ! $theRev ) { # PTh 03 Nov 2000: comment out for performance ### $theRev = getRevisionNumber( $theTopic, $theWebName ); $theRev = ""; # do a "rlog -r filename" to get top revision info } my $tmp= $TWiki::revInfoCmd; $theRev =~ s/$TWiki::securityFilter//go; $theRev =~ /(.*)/; $theRev = $1; # now safe, so untaint variable $tmp =~ s/%REVISION%/$theRev/; my $fileName = getFileName( $theWebName, $theTopic, $attachment ); $fileName =~ s/$TWiki::securityFilter//go; $fileName =~ /(.*)/; $fileName = $1; # now safe, so untaint variable $tmp =~ s/%FILENAME%/$fileName/; $tmp = `$tmp`; $tmp =~ /date: (.*?); author: (.*?);/; my $date = $1; my $user = $2; $tmp =~ /revision 1.([0-9]*)/; my $rev = $1; if( ! $user ) { # repository file is missing or corrupt, use file timestamp $user = $TWiki::defaultUserName; $date = (stat "$fileName")[9] || 600000000; my @arr = gmtime( $date ); # format to RCS date "2000.12.31.23.59.59" $date = sprintf( "%.4u.%.2u.%.2u.%.2u.%.2u.%.2u", $arr[5] + 1900, $arr[4] + 1, $arr[3], $arr[2], $arr[1], $arr[0] ); $rev = 1; } if( $changeToIsoDate ) { # change date to ISO format $tmp = $date; # try "2000.12.31.23.59.59" format $tmp =~ /(.*?)\.(.*?)\.(.*?)\.(.*?)\.(.*?)\.[0-9]/; if( $5 ) { $date = "$3 $TWiki::isoMonth[$2-1] $1 - $4:$5"; } else { # try "2000/12/31 23:59:59" format $tmp =~ /(.*?)\/(.*?)\/(.*?) (.*?):[0-9][0-9]$/; if( $4 ) { $date = "$3 $TWiki::isoMonth[$2-1] $1 - $4"; } } } return ( $date, $user, $rev ); } # ========================= sub topicIsLockedBy # was topicIsLockedNew { my( $theWeb, $theTopic ) = @_; # pragmatic approach: Warn user if somebody else pressed the # edit link within one hour my $lockFilename = "$TWiki::dataDir/$theWeb/$theTopic.lock"; #!!!use file generation method if( ( -e "$lockFilename" ) && ( $TWiki::editLockTime > 0 ) ) { my $tmp = readFile( $lockFilename ); my( $lockUser, $lockTime ) = split( /\n/, $tmp ); if( $lockUser ne $TWiki::userName ) { # time stamp of lock within one hour of current time? my $systemTime = time(); # calculate remaining lock time in seconds $lockTime = $lockTime + $TWiki::editLockTime - $systemTime; if( $lockTime > 0 ) { # must warn user that it is locked return( $lockUser, $lockTime ); } } } return( "", 0 ); } # ========================= sub saveTopic { my( $topic, $text, $saveCmd, $doUnlock, $dontNotify, $dontLogSave ) = @_; # my( $topic, $text, $saveCmd, $doNotLogChanges, $doUnlock ) = @_; my $attachment = ""; save( $TWiki::webName, $topic, $text, $saveCmd, $attachment, $dontLogSave, $doUnlock, $dontNotify ); } # ========================= sub save { my( $web, $topic, $text, $saveCmd, $attachment, $dontLogSave, $doUnlock, $dontNotify ) = @_; my $name = getFileName( $web, $topic, $attachment ); my $dir = getFileDir( $web, $topic, $attachment ); my $time = time(); my $tmp = ""; my $rcsError = ""; if( $attachment ) { $dontLogSave = 1; #!!! } else { # RCS requires a newline for the last line, # so add newline if needed $text =~ s/([^\n\r])$/$1\n/os; } #### Normal Save if( ! $saveCmd ) { $saveCmd = ""; # get time stamp of existing file my $mtime1 = 0; my $mtime2 = 0; if( -e $name ) { my( $tmp1,$tmp2,$tmp3,$tmp4,$tmp5,$tmp6,$tmp7,$tmp8,$tmp9, $tmp10,$tmp11,$tmp12,$tmp13 ) = stat $name; $mtime1 = $tmp10; } if( ! $attachment ) { # save file &TWiki::writeDebug( "save: web: $web, name: $name, topic: $topic" ); saveFile( $name, $text ); # reset lock time, this is to prevent contention in case of a long edit session lockTopicNew( $web, $topic, $doUnlock ); } # time stamp of existing file within one hour of old one? my( $tmp1,$tmp2,$tmp3,$tmp4,$tmp5,$tmp6,$tmp7,$tmp8,$tmp9, $tmp10,$tmp11,$tmp12,$tmp13 ) = stat $name; $mtime2 = $tmp10; if( abs( $mtime2 - $mtime1 ) < $TWiki::editLockTime ) { my $rev = getRevisionNumberNew( $web, $topic, $attachment ); my( $date, $user ) = getRevisionInfoNew( $topic, $rev, "", $web, $attachment ); # same user? if( ( $TWiki::doKeepRevIfEditLock ) && ( $user eq $TWiki::userName ) ) { # replace last repository entry $saveCmd = "repRev"; #!!! if( $attachment ) { $saveCmd = ""; } } } if( $saveCmd ne "repRev" ) { # If attachment and RCS file doesn't exist, initialise if( $attachment ) { my $rcsFile = getFileName( $web, $topic, $attachment, 1 ); if( ! -e $rcsFile ) { $tmp = $TWiki::revInitBinaryCmd; $tmp =~ s/%USERNAME%/$TWiki::userName/; $tmp =~ s/%FILENAME%/$name/; $tmp =~ /(.*)/; $tmp = $1; # safe, so untaint variable &TWiki::writeDebug( "save: Init RCS file" ); `$tmp`; } } # update repository $tmp= $TWiki::revCiCmd; $tmp =~ s/%USERNAME%/$TWiki::userName/; $tmp =~ s/%FILENAME%/$name/; $tmp =~ /(.*)/; $tmp = $1; # safe, so untaint variable $rcsError = `$tmp 2>&1 1>/dev/null`; # capture stderr (S.Knutson) $rcsError =~ s/^Warning\: missing newline.*//os; # forget warning if( $rcsError ) { # oops, stderr was not empty, return error $rcsError = "$tmp\n$rcsError"; return $rcsError; } if( ! $dontNotify ) { # update .changes my( $fdate, $fuser, $frev ) = getRevisionInfo( $topic, "" ); $fdate = ""; # suppress warning $fuser = ""; # suppress warning my @foo = split( /\n/, &readFile( "$TWiki::dataDir/$TWiki::webName/.changes" ) ); if( $#foo > 100 ) { shift( @foo); } push( @foo, "$topic\t$TWiki::userName\t$time\t$frev" ); open( FILE, ">$TWiki::dataDir/$TWiki::webName/.changes" ); print FILE join( "\n", @foo )."\n"; close(FILE); } if( ( $TWiki::doLogTopicSave ) && ! ( $dontLogSave ) ) { # write log entry writeLog( "save", "$TWiki::webName.$topic", "" ); } } } #### Replace Revision Save if( $saveCmd eq "repRev" ) { # fix topic by replacing last revision # save file saveFile( $name, $text ); lockTopic( $topic, $doUnlock ); # update repository with same userName and date, but do not update .changes my $rev = getRevisionNumberNew( $web, $topic, $attachment ); my( $date, $user ) = getRevisionInfoNew( $topic, $rev, "", $web, $attachment ); if( $rev eq "1.1" ) { # initial revision, so delete repository file and start again unlink "$name,v"; } else { # delete latest revision (unlock, delete revision, lock) $tmp= $TWiki::revUnlockCmd; $tmp =~ s/%FILENAME%/$name/go; $tmp =~ /(.*)/; $tmp = $1; # safe, so untaint variable $rcsError = `$tmp 2>&1 1>/dev/null`; # capture stderr (S.Knutson) $rcsError =~ s/^Warning\: missing newline.*//os; # forget warning if( $rcsError ) { # oops, stderr was not empty, return error $rcsError = "$tmp\n$rcsError"; return $rcsError; } $tmp= $TWiki::revDelRevCmd; $tmp =~ s/%REVISION%/$rev/go; $tmp =~ s/%FILENAME%/$name/go; $tmp =~ /(.*)/; $tmp = $1; # safe, so untaint variable $rcsError = `$tmp 2>&1 1>/dev/null`; # capture stderr (S.Knutson) $rcsError =~ s/^Warning\: missing newline.*//os; # forget warning if( $rcsError ) { # oops, stderr was not empty, return error $rcsError = "$tmp\n$rcsError"; return $rcsError; } $tmp= $TWiki::revLockCmd; $tmp =~ s/%REVISION%/$rev/go; $tmp =~ s/%FILENAME%/$name/go; $tmp =~ /(.*)/; $tmp = $1; # safe, so untaint variable $rcsError = `$tmp 2>&1 1>/dev/null`; # capture stderr (S.Knutson) $rcsError =~ s/^Warning\: missing newline.*//os; # forget warning if( $rcsError ) { # oops, stderr was not empty, return error $rcsError = "$tmp\n$rcsError"; return $rcsError; } } $tmp = $TWiki::revCiDateCmd; $tmp =~ s/%DATE%/$date/; $tmp =~ s/%USERNAME%/$user/; $tmp =~ s/%FILENAME%/$name/; $tmp =~ /(.*)/; $tmp = $1; # safe, so untaint variable $rcsError = `$tmp 2>&1 1>/dev/null`; # capture stderr (S.Knutson) $rcsError =~ s/^Warning\: missing newline.*//os; # forget warning if( $rcsError ) { # oops, stderr was not empty, return error $rcsError = "$tmp\n$rcsError"; return $rcsError; } if( ( $TWiki::doLogTopicSave ) && ! ( $dontLogSave ) ) { # write log entry $tmp = &TWiki::userToWikiName( $user ); writeLog( "save", "$TWiki::webName.$topic", "repRev $rev $tmp $date" ); } } #### Delete Revision if( $saveCmd eq "delRev" ) { # delete last revision # delete last entry in repository (unlock, delete revision, lock operation) my $rev = getRevisionNumber( $topic ); if( $rev eq "1.1" ) { # can't delete initial revision return; } $tmp= $TWiki::revUnlockCmd; $tmp =~ s/%FILENAME%/$name/go; $tmp =~ /(.*)/; $tmp = $1; # safe, so untaint variable $rcsError = `$tmp 2>&1 1>/dev/null`; # capture stderr (S.Knutson) $rcsError =~ s/^Warning\: missing newline.*//os; # forget warning if( $rcsError ) { # oops, stderr was not empty, return error $rcsError = "$tmp\n$rcsError"; return $rcsError; } $tmp= $TWiki::revDelRevCmd; $tmp =~ s/%REVISION%/$rev/go; $tmp =~ s/%FILENAME%/$name/go; $tmp =~ /(.*)/; $tmp = $1; # safe, so untaint variable $rcsError = `$tmp 2>&1 1>/dev/null`; # capture stderr (S.Knutson) $rcsError =~ s/^Warning\: missing newline.*//os; # forget warning if( $rcsError ) { # oops, stderr was not empty, return error $rcsError = "$tmp\n$rcsError"; return $rcsError; } $tmp= $TWiki::revLockCmd; $tmp =~ s/%REVISION%/$rev/go; $tmp =~ s/%FILENAME%/$name/go; $tmp =~ /(.*)/; $tmp = $1; # safe, so untaint variable $rcsError = `$tmp 2>&1 1>/dev/null`; # capture stderr (S.Knutson) $rcsError =~ s/^Warning\: missing newline.*//os; # forget warning if( $rcsError ) { # oops, stderr was not empty, return error $rcsError = "$tmp\n$rcsError"; return $rcsError; } # restore last topic from repository $rev = getRevisionNumber( $topic ); $tmp = readVersion( $topic, $rev ); saveFile( $name, $tmp ); lockTopic( $topic, $doUnlock ); # delete entry in .changes : To Do ! if( $TWiki::doLogTopicSave ) { # write log entry writeLog( "cmd", "$TWiki::webName.$topic", "delRev $rev" ); } } return 0; # all is well } # ========================= sub writeLog { my( $action, $webTopic, $extra, $user ) = @_; # use local time for log, not UTC (gmtime) my ( $sec, $min, $hour, $mday, $mon, $year ) = localtime( time() ); my( $tmon) = $TWiki::isoMonth[$mon]; $year = sprintf( "%.4u", $year + 1900 ); # Y2K fix my $time = sprintf( "%.2u ${tmon} %.2u - %.2u:%.2u", $mday, $year, $hour, $min ); my $yearmonth = sprintf( "%.4u%.2u", $year, $mon+1 ); my $wuserName = $user || $TWiki::userName; $wuserName = &TWiki::userToWikiName( $wuserName ); my $remoteAddr = $ENV{'REMOTE_ADDR'} || ""; my $text = "| $time | $wuserName | $action | $webTopic | $extra | $remoteAddr |"; my $filename = $TWiki::logFilename; $filename =~ s/%DATE%/$yearmonth/go; open( FILE, ">>$filename"); print FILE "$text\n"; close( FILE); } # ========================= sub saveFile { my( $name, $text ) = @_; open( FILE, ">$name" ) or warn "Can't create file $name\n"; print FILE $text; close( FILE); } # ========================= sub lockTopic { my ( $name, $doUnlock ) = @_; lockTopicNew( $TWiki::webName, $name, $doUnlock ); } # ========================= sub lockTopicNew { my( $web, $name, $doUnlock ) = @_; my $lockFilename = getFileName( $web, $name, "", ".lock" ); if( $doUnlock ) { unlink "$lockFilename"; } else { my $lockTime = time(); saveFile( $lockFilename, "$TWiki::userName\n$lockTime" ); } } # ========================= sub removeObsoleteTopicLocks { my( $web ) = @_; # Clean all obsolete .lock files in a web. # This should be called regularly, best from a cron job (called from mailnotify) my $webDir = "$TWiki::dataDir/$web"; opendir( DIR, "$webDir" ); my @fileList = grep /\.lock$/, readdir DIR; closedir DIR; my $file = ""; my $pathFile = ""; my $lockUser = ""; my $lockTime = ""; my $systemTime = time(); foreach $file ( @fileList ) { $pathFile = "$webDir/$file"; $pathFile =~ /(.*)/; $pathFile = $1; # untaint file ( $lockUser, $lockTime ) = split( /\n/, readFile( "$pathFile" ) ); if( ! $lockTime ) { $lockTime = ""; } # time stamp of lock over one hour of current time? if( abs( $systemTime - $lockTime ) > $TWiki::editLockTime ) { # obsolete, so delete file unlink "$pathFile"; } } } # ========================= sub webExists { my( $theWeb ) = @_; return -e "$TWiki::dataDir/$theWeb"; } # ========================= sub topicExists { my( $theWeb, $theName ) = @_; return -e "$TWiki::dataDir/$theWeb/$theName.txt"; } # ========================= sub readTopic { my( $theName ) = @_; return &readFile( "$TWiki::dataDir/$TWiki::webName/$theName.txt" ); } # ========================= sub readWebTopic { my( $theWeb, $theName ) = @_; return &readFile( "$TWiki::dataDir/$theWeb/$theName.txt" ); } # ========================= sub readTemplate # rhk: Now that I've gone through this entire sub line-by-line, I should write a brief summary. # rhk: I guess I don't think I like the name -- the sub actually searches for the appropriate template (what is now called $theName -- view, preview, edit, etc., which is not intuitive either -- suggestions several lines below) # rhk: Would "findTemplate" be better? getTemplate, findAndGetTemplate, findAndReadTemplate, seekTemplate, ?? # rhk: readTemplate accepts up to three parameters, then searches possible locations and names for templates in a specified order, and returns the most appropriate template. # rhk: The three parameters: # rhk: $theName -- view, edit, preview, etc. -- the TWiki "function" that the template is used for # rhk: $theTopic -- the specific topic for which a template is needed, if known # rhk: $theSkin -- the specific skin to be used, if a skin is in use or specified # rhk: The search locations: # rhk: .../<twiki_dir>/template -- for generic templates which apply to any web # rhk: .../<twiki_dir>/template/<Webname> -- for templates specific to a web # rhk: hmmm! the Webname is not passed as a parameter -- but would I call it a global? It is called as $TWiki::webname (and the twikiTemplateDir is handled the same way) -- any reason they should be parameters?? # rhk: Both directories are searched for all possible template candidates of the form $theName.<optional_topic><optional_skin>tmpl (with periods at the appropriate places), and these candidates are put in a list # rhk: Then a "best candidate" is picked from the list using these priorities: # rhk: (The general rule is to return the best (most specific) match # rhk: .../templates/$TWiki::webName/$theName.$theTopic.tmpl # rhk: .../templates/$TWiki::webName/$theName.$theSkin.tmpl # rhk: .../templates/$TWiki::webName/$theName.$theTopic.$theSkin.tmpl # rhk: Shouldn't this be the first choice? # rhk: .../templates/$TWiki::webName/$theName.tmpl # rhk: .../templates/$theName.$theTopic.tmpl # rhk: .../templates/$theName.$theSkin.tmpl # rhk: .../templates/$theName.$theTopic.$theSkin.tmpl # rhk: Shouldn't this be higher priority than the previous two? # rhk: .../templates/$theName.tmpl # rhk: If no other candidates, return "" # rhk: Note, before using $theName, $theTopic, and $theSkin, they are checked against a (the) security filter for characters like / \ ? * <control_characters> etc. { # rhk: The @_ is a strange thing, known also as $ARG or the default argument(?). It is used by default under some circumstances, but I'm not clear on those circumstances. In this case, this appears to be part of the (a?) standard Perl approach to passing parameters to/from a subroutine. # rhk: The subroutine call (in one case -- a single parameter) looks like this: $tmpl= &TWiki::Store::readTemplate( "noweb" ); # rhk: Apparently, the parameter(s) in parenthesis are stuffed into the array @_ by magic # rhk: Here, then, the local my variables (oops, need to think about this -- are these three local variables, or could they be more than local variables that just happen to be in a local unnamed array consisting of these three variables?) are initialized with the values passed in the @_ array (by position). # rhk: Later I will look at how a parameter or return value is passed back. my( $theName, $theTopic, $theSkin ) = @_; # rhk: Oops, I was going to assume that if only one parameter was passed, the others would be "null" -- apparently not the case or the next two lines would not be required. # rhk: Re the above, maybe this would not be an issue if some level of checking was turned off (don't invoke the program with -wall), but I think that would be a mistake. $theTopic = "" unless $theTopic; # prevent 'uninitialized value' ... $theSkin = "" unless $theSkin; # ... warnings # rhk: Aside: I don't like $theName for the "template type" -- brainstorming about alternates: # rhk: $templateType, $templateName, $templateFunction, ??? # rhk: Now I have to go look at sub securityFilter in TWiki.pm # rhk: Oops, it's not a sub, it's a variable, in fact it's a string that is a pattern, that includes many characters like \,*,?,^, and it looks like any control characters (ASCII 0 to 32). # rhk: How could I have known it was a variable instead of a sub before going to look for it? What clue tells me that? # rhk: Ahha, looks like it's the $ (for a string variable) vs. a & (for a sub) in front of the TWiki -- I guess there could also be the other Perl type indicators, like @ for array, and (??) for hash # CrisBailiff, PeterThoeny 13 Jun 2000: Add security $theName =~ s/$TWiki::securityFilter//go; # zap anything suspicious $theName =~ s/\.+/\./g; # Filter out ".." from filename $theTopic =~ s/$TWiki::securityFilter//go; # zap anything suspicious $theTopic =~ s/\.+/\./g; # Filter out ".." from filename $theSkin =~ s/$TWiki::securityFilter//go; # zap anything suspicious $theSkin =~ s/\.+/\./g; # Filter out ".." from filename # rhk: As I've learned already, you have to read regular expressions carefully -- the \.+ means that it is matching one or more periods -- if it was just . it would match everything/anything (I think) my $tmplFile = ""; # search first in twiki/templates/Web dir # for file script(.topic)(.skin).tmpl # rhk: One line at a time ... # rhk: Build the path for the Web specific template directory by concatenating the path for the generic template directory, a /, and the name of the (current??) web my $tmplDir = "$TWiki::templateDir/$TWiki::webName"; # rhk: "opens" the directory and sets up a "dirhandle" DIR (in a different namespace than filehandles) if( opendir( DIR, $tmplDir ) ) { # for performance use readdir, not a row of ( -e file ) # rhk: Next line uses grep to look for and create a list (array) of all templates in directory .../templates/Webname which match $theName.<anything>tmpl, which should make a list of all templates of this type ($theName -- view, edit, preview, etc.) in the template subdirectory for this web, with any topic name. # rhk: Note that this sounds a little inefficient to me -- not sure yet why we need the list dealing with all topics -- maybe I'll understand more later -- I need to remember that in this the subroutine was called with only one parameter. # rhk: Grep looks for $theName at the beginning of a string (filename), followed by a period, followed by anything, followed by "tmpl", and the $ is an anchor to the end of the line (like the caret is to the beginning of the line) -- in essence the caret and the $ together indicate that the pattern must match the entire string -- nothing left over. # rhk: If grep is successful, the successfully matched string is added to @filelist -- presumably it will only be successful for one filename at the most # rhk: (In a scalar context) grep also returns the number of times the expression was true # rhk: Ahha, now I have a glimmer of understanding what they mean by a scalar context -- see the if statement a few lines below this my @filelist = grep /^$theName\..*tmpl$/, readdir DIR; # close the directory because you're done with it closedir DIR; # rhk: Next line creates the name of a topic specific template file, in preparation to seeing if one exists. # rhk: If one exists, it would be named like: <templateType>.<TopicName>.tmpl, for example: view.TopicName.tmpl # rhk: It would be in the Web specific directory searched previously -- ahh, I screwed up above -- it may find several files -- need to fix the comments above $tmplFile = "$theName.$theTopic.tmpl"; # rhk: Now we search the file list created earlier looking for the template of the specified type for "this" specific topic (if specified in $theTopic) if( ! grep { /^$tmplFile$/ } @filelist ) { # rhk: If not found, then construct a template name for this type with the specified skin, and search for it $tmplFile = "$theName.$theSkin.tmpl"; if( ! grep { /^$tmplFile$/ } @filelist ) { # # rhk: If not found, then construct a template name for the specified function, the specified topic name, and the specified skin, and search for it $tmplFile = "$theName.$theTopic.$theSkin.tmpl"; if( ! grep { /^$tmplFile$/ } @filelist ) { # rhk: If not found, construct a template name for the specified function and search for it $tmplFile = "$theName.tmpl"; if( ! grep { /^$tmplFile$/ } @filelist ) { # rhk: If not found, set the template file name to "" $tmplFile = ""; } } } } # rhk: If a template was found (other than ""), concatenate the template directory to it to make a fully qualified filename if( $tmplFile ) { $tmplFile = "$tmplDir/$tmplFile"; } } # if not found, search in twiki/templates dir # rhk: What he said! -- following the same pattern of searches that we used in the tempates/Web directory $tmplDir = $TWiki::templateDir; if( ( ! $tmplFile ) && ( opendir( DIR, $tmplDir ) ) ) { my @filelist = grep /^$theName\..*tmpl$/, readdir DIR; closedir DIR; $tmplFile = "$theName.$theTopic.tmpl"; if( ! grep { /^$tmplFile$/ } @filelist ) { $tmplFile = "$theName.$theSkin.tmpl"; if( ! grep { /^$tmplFile$/ } @filelist ) { $tmplFile = "$theName.$theTopic.$theSkin.tmpl"; if( ! grep { /^$tmplFile$/ } @filelist ) { $tmplFile = "$theName.tmpl"; if( ! grep { /^$tmplFile$/ } @filelist ) { $tmplFile = ""; } } } } if( $tmplFile ) { $tmplFile = "$tmplDir/$tmplFile"; } } # read the template file # rhk: Finally (what he said!) -- Need to study this a little more -- I assume we're returning the contents of the template file, but I don't follow how we're doing it yet. # rhk: -e is a "file test operator" which tests whether the file exists, so # rhk: If the file exists, we call sub readFile and return it (is that a good way to phrase that?) if( -e $tmplFile ) { return &readFile( $tmplFile ); } # rhk: If the file doesn't exist, return "" (null, false, whatever) return ""; } # ========================= sub readFile # rhk: Read the entire contents of the specified filename (the only parameter) into a string and return the string. # rhk: Curious: is the string passed back in $_ ? { # rhk: Get the parameter and assign it to $name my( $name ) = @_; # rhk: Initialize $data (to "") my $data = ""; # rhk: Elsewhere in TWiki $/ (the record delimiter) is set to \n to read a line at a time. We want to read the whole file, so we need to undefine $/. undef $/; # set to read to EOF # rhk: Open the file named in $name for input (the <) with handle IN_FILE -- if the operation fails, quit and return "" open( IN_FILE, "<$name" ) || return ""; # rhk: Read the contents of the file with handle IN_FILE into $data $data = <IN_FILE>; # rhk: Restore $/ (to \n) for use elsewhere in TWiki # rhk: I think I see a subtle bug -- if this operation ever fails, $/ is not restored -- maybe I'm missing something -- maybe if it fails, this "instance" of TWiki is complete / dies, and the next instance of TWiki is OK? Not sure, probably won't figure this out soon. # rhk: I was going to say that maybe this is not a bug, because maybe nothing bad can ever happen as a result of this because of where this sub is called from, and one happens next. # rhk: But, after thinking about it a little, I think it is a bug. The intention of this subroutine seems to be to read the contents of the file (or fail to) and return the contents or a null string, and with no other side effects. # rhk: If the file is opened successfully, the contents is returned with no other side effect, but if it fails to open successfully, a null string is returned, and there is a side effect, $/ is left undefined. $/ = "\n"; # rhk: Close IN_FILE (You're definitely overdoing the comments now, Randy!) close( IN_FILE ); # rhk: and return the contents of the file return $data; } # ========================= sub readFileHead { my( $name, $maxLines ) = @_; my $data = ""; my $line; my $l = 0; $/ = "\n"; # read line by line open( IN_FILE, "<$name" ) || return ""; while( ( $l < $maxLines ) && ( $line = <IN_FILE> ) ) { $data .= $line; $l += 1; } close( IN_FILE ); return $data; } # ========================= #AS 5 Dec 2000 collect all Web's topic names sub getTopicNames { my( $web ) = @_ ; if( !defined $web ) { $web=""; } #FIXME untaint web name? # get list of all topics by scanning $dataDir opendir DIR, "$TWiki::dataDir/$web" ; my @tmpList = readdir( DIR ); closedir( DIR ); # this is not magic, it just looks like it. my @topicList = sort grep { s#^.+/([^/]+)\.txt$#$1# } grep { ! -d } map { "$TWiki::dataDir/$web/$_" } grep { ! /^\.\.?$/ } @tmpList; return @topicList ; } #/AS # ========================= #AS 5 Dec 2000 collect immediate subWeb names sub getSubWebs { my( $web ) = @_ ; if( !defined $web ) { $web=""; } #FIXME untaint web name? # get list of all subwebs by scanning $dataDir opendir DIR, "$TWiki::dataDir/$web" ; my @tmpList = readdir( DIR ); closedir( DIR ); # this is not magic, it just looks like it. my @webList = sort grep { s#^.+/([^/]+)$#$1# } grep { -d } map { "$TWiki::dataDir/$web/$_" } grep { ! /^\.\.?$/ } @tmpList; return @webList ; } #/AS # ========================= #AS 26 Dec 2000 recursively collects all Web names #FIXME: move var to TWiki.cfg ? use vars qw ($subWebsAllowedP); $subWebsAllowedP = 0; # 1 = subwebs allowed, 0 = flat webs sub getAllWebs { # returns a list of subweb names my( $web ) = @_ ; if( !defined $web ) { $web=""; } my @webList = map { s/^\///o; $_ } map { "$web/$_" } &getSubWebs( $web ); my $subWeb = ""; if( $subWebsAllowedP ) { my @subWebs = @webList; foreach $subWeb ( @webList ) { push @subWebs, &getAllWebs( $subWeb ); } return @subWebs; } return @webList ; } #/AS # ========================= 1; # EOF ##### for debug only: Remove next 2 comments (but redirect does not work) #open(STDERR,'>&STDOUT'); # redirect error to browser #$| = 1; # no buffering &main(); # rhk: Invoke the main subroutine sub main # rhk: subroutine main { my $tmpl = ""; my $text = ""; my $rev = $query->param( "rev" ); # rhk: The query object checks to see if there is a named parameter in the URL named "rev" -- if so it returns the value specified in the URL, if not it returns "" (?) my $maxrev = 1; my $extra = ""; my $wikiUserName = &TWiki::userToWikiName( $userName ); # rhk: Function userToWikiName in TWiki.pm is invoked which apparently converts the user name previously returned from $remote_user to the WikiName of the remote user. I guess my user name is rhkramer (??), my wiki name is RandyKramer. my $revdate = ""; my $revuser = ""; # rhk: Action if the specified web does not exist. (I really need to go and work my way through the functions in module Store -- I'll be back. # rhk: Get the "noweb" template # rhk: Add the topic name to the template # rhk: Display the template (in the browser, as HTML) if( ! &TWiki::Store::webExists( $webName ) ) { $tmpl= &TWiki::Store::readTemplate( "noweb" ); $tmpl = &TWiki::handleCommonTags( $tmpl, $topic ); print "Content-type: text/html\n\n"; print $tmpl; return; } Before or after importing TWiki files, you can add some things to the text files to make separating the files into nodes easier. Specifically, in front of, for example a subroutine named "sub example", insert the following lines: <> @code sub example { } Then, after importing the file into Leo (with <ctrl><shift>f), select everything including the first << to the last } (of a particular subroutine), and press Edit --> Edit Body --> Extract Section (<ctrl><shift>e) to create a node containing the selected text, with a heading <>, and deleting the selected text except for <> from the original node. (OK, tell people where to put the original node, and how to get it there.) package TWiki; # rhk: Declares that the "rest of the innermost enclosing block, subroutine, eval, or file belongs to the indicated namespace." (And I wholeheartedly agree ;-) (I think this was quoted from one of the Wall books.) use strict; Restricts use of unsafe Perl constructs for variables (must be declared, fully qualified, or imported), references (must not be symbolic), and subroutines (can't use a bareword identifier that's not a predeclared subroutine) -- I need to do more reading about this. use vars <list>; Predeclares the variables in the following list so that you can use them under "use strict" -- it also disables any typo warnings. May have something to do with delayed loading of subroutines. use vars qw( use Time::Local; Perl standard functions for computing time, using either GMT or local time. Based on number of seconds since 1/1/70 (overflow on 1/1/2038 on most machines). Don't know much yet, but generally allows one to tie a variable to a field in a database and such. Might also be much more general / capable than that. # ========================= See "subroutine calling idiom" sub userToWikiName { my( $loginUser, $dontAddWeb ) = @_; if( !$loginUser ) { return ""; } $loginUser =~ s/$securityFilter//go; my $wUser = $userToWikiList{ $loginUser } || $loginUser; if( $dontAddWeb ) { return $wUser; } return "$mainWebname.$wUser"; } See "subroutine calling idiom". The first three lines below illustrate one half of the typical Perl parameter passing mechanism. "@_" is the Perl "default variable", and, in fact, it is an array variable. It is used in many places, and if an operation is specified without a variable, the operation is performed on the default variable (without it appearing in the code). In the case of passing parameters to a subroutine, the @_ is explicit in the subroutine. Before the subroutine is called, the parameters to be passed are assigned (implicitly or explicitly) to the default variable (@_). The subroutine accesses those variables typically by a statement like my( "$loginUser, $dontAddWeb ) = @_;", which assigns the first value in @_ to $loginUser, and the second value to $dontAddWeb. There may be more values in @_ that are not used. Questions: * Do these values get removed from @_? (I suspect not.) * If these values are changed in the subroutine, are the changes passed back to the caller? (I suspect not, unless an appropriate assignment is made within the subroutine.) A sample subroutine: sub userToWikiName { my( $loginUser, $dontAddWeb ) = @_; if( !$loginUser ) { return ""; } $loginUser =~ s/$securityFilter//go; my $wUser = $userToWikiList{ $loginUser } || $loginUser; if( $dontAddWeb ) { return $wUser; } return "$mainWebname.$wUser"; } Based on the name, it seems clear that this subroutine is used to convert a "user name" to a WikiName. A WikiName is a WikiWord a user chooses as his "nickname" on TWiki. My WikiName is RandyKramer. A user name is the name returned from the CGI function RemoteUser??? I may or may not have a user name depending on several things mainly related to whether I am authenticated (or on an authenticated TWiki?). If I do have a user name, it is the name I used to log in on the LAN. On the Internet, I will not have a user name. (Need to consider how the special situations are handled -- are they handled in this subroutine or somewhere else -- things like "TWikiGuest" and remembering my WikiName based on my IP address, and ??) So, I'm guessing that this subroutine is only called if the RemoteUser or whatever returns a value, but I could be wrong (and that's why I'm working on reading the code). # ========================= sub userToWikiName { my( $loginUser, $dontAddWeb ) = @_; if( !$loginUser ) { return ""; } $loginUser =~ s/$securityFilter//go; my $wUser = $userToWikiList{ $loginUser } || $loginUser; if( $dontAddWeb ) { return $wUser; } return "$mainWebname.$wUser"; } @code # Configuration and custom extensions for wiki.pm of TWiki. # Notes: # - Latest version at http://twiki.org/ # - Installation instructions in $dataDir/TWiki/TWikiDocumentation.txt # - Customize variables in TWiki.cfg when installing TWiki. # - Optionally create a new plugin or customize DefaultPlugin.pm for # custom extensions of rendering rules. # - Upgrading TWiki is easy as long as you only customize DefaultPlugin.pm. @code # - Variables that can be accessed from topics (see details in # TWikiDocumentation.html) : # %TOPIC% name of current topic # %WEB% name of current web # %WIKIHOMEURL% link of top left icon # %SCRIPTURL% base TWiki script URL (place of view, edit...) # %SCRIPTURLPATH% like %SCRIPTURL%, but path only (cut protocol and domain) # %SCRIPTSUFFIX% script suffix (empty by default, ".pl" if required) # %PUBURL% public URL (root of attachment URL) # %PUBURLPATH% path of public URL # %ATTACHURL% attachment URL of current topic # %ATTACHURLPATH% path of attachment URL of current topic # %DATE% today's date # %WIKIVERSION% tool version # %USERNAME% login user name # %WIKIUSERNAME% wiki user name # %WIKITOOLNAME% tool name (TWiki) # %MAINWEB% main web name (Main) # %TWIKIWEB% TWiki system web name (TWiki) # %HOMETOPIC% home topic name (WebHome) # %NOTIFYTOPIC% notify topic name (WebNotify) # %WIKIUSERSTOPIC% user list topic name (TWikiUsers) # %WIKIPREFSTOPIC% site-level preferences topic name (TWikiPreferences) # %WEBPREFSTOPIC% web preferences topic name (WebPreferences) # %STATISTICSTOPIC statistics topic name (WebStatistics) # %INCLUDE{...}% server side include # %SEARCH{...}% inline search @code # variables that need to be changed when installing on a new server: # ================================================================== # %WIKIHOMEURL% : link of TWiki icon in upper left corner : $wikiHomeUrl = "http://your.domain.com/twiki"; # Host of TWiki URL : (Example "http://myhost.com:123") $defaultUrlHost = "http://your.domain.com"; # %SCRIPTURLPATH% : cgi-bin path of TWiki URL: $scriptUrlPath = "/twiki/bin"; # %PUBURLPATH% : Public data path of TWiki URL (root of attachments) : $pubUrlPath = "/twiki/pub"; # Public data directory, must match $pubUrlPath : $pubDir = "/home/httpd/twiki/pub"; # Template directory : $templateDir = "/home/httpd/twiki/templates"; # Data (topic files) root directory : $dataDir = "/home/httpd/twiki/data"; @code # FIGURE OUT THE OS WE'RE RUNNING UNDER - from CGI.pm # ================================================================== # Some systems support the $^O variable. If not # available then require() the Config library unless ($OS) { unless ($OS = $^O) { require Config; $OS = $Config::Config{'osname'}; } } if ($OS=~/Win/i) { $OS = 'WINDOWS'; } elsif ($OS=~/vms/i) { $OS = 'VMS'; } elsif ($OS=~/bsdos/i) { $OS = 'UNIX'; } elsif ($OS=~/dos/i) { $OS = 'DOS'; } elsif ($OS=~/^MacOS$/i) { $OS = 'MACINTOSH'; } elsif ($OS=~/os2/i) { $OS = 'OS2'; } else { $OS = 'UNIX'; } @code # variables that might need to be changed: # ================================================================== # Defines which attachments will be treated as ASCII in RCS $attachAsciiPath = "\.(txt|html|xml|pl)\$"; # %SCRIPTSUFFIX% : Suffix of TWiki Perl scripts (i.e. ".pl") : $scriptSuffix = ""; # Set ENV{'PATH'} explicitly for taint checks ( #!perl -T option ) : # (Note: PATH environment variable is not changed if set to "") # Unix separator is : Windows is ; $safeEnvPath = "/bin:/usr/bin"; # Mail program used in case Net::SMTP is not installed. # See also SMPTMAILHOST in TWikiPreferences. $mailProgram = "/usr/sbin/sendmail -t -oi -oeq"; # Prevent spambots from grabing addresses, default "". # I.e. set to "NOSPAM" to get "user@somewhereNOSPAM.com" $noSpamPadding = ""; # Pathname of mime types file that maps file suffixes to MIME types : # For Apache server set this to Apache's mime.types file pathname. # Default "$dataDir/mime.types" $mimeTypesFilename = "$dataDir/mime.types"; # RCS directory (find out by 'which rcs') : $rcsDir = "/usr/bin"; # Initialise RCS file, ignored if empty string, # needed on Windows for binary files. Added JET 22-Feb-01 $rcsArg = ""; $rcsArg = "-x,v" if( $OS eq "WINDOWS" ); # null device /dev/null for unix, NUL for windows $nullDev = { UNIX=>'/dev/null', OS2=>'', WINDOWS=>'NUL', DOS=>'NUL', MACINTOSH=>'', VMS=>'' }->{$OS}; # Store RCS history files in directory (RCS under content dir), default "0" # Don't change this in a working installation, only change when initially setting up a TWiki installation # You also need to create an RCS directory for each Web. TWiki will create RCS directories under pub for attachments historys. $useRcsDir = "0"; # Command quote ' for unix, \" for Windows $cmdQuote = "'"; $cmdQuote = "\"" if( $OS eq "WINDOWS" ); # RCS init command, needed when initialising a file as binary $revInitBinaryCmd = "$rcsDir/rcs $rcsArg -q -i -t-none -kb %FILENAME%"; # RCS check in command : $revCiCmd = "$rcsDir/ci $rcsArg -q -l -m$cmdQuote%COMMENT%$cmdQuote -t-none -w$cmdQuote%USERNAME%$cmdQuote %FILENAME%"; #FIXME more entries need %COMMENT% # RCS check in command with date : $revCiDateCmd = "$rcsDir/ci -l $rcsArg -q -mnone -t-none -d$cmdQuote%DATE%$cmdQuote -w$cmdQuote%USERNAME%$cmdQuote %FILENAME%"; # RCS check out command : $revCoCmd = "$rcsDir/co $rcsArg -q -p%REVISION% %FILENAME%"; # RCS history command : $revHistCmd = "$rcsDir/rlog $rcsArg -h %FILENAME%"; # RCS history on revision command : $revInfoCmd = "$rcsDir/rlog $rcsArg -r%REVISION% %FILENAME%"; # RCS revision diff command : $revDiffCmd = "$rcsDir/rcsdiff $rcsArg -q -w -B -r%REVISION1% -r%REVISION2% %FILENAME%"; # RCS delete revision command : $revDelRevCmd = "$rcsDir/rcs $rcsArg -q -o%REVISION% %FILENAME%"; # RCS unlock command : $revUnlockCmd = "$rcsDir/rcs $rcsArg -q -u %FILENAME%"; # RCS lock command : $revLockCmd = "$rcsDir/rcs $rcsArg -q -l %FILENAME%"; # RCS for breaking a lock $revBreakLockCmd = "$rcsDir/rcs $rcsArg -q -l -M %FILENAME%"; # NOTE: You might want to avoid c: at start of cygwin unix command for # Windows, seems to cause a problem with pipe used in search # Unix ls command : $lsCmd = "/bin/ls"; # Unix egrep command : $egrepCmd = "/bin/egrep"; # Unix fgrep command : $fgrepCmd = "/bin/fgrep"; @code # variables that probably do not change: # ================================================================== # %WIKITOOLNAME% : TWiki tool name, default "TWiki" : $wikiToolName = "TWiki"; # Regex security filter for web name, topic name, user name : $securityFilter = "[\\\*\?\~\^\$\@\%\`\"\'\&\;\|\<\>\x00-\x1F]"; # Regex security filter for uploaded files : # (Matching files will have a ".txt" appended) $uploadFilter = "^(\.htaccess|.*\.php[0-9s]?|.*\.phtm[l]?)\$"; # Default user name, default "guest" : $defaultUserName = "guest"; # Site Web.Topic name, i.e. "Main.TokyoOffice". Default "" : $siteWebTopicName = ""; # %MAINWEB% : Name of Main web, default "Main" : $mainWebname = "Main"; # %TWIKIWEB% : Name of TWiki system web, default "TWiki" : $twikiWebname = "TWiki"; # Pathname of debug file : $debugFilename = "$dataDir/debug.txt"; # Pathname of warning file (default $dataDir/warning.txt), if empty no warnings written $warningFilename = "$dataDir/warning.txt"; # Pathname of user name/password file for authentication : $htpasswdFilename = "$dataDir/.htpasswd"; # Pathname of log file : $logFilename = "$dataDir/log%DATE%.txt"; # Pathname of remote users file that maps IP to user : $remoteUserFilename = "$dataDir/remoteusers.txt"; # %WIKIUSERSTOPIC% : Name of users list topic : $wikiUsersTopicname = "TWikiUsers"; # Pathname of users topic, used to translate Intranet name to Wiki name : $userListFilename = "$dataDir/$mainWebname/$wikiUsersTopicname.txt"; # %HOMETOPIC% : Name of main topic in a web, default "WebHome" : $mainTopicname = "WebHome"; # %NOTIFYTOPIC% : Name of topic for email notifications, default "WebNotify" : $notifyTopicname = "WebNotify"; # %WIKIPREFSTOPIC% : Name of site-level preferences topic, default "TWikiPreferences" : $wikiPrefsTopicname = "TWikiPreferences"; # %WEBPREFSTOPIC% : Name of preferences topic in a web, default "WebPreferences" : $webPrefsTopicname = "WebPreferences"; # %STATISTICSTOPIC% : Name of statistics topic, default "WebStatistics" : $statisticsTopicname = "WebStatistics"; # Number of top viewed topics to show in statistics topic, default "10" : $statsTopViews = "10"; # Number of top contributors to show in statistics topic, default "10" : $statsTopContrib = "10"; # Show how many number of revision links, "0" for all, default "3" : $numberOfRevisions = "3"; # Number of seconds a topic is locked during edit, default "3600" : $editLockTime = "3600"; # Group of users that can use cmd=repRev # or that ALWAYS have edit powers (set $doSuperAdminGroup=1) $superAdminGroup = "TWikiAdminGroup"; @code # flag variables that could change: # ================================================================== # values are "0" for no, or "1" for yes # Keep same revision if topic is saved again within edit lock time. Default "1" $doKeepRevIfEditLock = "1"; # Build $scriptUrlPath from $query->url parameter. Default "0". # Note that links are incorrect after failed authentication if "1" $doGetScriptUrlFromCgi = "0"; # Remove port number from URL. Default "0" $doRemovePortNumber = "0"; # Remember remote user by matching the IP address # in case REMOTE_USER is empty. Default "0" # (Note: Does not work reliably with dynamic IP addresses) $doRememberRemoteUser = "0"; # Change non existing plural topic name to singular, # e.g. TestPolicies to TestPolicy. Default "1" $doPluralToSingular = "1"; # Hide password in registration email $doHidePasswdInRegistration = "1"; # Remove ".." from %INCLUDE{""}% filename, to # prevent includes of "../../file". Default "1" $doSecureInclude = "1"; # Log topic views to $logFilename. Default "0" $doLogTopicView = "0"; # Log topic edits to $logFilename. Default "1" $doLogTopicEdit = "1"; # Log topic saves to $logFilename. Default "1" $doLogTopicSave = "1"; # Log renames to $logFilename. Default "1". Added JET 22-Feb-01 $doLogRename = "1"; # Log view attach to $logFilename. Default "1" $doLogTopicAttach = "1"; # Log file upload to $logFilename. Default "1" $doLogTopicUpload = "1"; # Log topic rdiffs to $logFilename. Default "0" $doLogTopicRdiff = "0"; # Log view changes to $logFilename. Default "0" $doLogTopicChanges = "0"; # Log view changes to $logFilename. Default "0" $doLogTopicSearch = "1"; # Log user registration to $logFilename. Default "1" $doLogRegistration = "1"; # Disable plugins. Set to "1" in case TWiki is non functional after # installing a new plugin. This allows you to remove the plugin from # the ACTIVEPLUGINS list in TWikiPreferences. Default "0" $disableAllPlugins = "0"; # Enable super-powers to $superAdminGroup members # see Codev.UnchangeableTopicBug $doSuperAdminGroup = "1"; @code ############################################################# ########## Administration notes ################## ############################################################# # # Don't forget to customize also the TWiki.TWikiPreferences topic. # # You can alter the most recent revision of a topic using /edit/web/topic?cmd=repRev # - use only as a last resort, as history is altered # - you must be in TWikiAdminGroup # - you will be presented with normal edit box, but this will also include meta # information, modify this with extreme care # # You can delete the most recent revision of a topic using /edit/web/topic?cmd=delRev # - use only as a last resort, as history is lost # - you must be in TWikiAdminGroup # - fill in some dummy text in the edit box # - ignore preview output # - when you press save last revision will be deleted # This page (topic) comes from a .leo file which provides additional documentation for TWiki. By cutting and pasting it to a working TWiki, you can see the actual values for the variables. I don't guarantee that my comments are correct on this page, nor do I know that this is exactly the amount of material or the approach I want to use to present it to a TWiki newbie. It is being used for two purposes at this point in time: * collecting the facts about these variables -- if you can correct any errors please do * serving as an example in my sample .leo file of TWiki to demonstrate one way that extensive overly verbose comments can be included in a .leo file with minimal impact on developers who don't need or want this level of verbosity ToDos: * Since the primary audience for this material will be on a public twiki (WikiLearn), all the examples on this page that have "hard" references to my home TWiki should be changed to links or "hard" references for twiki.org or WikiLearn. (Can I find out what is in the httpd.conf file for Apache on SourceForge?) * Fix errors, rewrite (but leave the intended audience as newbies to twiki), consider creating a summary for experienced developers of twiki. Here are two sample TWiki URLs for use as examples on this page -- the first is a page on twiki.org, the second is a page on atwiki on my home LAN: * http://twiki.org/cgi-bin/view/Test/TWikiVariables * http://192.168.0.8/w/edit/Sandbox/TWikiVariables These variables can be accessed from topics (see details in TWikiDocumentation.html): %<nop>TOPIC% (%TOPIC%) -- Every "webpage" of TWiki is known as a "topic" -- this is the name of the current topic. It is automatically determined by TWiki. In the examples above, the topic is "TWikiVariables". %<nop>WEB% (%WEB%) -- TWiki is organized in directories of topics -- the directories are known as webs -- this is the name of the current web. It is automatically determined by TWiki. In the first example, the web is "Test", in the second example the web is "Sandbox". %<nop>WIKIHOMEURL% (%WIKIHOMEURL%) -- This is the URL for twiki.org -- the "home" page of TWiki development. It must be manually set in TWiki.cfg when the TWiki is installed. %defaultUrlHost% is not a TWiki variable that can be accessed in a twiki topic. It is set in TWiki.cfg, and is the base URL for this installation of twiki. In the first example above it is http://twiki.org, in the second example it is http://192.168.0.8. (IMHO, it should be renamed to hostURL.) Some of the variables in this section must be set to correlate with settings of the web server and the %defaultUrlHost%. The next six lines are from the httpd.conf file for the Apache server which serves my home TWiki. <verbatim> # Another trial setup #(with %<nop>SCRIPTURLPATH% set to "/w") ScriptAlias /w/ "/home/httpd/twiki/bin/" ScriptAlias /v/ "/home/httpd/twiki/bin/view/" # (and %<nop>PUBURLPATH set to "/pub") Alias / "/home/httpd/twiki/" </verbatim> %<nop>SCRIPTURLPATH% (%SCRIPTURLPATH%) -- must be set (manually) to a value so that this path will lead to the /bin directory for this installation of TWiki. The bin directory for my home LAN is at /home/httpd/twiki/bin/, an alias for this path is /w/ (from the ScriptAlias line above), so the %<nop>SCRIPTURLPATH% for this TWiki must be set to "/w". (Note the absence of a final slash in "/w" -- I can't easily or immediately explain why the difference, but it seems to be required.) See the next item. <aside> The next ScriptAlias (/v/) gives a specific path to the view script, which allows me to enter URLs of the form http://192.168.0.8/v/Sandbox/TWikiVariables instead of http://192.168.0.8/w/view/Sandbox/TWikiVariables, which just saves me a few keystrokes when typing URLs into my browser's address bar. I've tried various experiments trying to get this down to URLs of the form http://192.168.0.8/Sandbox/TWikiVariables, but when I make this work, I can't find a combination of variable settings that allow the automatically created URLs for the other scripts (edit, preview, etc.) to work properly. AFAICT, I would have to make changes to the TWiki Perl code, which I am not ready to do. There could be various other approaches useful for this reason and others -- on a TWiki subject to a lot of use, it might be helpful to create and save all the views and serve them as static pages, and only serve the edit, preview, and similar pages as dynamic "TWiki" pages. (Of course, after an edit, preview, save cycle, code would have to replace the existing static view with the new static view. </aside> %<nop>SCRIPTURL% (%SCRIPTURL%) -- this is the base TWiki script URL (where the view, edit, etc. scripts are stored). TWiki creates this URL (AFAIK) by adding %<nop>SCRIPTURLPATH% onto the end of %defaultUrlHost%. %<nop>SCRIPTSUFFIX% (%SCRIPTSUFFIX%) -- some versions of Perl (Windows versions?) apparently require a ".pl" extension to the script file names and hence a script suffix. Then I presume URLs would have to be of the form http://192.168.0.8/w/view.pl/Sandbox/TWikiVariables, and all the scripts have to be renamed to include a .pl extension. %<nop>PUBURLPATH% (%PUBURLPATH%) -- must be set (manually) to a value so that this path will lead to the /pub directory for this installation of TWiki. The pub directory for my home LAN is at /home/httpd/twiki/pub/. An alias for /home/httpd/twiki/ is "/" (from the Alias line above), so the %<nop>PUBURLPATH% for this TWiki must be set to "/pub". (Note the absence of a final slash in "/pub" -- I can't easily or immediately explain why the difference, but it seems to be required.) See the next item. %<nop>PUBURL% (%PUBURL%) -- this is the base TWiki pub URL (where icons, attached files, and other things that TWiki may "serve" as objects are stored). TWiki creates this URL (AFAIK) by adding %<nop>PUBURLPATH% onto the end of %defaultUrlHost%. %pubDir% -- this is the "real" "filesystem path" on the Web server to the /pub directory. On my home TWiki it is /home/httpd/twiki/pub/. Apache can determine this from the Alias line in httpd.conf. (I'm not sure whether TWiki needs this or how it gets it.) %templateDir% -- later %dataDir% -- later %<nop>ATTACHURLPATH% (%ATTACHURLPATH%) -- TWiki creates directories for each topic to store attachments to that topic. The directories are created under the /pub directory, under subdirectories named for the particular Web. So, attachments for http://192.168.0.8/v/Sandbox/TWikiVariables would be stored under directory /home/httpd/twiki/pub/Sandbox/TWikiVariables/. The %<nop>ATTACHURLPATH% is created by TWiki by combining $pubDir$ (/home/httpd/twiki/pub/), %<nop>WEB% (Sandbox), and %<nop>WEB% (TWikiVariables). %<nop>ATTACHURL% (%ATTACHURL%) -- see %<nop>ATTACHURLPATH%. TWiki creates the %<nop>ATTACHURL% by combining %defaultUrlHost% and %<nop>ATTACHURLPATH%. %<nop>DATE% (%DATE%) -- the current date (determined by TWiki (?), from the local system clock (?)) %<nop>WIKIVERSION% (%WIKIVERSION%) -- the version of TWiki used at this site, expressed as the release date. %<nop>USERNAME% (%USERNAME%) -- login user name (more later(?), but here's a start) -- I don't know where the user name comes from in every case. If you log in to a local LAN with a userid, that userid is your %<nop>USERNAME%(?). On twiki.org, until you've logged in, your username is "guest", which corresponds to %<nop>WIKIUSERNAME% TWikiGuest. After you've logged in (on twiki.org), your %<nop>USERNAME% is the same as your %<nop>WIKIUSERNAME% (in my case RandyKramer). %<nop>WIKIUSERNAME% (%WIKIUSERNAME%) -- The WikiWord you've chosen to use as your (nick)name on TWiki. See %<nop>USERNAME%. %<nop>WIKITOOLNAME% (%WIKITOOLNAME%) -- the name that you choose to give to your TWiki website. On twiki.org, it is "TWiki". On my public twiki site (under construction), it will be "WikiLearn". At the top of a typical twiki page (with the default template) you will see the "page name" displayed something like: WikiLearn . Sandbox . TWikiVariables The WikiLearn is displayed because the template displays %<nop>WIKITOOLNAME% . %<nop>WEB% %<nop>TOPIC% I am sure that this is not the only use for %<nop>WIKITOOLNAME% %<nop>MAINWEB% (%MAINWEB%) -- in TWiki there are two special webs that must exist for special purposes. Originally they were "hardnamed" "Main" and "TWiki". Now, through the use of this and the next variable, you can rename them as desired (with appropriate care or changes in other places). The %<nop>MAINWEB% (default "Main") contains: * Registered user's home pages (automatically created by TWiki upon registration) (and must be removed and recreated for reregistration (still?)). Thus signatures (in all webs) should be of the form Main.RandyKramer, or preferably %<nop>MAINWEB%.RandyKramer to allow for possible future renaming of the %<nop>MAINWEB%. * [[Main.TWikiUser]] -- the list of all registered users on a TWiki * Definition of groups, like the Admin group and other user groups that may be created. * more? %<nop>TWIKIWEB% (%TWIKIWEB%) -- This is the other of two special webs that must (should?) exist. (See %<nop>MAINWEB%.) The %<nop>MAINWEB% (default "TWiki") is used to store: * (standard) documentation for installing and using TWiki (I expect to be adding additional documentation, and, for ease in upgrading (avoiding loss or overwriting of customized documentation), that customized documentation will be stored in a different web, unless it is adopted as part of the TWiki standard documentation. * * more? %<nop>HOMETOPIC% (%HOMETOPIC%) -- a topic present in each Web that is in some sense the home topic -- if a TWiki URL includes a web name but no topic, the %<nop>MAINWEB% is displayed (default is WebHome). %<nop>NOTIFYTOPIC% (%NOTIFYTOPIC%) -- a topic present in each Web that contains the list of (usually registered) users who wish to be notified by email when any topic in that web has been changed (default is WebNotify). Registered users can edit that page and add their names and email addresses. Notification is setup to work off a cron job, notification on twiki.org is once per day. (Email addresses have a simple / primitive means of being blocked to avoid being harvested and used for spam.) There is currently no means in TWiki to achieve email notification on a per topic basis. Policy changes on SourceForge (after 20010911) may force a change to a different server or approach. %<nop>WIKIUSERSTOPIC% (%WIKIUSERSTOPIC%) -- the topic used to store the list of registered users (defaults to TWikiUsers, in the %<nop>MAINWEB%). Until the 20010901 release, user names had to be deleted from here to allow reregistration. (And their home pages had to be deleted and their entry in .htpasswd. (??)) %<nop>WIKIPREFSTOPIC% (%WIKIPREFSTOPIC%) -- a topic in the %<nop>TWIKIWEB%that stores site-level preferences for this installation of TWiki (defaults to TWikiPreferences). See that topic for an example of preferences that can be set. Preferences can be set for an entire site, a web, or for a user. See the next item. Personal preferences are set on the home page of each registered twiki user (in the %<nop>MAINWEB%. %<nop>WEBPREFSTOPIC% (%WEBPREFSTOPIC%) -- a topic in each web that stores web-level preferences for a given web on a twiki installation (defaults to WebPreferences). See that topic for an example of preferences that can be set. %<nop>STATISTICSTOPIC% (%STATISTICSTOPIC%) -- a topic in each web that is used to collect and display statistics for the topics in that web(default is WebStatistics). See a page for examples. Statistics can be collected automatically once per day, but require some setup. See the installation instructions. %<nop>INCLUDE{...}% (No example yet -- %INCLUDE{...}%) -- (server side include) This variable, and some others (%INCLUDESTART%, %INCLUDESTOP%) allow all or a portion of one twiki topic to be included on another page. This is useful for various reasons, including, in the present design, creating a complete Table of Contents for a topic that is divided among several pages for convenience (smaller pages for easier editing, and so forth). %<nop>SEARCH{WikiLearn}% (example below) -- This variable allows the inclusion of the results of an inline search on a TWiki page. The following is an example of the results of an inline search on WikiLearn: <inline search results> %SEARCH{WikiLearn}% </inline search results> -- Main.RandyKramer - 23 Jul 2001 Literate programming is an effort to improve the documentation of programs to make them easier for the human audience to read and understand. Two things comprise the essence of literate programming: * Extensive commenting or documentation aimed at the human reader * Presentation of that documentation in a sequence best suited for the human reader, not constrained by the sequence of presentation required for the compiler In Donald Knuth's original efforts at literate programming he created a system for literate programming called CWEB(?). In that and many of the traditional approaches, the program and documentation are written in a special form, or with a special markup language, that is ideal for neither the compiler or the human audience. Two programs can be run against the specially marked up program: * A "tangle" program converts the program to a form suited for the compilier, with much of the extensive documentation removed, and in the sequence required by the compiler. * A "weave" program converts the program to a form suited for the human reader, in a sequence better suited for the human reader, with all the documentation, and with less emphasis on the code. Aside: To support presenting the program in two different sequences in the special marked up form, code and/or documentation are divided into named "chunks" that can be reassembled in an arbitrary order by specifying the names of the chunks in the desired order. Leo takes a slightly different approach. <<How Leo approaches Literate Programming>> Where traditional literate programming has three representations of a program: * the specially marked up form * the tangled form for the computer * the woven form for the human reader Leo (1 and 2) have only two representations of a program: * the tangled form for the compiler * the native outline form that serves as the special markup and the human readable form Later I will talk more about how Leo can be used for TWiki development. In general, development should take place in Leo and then the files tangled to normal Perl files for debug and run. However, if certain types of minor changes are made to the Perl files, Leo can incorporate those changes in the original Leo file by a process called "untangling". Aside: I don't fully understand the limits on the types of changes allowed in the Perl files, but I think they relate to avoiding changes that would entail adding, deleting, or rearranging the order of nodes in the outline. If I were trying to develop in Leo at this time, I'm make all basic structure changes in the Leo file, and then tangle it and run. The only changes I'd make to the Perl files would be corrections of typos or minor errors on an existing line -- no changes that would involve additions, deletions, or reordering of lines. (This might be an overly conservative approach, but this is the approach I would take until I knew for sure whether I could go any further or not.) I suppose I should and could describe the outline form, but that's a big undertaking, and I think it will be easier for you and me if you peruse the outline, perhaps with a few hints from me (later). You may even want to go now and peruse the outline a little without further introduction. It may be easier if you read the notes on: * <<How to change the font>> * <<Use a gray left border>> * <<Use a fixed width font>> * <<Double angle brackets>> Aside: Not all node names have to be enclosed in double angle brackets -- usually it is only the nodes that will be tangled into a file. I tangled some of the other headings for two reasons -- to make it easier to recognize that I am referring to another node, and to allow me to incorporate these nodes into a tangled file (perhaps readme.txt) at some time in the future. You may wish to start your review of the outline by finding the node called "programs", expanding it, finding the node called "view", expanding that, and then exploring the nodes under it. Note that only the nodes with names in double angle brackets that are listed in the "view" node will get tangled into the program. Thus, if you see some nodes labeled "Perl newbie" or "TWiki newbie", the contents of those nodes will not appear in the tangled Perl programs. Also, within the nodes that will be tangled into the programs, you may see various directives (a word prefaced by "@") or comments (prefaced by "@<space>" that will not be tangled into the Perl programs. After you have perused the outline, you may wish to try tangling all or one of the contained files, and then examining them to note the "sentinels" that are the almost the only indication that the files were tangled from a Leo file. If you want to examine one or more tangled files, press <ctrl><shift>a, which will tangle all the files I've set up to be tangled. (This might not include all the files in this Leo file, just because I may not have set up all the necessary @root and other directives.) I have not told you everything about Leo at this point in time, but this is a reasonable start. Select Edit --> Font Panel from the menu, and then choose a font that is readable for you. Unfortunately, in this version of Leo preferences like this cannot be saved. For reasons that are discussed later (<<Use a fixed width font>>), I also recommend that you choose a fixed width font. Expound more later (I thought I had covered this somewhere else, already.) If you choose a variable width font, and are editing (adding text to a node), the behavior gets very strange near the end of a line. This version of Leo is annoying in that the left margin in the body pane is very narrow -- so narrow that the first letter of words near the left hand margin tend to appear to touch the black border that surrounds the screen. The problem can be mitigated by viewing a reduced size window, so the surrounding margin is not black, or by using Edit --> Syntax Coloring --> Options to set a "Visible gutter" at about 10 (units?), and by unchecking the checkbox for "Mark wrapped lines". This is probably more my confusion than anything else. I think somewhere in the Leo documentation I've seen a phrase like "outline order", and I need to clarify what it means. It may cause some things that surprise me. I think what they mean by outline order is the order you get if you expand all the nodes, and then sequence through them in order from top to bottom. (I may be mixed up on this.) I might have thought outline order would have started at the highest level node in the outline, traversed through all of it's children, then traversed through all the grandchildren (of all the children), and so forth. Covered earlier, and perhaps adequately, at least for now. There are two major versions of Leo (1 and 2), they have significantly different ways of tangling and storing the tangled files, and the markup is significantly different. I have chosen to use the Leo 1 style of markup and tangling, mainly because: * AFAICT, Leo 2 markup is less supportive (maybe doesn't support) a presentation for the reader in a different sequence than the order required for the compiler. * Leo 2 is newer, and the documentation is (was?) not as good -- it was hard to figure out how to set up a program in Leo 2 markup. I may have overlooked the means to present to the reader in a different order. For other reasons, Leo 2 may be a better choice, because Leo 1 stores the source programs within the .leo file, while Leo 2 stores only the outline structure and human documentation in the .leo file -- the source programs are always stored in the tangled form. I will talk more about this at some point in time, but I really think Leo 1 markup is preferred at this point in time.