2008-03-11 20:58:42 +00:00
#!/usr/bin/perl
#
# Copyright (c) 2008 Digium, Inc.
#
# Tilghman Lesher <dbsep.cgi@the-tilghman.com>
#
# See http://www.asterisk.org for more information about
# the Asterisk project. Please do not directly contact
# any of the maintainers of this project for assistance;
# the project provides a web site, mailing lists and IRC
# channels for your use.
#
# This program is free software, distributed under the terms of
# the GNU General Public License Version 2. See the LICENSE file
# at the top of the source tree.
#
# $Id$
#
use CGI ;
use DBI ;
use strict ;
my ( $cgi , $dbh , %cfg , $table , $mode );
# The following settings are expected:
#
# dsn=<some valid dsn>
# dbuser=<user>
# dbpass=<passwd>
2008-06-05 19:07:27 +00:00
# dbschema=<dbname>
2008-03-11 20:58:42 +00:00
# backslash_is_escape={yes|no}
#
open CFG , "</etc/asterisk/dbsep.conf" ;
while ( <CFG> ) {
chomp ;
next if ( m/^[#;]/ );
next if ( m/^\s*$/ );
2010-03-22 16:59:35 +00:00
my ( $name , @value ) = split '=' ;
$cfg { lc ( $name )} = join ( '=' , @value );
2008-03-11 20:58:42 +00:00
}
close CFG ;
$cgi = new CGI ;
$ENV { PATH_INFO } =~ m/\/([^\/]*)\/([^\/]*)$/ ;
( $table , $mode ) = ( $1 , lc ( $2 ));
2008-03-18 19:53:02 +00:00
#print STDERR "PATH_INFO=$ENV{PATH_INFO}, table=$table, mode=$mode\n";
2008-03-11 20:58:42 +00:00
if ( $mode eq 'single' ) {
# All parameters as POST
my ( $sql , $sth , $row , @answer );
$sql = "SELECT * FROM $table WHERE " . join ( " AND " , cgi_to_where_clause ( $cgi , \ %cfg ));
$dbh = DBI -> connect ( $cfg { dsn }, $cfg { dbuser }, $cfg { dbpass });
$sth = $dbh -> prepare ( $sql ) || throw_error ( "Invalid query: $sql" );
$sth -> execute () || throw_error ( "Invalid query: $sql" );
$row = $sth -> fetchrow_hashref ();
foreach ( keys %$row ) {
2008-06-27 20:38:59 +00:00
foreach my $item ( split /\;/ , $row -> { $_ }) {
push @answer , encode ( $_ ) . "=" . encode ( $item );
}
2008-03-11 20:58:42 +00:00
}
$sth -> finish ();
$dbh -> disconnect ();
print "Content-type: text/plain\n\n" ;
print join ( "&" , @answer ) . "\n" ;
} elsif ( $ENV { PATH_INFO } =~ m/multi$/ ) {
# All parameters as POST
my ( $sql , $sth , @answer );
$sql = "SELECT * FROM $table WHERE " . join ( " AND " , cgi_to_where_clause ( $cgi , \ %cfg ));
$dbh = DBI -> connect ( $cfg { dsn }, $cfg { dbuser }, $cfg { dbpass });
$sth = $dbh -> prepare ( $sql ) || throw_error ( "Invalid query: $sql" );
$sth -> execute () || throw_error ( "Invalid query: $sql" );
print "Content-type: text/plain\n\n" ;
while ( my $row = $sth -> fetchrow_hashref ()) {
@answer = ();
foreach ( keys %$row ) {
2008-06-27 20:38:59 +00:00
foreach my $item ( split /\;/ , $row -> { $_ }) {
push @answer , encode ( $_ ) . "=" . encode ( $item );
}
2008-03-11 20:58:42 +00:00
}
print join ( "&" , @answer ) . "\n" ;
}
$sth -> finish ();
$dbh -> disconnect ();
} elsif ( $ENV { PATH_INFO } =~ m/update$/ ) {
# where clause in GET, update parameters in POST
my ( %get , @get , $sql , $name , $value , $affected );
foreach ( split '&' , $ENV { QUERY_STRING }) {
( $name , $value ) = split '=' ;
$name = decode ( $name );
next if ( ! isname ( $name ));
$value = escape_value ( decode ( $value ));
if ( $name =~ m/ / ) {
push @get , "$name '$value'" ;
} else {
push @get , "$name='$value'" ;
}
$get { $name } ++ ;
}
2010-03-22 19:05:27 +00:00
$sql = "UPDATE $table SET " . join ( "," , cgi_to_where_clause ( $cgi , \ %cfg , \ %get )) . " WHERE " . join ( " AND " , @get );
2008-03-11 20:58:42 +00:00
$dbh = DBI -> connect ( $cfg { dsn }, $cfg { dbuser }, $cfg { dbpass });
$affected = $dbh -> do ( $sql );
$dbh -> disconnect ();
print "Content-type: text/html\n\n$affected\n" ;
} elsif ( $ENV { PATH_INFO } =~ m/store$/ ) {
# All parameters as POST
my ( @param , $sql , @fields , @values , $affected );
foreach my $param ( cgi_to_where_clause ( $cgi , \ %cfg )) {
my ( $name , $value ) = split /=/ , $param ;
push @fields , $name ;
push @values , $value ;
}
$sql = "INSERT INTO $table (" . join ( "," , @fields ) . ") VALUES (" . join ( "," , @values ) . ")" ;
$dbh = DBI -> connect ( $cfg { dsn }, $cfg { dbuser }, $cfg { dbpass });
$affected = $dbh -> do ( $sql );
$dbh -> disconnect ();
print "Content-type: text/html\n\n$affected\n" ;
} elsif ( $ENV { PATH_INFO } =~ m/destroy$/ ) {
# All parameters as POST
my ( $sql , $affected );
$sql = "DELETE FROM $table WHERE " . join ( " AND " , cgi_to_where_clause ( $cgi , \ %cfg ));
$dbh = DBI -> connect ( $cfg { dsn }, $cfg { dbuser }, $cfg { dbpass });
$affected = $dbh -> do ( $sql );
$dbh -> disconnect ();
print "Content-type: text/html\n\n$affected\n" ;
2008-06-05 19:07:27 +00:00
} elsif ( $ENV { PATH_INFO } =~ m/require$/ ) {
my $result = 0 ;
my $dbh = DBI -> connect ( $cfg { dsn }, $cfg { dbuser }, $cfg { dbpass });
my $sql = "SELECT data_type, character_maximum_length FROM information_schema.tables AS t " .
"JOIN information_schema.columns AS c " .
"ON t.table_catalog=c.table_catalog AND " .
"t.table_schema=c.table_schema AND " .
"t.table_name=c.table_name " .
"WHERE c.table_schema='$cfg{dbschema}' AND " .
"c.table_name=? AND c.column_name=?" ;
my $sth = $dbh -> prepare ( $sql );
foreach my $param ( cgi_to_where_clause ( $cgi , \ %cfg )) {
my ( $colname , $value ) = split /=/ , $param ;
my ( $type , $size ) = split /:/ , $value ;
$sth -> execute ( $table , $colname );
my ( $dbtype , $dblen ) = $sth -> fetchrow_array ();
$sth -> finish ();
if ( $type eq 'char' ) {
if ( $dbtype !~ m #char#i) {
print STDERR "REQUIRE: $table: Type of column $colname requires char($size), but column is of type $dbtype instead!\n" ;
$result = - 1 ;
} elsif ( $dblen < $size ) {
print STDERR "REQUIRE: $table: Size of column $colname requires $size, but column is only $dblen long!\n" ;
$result = - 1 ;
}
} elsif ( $type eq 'integer' ) {
if ( $dbtype =~ m #char#i and $dblen < $size) {
print STDERR "REQUIRE: $table: Size of column $colname requires $size, but column is only $dblen long!\n" ;
$result = - 1 ;
} elsif ( $dbtype !~ m #int|float|double|dec|num#i) {
print STDERR "REQUIRE: $table: Type of column $colname requires integer($size), but column is of type $dbtype instead!\n" ;
$result = - 1 ;
}
} # TODO More type checks
}
$dbh -> disconnect ();
print "Content-type: text/html\n\n$result\n" ;
2008-03-11 20:58:42 +00:00
} elsif ( $ENV { PATH_INFO } =~ m/static$/ ) {
# file parameter in GET, no POST
my ( @get , $filename , $sql , $sth );
@get = split '&' , $ENV { QUERY_STRING };
foreach ( @get ) {
my ( $name , $value ) = split '=' ;
if ( decode ( $name ) eq 'file' ) {
$filename = decode ( $value );
last ;
}
}
$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" ;
$dbh = DBI -> connect ( $cfg { dsn }, $cfg { dbuser }, $cfg { dbpass });
$sth = $dbh -> prepare ( $sql ) || throw_error ( "Invalid query: $sql" );
$sth -> execute () || throw_error ( "Invalid query: $sql" );
print "Content-type: text/plain\n\n" ;
while ( my $row = $sth -> fetchrow_hashref ()) {
my @answer = ();
foreach ( keys %$row ) {
push @answer , encode ( $_ ) . "=" . encode ( $row -> { $_ });
}
print join ( "&" , @answer ) . "\n" ;
}
$sth -> finish ();
$dbh -> disconnect ();
} else {
print "Content-type: text/plain\n\nUnknown query\n" ;
}
sub encode {
my ( $stuff ) = @_ ;
$stuff =~ s/([^a-zA-Z0-9_\.])/uc sprintf("%%%02x",ord($1))/eg ;
return $stuff ;
}
sub decode {
my ( $stuff ) = @_ ;
$stuff =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack("C", hex($1))/eg ;
return $stuff ;
}
sub isname {
my ( $name ) = @_ ;
if ( $name =~ m #[^A-Za-z0-9_ ]#) {
return 0 ;
} else {
return 1 ;
}
}
sub escape_value {
my ( $value , $cfg ) = @_ ;
if ( $cfg -> { backslash_is_escape } =~ m/^(no|0|false)$/i ) {
$value =~ s #'#''#g;
} else {
$value =~ s #(['\\])#$1$1#g;
}
return $value ;
}
sub cgi_to_where_clause {
my ( $cgi , $cfg , $get ) = @_ ;
my @param = ();
foreach my $name ( $cgi -> param ()) {
my $value = escape_value ( $cgi -> param ( $name ), $cfg );
# Ensure name isn't funny-like
next if ( ! isname ( $name ));
next if ( $get -> { $name });
if ( $name =~ m # #) {
push @param , "$name '$value'" ;
} else {
push @param , "$name='$value'" ;
}
}
2010-03-22 18:58:48 +00:00
return @param ;
2008-03-11 20:58:42 +00:00
}
sub throw_error {
my ( $msg ) = @_ ;
print "Content-type: text/plain\n\n$msg\n" ;
print STDERR $msg . "\n" ;
exit ;
}