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