setnotes.pl

   1 #!/usr/bin/perl
   2
   3 =comment
   4
   5 Copyright (c) 2003-2010, Andrew Dunstan
   6
   7 See accompanying License file for license details
   8
   9 =cut
  10
  11 use vars qw($VERSION); $VERSION = 'REL_0.1';
  12
  13 use strict;
  14 use warnings;
  15 no warnings qw(once); # suppress spurious warning about conf structure
  16
  17 use LWP;
  18 use HTTP::Request::Common;
  19 use MIME::Base64;
  20 use Digest::SHA  qw(sha1_hex);
  21 use Getopt::Long;
  22
  23 # copy command line before processing - so we can later report it
  24 # unmunged
  25
  26 my @invocation_args = (@ARGV);
  27
  28 my $buildconf = "build-farm.conf"; # default value
  29 my ($sys_notes,$help,$del);
  30
  31 GetOptions(
  32     'config=s' => \$buildconf,
  33     'help' => \$help,
  34     'delete' => \$del,
  35 )|| usage("bad command line");
  36
  37 $sys_notes = shift;
  38
  39 usage("No extra args allowed")
  40   if @_;
  41
  42 usage("must not specify notes if delete flag used")
  43   if $del && defined($sys_notes);
  44
  45 usage()
  46   if $help;
  47
  48 usage("must specify notes")
  49   unless ($del || defined($sys_notes));
  50
  51 #
  52 # process config file
  53 #
  54 require $buildconf;
  55
  56 my ($target,$animal,$secret) =@EximBuild::conf{qw(target animal secret)};
  57
  58 $target =~ s/eximstatus.pl/addnotes.pl/;
  59
  60 # make the base64 data escape-proof; = is probably ok but no harm done
  61 # this ensures that what is seen at the other end is EXACTLY what we
  62 # see when we calculate the signature
  63
  64 map{ $_ ||= ""; $_ = encode_base64($_,""); tr/+=/$@/; }($sys_notes);
  65
  66 my $content = "animal=$animal\&sysnotes=$sys_notes";
  67
  68 my $sig= sha1_hex($content,$secret);
  69
  70 # set environment from config
  71 while (my ($envkey,$envval) = each %{$EximBuild::conf{build_env}})
  72 {
  73     $ENV{$envkey}=$envval;
  74 }
  75
  76 my $ua = new LWP::UserAgent;
  77 $ua->agent("Exim Build Farm Reporter");
  78 if (my $proxy = $ENV{BF_PROXY})
  79 {
  80     $ua->proxy('http',$proxy);
  81 }
  82
  83 my $request=HTTP::Request->new(POST => "$target/$sig");
  84 $request->content_type("application/x-www-form-urlencoded");
  85 $request->content($content);
  86
  87 my $response=$ua->request($request);
  88
  89 unless ($response->is_success)
  90 {
  91     print
  92       "Query for: animal=$animal\n",
  93       "Target: $target/$sig\n",
  94       "Query Content: $content\n";
  95     print "Status Line: ",$response->status_line,"\n";
  96     print "Content: \n", $response->content,"\n";
  97     exit 1;
  98 }
  99
 100 exit(0);
 101
 102 #######################################################################
 103
 104 sub usage
 105 {
 106     my $opt_message = shift;
 107     print "$opt_message\n" if $opt_message;
 108     print  <<EOH;
 109 set_notes.pl [ option ... ] notes
 110 or
 111 set_notes.pl --delete [ option ... ]
 112
 113 where option is one or more of
 114   --config=path                 /path/to/buildfarm.conf
 115   --help                        get this message
 116 EOH
 117
 118     exit defined($opt_message)+0;
 119 }
 120