summaryrefslogtreecommitdiff
path: root/IkiWiki/Plugin/svn.pm
blob: 9cf82b5db3c4ce663a552cee9acd7cd22e665c3c (plain)
  1. #!/usr/bin/perl
  2. package IkiWiki::Plugin::svn;
  3. use warnings;
  4. use strict;
  5. use IkiWiki;
  6. use POSIX qw(setlocale LC_CTYPE);
  7. sub import {
  8. hook(type => "checkconfig", id => "svn", call => \&checkconfig);
  9. hook(type => "getsetup", id => "svn", call => \&getsetup);
  10. hook(type => "rcs", id => "rcs_update", call => \&rcs_update);
  11. hook(type => "rcs", id => "rcs_prepedit", call => \&rcs_prepedit);
  12. hook(type => "rcs", id => "rcs_commit", call => \&rcs_commit);
  13. hook(type => "rcs", id => "rcs_commit_staged", call => \&rcs_commit_staged);
  14. hook(type => "rcs", id => "rcs_add", call => \&rcs_add);
  15. hook(type => "rcs", id => "rcs_remove", call => \&rcs_remove);
  16. hook(type => "rcs", id => "rcs_rename", call => \&rcs_rename);
  17. hook(type => "rcs", id => "rcs_recentchanges", call => \&rcs_recentchanges);
  18. hook(type => "rcs", id => "rcs_diff", call => \&rcs_diff);
  19. hook(type => "rcs", id => "rcs_getctime", call => \&rcs_getctime);
  20. hook(type => "rcs", id => "rcs_getmtime", call => \&rcs_getmtime);
  21. }
  22. sub checkconfig () {
  23. if (! defined $config{svnpath}) {
  24. $config{svnpath}="trunk";
  25. }
  26. if (exists $config{svnpath}) {
  27. # code depends on the path not having extraneous slashes
  28. $config{svnpath}=~tr#/#/#s;
  29. $config{svnpath}=~s/\/$//;
  30. $config{svnpath}=~s/^\///;
  31. }
  32. if (defined $config{svn_wrapper} && length $config{svn_wrapper}) {
  33. push @{$config{wrappers}}, {
  34. wrapper => $config{svn_wrapper},
  35. wrappermode => (defined $config{svn_wrappermode} ? $config{svn_wrappermode} : "04755"),
  36. };
  37. }
  38. }
  39. sub getsetup () {
  40. return
  41. plugin => {
  42. safe => 0, # rcs plugin
  43. rebuild => undef,
  44. section => "rcs",
  45. },
  46. svnrepo => {
  47. type => "string",
  48. example => "/svn/wiki",
  49. description => "subversion repository location",
  50. safe => 0, # path
  51. rebuild => 0,
  52. },
  53. svnpath => {
  54. type => "string",
  55. example => "trunk",
  56. description => "path inside repository where the wiki is located",
  57. safe => 0, # paranoia
  58. rebuild => 0,
  59. },
  60. svn_wrapper => {
  61. type => "string",
  62. example => "/svn/wikirepo/hooks/post-commit",
  63. description => "svn post-commit hook to generate",
  64. safe => 0, # file
  65. rebuild => 0,
  66. },
  67. svn_wrappermode => {
  68. type => "string",
  69. example => '04755',
  70. description => "mode for svn_wrapper (can safely be made suid)",
  71. safe => 0,
  72. rebuild => 0,
  73. },
  74. historyurl => {
  75. type => "string",
  76. example => "http://svn.example.org/trunk/[[file]]",
  77. description => "viewvc url to show file history ([[file]] substituted)",
  78. safe => 1,
  79. rebuild => 1,
  80. },
  81. diffurl => {
  82. type => "string",
  83. example => "http://svn.example.org/trunk/[[file]]?root=wiki&r1=[[r1]]&r2=[[r2]]",
  84. description => "viewvc url to show a diff ([[file]], [[r1]], and [[r2]] substituted)",
  85. safe => 1,
  86. rebuild => 1,
  87. },
  88. }
  89. # svn needs LC_CTYPE set to a UTF-8 locale, so try to find one. Any will do.
  90. sub find_lc_ctype() {
  91. my $current = setlocale(LC_CTYPE());
  92. return $current if $current =~ m/UTF-?8$/i;
  93. # Make some obvious attempts to avoid calling `locale -a`
  94. foreach my $locale ("$current.UTF-8", "en_US.UTF-8", "en_GB.UTF-8") {
  95. return $locale if setlocale(LC_CTYPE(), $locale);
  96. }
  97. # Try to get all available locales and pick the first UTF-8 one found.
  98. if (my @locale = grep(/UTF-?8$/i, `locale -a`)) {
  99. chomp @locale;
  100. return $locale[0] if setlocale(LC_CTYPE(), $locale[0]);
  101. }
  102. # fallback to the current locale
  103. return $current;
  104. }
  105. $ENV{LC_CTYPE} = $ENV{LC_CTYPE} || find_lc_ctype();
  106. sub svn_info ($$) {
  107. my $field=shift;
  108. my $file=shift;
  109. my $info=`LANG=C svn info $file`;
  110. my ($ret)=$info=~/^$field: (.*)$/m;
  111. return $ret;
  112. }
  113. sub rcs_update () {
  114. if (-d "$config{srcdir}/.svn") {
  115. if (system("svn", "update", "--quiet", $config{srcdir}) != 0) {
  116. warn("svn update failed\n");
  117. }
  118. }
  119. }
  120. sub rcs_prepedit ($) {
  121. # Prepares to edit a file under revision control. Returns a token
  122. # that must be passed into rcs_commit when the file is ready
  123. # for committing.
  124. # The file is relative to the srcdir.
  125. my $file=shift;
  126. if (-d "$config{srcdir}/.svn") {
  127. # For subversion, return the revision of the file when
  128. # editing begins.
  129. my $rev=svn_info("Revision", "$config{srcdir}/$file");
  130. return defined $rev ? $rev : "";
  131. }
  132. }
  133. sub commitmessage (@) {
  134. my %params=@_;
  135. if (defined $params{session}) {
  136. if (defined $params{session}->param("name")) {
  137. return "web commit by ".
  138. $params{session}->param("name").
  139. (length $params{message} ? ": $params{message}" : "");
  140. }
  141. elsif (defined $params{session}->remote_addr()) {
  142. return "web commit from ".
  143. $params{session}->remote_addr().
  144. (length $params{message} ? ": $params{message}" : "");
  145. }
  146. }
  147. return $params{message};
  148. }
  149. sub rcs_commit (@) {
  150. # Tries to commit the page; returns undef on _success_ and
  151. # a version of the page with the rcs's conflict markers on failure.
  152. # The file is relative to the srcdir.
  153. my %params=@_;
  154. if (-d "$config{srcdir}/.svn") {
  155. # Check to see if the page has been changed by someone
  156. # else since rcs_prepedit was called.
  157. my ($oldrev)=$params{token}=~/^([0-9]+)$/; # untaint
  158. my $rev=svn_info("Revision", "$config{srcdir}/$params{file}");
  159. if (defined $rev && defined $oldrev && $rev != $oldrev) {
  160. # Merge their changes into the file that we've
  161. # changed.
  162. if (system("svn", "merge", "--quiet", "-r$oldrev:$rev",
  163. "$config{srcdir}/$params{file}", "$config{srcdir}/$params{file}") != 0) {
  164. warn("svn merge -r$oldrev:$rev failed\n");
  165. }
  166. }
  167. if (system("svn", "commit", "--quiet",
  168. "--encoding", "UTF-8", "-m",
  169. IkiWiki::possibly_foolish_untaint(commitmessage(%params)),
  170. $config{srcdir}) != 0) {
  171. my $conflict=readfile("$config{srcdir}/$params{file}");
  172. if (system("svn", "revert", "--quiet", "$config{srcdir}/$params{file}") != 0) {
  173. warn("svn revert failed\n");
  174. }
  175. return $conflict;
  176. }
  177. }
  178. return undef # success
  179. }
  180. sub rcs_commit_staged (@) {
  181. # Commits all staged changes. Changes can be staged using rcs_add,
  182. # rcs_remove, and rcs_rename.
  183. my %params=@_;
  184. if (system("svn", "commit", "--quiet",
  185. "--encoding", "UTF-8", "-m",
  186. IkiWiki::possibly_foolish_untaint(commitmessage(%params)),
  187. $config{srcdir}) != 0) {
  188. warn("svn commit failed\n");
  189. return 1; # failure
  190. }
  191. return undef # success
  192. }
  193. sub rcs_add ($) {
  194. # filename is relative to the root of the srcdir
  195. my $file=shift;
  196. if (-d "$config{srcdir}/.svn") {
  197. my $parent=IkiWiki::dirname($file);
  198. while (! -d "$config{srcdir}/$parent/.svn") {
  199. $file=$parent;
  200. $parent=IkiWiki::dirname($file);
  201. }
  202. if (system("svn", "add", "--quiet", "$config{srcdir}/$file") != 0) {
  203. warn("svn add failed\n");
  204. }
  205. }
  206. }
  207. sub rcs_remove ($) {
  208. # filename is relative to the root of the srcdir
  209. my $file=shift;
  210. if (-d "$config{srcdir}/.svn") {
  211. if (system("svn", "rm", "--force", "--quiet", "$config{srcdir}/$file") != 0) {
  212. warn("svn rm failed\n");
  213. }
  214. }
  215. }
  216. sub rcs_rename ($$) {
  217. # filenames relative to the root of the srcdir
  218. my ($src, $dest)=@_;
  219. if (-d "$config{srcdir}/.svn") {
  220. # Add parent directory for $dest
  221. my $parent=IkiWiki::dirname($dest);
  222. if (! -d "$config{srcdir}/$parent/.svn") {
  223. while (! -d "$config{srcdir}/$parent/.svn") {
  224. $parent=IkiWiki::dirname($dest);
  225. }
  226. if (system("svn", "add", "--quiet", "$config{srcdir}/$parent") != 0) {
  227. warn("svn add $parent failed\n");
  228. }
  229. }
  230. if (system("svn", "mv", "--force", "--quiet",
  231. "$config{srcdir}/$src", "$config{srcdir}/$dest") != 0) {
  232. warn("svn rename failed\n");
  233. }
  234. }
  235. }
  236. sub rcs_recentchanges ($) {
  237. my $num=shift;
  238. my @ret;
  239. return unless -d "$config{srcdir}/.svn";
  240. eval q{
  241. use Date::Parse;
  242. use XML::SAX;
  243. use XML::Simple;
  244. };
  245. error($@) if $@;
  246. # avoid using XML::SAX::PurePerl, it's buggy with UTF-8 data
  247. my @parsers = map { ${$_}{Name} } @{XML::SAX->parsers()};
  248. do {
  249. $XML::Simple::PREFERRED_PARSER = pop @parsers;
  250. } until $XML::Simple::PREFERRED_PARSER ne 'XML::SAX::PurePerl';
  251. # --limit is only supported on Subversion 1.2.0+
  252. my $svn_version=`svn --version -q`;
  253. my $svn_limit='';
  254. $svn_limit="--limit $num"
  255. if $svn_version =~ /\d\.(\d)\.\d/ && $1 >= 2;
  256. my $svn_url=svn_info("URL", $config{srcdir});
  257. my $xml = XMLin(scalar `svn $svn_limit --xml -v log '$svn_url'`,
  258. ForceArray => [ 'logentry', 'path' ],
  259. GroupTags => { paths => 'path' },
  260. KeyAttr => { path => 'content' },
  261. );
  262. foreach my $logentry (@{$xml->{logentry}}) {
  263. my (@pages, @message);
  264. my $rev = $logentry->{revision};
  265. my $user = $logentry->{author};
  266. my $when=str2time($logentry->{date}, 'UTC');
  267. foreach my $msgline (split(/\n/, $logentry->{msg})) {
  268. push @message, { line => $msgline };
  269. }
  270. my $committype="web";
  271. if (defined $message[0] &&
  272. $message[0]->{line}=~/$config{web_commit_regexp}/) {
  273. $user=defined $2 ? "$2" : "$3";
  274. $message[0]->{line}=$4;
  275. }
  276. else {
  277. $committype="svn";
  278. }
  279. foreach my $file (keys %{$logentry->{paths}}) {
  280. if (length $config{svnpath}) {
  281. next unless $file=~/^\/\Q$config{svnpath}\E\/([^ ]+)(?:$|\s)/;
  282. $file=$1;
  283. }
  284. my $diffurl=defined $config{diffurl} ? $config{diffurl} : "";
  285. $diffurl=~s/\[\[file\]\]/$file/g;
  286. $diffurl=~s/\[\[r1\]\]/$rev - 1/eg;
  287. $diffurl=~s/\[\[r2\]\]/$rev/g;
  288. push @pages, {
  289. page => pagename($file),
  290. diffurl => $diffurl,
  291. } if length $file;
  292. }
  293. push @ret, {
  294. rev => $rev,
  295. user => $user,
  296. committype => $committype,
  297. when => $when,
  298. message => [@message],
  299. pages => [@pages],
  300. } if @pages;
  301. return @ret if @ret >= $num;
  302. }
  303. return @ret;
  304. }
  305. sub rcs_diff ($) {
  306. my $rev=IkiWiki::possibly_foolish_untaint(int(shift));
  307. return `svnlook diff $config{svnrepo} -r$rev --no-diff-deleted`;
  308. }
  309. {
  310. my ($lastfile, $lastmtime, $lastctime);
  311. sub findtimes ($) {
  312. my $file=shift;
  313. if (defined $lastfile && $lastfile eq $file) {
  314. return $lastmtime, $lastctime;
  315. }
  316. $lastfile=$file;
  317. my $svn_log_infoline=qr/^r\d+\s+\|\s+[^\s]+\s+\|\s+(\d+-\d+-\d+\s+\d+:\d+:\d+\s+[-+]?\d+).*/;
  318. my $child = open(SVNLOG, "-|");
  319. if (! $child) {
  320. exec("svn", "log", "$config{srcdir}/$file") || error("svn log failed to run");
  321. }
  322. my ($cdate, $mdate);
  323. while (<SVNLOG>) {
  324. if (/$svn_log_infoline/) {
  325. $cdate=$1;
  326. $mdate=$1 unless defined $mdate;
  327. }
  328. }
  329. close SVNLOG || error "svn log exited $?";
  330. if (! defined $cdate) {
  331. error "failed to parse svn log for $file";
  332. }
  333. eval q{use Date::Parse};
  334. error($@) if $@;
  335. $lastctime=str2time($cdate);
  336. $lastmtime=str2time($mdate);
  337. return $lastmtime, $lastctime;
  338. }
  339. }
  340. sub rcs_getctime ($) {
  341. my $file=shift;
  342. return (findtimes($file))[1];
  343. }
  344. sub rcs_getmtime ($) {
  345. my $file=shift;
  346. return (findtimes($file))[0];
  347. }
  348. 1