PageRenderTime 52ms CodeModel.GetById 21ms RepoModel.GetById 0ms app.codeStats 0ms

/packaging/utils/ciabot.pl

https://gitlab.com/envieidoc/Openswan
Perl | 288 lines | 129 code | 74 blank | 85 comment | 12 complexity | c618b134a90c2a0077c8c31cc74943d7 MD5 | raw file
  1. #!/usr/bin/perl -w
  2. #
  3. # ciabot -- Mail a git log message to a given address, for the purposes of CIA
  4. #
  5. # Loosely based on cvslog by Russ Allbery <rra@stanford.edu>
  6. # Copyright 1998 Board of Trustees, Leland Stanford Jr. University
  7. #
  8. # Copyright 2001, 2003, 2004, 2005 Petr Baudis <pasky@ucw.cz>
  9. #
  10. # This program is free software; you can redistribute it and/or modify it under
  11. # the terms of the GNU General Public License version 2, as published by the
  12. # Free Software Foundation.
  13. #
  14. # The master location of this file is in the Cogito repository
  15. # (see http://www.kernel.org/git/).
  16. #
  17. # This program is designed to run as the .git/commit-post-hook script. It takes
  18. # the commit information, massaging it and mailing it to the address given below.
  19. #
  20. # The calling convention of the commit-post-hook script is:
  21. #
  22. # commit-post-hook $commit_sha1 $branch_name
  23. #
  24. # If it does not work, try to disable $xml_rpc in the configuration section
  25. # below.
  26. #
  27. #
  28. # Note that you can (and it might be actually more desirable) also use this
  29. # script as the GIT update hook:
  30. #
  31. # refname=${1#refs/heads/}
  32. # [ "$refname" = "master" ] && refname=
  33. # oldhead=$2
  34. # newhead=$3
  35. # for merged in $(git-rev-list $newhead ^$oldhead | tac); do
  36. # /path/to/ciabot.pl $merged $refname
  37. # done
  38. #
  39. # This is useful when you use a remote repository without working copy, where
  40. # you only push to - the update hook will be trigerred each time you push into
  41. # that repository, and the pushed commits will be reported through CIA.
  42. use strict;
  43. use vars qw ($project $from_email $dest_email $noisy $rpc_uri $sendmail
  44. $xml_rpc $ignore_regexp $alt_local_message_target);
  45. ### Configuration
  46. # Project name (as known to CIA).
  47. $project = 'Openswan';
  48. # The from address in generated mails.
  49. $from_email = 'nightly@xelerance.com';
  50. # Mail all reports to this address.
  51. $dest_email = 'nightly@lists.openswan.org';
  52. # If using XML-RPC, connect to this URI.
  53. $rpc_uri = 'http://cia.navi.cx/RPC2';
  54. # Path to your USCD sendmail compatible binary (your mailer daemon created this
  55. # program somewhere).
  56. $sendmail = '/usr/sbin/sendmail';
  57. # If set, the script will send CIA the full commit message. If unset, only the
  58. # first line of the commit message will be sent.
  59. $noisy = 1;
  60. # This script can communicate with CIA either by mail or by an XML-RPC
  61. # interface. The XML-RPC interface is faster and more efficient, however you
  62. # need to have RPC::XML perl module installed, and some large CVS hosting sites
  63. # (like Savannah or Sourceforge) might not allow outgoing HTTP connections
  64. # while they allow outgoing mail. Also, this script will hang and eventually
  65. # not deliver the event at all if CIA server happens to be down, which is
  66. # unfortunately not an uncommon condition.
  67. $xml_rpc = 0;
  68. # You can make this bot to totally ignore events concerning the objects
  69. # specified below. Each object is composed of <path>/<filename>,
  70. #
  71. # This variable should contain regexp, against which will each object be
  72. # checked, and if the regexp is matched, the file is ignored. Therefore ie. to
  73. # ignore all changes in the two files above and everything concerning module
  74. # 'admin', use:
  75. #
  76. # $ignore_regexp = "^(gentoo/Manifest|elinks/src/bfu/inphist.c|admin/)";
  77. $ignore_regexp = "";
  78. # It can be useful to also grab the generated XML message by some other
  79. # programs and ie. autogenerate some content based on it. Here you can specify
  80. # a file to which it will be appended.
  81. $alt_local_message_target = "";
  82. ### The code itself
  83. use vars qw ($commit $tree @parent $author $committer);
  84. use vars qw ($user $branch $rev @files $logmsg $message);
  85. my $line;
  86. ### Input data loading
  87. # The commit stuff
  88. $commit = $ARGV[0];
  89. $branch = $ARGV[1];
  90. open COMMIT, "git-cat-file commit $commit|" or die "git-cat-file commit $commit: $!";
  91. my $state = 0;
  92. $logmsg = '';
  93. while (defined ($line = <COMMIT>)) {
  94. if ($state == 1) {
  95. $logmsg .= $line;
  96. $noisy or $state++;
  97. next;
  98. } elsif ($state > 1) {
  99. next;
  100. }
  101. chomp $line;
  102. unless ($line) {
  103. $state = 1;
  104. next;
  105. }
  106. my ($key, $value) = split(/ /, $line, 2);
  107. if ($key eq 'tree') {
  108. $tree = $value;
  109. } elsif ($key eq 'parent') {
  110. push(@parent, $value);
  111. } elsif ($key eq 'author') {
  112. $author = $value;
  113. } elsif ($key eq 'committer') {
  114. $committer = $value;
  115. }
  116. }
  117. close COMMIT;
  118. open DIFF, "git-diff-tree -r $parent[0] $tree|" or die "git-diff-tree $parent[0] $tree: $!";
  119. while (defined ($line = <DIFF>)) {
  120. chomp $line;
  121. my @f;
  122. (undef, @f) = split(/\t/, $line, 2);
  123. push (@files, @f);
  124. }
  125. close DIFF;
  126. # Figure out who is doing the update.
  127. # XXX: Too trivial this way?
  128. ($user) = $author =~ /<(.*?)@/;
  129. $rev = substr($commit, 0, 12);
  130. ### Remove to-be-ignored files
  131. @files = grep { $_ !~ m/$ignore_regexp/; } @files
  132. if ($ignore_regexp);
  133. exit unless @files;
  134. ### Compose the mail message
  135. my ($VERSION) = '1.0';
  136. my $ts = time;
  137. $message = <<EM
  138. <message>
  139. <generator>
  140. <name>CIA Perl client for Git</name>
  141. <version>$VERSION</version>
  142. </generator>
  143. <source>
  144. <project>$project</project>
  145. EM
  146. ;
  147. $message .= " <branch>$branch</branch>" if ($branch);
  148. $message .= <<EM
  149. </source>
  150. <timestamp>
  151. $ts
  152. </timestamp>
  153. <body>
  154. <commit>
  155. <author>$user</author>
  156. <revision>$rev</revision>
  157. <files>
  158. EM
  159. ;
  160. foreach (@files) {
  161. s/&/&amp;/g;
  162. s/</&lt;/g;
  163. s/>/&gt;/g;
  164. $message .= " <file>$_</file>\n";
  165. }
  166. $logmsg =~ s/&/&amp;/g;
  167. $logmsg =~ s/</&lt;/g;
  168. $logmsg =~ s/>/&gt;/g;
  169. $message .= <<EM
  170. </files>
  171. <log>
  172. $logmsg
  173. </log>
  174. </commit>
  175. </body>
  176. </message>
  177. EM
  178. ;
  179. ### Write the message to an alt-target
  180. if ($alt_local_message_target and open (ALT, ">>$alt_local_message_target")) {
  181. print ALT $message;
  182. close ALT;
  183. }
  184. ### Send out the XML-RPC message
  185. if ($xml_rpc) {
  186. # We gotta be careful from now on. We silence all the warnings because
  187. # RPC::XML code is crappy and works with undefs etc.
  188. $^W = 0;
  189. $RPC::XML::ERROR if (0); # silence perl's compile-time warning
  190. require RPC::XML;
  191. require RPC::XML::Client;
  192. my $rpc_client = new RPC::XML::Client $rpc_uri;
  193. my $rpc_request = RPC::XML::request->new('hub.deliver', $message);
  194. my $rpc_response = $rpc_client->send_request($rpc_request);
  195. unless (ref $rpc_response) {
  196. die "XML-RPC Error: $RPC::XML::ERROR\n";
  197. }
  198. exit;
  199. }
  200. ### Send out the mail
  201. # Open our mail program
  202. open (MAIL, "| $sendmail -t -oi -oem") or die "Cannot execute $sendmail : " . ($?>>8);
  203. # The mail header
  204. print MAIL <<EOM;
  205. From: $from_email
  206. To: $dest_email
  207. Content-type: text/xml
  208. Subject: DeliverXML
  209. EOM
  210. print MAIL $message;
  211. # Close the mail
  212. close MAIL;
  213. die "$0: sendmail exit status " . ($? >> 8) . "\n" unless ($? == 0);
  214. # vi: set sw=2: