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