install_prereq: Update FreeBSD libraries.
[asterisk/asterisk.git] / contrib / scripts / dbsep.cgi
1 #!/usr/bin/perl
2 #
3 # Copyright (c) 2008 Digium, Inc.
4 #
5 # Tilghman Lesher <dbsep.cgi@the-tilghman.com>
6 #
7 # See http://www.asterisk.org for more information about
8 # the Asterisk project. Please do not directly contact
9 # any of the maintainers of this project for assistance;
10 # the project provides a web site, mailing lists and IRC
11 # channels for your use.
12 #
13 # This program is free software, distributed under the terms of
14 # the GNU General Public License Version 2. See the LICENSE file
15 # at the top of the source tree.
16 #
17 # $Id$
18 #
19
20 use CGI;
21 use DBI;
22 use strict;
23
24 my ($cgi, $dbh, %cfg, $table, $mode);
25
26 # The following settings are expected:
27 #
28 # dsn=<some valid dsn>
29 # dbuser=<user>
30 # dbpass=<passwd>
31 # dbschema=<dbname>
32 # backslash_is_escape={yes|no}
33 #
34 open CFG, "</etc/asterisk/dbsep.conf";
35 while (<CFG>) {
36         chomp;
37         next if (m/^[#;]/);
38         next if (m/^\s*$/);
39         my ($name,@value) = split '=';
40         $cfg{lc($name)} = join('=', @value);
41 }
42 close CFG;
43
44 $cgi = new CGI;
45
46 $ENV{PATH_INFO} =~ m/\/([^\/]*)\/([^\/]*)$/;
47 ($table, $mode) = ($1, lc($2));
48
49 #print STDERR "PATH_INFO=$ENV{PATH_INFO}, table=$table, mode=$mode\n";
50
51 if ($mode eq 'single') {
52         # All parameters as POST
53         my ($sql, $sth, $row, @answer);
54         $sql = "SELECT * FROM $table WHERE " . join(" AND ", cgi_to_where_clause($cgi, \%cfg));
55         $dbh = DBI->connect($cfg{dsn}, $cfg{dbuser}, $cfg{dbpass});
56         $sth = $dbh->prepare($sql) || throw_error("Invalid query: $sql");
57         $sth->execute() || throw_error("Invalid query: $sql");
58         $row = $sth->fetchrow_hashref();
59         foreach (keys %$row) {
60                 foreach my $item (split /\;/, $row->{$_}) {
61                         push @answer, encode($_) . "=" . encode($item);
62                 }
63         }
64         $sth->finish();
65         $dbh->disconnect();
66         print "Content-type: text/plain\n\n";
67         print join("&", @answer) . "\n";
68 } elsif ($ENV{PATH_INFO} =~ m/multi$/) {
69         # All parameters as POST
70         my ($sql, $sth, @answer);
71         $sql = "SELECT * FROM $table WHERE " . join(" AND ", cgi_to_where_clause($cgi, \%cfg));
72         $dbh = DBI->connect($cfg{dsn}, $cfg{dbuser}, $cfg{dbpass});
73         $sth = $dbh->prepare($sql) || throw_error("Invalid query: $sql");
74         $sth->execute() || throw_error("Invalid query: $sql");
75         print "Content-type: text/plain\n\n";
76         while (my $row = $sth->fetchrow_hashref()) {
77                 @answer = ();
78                 foreach (keys %$row) {
79                         foreach my $item (split /\;/, $row->{$_}) {
80                                 push @answer, encode($_) . "=" . encode($item);
81                         }
82                 }
83                 print join("&", @answer) . "\n";
84         }
85         $sth->finish();
86         $dbh->disconnect();
87 } elsif ($ENV{PATH_INFO} =~ m/update$/) {
88         # where clause in GET, update parameters in POST
89         my (%get, @get, $sql, $name, $value, $affected);
90         foreach (split '&', $ENV{QUERY_STRING}) {
91                 ($name, $value) = split '=';
92                 $name = decode($name);
93                 next if (!isname($name));
94                 $value = escape_value(decode($value));
95                 if ($name =~ m/ /) {
96                         push @get, "$name '$value'";
97                 } else {
98                         push @get, "$name='$value'";
99                 }
100                 $get{$name}++;
101         }
102         $sql = "UPDATE $table SET " . join(",", cgi_to_where_clause($cgi, \%cfg, \%get)) . " WHERE " . join(" AND ", @get);
103         $dbh = DBI->connect($cfg{dsn}, $cfg{dbuser}, $cfg{dbpass});
104         $affected = $dbh->do($sql);
105         $dbh->disconnect();
106         print "Content-type: text/html\n\n$affected\n";
107 } elsif ($ENV{PATH_INFO} =~ m/store$/) {
108         # All parameters as POST
109         my (@param, $sql, @fields, @values, $affected);
110         foreach my $param (cgi_to_where_clause($cgi, \%cfg)) {
111                 my ($name, $value) = split /=/, $param;
112                 push @fields, $name;
113                 push @values, $value;
114         }
115         $sql = "INSERT INTO $table (" . join(",", @fields) . ") VALUES (" . join(",", @values) . ")";
116         $dbh = DBI->connect($cfg{dsn}, $cfg{dbuser}, $cfg{dbpass});
117         $affected = $dbh->do($sql);
118         $dbh->disconnect();
119         print "Content-type: text/html\n\n$affected\n";
120 } elsif ($ENV{PATH_INFO} =~ m/destroy$/) {
121         # All parameters as POST
122         my ($sql, $affected);
123         $sql = "DELETE FROM $table WHERE " . join(" AND ", cgi_to_where_clause($cgi, \%cfg));
124         $dbh = DBI->connect($cfg{dsn}, $cfg{dbuser}, $cfg{dbpass});
125         $affected = $dbh->do($sql);
126         $dbh->disconnect();
127         print "Content-type: text/html\n\n$affected\n";
128 } elsif ($ENV{PATH_INFO} =~ m/require$/) {
129         my $result = 0;
130         my $dbh = DBI->connect($cfg{dsn}, $cfg{dbuser}, $cfg{dbpass});
131         my $sql = "SELECT data_type, character_maximum_length FROM information_schema.tables AS t " .
132                         "JOIN information_schema.columns AS c " .
133                         "ON t.table_catalog=c.table_catalog AND " .
134                         "t.table_schema=c.table_schema AND " .
135                         "t.table_name=c.table_name " .
136                         "WHERE c.table_schema='$cfg{dbschema}' AND " .
137                         "c.table_name=? AND c.column_name=?";
138         my $sth = $dbh->prepare($sql);
139         foreach my $param (cgi_to_where_clause($cgi, \%cfg)) {
140                 my ($colname, $value) = split /=/, $param;
141                 my ($type, $size) = split /:/, $value;
142                 $sth->execute($table, $colname);
143                 my ($dbtype, $dblen) = $sth->fetchrow_array();
144                 $sth->finish();
145                 if ($type eq 'char') {
146                         if ($dbtype !~ m#char#i) {
147                                 print STDERR "REQUIRE: $table: Type of column $colname requires char($size), but column is of type $dbtype instead!\n";
148                                 $result = -1;
149                         } elsif ($dblen < $size) {
150                                 print STDERR "REQUIRE: $table: Size of column $colname requires $size, but column is only $dblen long!\n";
151                                 $result = -1;
152                         }
153                 } elsif ($type eq 'integer') {
154                         if ($dbtype =~ m#char#i and $dblen < $size) {
155                                 print STDERR "REQUIRE: $table: Size of column $colname requires $size, but column is only $dblen long!\n";
156                                 $result = -1;
157                         } elsif ($dbtype !~ m#int|float|double|dec|num#i) {
158                                 print STDERR "REQUIRE: $table: Type of column $colname requires integer($size), but column is of type $dbtype instead!\n";
159                                 $result = -1;
160                         }
161                 } # TODO More type checks
162         }
163         $dbh->disconnect();
164         print "Content-type: text/html\n\n$result\n";
165 } elsif ($ENV{PATH_INFO} =~ m/static$/) {
166         # file parameter in GET, no POST
167         my (@get, $filename, $sql, $sth);
168         @get = split '&', $ENV{QUERY_STRING};
169         foreach (@get) {
170                 my ($name, $value) = split '=';
171                 if (decode($name) eq 'file') {
172                         $filename = decode($value);
173                         last;
174                 }
175         }
176         $sql = "SELECT cat_metric, category, var_name, var_val FROM $table WHERE filename=" . escape_value($filename) . " AND commented=0 ORDER BY cat_metric DESC, var_metric ASC, category, var_name";
177         $dbh = DBI->connect($cfg{dsn}, $cfg{dbuser}, $cfg{dbpass});
178         $sth = $dbh->prepare($sql) || throw_error("Invalid query: $sql");
179         $sth->execute() || throw_error("Invalid query: $sql");
180         print "Content-type: text/plain\n\n";
181         while (my $row = $sth->fetchrow_hashref()) {
182                 my @answer = ();
183                 foreach (keys %$row) {
184                         push @answer, encode($_) . "=" . encode($row->{$_});
185                 }
186                 print join("&", @answer) . "\n";
187         }
188         $sth->finish();
189         $dbh->disconnect();
190 } else {
191         print "Content-type: text/plain\n\nUnknown query\n";
192 }
193
194 sub encode {
195         my ($stuff) = @_;
196         $stuff =~ s/([^a-zA-Z0-9_\.])/uc sprintf("%%%02x",ord($1))/eg;
197         return $stuff;
198 }
199
200 sub decode {
201         my ($stuff) = @_;
202         $stuff =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack("C", hex($1))/eg;
203         return $stuff;
204 }
205
206 sub isname {
207         my ($name) = @_;
208         if ($name =~ m#[^A-Za-z0-9_ ]#) {
209                 return 0;
210         } else {
211                 return 1;
212         }
213 }
214
215 sub escape_value {
216         my ($value, $cfg) = @_;
217         if ($cfg->{backslash_is_escape} =~ m/^(no|0|false)$/i) {
218                 $value =~ s#'#''#g;
219         } else {
220                 $value =~ s#(['\\])#$1$1#g;
221         }
222         return $value;
223 }
224
225 sub cgi_to_where_clause {
226         my ($cgi, $cfg, $get) = @_;
227         my @param = ();
228
229         foreach my $name ($cgi->param()) {
230                 my $value = escape_value($cgi->param($name), $cfg);
231
232                 # Ensure name isn't funny-like
233                 next if (!isname($name));
234                 next if ($get->{$name});
235
236                 if ($name =~ m# #) {
237                         push @param, "$name '$value'";
238                 } else {
239                         push @param, "$name='$value'";
240                 }
241         }
242         return @param;
243 }
244
245 sub throw_error {
246         my ($msg) = @_;
247         print "Content-type: text/plain\n\n$msg\n";
248         print STDERR $msg . "\n";
249         exit;
250 }