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