Index: twiki/lib/TWiki.pm diff -u twiki/lib/TWiki.pm:1.1.1.1 twiki/lib/TWiki.pm:1.10 --- twiki/lib/TWiki.pm:1.1.1.1 Wed Jul 7 18:51:10 2004 +++ twiki/lib/TWiki.pm Mon Jul 12 18:29:02 2004 @@ -50,8 +50,10 @@ use strict; + use Time::Local; # Added for revDate2EpSecs use Cwd qw( cwd ); # Added for getTWikiLibDir +use WebDebug qw(&debug); require 5.005; # For regex objects and internationalisation @@ -254,8 +256,10 @@ } } + =pod + ---++ writeDebug( $text ) Prints date, time, and contents of $text to $debugFilename, typically @@ -329,6 +333,8 @@ basicInitialize(); } + &WebDebug::installWriteLnDriver(\&writeDebug); + ##writeDebug( "\n---------------------------------" ); $cgiQuery = $theQuery; @@ -813,7 +819,7 @@ # Handle Edit pages - future versions will extend to caching # of other types of page, with expiry time driven by page type. - my( $pluginHeaders, $coreHeaders ); + my( @pluginHeaders, @coreHeaders ); $contentType .= "; charset=$siteCharset"; @@ -834,7 +840,7 @@ # Set content length, to enable HTTP/1.1 persistent connections # (aka HTTP keepalive), and cache control headers, to ensure edit page # is cached until required expiry time. - $coreHeaders = $query->header( + @coreHeaders = ( -content_type => $contentType, -content_length => $contentLength, -last_modified => $lastModifiedString, @@ -842,52 +848,30 @@ -cache_control => "max-age=$expireSeconds", ); } elsif ($pageType eq 'basic') { - $coreHeaders = $query->header( + @coreHeaders = ( -content_type => $contentType, - ); + ); } else { writeWarning( "===== invalid page type in TWiki.pm, writeHeaderFull(): $pageType" ); } - # Delete extra CR/LF to allow suffixing more headers - $coreHeaders =~ s/\r\n\r\n$/\r\n/s; ##writeDebug( "===== After trim, Headers are:\n$coreHeaders" ); # Wiki Plugin Hook - get additional headers from plugin - $pluginHeaders = &TWiki::Plugins::writeHeaderHandler( $query ) || ''; - - # Delete any trailing blank line - $pluginHeaders =~ s/\r\n\r\n$/\r\n/s; + @pluginHeaders = &TWiki::Plugins::writeHeaderHandler( $query ); # Add headers supplied by plugin, omitting any already in core headers - my $finalHeaders = $coreHeaders; - if( $pluginHeaders ) { - # Build hash of all core header names, lower-cased - my ($headerLine, $headerName, %coreHeaderSeen); - for $headerLine (split /\r\n/, $coreHeaders) { - $headerLine =~ m/^([^ ]+): /i; # Get header name - $headerName = lc($1); - ##writeDebug("==== core header name $headerName"); - $coreHeaderSeen{$headerName}++; - } - # Append plugin headers if legal and not seen in core headers - for $headerLine (split /\r\n/, $pluginHeaders) { - $headerLine =~ m/^([^ ]+): /i; # Get header name - $headerName = lc($1); - if ( $headerName =~ m/[\-a-z]+/io ) { # Skip bad headers - ##writeDebug("==== plugin header name $headerName"); - ##writeDebug("Saw $headerName already ") if $coreHeaderSeen{$headerName}; - $finalHeaders .= $headerLine . "\r\n" - unless $coreHeaderSeen{$headerName}; - } - - } - } - $finalHeaders .= "\r\n" if ( $finalHeaders); - - ##writeDebug( "===== Final Headers are:\n$finalHeaders" ); - print $finalHeaders; - + my @finalHeaders = @coreHeaders; +# writeDebug("Core headers: ".join(',',@coreHeaders)); +# writeDebug("Plugin headers: ".join(',',@pluginHeaders)); + if ( @pluginHeaders && defined($pluginHeaders[0])) { + unshift @finalHeaders,@pluginHeaders; + } +# writeDebug("Final headers: ".join(',',@pluginHeaders)); + print $query->header(@finalHeaders); + &WebDebug::webHeadersDone; +# &WebDebug::debugOff; +# &WebDebug::debug("headers done."); } =pod @@ -2014,6 +1998,7 @@ # set include web/filenames and current web/filenames $includingWebName = $theWeb; $includingTopicName = $theTopic; +# &WebDebug::debug("include $fileName from $theWeb.$theTopic"); if( $fileName =~ s/\/([^\/]*)\/([^\/]*)\.txt$/$1/ ) { # identified "/Web/TopicName.txt" filename, e.g. a Wiki topic # so save the current web and topic name @@ -2043,10 +2028,11 @@ # handle all preferences and internal tags &TWiki::Prefs::handlePreferencesTags( $text ); - handleInternalTags( $text, $theTopic, $theWeb ); + my $dynamic = handleInternalTags( $text, $theTopic, $theWeb ); + # Wiki Plugin Hook (4th parameter tells plugin that its called from an include) - &TWiki::Plugins::commonTagsHandler( $text, $theTopic, $theWeb, 1 ); + &TWiki::Plugins::commonTagsHandler( $text, $theTopic, $theWeb, 1, $dynamic ); # handle tags again because of plugin hook &TWiki::Prefs::handlePreferencesTags( $text ); @@ -2784,6 +2770,68 @@ return $theRelativePath; } + +sub nonce +{ + return time(); +} + +sub nonce_query +{ + return "?t=" . &nonce; +} + +sub javascript_string +{ + my ($text)=@_; + $text='' unless defined($text); + $text =~ s/([\0\b\t\n\x0b\f\r"'\\])/sprintf('\x%02X',ord($1))/eg; + return "'$text'"; +} + +=pod + +---++ alt_javascript_text ( $pretext,$alttext,$posttext,$javascript ) + +Returns HTML equivalent to $pretext.$alttext.$posttext if javascript is +disabled, or $pretext.(result of running $javascript).$posttext otherwise. + +=cut + +sub alt_javascript_text +{ + my ( $pretext,$alttext,$posttext,$javascript )=@_; + my $plain=$pretext.$alttext.$posttext; + my $javascript_gen = "document.write(".&javascript_string($pretext)."+".$javascript."+".&javascript_string($posttext).");"; +# &WebDebug::debug("plain $plain ; javascript $javascript"); + return qq{}; +} + +sub javascript_nonce +{ + return "(new Date()).getTime()"; +} + +=pod + + +---++ alt_nonce_text ( $pretext, $alttext, $posttext ) + +Returns HTML equivalent to $pretext.$alttext.$posttext if javascript is +disabled, or $pretext.&client_side_nonce.$posttext if javascript is enabled). A +nonce is a unique identifier which will never be repeated in the future. + +=cut + +sub alt_nonce_text +{ + my ( $pretext,$alttext,$posttext )=@_; + + my $nonced_text=&alt_javascript_text($pretext,$alttext,$posttext,&javascript_nonce); +# &WebDebug::debug($nonced_text); + return $nonced_text; +} + =pod ---++ handleInternalTags( $text, $topic, $web ) @@ -2795,14 +2843,16 @@ sub handleInternalTags { + my $dynamic=0; # modify arguments directly, i.e. call by reference # $_[0] is text # $_[1] is topic # $_[2] is web # Make Edit URL unique for every edit - fix for RefreshEditPage. - $_[0] =~ s!%EDITURL%!"$dispScriptUrlPath/edit$scriptSuffix/%WEB%/%TOPIC%\?t=" . time()!ge; - + $_[0] =~ s!%EDITURL%!"$dispScriptUrlPath/edit$scriptSuffix/%WEB%/%TOPIC%".&nonce_query!ge; + $_[0] =~ s!%SAVEURL%!"$dispScriptUrlPath/save$scriptSuffix/%WEB%/%TOPIC%".&nonce_query!ge; + $_[0] =~ s!%PREVIEWURL%!"$dispScriptUrlPath/preview$scriptSuffix/%WEB%/%TOPIC%".&nonce_query!ge; $_[0] =~ s/%NOP{(.*?)}%/$1/gs; # remove NOP tag in template topics but show content $_[0] =~ s/%NOP%//g; $_[0] =~ s/%TMPL\:P{(.*?)}%/&handleTmplP($1)/ge; @@ -2854,7 +2904,10 @@ $_[0] =~ s/%(URL)?ENCODE{(.*?)}%/&handleUrlEncode($2,1)/ge; # ENCODE is documented, URLENCODE is legacy $_[0] =~ s/%INTURLENCODE{(.*?)}%/&handleIntUrlEncode($1)/ge; # Deprecated - not needed with UTF-8 URL support + + # Dates and times + $dynamic = 1 if $_[0] =~ m/\%(?:GM|SERVER|DISPLAY)TIME(?:\{[^}]*(?:hour|min|sec)[^}]*\})?\%/so; $_[0] =~ s/%DATE%/&formatTime(time(), "\$day \$mon \$year", "gmtime")/ge; # Deprecated, but used in signatures $_[0] =~ s/%GMTIME%/&handleTime("","gmtime")/ge; $_[0] =~ s/%GMTIME{(.*?)}%/&handleTime($1,"gmtime")/ge; @@ -2880,11 +2933,13 @@ $_[0] =~ s/%STOPINCLUDE%//g; $_[0] =~ s/%SECTION{(.*?)}%//g; $_[0] =~ s/%ENDSECTION%//g; - $_[0] =~ s/%SEARCH{(.*?)}%/&handleSearchWeb($1)/ge; # can be nested - $_[0] =~ s/%SEARCH{(.*?)}%/&handleSearchWeb($1)/ge if( $_[0] =~ /%SEARCH/o ); - $_[0] =~ s/%METASEARCH{(.*?)}%/&handleMetaSearch($1)/ge; + $dynamic = 1 if $_[0] =~ s/%SEARCH{(.*?)}%/&handleSearchWeb($1)/ge; # can be nested + $dynamic = 1 if $_[0] =~ /%SEARCH/o && $_[0] =~ s/%SEARCH{(.*?)}%/&handleSearchWeb($1)/ge; + $dynamic = 1 if $_[0] =~ s/%METASEARCH{(.*?)}%/&handleMetaSearch($1)/ge; $_[0] =~ s/%FORMFIELD{(.*?)}%/&TWiki::Render::getFormField($_[2],$_[1],$1)/ge; $_[0] =~ s/%GROUPS%/join( ", ", &TWiki::Access::getListOfGroups() )/ge; #SVEN + + return $dynamic; } =pod @@ -3024,13 +3079,13 @@ $includingWebName = $theWeb; $includingTopicName = $theTopic; &TWiki::Prefs::handlePreferencesTags( $text ); - handleInternalTags( $text, $theTopic, $theWeb ); + my $dynamic = handleInternalTags( $text, $theTopic, $theWeb ); # recursively process multiple embedded %INCLUDE% statements and prefs $text =~ s/%INCLUDE{(.*?)}%/&handleIncludeFile($1, $theTopic, $theWeb, \@verbatim, @theProcessedTopics )/ge; # Wiki Plugin Hook - &TWiki::Plugins::commonTagsHandler( $text, $theTopic, $theWeb, 0 ); + &TWiki::Plugins::commonTagsHandler( $text, $theTopic, $theWeb, 0, $dynamic ); # handle tags again because of plugin hook &TWiki::Prefs::handlePreferencesTags( $text ); Index: twiki/lib/WebDebug.pm diff -u /dev/null twiki/lib/WebDebug.pm:1.9 --- /dev/null Tue Jul 13 13:14:04 2004 +++ twiki/lib/WebDebug.pm Tue Jul 13 13:13:16 2004 @@ -0,0 +1,320 @@ +# Jonathan Graehl - "jonathan#graehl!org" =~ tr/#!/@./ + +=begin twiki + +---++ Description + + Debug routines with custom printed representations depending on argument + types. Configurable output by default to STDERR (if the DEBUG environment + variable is set) or to HTML (if the SCRIPT_NAME var contains "debug"). For + HTML output, prints a default response header unless you have already done + so yourself (and indicated it with &webHeadersDone). + +=cut + +package WebDebug; + +use strict; +#BEGIN { $diagnostics::PRETTY = 1 } +#use diagnostics; + +use Exporter; +use vars qw($VERSION @ISA @EXPORT @EXPORT_OK %EXPORT_TAGS $WEBDEBUG $SCRIPTURL $BROWSERDEBUG $WRITELNDRIVER $WEBHEADERSDONE $SHELLDEBUG $DEBUGDEFAULTON @WEBBUFFER %DEBUGONPACKAGE %DEBUGTABLE); + +$VERSION = 1.00; +@ISA = qw(Exporter); +@EXPORT = qw(); +@EXPORT_OK = qw(&debug &debugAlways &debugOn &debugOff &debugging &debugDefaultOn &debugDefaultOff &debugDump &setDumperFor &webHeadersDone &webBoxedQuote &debugWriteLn &installWriteLnDriver); +%EXPORT_TAGS = ( all => \@EXPORT_OK, + ); + + +# ========================= +=pod + +---++ Functions: Debug messages and value inspection + +=cut + + +=pod + +---+++ &init + +called once on module load, but can be repeated for new web requests in a mod_perl like environment + +=cut + +sub init +{ + $SCRIPTURL=exists $ENV{SCRIPT_NAME} ? $ENV{SCRIPT_NAME} : ''; + $WEBDEBUG=($SCRIPTURL =~ /debug/); + $BROWSERDEBUG=$WEBDEBUG; # && exists $ENV{REMOTE_HOST}; +eval("use CGI;use CGI::Carp qw(fatalsToBrowser warningsToBrowser);") if $BROWSERDEBUG; + $WRITELNDRIVER=undef; + $WEBHEADERSDONE=0; + $SHELLDEBUG=exists $ENV{DEBUG} || ($WEBDEBUG && !$BROWSERDEBUG); + + @WEBBUFFER=(); + &debugDefaultOn; + %DEBUGONPACKAGE=(); +} + +&initDump; + +&init; + +=pod + +---+++ &webBoxedQuote($text) + +returns HTML for displaying boxed blockquoted verbatim (fully escaped) text as +it would appear in a plain terminal + +=cut + +sub webBoxedQuote { + my($message) = @_; + my $escapeH=eval '\\&CGI::escapeHTML'; + my $esc=defined($escapeH) ? $escapeH->($message) : $message; + return <<__EOF; +
+
+
$esc
+
+
+__EOF +} + + + +=pod + +---+++ &installWriteLnDriver + +takes a reference to code to be called with any debug text (even if it is also displayed in HTML or to console) + +=cut + + +sub installWriteLnDriver { + $WRITELNDRIVER=$_[0]; +} + + +=pod + +---+++ &debugWriteLn + +calls writeDebug (appends message to data/debug.txt). if the scriptname +contains 'debug', then messages are also output as HTML. if the $DEBUG +environment var is set and the script is run from the command line the message +is output to STDERR as well. also passes through argument to any user supplied WriteLnDriver + +=cut + + +sub debugWriteLn +{ + if ($BROWSERDEBUG) { + my $out=&webBoxedQuote; + if ($WEBHEADERSDONE) { + print $out; + } else { +# print &CGI::header(),&CGI::start_html(&CGI::script_name()." - debug mode"); + push @WEBBUFFER,$out; + } + } elsif ($SHELLDEBUG) { + print STDERR $_[0],"\n"; + } + &$WRITELNDRIVER if (defined $WRITELNDRIVER); +} + + +=pod + +---+++ &webHeadersDone + +For web browser debug output, must be called after your HTTP headers are printed, or else you won't see anything. + +=cut + +sub webHeadersDone { + $WEBHEADERSDONE=1; + eval("&warningsToBrowser(1);") if $BROWSERDEBUG; + print $_ for (@WEBBUFFER); + @WEBBUFFER=(); +} + +=pod + +---+++ &setDumperFor($argtype,$handler) + +$argtype is a reference to an object, and $handler is the new &debugDump handler +for obtaining printed representations of objects of that type + +=cut + +sub setDumperFor { + my ($argtype,$handler) = @_; + $DEBUGTABLE{$argtype} = $handler; +} + +=pod + +---+++ &debugDump($datum) + +$datum is an object (not a reference to it) - a printed representation of the +object's value is returned + +=cut + +sub debugDump { + my $argtype = ref($_[0]) || ''; + my $handler = $DEBUGTABLE{$argtype}; +# if (!$handler) { +# foreach my $anc ( ancestors($argtype) ) { +# $handler = $DEBUGTABLE{$anc}; +# next unless $handler; +# $DEBUGTABLE{$argtype} = $handler; +# last; +# } +# } + return "unknown<$argtype>($_[0])" unless $handler; + return $handler->(@_); +} + +sub initDump { +%DEBUGTABLE=(); + +setDumperFor '' + => sub { defined($_[0]) ? qq{"$_[0]"} : 'undef' }; + +setDumperFor "REF" + => sub { '\\('.&debugDump(${$_[0]}).')' }; + +setDumperFor "SCALAR" + => sub { '\\('.&debugDump(${$_[0]}).')' }; +# => sub { $_[0].'='.&debugDump(${$_[0]}) }; + +setDumperFor "ARRAY" + => sub { + my @arrayreps=map {&debugDump($_)} @{$_[0]}; + '[' . join(',',@arrayreps) . ']' + }; + +setDumperFor "HASH" + => sub { + my @entryreps=map {&debugDump($_) . "=>".&debugDump($_[0]->{$_})} keys(%{$_[0]}); + '{' . join(',',@entryreps) . '}' + }; + +setDumperFor "CODE" + => sub { "$_[0]" }; + +setDumperFor "GLOB" + => sub { "GLOB:$_[0]" }; +} + +=pod + +---+++ &debugAlways(...) + +same as &debug(...) but always active, even if &debugOff was called + +=cut + +sub debugAlways { + my @args=map { &debugDump($_) } @_; + my ($package, $filename, $line) = caller; + $filename = $1 if $filename =~ m|/([^/]+)$|; + my $dbg="[$package]$filename($line): ".join('; ',@args); + &debugWriteLn($dbg); +} + +sub setDebug { + my ($package, $filename, $line) = caller; + $DEBUGONPACKAGE{$package} = $_[0]; +} + +=pod + +---+++ &debugOn + +enables debug output for the calling package + +=cut +sub debugOn { + my ($package, $filename, $line) = caller; + $DEBUGONPACKAGE{$package} = 1; +} + +=pod + +---+++ &debugOff + +disables debug output for the calling package + +=cut +sub debugOff { + my ($package, $filename, $line) = caller; + $DEBUGONPACKAGE{$package} = 0; +} + + +=pod +---+++ &debugDefaultOn + +sets default to &debugOn + +=cut +sub debugDefaultOn { + $DEBUGDEFAULTON = 1; +} + +=pod +---+++ &debugDefaultOff + +sets default to &debugOff + +=cut +sub debugDefaultOff { + $DEBUGDEFAULTON = 0; +} + +=pod + +---+++ &debugging($package) + +returns true if debug output is enabled in the package (defaults to calling package) +(else returns false, duh) + +=cut + +sub debugging +{ + my ($package, $filename, $line) = caller; + $package = $_[0] if defined($_[0]); + return (exists $DEBUGONPACKAGE{$package}) ? $DEBUGONPACKAGE{$package} : $DEBUGDEFAULTON; +} + +=pod + +---+++ &debug(...) + +dumps the values of the arguments to the debug display (debugWriteLn) if &debugOn was called + +=cut + +sub debug { + my ($package, $filename, $line) = caller; + if (&debugging($package)) { + my @args=map { &debugDump($_) } @_; + $filename = $1 if $filename =~ m|/([^/]+)$|; + my $dbg="[$package]$filename($line): ".join('; ',@args); + &debugWriteLn($dbg); + } +} + + +1; Index: twiki/lib/TWiki/Func.pm diff -u twiki/lib/TWiki/Func.pm:1.1.1.1 twiki/lib/TWiki/Func.pm:1.5 --- twiki/lib/TWiki/Func.pm:1.1.1.1 Wed Jul 7 18:51:10 2004 +++ twiki/lib/TWiki/Func.pm Tue Jul 13 13:09:06 2004 @@ -44,6 +44,9 @@ use strict; + + + # ========================= =pod @@ -379,6 +382,27 @@ my $value = getPluginPreferencesValue( $theKey ); return TWiki::Prefs::formatAsFlag($value); } + + +=pod + +&getPrefFromText($prefName,$text) ==> $prefValue + +=cut + +sub getPrefFromText { + my $pref=$_[0]; + # $_[1] is $text + if( $_[1] =~ /\n\t+\*\sSet\s$pref\s*\=\s*((?:[^\n]|\n\t+[^*])*)\n/s ) { #like Prefs::parseText only doesn't remove tabs from multiline prefs + my $val=$1; + $val =~ s/\r//; + &WebDebug::debug("got topic pref $_[0]=$val"); + return $val; + } else { + return undef; + } +} + # ========================= =pod Index: twiki/lib/TWiki/Plugins.pm diff -u twiki/lib/TWiki/Plugins.pm:1.1.1.1 twiki/lib/TWiki/Plugins.pm:1.4 --- twiki/lib/TWiki/Plugins.pm:1.1.1.1 Wed Jul 7 18:51:10 2004 +++ twiki/lib/TWiki/Plugins.pm Wed Jul 7 20:01:07 2004 @@ -246,12 +246,10 @@ foreach $theHandler ( @{$registeredHandlers{$handlerName}} ) { # apply handler on the remaining list of args - $status = &$theHandler; if( $onlyOnceHandlers{$handlerName} ) { - if( $status ) { - return $status; - } + return &$theHandler; } + &$theHandler; } return undef; @@ -467,7 +465,9 @@ ---++ sub commonTagsHandler () -Not yet documented. +Not yet documented. Example usage: + # Wiki Plugin Hook (4th parameter tells plugin that its called from an include) + &TWiki::Plugins::commonTagsHandler( $text, $theTopic, $theWeb, 1 ); =cut @@ -652,7 +652,8 @@ ---++ sub writeHeaderHandler () -Not yet documented. + Return hash of additional arguments to CGI::header e.g. # "(-Last-Modified => $gmtime, -expires => '+1h')" + You won't be able to override @coreHeaders from TWiki.pm =cut Index: twiki/lib/TWiki/Search.pm diff -u twiki/lib/TWiki/Search.pm:1.1.1.1 twiki/lib/TWiki/Search.pm:1.2 --- twiki/lib/TWiki/Search.pm:1.1.1.1 Wed Jul 7 18:51:10 2004 +++ twiki/lib/TWiki/Search.pm Fri Jul 9 18:25:53 2004 @@ -220,7 +220,7 @@ $acmd =~ s/%FILES%/@set/o; $acmd =~ /(.*)/; $acmd = "$1"; # untaint variable (FIXME: Needs a better check!) - $result = `$acmd`; + $result = `$acmd 2>/dev/null`; _traceExec( $acmd, $result ); @set = split( /\n/, $result ); @set = map { /(.*)\.txt$/; $_ = $1; } @set; # cut ".txt" extension Index: twiki/lib/TWiki/UI.pm diff -u twiki/lib/TWiki/UI.pm:1.1.1.1 twiki/lib/TWiki/UI.pm:1.3 --- twiki/lib/TWiki/UI.pm:1.1.1.1 Wed Jul 7 18:51:10 2004 +++ twiki/lib/TWiki/UI.pm Mon Jul 12 18:29:02 2004 @@ -177,8 +177,8 @@ =cut sub writeDebugTimes { - my $mess = shift; - # TWiki::writeDebug(); + #my $mess = shift; +# &TWiki::writeDebugTimes; } 1; Index: twiki/lib/TWiki/User.pm diff -u twiki/lib/TWiki/User.pm:1.1.1.1 twiki/lib/TWiki/User.pm:1.2 --- twiki/lib/TWiki/User.pm:1.1.1.1 Wed Jul 7 18:51:10 2004 +++ twiki/lib/TWiki/User.pm Wed Jul 7 19:10:51 2004 @@ -233,7 +233,7 @@ my ( $wikiName, $remoteUser ) = @_; my $today = &TWiki::formatTime(time(), "\$day \$mon \$year", "gmtime"); my $topicName = $TWiki::wikiUsersTopicname; - my( $meta, $text ) = &TWiki::Store::readTopic( $TWiki::mainWebname, $topicName ); + my( $meta, $text ) = &TWiki::Store::readTopic( $TWiki::mainWebname, $topicName, 1 ); my $result = ""; my $status = "0"; my $line = ""; Index: twiki/lib/TWiki/Plugins/LastModifiedPlugin.pm diff -u /dev/null twiki/lib/TWiki/Plugins/LastModifiedPlugin.pm:1.16 --- /dev/null Tue Jul 13 13:14:04 2004 +++ twiki/lib/TWiki/Plugins/LastModifiedPlugin.pm Tue Jul 13 13:13:16 2004 @@ -0,0 +1,382 @@ +# +# TWiki WikiClone ($wikiversion has version info) +# +# Copyright (C) 2000-2001 Andrea Sterbini, a.sterbini@flashnet.it +# Copyright (C) 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 +# +# ========================= +# +# This is the default TWiki plugin. Use EmptyPlugin.pm as a template +# for your own plugins; see TWiki.TWikiPlugins for details. +# +# Each plugin is a package that contains the subs: +# +# initPlugin ( $topic, $web, $user, $installWeb ) +# commonTagsHandler ( $text, $topic, $web ) +# startRenderingHandler( $text, $web ) +# outsidePREHandler ( $text ) +# insidePREHandler ( $text ) +# endRenderingHandler ( $text ) +# +# initPlugin is required, all other are optional. +# For increased performance, DISABLE handlers you don't need. +# +# NOTE: To interact with TWiki use the official TWiki functions +# in the &TWiki::Func module. Do not reference any functions or +# variables elsewhere in TWiki!! + + +# ========================= +package TWiki::Plugins::LastModifiedPlugin; + +# ========================= +use vars qw( + $web $topic $user $installWeb $VERSION $DEBUG + $doOldInclude $renderingWeb $dataDir $lastMod + $pluginName $baseLastMod $dynamic $expires $expiresDynamic + $EXPIRESPREF $EXPIRESDYNAMICPREF $initWeb $initTopic $DEFAULT_EXPIRES $DEFAULT_EXPIRES_DYNAMIC + ); + +$VERSION = '1.010'; +$pluginName='LastModifiedPlugin'; + + $DEFAULT_EXPIRES=undef; + $DEFAULT_EXPIRES_DYNAMIC=0; + +$EXPIRESPREF="EXPIRESINSEC"; +$EXPIRESDYNAMICPREF="DYNAMICEXPIRESINSEC"; + +use TWiki::Func; +use WebDebug qw(:all); + +sub filenameFromTopic { + my($web,$topic)=@_; + my $filename=&TWiki::Func::getDataDir() . "/$web/$topic.txt"; +# &debug($filename); + return $filename; +} + +sub lastMod { +# &debug("stat $_[0]=",(stat $_[0])); + return (stat $_[0])[9]; +} + +sub lastModTopic { + return &lastMod(&filenameFromTopic); +} + +sub gmtimestring + { + my ($epochTime)=@_; + $epochTime=time() unless defined($epochTime); + my $ts=TWiki::formatTime($epochTime,'\$http',"gmtime"); + return $ts; + } + +sub isView { + my $isView=exists $ENV{SCRIPT_FILENAME} && $ENV{SCRIPT_FILENAME} =~ /^[^?]*\/(?:view|diff)/o; + &debug("isView", $ENV{SCRIPT_FILENAME},$isView); + return $isView; +} + +sub isEdit { + my $isEdit=exists $ENV{SCRIPT_FILENAME} && $ENV{SCRIPT_FILENAME} =~ /^[^?]*\/edit/o; +# &debug("isEdit", $ENV{SCRIPT_FILENAME},$isEdit); + return $isEdit; +} + +# ========================= +sub initPlugin +{ + ( $topic, $web, $user, $installWeb ) = @_; + + &debug("for $ENV{SCRIPT_NAME}/$web.$topic, MOD_PERL=",$ENV{'MOD_PERL'}); + + &debugOff; + + # check for Plugins.pm versions + if( $TWiki::Plugins::VERSION < 1 ) { + &TWiki::Func::writeWarning( "Version mismatch between DefaultPlugin and Plugins.pm" ); + return 0; + } + $initWeb=$web; + $initTopic=$topic; + $baseLastMod = $lastMod = &lastModTopic($web,$topic); + $dynamic = (TWiki::Func::topicExists($web,$topic)) ? 0 : 1; + $expires=&TWiki::Func::getPreferencesValue($EXPIRESPREF); + $expiresDynamic=&TWiki::Func::getPreferencesValue($EXPIRESDYNAMICPREF); + $expires=$DEFAULT_EXPIRES if $expires eq ''; + $expiresDynamic=undef if $expiresDynamic eq ''; + # Plugin correctly initialized + &debug("\n\ninitPlugin($web.$topic) OK - baselastmod",$baseLastMod,&gmtimestring($baseLastMod),"expires/dyn",$expires,$expiresDynamic); + &debug("topic exists unless dynamic(=$dynamic)"); + my $isview=&isView; + &debug("isview=",$isview); + $dynamic = 1 unless $isview; + return 1; +} + + +sub sec_to_expires { + return '+'.$_[0].'s'; +} + +sub writeHeaderHandler +{ +### my ( $query ) = @_; # do not uncomment, use $_[0], $_[1]... instead + &debug("writeHeaderHandler : X-TWiki $baseLastMod, Last-Modified $lastMod"); + my @expires=(); + if (!&isEdit) { + $expiresDynamic=$DEFAULT_EXPIRES_DYNAMIC unless defined($expiresDynamic); + if (defined($expires) && ($expires < $expiresDynamic || !$dynamic) ){ + @expires=('-expires' => &sec_to_expires($expires) ); + &debug("using static expire time $expires"); + } elsif ($dynamic) { + @expires=('-expires' => &sec_to_expires($expiresDynamic) ); + &debug("using dynamic expire time $expiresDynamic"); + } + } + my $lastModStr=&gmtimestring($lastMod); + my @headers=( + '-X-TWiki-Date' => &gmtimestring($baseLastMod), + '-Last-Modified' => $lastModStr, + '-ETag' => qq{W/"$lastModStr"}, + @expires + ); + &debug("expires:",@expires,"headers:",@headers); + return @headers; + +} + + + +# ========================= +sub commonTagsHandler +{ +### my ( $text, $topic, $web, $wasinclude, $dynamicText ) = @_; # do not uncomment, use $_[0], $_[1]... instead + +# TWiki::Func::writeDebug( "- ${pluginName}::commonTagsHandler( $_[2].$_[1] )" ) if $debug; + + # This is the place to define customized tags and variables + # Called by sub handleCommonTags, after %INCLUDE:"..."% + + # do custom extension rule, like for example: + # $_[0] =~ s/%XYZ%/&handleXyz()/ge; + # $_[0] =~ s/%XYZ{(.*?)}%/&handleXyz($1)/ge; + my $cweb=$_[2]; + my $ctopic=$_[1]; + my $wasinclude=$_[3]; + my $dynamicText=$_[4]; +# &debug("commonTagsHandler $cweb.$ctopic"); + unshift @_, ($EXPIRESPREF); + my $e=&TWiki::Func::getPrefFromText; + shift @_; + unshift @_, ($EXPIRESDYNAMICPREF); + my $ed=&TWiki::Func::getPrefFromText; + shift @_; + my $isInitTopic=($topic eq $initTopic && $web eq $initWeb); + &debug("initial topic = ",$isInitTopic); + $expires=$e if defined($e) && (!defined($expires) || ($e < $expires || $isInitTopic)); + $expiresDynamic=$ed if defined($ed) && (!defined($expiresDynamic) || ($ed < $expiresDynamic || $isInitTopic)); + &debug("$cweb.$ctopic expiry/dynamic expiry",$expires,$expiresDynamic); + if ($wasinclude) { # $wasinclude + my $thisMod = &lastModTopic($cweb,$ctopic); + $lastMod=$thisMod if ($thisMod > $lastMod); + &debug(" included($cweb,$ctopic,$lastMod,$thisMod)",&gmtimestring($lastMod),&gmtimestring($thisMod)); + } + if ($dynamicText) { # $dynamicText + &debug("Dynamic content found - $cweb.$ctopic"); + $dynamic=1; + $lastMod=time; + $baseLastMod=$lastMod unless $wasinclude; # $wasinclude + } +} + +# ========================= +sub DISABLE_earlyInitPlugin +{ +### Remove DISABLE_ for a plugin that requires early initialization, that is expects to have +### initializeUserHandler called before initPlugin, giving the plugin a chance to set the user +### See SessionPlugin for an example of this. + return 1; +} + + +# ========================= +sub DISABLE_initializeUserHandler +{ +### my ( $loginName, $url, $pathInfo ) = @_; # do not uncomment, use $_[0], $_[1]... instead + + TWiki::Func::writeDebug( "- ${pluginName}::initializeUserHandler( $_[0], $_[1] )" ) if $debug; + + # Allows a plugin to set the username based on cookies. Called by TWiki::initialize. + # Return the user name, or "guest" if not logged in. + # New hook in TWiki::Plugins $VERSION = '1.010' + +} + +# ========================= +sub DISABLE_registrationHandler +{ +### my ( $web, $wikiName, $loginName ) = @_; # do not uncomment, use $_[0], $_[1]... instead + + TWiki::Func::writeDebug( "- ${pluginName}::registrationHandler( $_[0], $_[1] )" ) if $debug; + + # Allows a plugin to set a cookie at time of user registration. + # Called by the register script. + # New hook in TWiki::Plugins $VERSION = '1.010' + +} + + +# ========================= +sub DISABLE_startRenderingHandler +{ +### my ( $text, $web ) = @_; # do not uncomment, use $_[0], $_[1] instead + + TWiki::Func::writeDebug( "- ${pluginName}::startRenderingHandler( $_[1] )" ) if $debug; + + # This handler is called by getRenderedVersion just before the line loop + + # do custom extension rule, like for example: + # $_[0] =~ s/old/new/g; +} + +# ========================= +sub DISABLE_outsidePREHandler +{ +### my ( $text ) = @_; # do not uncomment, use $_[0] instead + + + # This handler is called by getRenderedVersion, once per line, before any changes, + # for lines outside
 and  tags. 
+    # Use it to define customized rendering rules.
+    # Note: This is an expensive function to comment out.
+    # Consider startRenderingHandler instead
+
+    # do custom extension rule, like for example:
+    # $_[0] =~ s/old/new/g;
+}
+
+# =========================
+sub DISABLE_insidePREHandler
+{
+### my ( $text ) = @_;   # do not uncomment, use $_[0] instead
+
+
+    # This handler is called by getRenderedVersion, once per line, before any changes,
+    # for lines inside 
 and  tags. 
+    # Use it to define customized rendering rules.
+    # Note: This is an expensive function to comment out.
+    # Consider startRenderingHandler instead
+
+    # do custom extension rule, like for example:
+    # $_[0] =~ s/old/new/g;
+}
+
+# =========================
+sub DISABLE_endRenderingHandler
+{
+### my ( $text ) = @_;   # do not uncomment, use $_[0] instead
+
+
+    # This handler is called by getRenderedVersion just after the line loop, that is,
+    # after almost all XHTML rendering of a topic.  tags are removed after this.
+
+}
+
+# =========================
+sub DISABLE_beforeEditHandler
+{
+### my ( $text, $topic, $web ) = @_;   # do not uncomment, use $_[0], $_[1]... instead
+
+
+    # This handler is called by the edit script just before presenting the edit text
+    # in the edit box. Use it to process the text before editing.
+    # New hook in TWiki::Plugins $VERSION = '1.010'
+
+}
+
+# =========================
+sub DISABLE_afterEditHandler
+{
+### my ( $text, $topic, $web ) = @_;   # do not uncomment, use $_[0], $_[1]... instead
+
+
+    # This handler is called by the preview script just before presenting the text.
+    # New hook in TWiki::Plugins $VERSION = '1.010'
+
+}
+
+# =========================
+sub DISABLE_beforeSaveHandler
+{
+### my ( $text, $topic, $web ) = @_;   # do not uncomment, use $_[0], $_[1]... instead
+
+
+    # This handler is called by TWiki::Store::saveTopic just before the save action.
+    # New hook in TWiki::Plugins $VERSION = '1.010'
+
+}
+
+# =========================
+sub DISABLE_afterSaveHandler
+{
+### my ( $text, $topic, $web, $error ) = @_;   # do not uncomment, use $_[0], $_[1]... instead
+
+
+    # This handler is called by TWiki::Store::saveTopic just after the save action.
+    # New hook in TWiki::Plugins $VERSION = '1.020'
+
+}
+
+# =========================
+sub DISABLE_redirectCgiQueryHandler
+{
+### my ( $query, $url ) = @_;   # do not uncomment, use $_[0], $_[1] instead
+
+
+    # This handler is called by TWiki::redirect. Use it to overload TWiki's internal redirect.
+    # Use only in one Plugin.
+    # New hook in TWiki::Plugins $VERSION = '1.010'
+
+}
+
+# =========================
+sub DISABLE_getSessionValueHandler
+{
+### my ( $key ) = @_;   # do not uncomment, use $_[0] instead
+
+
+    # This handler is called by TWiki::getSessionValue. Return the value of a key.
+    # Use only in one Plugin.
+    # New hook in TWiki::Plugins $VERSION = '1.010'
+
+}
+
+# =========================
+sub DISABLE_setSessionValueHandler
+{
+### my ( $key, $value ) = @_;   # do not uncomment, use $_[0], $_[1] instead
+
+
+    # This handler is called by TWiki::setSessionValue. 
+    # Use only in one Plugin.
+    # New hook in TWiki::Plugins $VERSION = '1.010'
+
+}
+
+# =========================
+
+1;
Index: twiki/lib/TWiki/Store/RcsLite.pm
diff -u twiki/lib/TWiki/Store/RcsLite.pm:1.1.1.1 twiki/lib/TWiki/Store/RcsLite.pm:1.2
--- twiki/lib/TWiki/Store/RcsLite.pm:1.1.1.1	Wed Jul  7 18:51:11 2004
+++ twiki/lib/TWiki/Store/RcsLite.pm	Mon Jul 12 18:29:03 2004
@@ -50,7 +50,7 @@
 use FileHandle;
 use TWiki;
 
-TWiki::writeDebug("Diff version $Algorithm::Diff::VERSION\n");
+#TWiki::writeDebug("Diff version $Algorithm::Diff::VERSION\n");
 
 my $DIFF_DEBUG = 0;
 my $DIFFEND_DEBUG = 0;
Index: twiki/lib/TWiki/UI/Edit.pm
diff -u twiki/lib/TWiki/UI/Edit.pm:1.1.1.1 twiki/lib/TWiki/UI/Edit.pm:1.2
--- twiki/lib/TWiki/UI/Edit.pm:1.1.1.1	Wed Jul  7 18:51:11 2004
+++ twiki/lib/TWiki/UI/Edit.pm	Sat Jul 10 12:43:05 2004
@@ -195,6 +195,11 @@
     $tmpl =~ s/\(edit\)/\(edit cmd=$saveCmd\)/go;
   }
   $tmpl =~ s/%CMD%/$saveCmd/go;
+
+  my $previewForm=&TWiki::alt_nonce_text('
'); + $tmpl =~ s/%FORMPREVIEWTOPIC%/$previewForm/go; + + $tmpl = &TWiki::handleCommonTags( $tmpl, $topic ); if( $saveCmd ne "repRev" ) { $tmpl = &TWiki::handleMetaTags( $webName, $topic, $tmpl, $meta ); Index: twiki/lib/TWiki/UI/Preview.pm diff -u twiki/lib/TWiki/UI/Preview.pm:1.1.1.1 twiki/lib/TWiki/UI/Preview.pm:1.2 --- twiki/lib/TWiki/UI/Preview.pm:1.1.1.1 Wed Jul 7 18:51:11 2004 +++ twiki/lib/TWiki/UI/Preview.pm Sat Jul 10 12:43:05 2004 @@ -120,6 +120,9 @@ $ptext = &TWiki::putBackVerbatim( $ptext, "pre", @verbatim ); + my $saveForm=&TWiki::alt_nonce_text(''); + $tmpl =~ s/%FORMSAVETOPIC%/$saveForm/go; + $tmpl = &TWiki::handleCommonTags( $tmpl, $topic ); $tmpl = &TWiki::handleMetaTags( $webName, $topic, $tmpl, $meta ); $tmpl = &TWiki::Render::getRenderedVersion( $tmpl ); Index: twiki/lib/TWiki/UI/RDiff.pm diff -u twiki/lib/TWiki/UI/RDiff.pm:1.1.1.1 twiki/lib/TWiki/UI/RDiff.pm:1.2 --- twiki/lib/TWiki/UI/RDiff.pm:1.1.1.1 Wed Jul 7 18:51:11 2004 +++ twiki/lib/TWiki/UI/RDiff.pm Wed Jul 7 19:10:51 2004 @@ -427,7 +427,7 @@ # check access permission my $wikiUserName = &TWiki::userToWikiName( $userName ); my $viewAccessOK = &TWiki::Access::checkAccessPermission( "view", $wikiUserName, "", $topic, $webName ); - if( $TWiki::readTopicPermissionFailed ) { + if( $TWiki::readTopicPermissionFailed ne "") { # Can't read requested topic and/or included (or other accessed topics) # user could not be authenticated, may be not logged in yet? my $rdiffauthFile = $ENV{'SCRIPT_FILENAME'}; Index: twiki/lib/TWiki/UI/Save.pm diff -u twiki/lib/TWiki/UI/Save.pm:1.1.1.1 twiki/lib/TWiki/UI/Save.pm:1.5 --- twiki/lib/TWiki/UI/Save.pm:1.1.1.1 Wed Jul 7 18:51:11 2004 +++ twiki/lib/TWiki/UI/Save.pm Sun Jul 11 02:30:52 2004 @@ -127,12 +127,12 @@ use TWiki::Prefs; $text = TWiki::Prefs::updateSetFromForm( $meta, $text ); } - + &WebDebug::debug("saving (first 1000 chars): ".substr($text,0,1000)); my $error = TWiki::Store::saveTopic( $webName, $topic, $text, $meta, $saveCmd, $unlock, $dontNotify ); if( $error ) { TWiki::UI::oops( $webName, $topic, "saveerr", $error ); } else { - TWiki::redirect( $query, TWiki::getViewUrl( TWiki::Store::normalizeWebTopicName($webName, $topic)) ); + TWiki::redirect( $query, TWiki::getViewUrl( TWiki::Store::normalizeWebTopicName($webName, $topic)).&TWiki::nonce_query ); } } Index: twiki/lib/TWiki/UI/View.pm diff -u twiki/lib/TWiki/UI/View.pm:1.1.1.1 twiki/lib/TWiki/UI/View.pm:1.4 --- twiki/lib/TWiki/UI/View.pm:1.1.1.1 Wed Jul 7 18:51:11 2004 +++ twiki/lib/TWiki/UI/View.pm Thu Jul 8 19:21:47 2004 @@ -194,7 +194,8 @@ # New %EDITURL% variable is implemented by handleCommonTags, suffixes # '?t=NNNN' to ensure that every Edit link is unique, fixing # Codev.RefreshEditPage bug relating to caching of Edit page. - $tmpl =~ s!%EDITTOPIC%!$editAction!go; + my $editLink= &TWiki::alt_nonce_text('$editAction}); + $tmpl =~ s!%EDITTOPIC%!$editLink!go; # FIXME: Implement ColasNahaboo's suggested %EDITLINK% along the # same lines, within handleCommonTags @@ -251,7 +252,7 @@ # check access permission my $viewAccessOK = &TWiki::Access::checkAccessPermission( "view", $wikiUserName, $text, $topic, $webName ); - if( $TWiki::readTopicPermissionFailed ) { + if( (!$topicExists) || $TWiki::readTopicPermissionFailed ne "") { # Can't read requested topic and/or included (or other accessed topics # user could not be authenticated, may be not logged in yet? my $viewauthFile = $ENV{'SCRIPT_FILENAME'}; Index: twiki/templates/edit.tmpl diff -u twiki/templates/edit.tmpl:1.1.1.1 twiki/templates/edit.tmpl:1.3 --- twiki/templates/edit.tmpl:1.1.1.1 Wed Jul 7 18:51:09 2004 +++ twiki/templates/edit.tmpl Sat Jul 10 12:43:57 2004 @@ -67,7 +67,7 @@ #PageTop - +%FORMPREVIEWTOPIC% %TMPL:DEF{"titleaction"}%(edit) %TMPL:END% %TMPL:DEF{"titlehelp"}% %TMPL:END% %TMPL:DEF{"webaction"}%Change topic%TMPL:END% Index: twiki/templates/preview.tmpl diff -u twiki/templates/preview.tmpl:1.1.1.1 twiki/templates/preview.tmpl:1.3 --- twiki/templates/preview.tmpl:1.1.1.1 Wed Jul 7 18:51:09 2004 +++ twiki/templates/preview.tmpl Sat Jul 10 12:43:58 2004 @@ -35,7 +35,7 @@ %TEXT% %META{"form"}% %META{"attachments"}% - +%FORMSAVETOPIC% Index: twiki/templates/edit.iejs.tmpl diff -u twiki/templates/edit.iejs.tmpl:1.1.1.1 twiki/templates/edit.iejs.tmpl:1.3 --- twiki/templates/edit.iejs.tmpl:1.1.1.1 Wed Jul 7 18:51:09 2004 +++ twiki/templates/edit.iejs.tmpl Tue Jul 13 13:22:21 2004 @@ -327,7 +327,7 @@ #PageTop - +%FORMPREVIEWTOPIC% %TMPL:DEF{"titleaction"}%(edit) %TMPL:END% %TMPL:DEF{"webaction"}%Change topic%TMPL:END% %TMPL:P{"simpleheader"}% @@ -345,7 +345,6 @@ -See below for help in editing this page.