trunk/cgi-bin/addnotes.pl

   1 #!/usr/bin/perl
   2
   3 use strict;
   4
   5 use CGI;
   6 use Digest::SHA1  qw(sha1_hex);
   7 use MIME::Base64;
   8 use DBI;
   9 use DBD::Pg;
  10 use Data::Dumper;
  11
  12 use vars qw($dbhost $dbname $dbuser $dbpass $dbport);
  13
  14 my $query = new CGI;
  15
  16 my $sig = $query->path_info;
  17 $sig =~ s!^/!!;
  18
  19 my $animal = $query->param('animal');
  20 my $sysnotes = $query->param('sysnotes');
  21
  22 my $content = "animal=$animal\&sysnotes=$sysnotes";
  23
  24 require "$ENV{BFConfDir}/BuildFarmWeb.pl";
  25
  26 die "no dbname" unless $dbname;
  27 die "no dbuser" unless $dbuser;
  28
  29 my $dsn="dbi:Pg:dbname=$dbname";
  30 $dsn .= ";host=$dbhost" if $dbhost;
  31 $dsn .= ";port=$dbport" if $dbport;
  32
  33 unless ($animal && defined($sysnotes) && $sig)
  34 {
  35         print
  36             "Status: 490 bad parameters\nContent-Type: text/plain\n\n",
  37             "bad parameters for request\n";
  38         exit;
  39
  40 }
  41
  42
  43 my $db = DBI->connect($dsn,$dbuser,$dbpass);
  44
  45 die $DBI::errstr unless $db;
  46
  47 my $gethost=
  48     "select secret from buildsystems where name = ? and status = 'approved'";
  49 my $sth = $db->prepare($gethost);
  50 $sth->execute($animal);
  51 my ($secret)=$sth->fetchrow_array();
  52 $sth->finish;
  53
  54
  55 unless ($secret)
  56 {
  57         print
  58             "Status: 495 Unknown System\nContent-Type: text/plain\n\n",
  59             "System $animal is unknown\n";
  60         $db->disconnect;
  61         exit;
  62
  63 }
  64
  65
  66
  67
  68 my $calc_sig = sha1_hex($content,$secret);
  69
  70 if ($calc_sig ne $sig)
  71 {
  72
  73         print "Status: 450 sig mismatch\nContent-Type: text/plain\n\n";
  74         print "$sig mismatches $calc_sig on content:\n$content";
  75         $db->disconnect;
  76         exit;
  77 }
  78
  79 # undo escape-proofing of base64 data and decode it
  80 map {tr/$@/+=/; $_ = decode_base64($_); }
  81     ($sysnotes);
  82
  83 my  $set_notes = q{
  84
  85     update buildsystems
  86     set sys_notes = nullif($2,''),
  87     sys_notes_ts = case
  88                       when coalesce($2,'') <> '' then now()
  89                       else null
  90                    end
  91     where name = $1
  92           and status = 'approved'
  93
  94 };
  95
  96 $sth = $db->prepare($set_notes);
  97 my $rv = $sth->execute($animal,$sysnotes);
  98 unless($rv)
  99 {
 100         print "Status: 460 old data fetch\nContent-Type: text/plain\n\n";
 101         print "error: ",$db->errstr,"\n";
 102         $db->disconnect;
 103         exit;
 104 }
 105
 106 $sth->finish;
 107
 108
 109
 110 $db->disconnect;
 111
 112 print "Content-Type: text/plain\n\n";
 113 print "request was on:\n$content\n";
 114
 115
 116