fix organization
[buildfarm-server.git] / 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