git.oblomov.eu Git - ikiwiki/blob - IkiWiki/Plugin/cvs.pm

   1 #!/usr/pkg/bin/perl
   2 package IkiWiki::Plugin::cvs;
   3
   4 use warnings;
   5 use strict;
   6 use IkiWiki;
   7
   8 sub import {
   9         hook(type => "wrapperargcheck", id => "cvs", call => \&wrapperargcheck);
  10         hook(type => "checkconfig", id => "cvs", call => \&checkconfig);
  11         hook(type => "getsetup", id => "cvs", call => \&getsetup);
  12         hook(type => "rcs", id => "rcs_update", call => \&rcs_update);
  13         hook(type => "rcs", id => "rcs_prepedit", call => \&rcs_prepedit);
  14         hook(type => "rcs", id => "rcs_commit", call => \&rcs_commit);
  15         hook(type => "rcs", id => "rcs_commit_staged", call => \&rcs_commit_staged);
  16         hook(type => "rcs", id => "rcs_add", call => \&rcs_add);
  17         hook(type => "rcs", id => "rcs_remove", call => \&rcs_remove);
  18         hook(type => "rcs", id => "rcs_rename", call => \&rcs_rename);
  19         hook(type => "rcs", id => "rcs_recentchanges", call => \&rcs_recentchanges);
  20         hook(type => "rcs", id => "rcs_diff", call => \&rcs_diff);
  21         hook(type => "rcs", id => "rcs_getctime", call => \&rcs_getctime);
  22 }
  23
  24 sub wrapperargcheck () {
  25         my $check_args=<<"EOF";
  26         int j;
  27         for (j = 1; j < argc; j++)
  28                 if (strstr(argv[j], "New directory") != NULL)
  29                         return 0;
  30         return 1;
  31 EOF
  32         return $check_args;
  33 }
  34
  35 sub checkconfig () {
  36         if (! defined $config{cvspath}) {
  37                 $config{cvspath}="ikiwiki";
  38         }
  39         if (exists $config{cvspath}) {
  40                 # code depends on the path not having extraneous slashes
  41                 $config{cvspath}=~tr#/#/#s;
  42                 $config{cvspath}=~s/\/$//;
  43                 $config{cvspath}=~s/^\///;
  44         }
  45         if (defined $config{cvs_wrapper} && length $config{cvs_wrapper}) {
  46                 push @{$config{wrappers}}, {
  47                         wrapper => $config{cvs_wrapper},
  48                         wrappermode => (defined $config{cvs_wrappermode} ? $config{cvs_wrappermode} : "04755"),
  49                 };
  50         }
  51 }
  52
  53 sub getsetup () {
  54         return
  55                 plugin => {
  56                         safe => 0, # rcs plugin
  57                         rebuild => undef,
  58                 },
  59                 cvsrepo => {
  60                         type => "string",
  61                         example => "/cvs/wikirepo",
  62                         description => "cvs repository location",
  63                         safe => 0, # path
  64                         rebuild => 0,
  65                 },
  66                 cvspath => {
  67                         type => "string",
  68                         example => "ikiwiki",
  69                         description => "path inside repository where the wiki is located",
  70                         safe => 0, # paranoia
  71                         rebuild => 0,
  72                 },
  73                 cvs_wrapper => {
  74                         type => "string",
  75                         example => "/cvs/wikirepo/CVSROOT/post-commit",
  76                         description => "cvs post-commit hook to generate (triggered by CVSROOT/loginfo entry",
  77                         safe => 0, # file
  78                         rebuild => 0,
  79                 },
  80                 cvs_wrappermode => {
  81                         type => "string",
  82                         example => '04755',
  83                         description => "mode for cvs_wrapper (can safely be made suid)",
  84                         safe => 0,
  85                         rebuild => 0,
  86                 },
  87                 historyurl => {
  88                         type => "string",
  89                         example => "http://cvs.example.org/cvsweb.cgi/ikiwiki/[[file]]",
  90                         description => "cvsweb url to show file history ([[file]] substituted)",
  91                         safe => 1,
  92                         rebuild => 1,
  93                 },
  94                 diffurl => {
  95                         type => "string",
  96                         example => "http://cvs.example.org/cvsweb.cgi/ikiwiki/[[file]].diff?r1=text&amp;tr1=[[r1]]&amp;r2=text&amp;tr2=[[r2]]",
  97                         description => "cvsweb url to show a diff ([[file]], [[r1]], and [[r2]] substituted)",
  98                         safe => 1,
  99                         rebuild => 1,
 100                 },
 101 }
 102
 103 sub cvs_info ($$) {
 104         my $field=shift;
 105         my $file=shift;
 106
 107         chdir $config{srcdir} || error("Cannot chdir to $config{srcdir}: $!");
 108
 109         my $info=`cvs status $file`;
 110         my ($ret)=$info=~/^\s*$field:\s*(\S+)/m;
 111         return $ret;
 112 }
 113
 114 sub cvs_runcvs(@) {
 115         my @cmd = @_;
 116         unshift @cmd, 'cvs', '-Q';
 117
 118         chdir $config{srcdir} || error("Cannot chdir to $config{srcdir}: $!");
 119
 120         open(my $savedout, ">&STDOUT");
 121         open(STDOUT, ">", "/dev/null");
 122         my $ret = system(@cmd);
 123         open(STDOUT, ">&", $savedout);
 124
 125         return ($ret == 0) ? 1 : 0;
 126 }
 127
 128 sub cvs_is_controlling {
 129         my $dir=shift;
 130         $dir=$config{srcdir} unless defined($dir);
 131         return (-d "$dir/CVS") ? 1 : 0;
 132 }
 133
 134 sub rcs_update () {
 135         return unless cvs_is_controlling;
 136         cvs_runcvs('update', '-dP');
 137 }
 138
 139 sub rcs_prepedit ($) {
 140         # Prepares to edit a file under revision control. Returns a token
 141         # that must be passed into rcs_commit when the file is ready
 142         # for committing.
 143         # The file is relative to the srcdir.
 144         my $file=shift;
 145
 146         return unless cvs_is_controlling;
 147
 148         # For cvs, return the revision of the file when
 149         # editing begins.
 150         my $rev=cvs_info("Repository revision", "$file");
 151         return defined $rev ? $rev : "";
 152 }
 153
 154 sub rcs_commit ($$$;$$) {
 155         # Tries to commit the page; returns undef on _success_ and
 156         # a version of the page with the rcs's conflict markers on failure.
 157         # The file is relative to the srcdir.
 158         my $file=shift;
 159         my $message=shift;
 160         my $rcstoken=shift;
 161         my $user=shift;
 162         my $ipaddr=shift;
 163
 164         return unless cvs_is_controlling;
 165
 166         if (defined $user) {
 167                 $message="web commit by $user".(length $message ? ": $message" : "");
 168         }
 169         elsif (defined $ipaddr) {
 170                 $message="web commit from $ipaddr".(length $message ? ": $message" : "");
 171         }
 172
 173         # Check to see if the page has been changed by someone
 174         # else since rcs_prepedit was called.
 175         my ($oldrev)=$rcstoken=~/^([0-9]+)$/; # untaint
 176         my $rev=cvs_info("Repository revision", "$config{srcdir}/$file");
 177         if (defined $rev && defined $oldrev && $rev != $oldrev) {
 178                 # Merge their changes into the file that we've
 179                 # changed.
 180                 cvs_runcvs('update', $file) ||
 181                         warn("cvs merge from $oldrev to $rev failed\n");
 182         }
 183
 184         if (! cvs_runcvs('commit', '-m',
 185                          IkiWiki::possibly_foolish_untaint $message)) {
 186                 my $conflict=readfile("$config{srcdir}/$file");
 187                 cvs_runcvs('update', '-C', $file) ||
 188                         warn("cvs revert failed\n");
 189                 return $conflict;
 190         }
 191
 192         return undef # success
 193 }
 194
 195 sub rcs_commit_staged ($$$) {
 196         # Commits all staged changes. Changes can be staged using rcs_add,
 197         # rcs_remove, and rcs_rename.
 198         my ($message, $user, $ipaddr)=@_;
 199
 200         if (defined $user) {
 201                 $message="web commit by $user".(length $message ? ": $message" : "");
 202         }
 203         elsif (defined $ipaddr) {
 204                 $message="web commit from $ipaddr".(length $message ? ": $message" : "");
 205         }
 206
 207         if (! cvs_runcvs('commit', '-m',
 208                          IkiWiki::possibly_foolish_untaint $message)) {
 209                 warn "cvs staged commit failed\n";
 210                 return 1; # failure
 211         }
 212         return undef # success
 213 }
 214
 215 sub rcs_add ($) {
 216         # filename is relative to the root of the srcdir
 217         my $file=shift;
 218         my $parent=IkiWiki::dirname($file);
 219         my @files_to_add = ($file);
 220
 221         eval q{use File::MimeInfo};
 222         error($@) if $@;
 223
 224         until ((length($parent) == 0) || cvs_is_controlling("$config{srcdir}/$parent")){
 225                 push @files_to_add, $parent;
 226                 $parent = IkiWiki::dirname($parent);
 227         }
 228
 229         while ($file = pop @files_to_add) {
 230                 if (@files_to_add == 0) {
 231                         # file
 232                         my $filemime = File::MimeInfo::default($file);
 233                         if (defined($filemime) && $filemime eq 'text/plain') {
 234                                 cvs_runcvs('add', $file) ||
 235                                         warn("cvs add $file failed\n");
 236                         } else {
 237                                 cvs_runcvs('add', '-kb', $file) ||
 238                                         warn("cvs add binary $file failed\n");
 239                         }
 240                 } else {
 241                         # directory
 242                         cvs_runcvs('add', $file) ||
 243                                 warn("cvs add $file failed\n");
 244                 }
 245         }
 246 }
 247
 248 sub rcs_remove ($) {
 249         # filename is relative to the root of the srcdir
 250         my $file=shift;
 251
 252         return unless cvs_is_controlling;
 253
 254         cvs_runcvs('rm', '-f', $file) ||
 255                 warn("cvs rm $file failed\n");
 256 }
 257
 258 sub rcs_rename ($$) {
 259         # filenames relative to the root of the srcdir
 260         my ($src, $dest)=@_;
 261
 262         return unless cvs_is_controlling;
 263
 264         chdir $config{srcdir} || error("Cannot chdir to $config{srcdir}: $!");
 265
 266         if (system("mv", "$src", "$dest") != 0) {
 267                 warn("filesystem rename failed\n");
 268         }
 269
 270         rcs_add($dest);
 271         rcs_remove($src);
 272 }
 273
 274 sub rcs_recentchanges($) {
 275         my $num = shift;
 276         my @ret;
 277
 278         return unless cvs_is_controlling;
 279
 280         eval q{use Date::Parse};
 281         error($@) if $@;
 282
 283         chdir $config{srcdir} || error("Cannot chdir to $config{srcdir}: $!");
 284
 285         # There's no cvsps option to get the last N changesets.
 286         # Write full output to a temp file and read backwards.
 287
 288         eval q{use File::Temp qw/tempfile/};
 289         error($@) if $@;
 290         eval q{use File::ReadBackwards};
 291         error($@) if $@;
 292
 293         my (undef, $tmpfile) = tempfile(OPEN=>0);
 294         system("env TZ=UTC cvsps -q --cvs-direct -z 30 -x >$tmpfile");
 295         if ($? == -1) {
 296                 error "couldn't run cvsps: $!\n";
 297         } elsif (($? >> 8) != 0) {
 298                 error "cvsps exited " . ($? >> 8) . ": $!\n";
 299         }
 300
 301         tie(*SPSVC, 'File::ReadBackwards', $tmpfile)
 302                 || error "couldn't open $tmpfile for read: $!\n";
 303
 304         while (my $line = <SPSVC>) {
 305                 $line =~ /^$/ || error "expected blank line, got $line";
 306
 307                 my ($rev, $user, $committype, $when);
 308                 my (@message, @pages);
 309
 310                 # We're reading backwards.
 311                 # Forwards, an entry looks like so:
 312                 # ---------------------
 313                 # PatchSet $rev
 314                 # Date: $when
 315                 # Author: $user (or user CGI runs as, for web commits)
 316                 # Branch: branch
 317                 # Tag: tag
 318                 # Log:
 319                 # @message_lines
 320                 # Members:
 321                 #       @pages (and revisions)
 322                 #
 323
 324                 while ($line = <SPSVC>) {
 325                         last if ($line =~ /^Members:/);
 326                         for ($line) {
 327                                 s/^\s+//;
 328                                 s/\s+$//;
 329                         }
 330                         my ($page, $revs) = split(/:/, $line);
 331                         my ($oldrev, $newrev) = split(/->/, $revs);
 332                         $oldrev =~ s/INITIAL/0/;
 333                         $newrev =~ s/\(DEAD\)//;
 334                         my $diffurl = defined $config{diffurl} ? $config{diffurl} : "";
 335                         $diffurl=~s/\[\[file\]\]/$page/g;
 336                         $diffurl=~s/\[\[r1\]\]/$oldrev/g;
 337                         $diffurl=~s/\[\[r2\]\]/$newrev/g;
 338                         unshift @pages, {
 339                                 page => pagename($page),
 340                                 diffurl => $diffurl,
 341                         } if length $page;
 342                 }
 343
 344                 while ($line = <SPSVC>) {
 345                         last if ($line =~ /^Log:$/);
 346                         chomp $line;
 347                         unshift @message, { line => $line };
 348                 }
 349                 $committype = "web";
 350                 if (defined $message[0] &&
 351                     $message[0]->{line}=~/$config{web_commit_regexp}/) {
 352                         $user=defined $2 ? "$2" : "$3";
 353                         $message[0]->{line}=$4;
 354                 } else {
 355                         $committype="cvs";
 356                 }
 357
 358                 $line = <SPSVC>;        # Tag
 359                 $line = <SPSVC>;        # Branch
 360
 361                 $line = <SPSVC>;
 362                 if ($line =~ /^Author: (.*)$/) {
 363                         $user = $1 unless defined $user && length $user;
 364                 } else {
 365                         error "expected Author, got $line";
 366                 }
 367
 368                 $line = <SPSVC>;
 369                 if ($line =~ /^Date: (.*)$/) {
 370                         $when = str2time($1, 'UTC');
 371                 } else {
 372                         error "expected Date, got $line";
 373                 }
 374
 375                 $line = <SPSVC>;
 376                 if ($line =~ /^PatchSet (.*)$/) {
 377                         $rev = $1;
 378                 } else {
 379                         error "expected PatchSet, got $line";
 380                 }
 381
 382                 $line = <SPSVC>;        # ---------------------
 383
 384                 push @ret, {
 385                         rev => $rev,
 386                         user => $user,
 387                         committype => $committype,
 388                         when => $when,
 389                         message => [@message],
 390                         pages => [@pages],
 391                 } if @pages;
 392                 last if @ret >= $num;
 393         }
 394
 395         unlink($tmpfile) || error "couldn't unlink $tmpfile: $!\n";
 396
 397         return @ret;
 398 }
 399
 400 sub rcs_diff ($) {
 401         my $rev=IkiWiki::possibly_foolish_untaint(int(shift));
 402
 403         chdir $config{srcdir} || error("Cannot chdir to $config{srcdir}: $!");
 404
 405         # diff output is unavoidably preceded by the cvsps PatchSet entry
 406         my @cvsps = `env TZ=UTC cvsps -q --cvs-direct -z 30 -g -s $rev`;
 407         my $blank_lines_seen = 0;
 408
 409         while (my $line = shift @cvsps) {
 410                 $blank_lines_seen++ if ($line =~ /^$/);
 411                 last if $blank_lines_seen == 2;
 412         }
 413
 414         if (wantarray) {
 415                 return @cvsps;
 416         } else {
 417                 return join("", @cvsps);
 418         }
 419 }
 420
 421 sub rcs_getctime ($) {
 422         my $file=shift;
 423
 424         my $cvs_log_infoline=qr/^date: (.+);\s+author/;
 425
 426         open CVSLOG, "cvs -Q log -r1.1 '$file' |"
 427                 || error "couldn't get cvs log output: $!\n";
 428
 429         my $date;
 430         while (<CVSLOG>) {
 431                 if (/$cvs_log_infoline/) {
 432                         $date=$1;
 433                 }
 434         }
 435         close CVSLOG || warn "cvs log $file exited $?";
 436
 437         if (! defined $date) {
 438                 warn "failed to parse cvs log for $file\n";
 439                 return 0;
 440         }
 441
 442         eval q{use Date::Parse};
 443         error($@) if $@;
 444         $date=str2time($date, 'UTC');
 445         debug("found ctime ".localtime($date)." for $file");
 446         return $date;
 447 }
 448
 449 1