modules/static-hybrid.pl

   1 # Copyright (C) 2005  Fletcher T. Penney <fletcher@freeshell.org>
   2 # Copyright (C) 2004  Alex Schroeder <alex@emacswiki.org>
   3 #
   4 # This program is free software; you can redistribute it and/or modify
   5 # it under the terms of the GNU General Public License as published by
   6 # the Free Software Foundation; either version 2 of the License, or
   7 # (at your option) any later version.
   8 #
   9 # This program is distributed in the hope that it will be useful,
  10 # but WITHOUT ANY WARRANTY; without even the implied warranty of
  11 # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  12 # GNU General Public License for more details.
  13 #
  14 # You should have received a copy of the GNU General Public License
  15 # along with this program; if not, write to the
  16 #        Free Software Foundation, Inc.
  17 #        59 Temple Place, Suite 330
  18 #        Boston, MA 02111-1307 USA
  19
  20 $ModulesDescription .= '<p><a href="http://git.savannah.gnu.org/cgit/oddmuse.git/tree/modules/static-hybrid.pl">static-hybrid.pl</a>, see <a href="http://www.oddmuse.org/cgi-bin/oddmuse/Static_Hybrid_Module">Static Hybrid Module</a></p>';
  21
  22 $Action{static} = \&DoStatic;
  23
  24 use vars qw($StaticDir $StaticAlways %StaticMimeTypes $StaticUrl
  25 %StaticLinkedPages @StaticIgnoredPages);
  26
  27 $StaticDir = '' unless defined $StaticDir;
  28 $StaticUrl = '' unless defined $StaticUrl;        # change this!
  29 $StaticAlways = 0 unless defined $StaticFilesAlways;
  30                 # 1 = uploaded files only, 2 = all pages
  31
  32 my $StaticMimeTypes = '/etc/http/mime.types';
  33 my %StaticFiles;
  34
  35 my $StaticAction = 0;   # Are we doing action or not?
  36 my @StaticQueue = ();
  37
  38 my $ClusterHasChanged = 0;
  39 my $PageBeingSaved = "";
  40
  41 sub DoStatic {
  42         $StaticAction = 1;
  43         return unless UserIsAdminOrError();
  44         my $raw = GetParam('raw', 0);
  45         if ($raw) {
  46                 print GetHttpHeader('text/plain');
  47         } else {
  48                 print GetHeader('', T('Static Copy'), '');
  49         }
  50         CreateDir($StaticDir);
  51         %StaticMimeTypes = StaticMimeTypes() unless %StaticMimeTypes;
  52         %StaticFiles = ();
  53         my $id = GetParam('id', '');
  54         if ($id) {
  55                 local *GetDownloadLink = *StaticGetDownloadLink;
  56                 StaticWriteFile($id);
  57         } else {
  58                 StaticWriteFiles();
  59         }
  60         print '</p>' unless $raw;
  61         PrintFooter() unless $raw;
  62 }
  63
  64 sub StaticMimeTypes {
  65         my %hash;
  66         # the default mapping matches the default @UploadTypes...
  67         open(F,$StaticMimeTypes)
  68                 or return ('image/jpeg' => 'jpg', 'image/png' => 'png', 'image/gif' => 'gif');
  69         while (<F>) {
  70                 s/\#.*//;                                       # remove comments
  71                         my($type, $ext) = split;
  72                 $hash{$type} = $ext if $ext;
  73         }
  74                         close(F);
  75                 return %hash;
  76 }
  77
  78 sub StaticWriteFiles {
  79         my $raw = GetParam('raw', 0);
  80         local *GetDownloadLink = *StaticGetDownloadLink;
  81         foreach my $id (AllPagesList()) {
  82                 SetParam('rcclusteronly',0);
  83                 if (! grep(/^$id$/,@StaticIgnoredPages)) {
  84                         StaticWriteFile($id);
  85                 }
  86         }
  87 }
  88
  89 sub StaticGetDownloadLink {
  90         my ($name, $image, $revision, $alt) = @_; # ignore $revision
  91         $alt = $name unless $alt;
  92         my $id = FreeToNormal($name);
  93         AllPagesList();
  94         # if the page does not exist
  95         return '[' . ($image ? 'image' : 'link') . ':' . $name . ']' unless $IndexHash{$id};
  96         if ($image) {
  97                 my $result = $q->img({-src=>StaticFileName($id), -alt=>$alt, -class=>'upload'});
  98                 $result = ScriptLink($id, $result, 'image');
  99                 return $result;
 100         } else {
 101                 return ScriptLink($id, $alt, 'upload');
 102         }
 103 }
 104
 105 sub StaticFileName {
 106         my $id = shift;
 107         $id =~ s/ /_/g;
 108         $id =~ s/#.*//;           # remove named anchors for the filename test
 109         return $StaticFiles{$id} if $StaticFiles{$id}; # cache filenames
 110         my ($status, $data) = ReadFile(GetPageFile(StaticUrlDecode($id)));
 111         print "cannot read " . GetPageFile(StaticUrlDecode($id)) . $q->br() unless $status;
 112         my %hash = ParseData($data);
 113         my $ext = '.html';
 114         if ($hash{text} =~ /^\#FILE ([^ \n]+)\n(.*)/s) {
 115                 $ext = $StaticMimeTypes{$1};
 116                 $ext = '.' . $ext if $ext;
 117         }
 118         $StaticFiles{$id} = $id . $ext;
 119         return $StaticFiles{$id};
 120 }
 121
 122 sub StaticUrlDecode {
 123         my $str = shift;
 124         $str =~ s/%([0-9a-f][0-9a-f])/chr(hex($1))/ge;
 125         return $str;
 126 }
 127
 128 sub StaticWriteFile {
 129         my $id = shift;
 130         my $raw = GetParam('raw', 0);
 131         my $html = GetParam('html', 1);
 132         my $filename = StaticFileName($id);
 133
 134         OpenPage($id);
 135         my ($mimetype, $data) = $Page{text} =~ /^\#FILE ([^ \n]+)\n(.*)/s;
 136         return unless $html or $data;
 137         open(F,"> $StaticDir/$filename") or ReportError(Ts('Cannot write %s', $filename));
 138         if ($data) {
 139                 StaticFile($id, $mimetype, $data);
 140         } elsif ($html) {
 141                 StaticHtml($id);
 142         }
 143         close(F);
 144         chmod 0644,"$StaticDir/$filename";
 145         if (lc(GetParam('action','')) eq "static") {
 146                 print $filename, $raw ? "\n" : $q->br();
 147         }
 148 }
 149
 150 sub StaticFile {
 151         my ($id, $type, $data) = @_;
 152         require MIME::Base64;
 153         binmode(F);
 154         print F MIME::Base64::decode($data);
 155 }
 156
 157 sub StaticHtml {
 158         my $id = FreeToNormal(shift);
 159         my $title = $id;
 160         $title =~ s/_/ /g;
 161         my $result = '';
 162
 163         local *GetHttpHeader = *StaticGetHttpHeader;
 164         local *GetCommentForm = *StaticGetCommentForm;
 165         %NearLinksUsed = ();
 166
 167         # Isolate our output
 168         local *STDOUT;
 169         open(STDOUT, '>', \$result);
 170         local *STDERR;
 171         open(STDERR, '>/dev/null');
 172
 173         # Process the page
 174         local $Message = "";
 175         # encoding is left off, so fix it:
 176         print qq!<?xml version="1.0" encoding="UTF-8" ?>!;
 177         print GetHeader($id, QuoteHtml($id), undef, "");
 178         print $q->start_div({-class=> 'content browse'});
 179         print PageHtml($id);
 180         print $q->end_div();
 181         SetParam('rcclusteronly', $id) if (FreeToNormal(GetCluster($Page{text})) eq $id);
 182         if (($id eq $RCName) || (T($RCName) eq $id) || (T($id) eq $RCName)
 183                 || GetParam('rcclusteronly', '')) {
 184                 print $q->start_div({-class=>'rc'});;
 185                 print $q->hr()  if not GetParam('embed', $EmbedWiki);
 186                 DoRc(\&GetRcHtml);
 187                 print $q->end_div();
 188         }
 189         PrintFooter($id);
 190         print F $result;
 191         return;
 192 }
 193
 194 *StaticFilesOldDoPost = *DoPost;
 195 *DoPost = *StaticFilesNewDoPost;
 196
 197 sub StaticFilesNewDoPost {
 198         my $id = FreeToNormal(shift);
 199         OpenPage($id);
 200         my $old_cluster = FreeToNormal(GetCluster($Page{text}));
 201         StaticFilesOldDoPost($id);
 202         my $new_cluster = FreeToNormal(GetCluster($Page{text}));
 203
 204         $ClusterHasChanged = 1 if ($old_cluster ne $new_cluster);
 205
 206         if ($StaticAlways) {
 207                 # always delete
 208                 StaticDeleteFile($OpenPageName);
 209                 if ($Page{text} =~ /^\#FILE / # if a file was uploaded
 210                         or $StaticAlways > 1) {
 211                         CreateDir($StaticDir);
 212                         # If new Page added, update index
 213                         if (! $IndexHash{$OpenPageName} ) {
 214                                 push(@IndexList, $OpenPageName);
 215                                 $IndexHash{$OpenPageName} = 1;
 216                         }
 217
 218                         StaticWriteFile($OpenPageName);
 219                         $PageBeingSaved = $OpenPageName;
 220                         AddLinkedFilesToQueue($OpenPageName);
 221                         StaticWriteLinkedFiles();
 222                 }
 223         }
 224 }
 225
 226 *StaticOldDeletePage = *DeletePage;
 227 *DeletePage = *StaticNewDeletePage;
 228
 229 sub StaticNewDeletePage {
 230         my $id = shift;
 231         StaticDeleteFile($id) if ($StaticAlways);
 232         return StaticOldDeletePage($id);
 233 }
 234
 235 sub StaticDeleteFile {
 236         my $id = shift;
 237         %StaticMimeTypes = StaticMimeTypes() unless %StaticMimeTypes;
 238         # we don't care if the files or $StaticDir don't exist -- just delete!
 239         for my $f (map { "$StaticDir/$id.$_" } (values %StaticMimeTypes, 'html')) {
 240                 unlink $f;                               # delete copies with different extensions
 241         }
 242 }
 243
 244 # override the default!
 245 sub GetDownloadLink {
 246         my ($name, $image, $revision, $alt) = @_;
 247         $alt = $name unless $alt;
 248         my $id = FreeToNormal($name);
 249         AllPagesList();
 250         # if the page does not exist
 251         return '[' . ($image ? T('image') : T('download')) . ':' . $name
 252                 . ']' . GetEditLink($id, '?', 1) unless $IndexHash{$id};
 253         my $action;
 254         if ($revision) {
 255                 $action = "action=download;id=" . UrlEncode($id) . ";revision=$revision";
 256         } elsif ($UsePathInfo) {
 257                 $action = "download/" . UrlEncode($id);
 258         } else {
 259                 $action = "action=download;id=" . UrlEncode($id);
 260         }
 261         if ($image) {
 262                 if ($UsePathInfo and not $revision) {
 263                         if ($StaticAlways and $StaticUrl) {
 264                                 my $url = $StaticUrl;
 265                                 my $img = UrlEncode(StaticFileName($id));
 266                                 $url =~ s/\%s/$img/g or $url .= $img;
 267                                 $action = $url;
 268                         } else {
 269                                 $action = $ScriptName . '/' . $action;
 270                         }
 271                 } else {
 272                         $action = $ScriptName . '?' . $action;
 273                 }
 274                 my $result = $q->img({-src=>$action, -alt=>$alt, -class=>'upload'});
 275                 $result = ScriptLink(UrlEncode($id), $result, 'image') unless $id eq $OpenPageName;
 276                 return $result;
 277         } else {
 278                 return ScriptLink($action, $alt, 'upload');
 279         }
 280 }
 281
 282 # override function from Image Extension to support advanced image tags
 283 sub ImageGetInternalUrl{
 284         my $id = shift;
 285         if ($UsePathInfo) {
 286                 if ($StaticAlways and $StaticUrl) {
 287                         my $url = $StaticUrl;
 288                         my $img = UrlEncode(StaticFileName($id));
 289                         $url =~ s/\%s/$img/g or $url .= $img;
 290                         return $url;
 291                 } else {
 292                         return $ScriptName . '/download/' . UrlEncode($id);
 293                 }
 294         }
 295         return $ScriptName . '?action=download;id=' . UrlEncode($id);
 296 }
 297
 298
 299 sub AddLinkedFilesToQueue {
 300         my $id = shift;
 301
 302         foreach my $pattern (keys %StaticLinkedPages) {
 303                 if ($id =~ /$pattern/) {
 304                         AddNewFilesToQueue(@{$StaticLinkedPages{$pattern}})
 305                 }
 306         }
 307
 308         # If you modify a comment page, then update the original
 309         # Don't check for recursive updates - the only thing that
 310         # changed was the CommentCount - no reason to waste time
 311         if ($id =~ /^$CommentsPrefix(.*)/) {
 312                 my $match = $1;
 313                 push(@StaticQueue,$match);
 314         }
 315
 316         # If the page added belongs to a cluster, update the cluster's page
 317         # and the $ClusterMapPage
 318         # especially important with the clustermap module
 319         local %Page;
 320         local $OpenPageName = '';
 321         OpenPage($id);
 322         my $cluster = FreeToNormal(GetCluster($Page{text}));
 323
 324         # Only move up the cluster hierarchy if the page we originally
 325         # edited has a cluster
 326         if ($PageBeingSaved = $id) {
 327                 if ($cluster ne "" && $cluster ne $id) {
 328                         AddNewFilesToQueue($cluster);
 329
 330                         # If we are using clustermaps then update
 331                         # ClusterMapPage
 332                         # But only if cluster has changed
 333                         if ($ClusterHasChanged) {
 334                                 if ($ClusterMapPage ne "") {
 335                                         AddNewFilesToQueue($ClusterMapPage);
 336                                 }
 337                         }
 338                 }
 339         }
 340 }
 341
 342
 343 sub StaticWriteLinkedFiles {
 344         my $raw = GetParam('raw', 0);
 345         my $writeRC = 0;
 346         local *GetDownloadLink = *StaticGetDownloadLink;
 347
 348         foreach my $id (@StaticQueue) {
 349                 if (! grep(/^$id$/,@StaticIgnoredPages)) {
 350                         StaticWriteFile($id);
 351                         SetParam('rcclusteronly',0);
 352                 }
 353         }
 354 }
 355
 356 sub StaticGetCommentForm {
 357         my ($id, $rev, $comment) = @_;
 358         if ($CommentsPrefix ne '' and $id and $rev ne 'history' and $rev ne 'edit'
 359                 and $OpenPageName =~ /^$CommentsPrefix/) {
 360                 return $q->div({-class=>'comment'}, GetFormStart(undef, undef, 'comment'),
 361                                            $q->p(GetHiddenValue('title', $OpenPageName),
 362                                                          GetTextArea('aftertext', $comment ? $comment : $NewComment)),
 363                                            $q->p(T('Username:'), ' ',
 364                                                          $q->textfield(-name=>'username', -default=>'',
 365                                                                                    -override=>1, -size=>20, -maxlength=>50),
 366                                                          T('Homepage URL:'), ' ',
 367                                                          $q->textfield(-name=>'homepage', -default=>'',
 368                                                                                    -override=>1, -size=>40, -maxlength=>100)),
 369                                            $q->p($q->submit(-name=>'Save', -accesskey=>T('s'), -value=>T('Save')), ' ',
 370                                                          $q->submit(-name=>'Preview', -value=>T('Preview'))),
 371                                            $q->endform());
 372         }
 373         return '';
 374 }
 375
 376 sub StaticGetHttpHeader {
 377         return;
 378 }
 379
 380 sub AddNewFilesToQueue {
 381         # Add a file to queue, but only if not already there
 382         my @ids = @_;
 383
 384         foreach my $id (@ids) {
 385                 if (! grep(/^$id$/,@StaticQueue)) {
 386                         push(@StaticQueue,$id);
 387                         AddLinkedFilesToQueue($id);
 388                 }
 389         }
 390 }
 391
 392 # Make rollback compatible
 393
 394 *StaticOldDoRollback = *DoRollback;
 395 *DoRollback = *StaticNewDoRollback;
 396 $Action{rollback} = \&StaticNewDoRollback;
 397
 398 # Delete the static file so that changes made during a rollback are propogated
 399
 400 sub StaticNewDoRollback {
 401   my $page = shift;
 402   my $to = GetParam('to', 0);
 403   ReportError(T('Missing target for rollback.'), '400 BAD REQUEST') unless $to;
 404   ReportError(T('Target for rollback is too far back.'), '400 BAD REQUEST') unless $page or RollbackPossible($to);
 405   ReportError(T('A username is required for ordinary users.'), '403 FORBIDDEN') unless GetParam('username', '') or UserIsEditor();
 406   my @ids = ();
 407   if (not $page) { # cannot just use list length because of ('')
 408     return unless UserIsAdminOrError(); # only admins can do mass changes
 409     my %ids = map { my ($ts, $id) = split(/$FS/o); $id => 1; } # make unique via hash
 410       GetRcLines($Now - $KeepDays * 86400, 1); # 24*60*60
 411     @ids = keys %ids;
 412   } else {
 413     @ids = ($page);
 414   }
 415   RequestLockOrError();
 416   print GetHeader('', T('Rolling back changes')), $q->start_div({-class=>'content rollback'}), $q->start_p();
 417   foreach my $id (@ids) {
 418     OpenPage($id);
 419     my ($text, $minor, $ts) = GetTextAtTime($to);
 420     if ($Page{text} eq $text) {
 421       print T("The two revisions are the same."), $q->br() if $page; # no message when doing mass revert
 422     } elsif (!UserCanEdit($id, 1)) {
 423       print Ts('Editing not allowed for %s.', $id), $q->br();
 424     } else {
 425       Save($id, $text, Ts('Rollback to %s', TimeToText($to)), $minor, ($Page{ip} ne $ENV{REMOTE_ADDR}));
 426         StaticDeleteFile($id);
 427                 print Ts('%s rolled back', GetPageLink($id)), ($ts ? ' ' . Ts('to %s', TimeToText($to)) : ''), $q->br();
 428     }
 429   }
 430   WriteRcLog('[[rollback]]', '', $to) unless $page; # leave marker for DoRc() if mass rollback
 431   print $q->end_p() . $q->end_div();
 432   ReleaseLock();
 433   PrintFooter();
 434 }
 435
 436 *StaticOldDespamPage = *DespamPage;
 437 *DespamPage = *StaticNewDespamPage;
 438
 439 sub StaticNewDespamPage {
 440   my $rule = shift;
 441   # from DoHistory()
 442   my @revisions = sort {$b <=> $a} map { m|/([0-9]+).kp$|; $1; } GetKeepFiles($OpenPageName);
 443   foreach my $revision (@revisions) { # remember the last revision checked
 444     my ($text, $rev) = GetTextRevision($revision, 1); # quiet
 445     if (not $rev) {
 446       print ': ' . Ts('Cannot find revision %s.', $revision);
 447       return;
 448     } elsif (not DespamBannedContent($text)) {
 449       my $summary = Tss('Revert to revision %1: %2', $revision, $rule);
 450       print ': ' . $summary;
 451       Save($OpenPageName, $text, $summary) unless GetParam('debug', 0);
 452                 StaticDeleteFile($OpenPageName);
 453       return;
 454     }
 455   }
 456   if (grep(/^1$/, @revisions) or not @revisions) { # if there is no kept revision, yet
 457     my $summary = Ts($rule). ' ' . Ts('Marked as %s.', $DeletedPage);
 458     print ': ' . $summary;
 459     Save($OpenPageName, $DeletedPage, $summary) unless GetParam('debug', 0);
 460         StaticDeleteFile($OpenPageName);
 461   } else {
 462     print ': ' . T('Cannot find unspammed revision.'. $revision);
 463   }
 464 }