Fix multiple lines returned for animal on status page
[buildfarm-server.git] / 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";