Switch branches/tags
Nothing to show
Find file Copy path
Fetching contributors…
Cannot retrieve contributors at this time
executable file 246 lines (205 sloc) 7.35 KB
#!/usr/bin/perl -0777
# run an arbitrary readonly SQL query webapp
# v2 does NOT canonize the domain name, tries to derive it from HTTP_HOST
# format: [rss|csv|].[query|"schema"].db.(db|database).other.stuff
require "/usr/local/lib/";
# TODO: sense I'm not handling the printing of content-type: text/html
# optimally
# special case for fetlife move (for
if ($ENV{HTTP_HOST}=~/fetlife/i) {
print << "MARK";
Content-type: text/html
The fetlife users database has <a href="">moved</a>
# where the dbs are <h>(sadly, /sites/GIRLS/ does not work as well...)</h>
# hack to handle / which I used in previous version
if ($ENV{REQUEST_URI}=~/rss/i) {$ENV{HTTP_HOST} = "rss.$ENV{HTTP_HOST}";}
# check to see if db exists
# TODO: add non-redundant error checking
# parse hostname ($tld includes ".db." part)
if ($ENV{HTTP_HOST}=~/^schema\.([a-z]+)\.(db|database)\.(.*?)$/i) {
# schema request($database, $tld)
} elsif ($ENV{HTTP_HOST}=~/^iftttrss\.([0-9a-f]+)\.([a-z]+)\.(db|database)\.(.*?)$/i) {
# request for IFTTT compatible RSS (same subroutine as request for query)
query_request($1,$2,"$3.$4", "iftttrss");
} elsif ($ENV{HTTP_HOST}=~/^rss\.([0-9a-f]+)\.([a-z]+)\.(db|database)\.(.*?)$/i) {
# request for RSS (same subroutine as request for query)
query_request($1,$2,"$3.$4", "rss");
} elsif ($ENV{HTTP_HOST}=~/^csv\.([0-9a-f]+)\.([a-z]+)\.(db|database)\.(.*?)$/i) {
# request for CSV (same subroutine as request for query)
query_request($1,$2,"$3.$4", "csv");
} elsif ($ENV{HTTP_HOST}=~/^([0-9a-f]+)\.([a-z]+)\.(db|database)\.(.*?)$/i) {
# request for existing query
} elsif ($ENV{HTTP_HOST}=~/^post\.([a-z]+)\.(db|database)\.(.*?)$/i) {
# posting a new query
} elsif ($ENV{HTTP_HOST}=~/^([a-z]+)\.(db|database)\.(.*?)$/i) {
# request for form only
print "Content-type: text/html\n\n";
} elsif ($ENV{HTTP_HOST}=~/^(db|database)\.(.*?)$/i) {
# request for list of dbs (currently not honored)
} else {
print "Content-type: text/html\n\nHostname $ENV{HTTP_HOST} not understood";
sub check_db {
my($db) = @_;
# doesnt exist
unless (-f "$db.db") {
print "Content-type: text/html\n\n";
webdie("$db.db: no such file");
# this subroutines are specific to this program thus not well documented
sub schema_request {
my($db,$tld) = @_;
print "Content-type: text/plain\n\n";
my($out,$err,$res) = cache_command2("echo '.schema' | sqlite3 $db.db");
if ($res) {webdie("SCHEMA ERROR: $err");}
print $out;
# request for query already in requests.db
sub query_request {
my($hash,$db,$tld,$rss) = @_;
my($query) = decode_base64(sqlite3val("SELECT query FROM requests WHERE md5='$hash' AND db='$db'", "requests.db"));
# no query returned?
unless ($query) {
webdie("$db exists, but no query with hash $hash. Try http://$db.$tld/");
# actually run query (use tmpfile to avoid command line danger)
my($tmp) = my_tmpfile("dbquery");
write_file("$query;", $tmp);
# if $rss is actually "csv", give comma-separated output
if ($rss=~/^csv$/) {$format="csv";} else {$format="html";}
# avoid DOS by limiting cputime
my($out, $err, $res);
if ($rss=~/^iftttrss$/i) {
($out,$err,$res) = cache_command2("ulimit -t 5 && sqlite3 -line -batch $db.db < $tmp");
} else {
($out,$err,$res) = cache_command2("ulimit -t 5 && sqlite3 -$format -header $db.db < $tmp");
# restore hyperlinks and quotes
# error?
if ($res) {
print "Content-type: text/html\n\n";
webdie("QUERY: $query<br>ERROR: $err<br>");
# known good result; requesting rss or iftttrss?
if ($rss=~/^iftttrss$/i) {
open(A,"|/usr/local/bin/ --title=$ENV{HTTP_HOST} --desc=DB_QUERY");
print A $out;
} elsif ($rss=~/^rss$/i) {
open(A,"|/usr/local/bin/ --title=$ENV{HTTP_HOST} --desc=DB_QUERY");
print A $out;
} else {
# info about db
if ($format=~/^csv$/) {
print "Content-type: text/plain\n\n";
} else {
print "Content-type: text/html\n\n";
print read_file("$db.txt");
print << "MARK";
NOTE: This page is experimental. Bug reports to
carter.barry\ Query language is SQLite3.<p>
Prepend rss. to the URL for an RSS feed, csv. to the URL for CSV output.<p>
<p><pre>QUERY: $query</pre><p>
To edit query (or if query above is munged), see textbox at bottom of page<p>
Empty result may indicate error: I'm not sure why my error checking
code isn't working.<p>
<a href="" target="_blank">Source code</a>
<p><table border>
sub post_request {
my($db,$tld) = @_;
my($query) = <STDIN>;
# check this query, add it to requests.db as MIME, redirect to execute it
$query=~s/\+/ /isg;
$query=~s/\%([A-Fa-f0-9]{2})/pack('C', hex($1))/seg;
# these characters are permitted, but ignored
$query=~s/[\;\r\n]/ /isg;
# trim spaces to canonize query (may not be a great idea)
$query=~s/\s+/ /isg;
# if blank query, just redirect to main site
unless ($query) {
print "Location: http://$db.$tld/\n\n";
# safety checks
unless ($query=~/^select/i) {webdie("Query doesn't start w SELECT: $query");}
# permitted characters (is this going to end up being everything?)
if ($query=~/([^a-z0-9_: \(\)\,\*\<\>\"\'\=\.\/\?\|\!\+\-\%\\]\&)/i) {
webdie("Query contains illegal character '$1': $query");
# query is now safe, add to requests.db (as base 64)
my($iquery) = encode_base64($query);
my($queryhash) = md5_hex($iquery);
sqlite3("REPLACE INTO requests (query,db,md5) VALUES ('$iquery', '$db', '$queryhash')", "requests.db");
if ($SQL_ERROR) {
print "Content-type: text/html\n\n";
webdie("SQL ERROR (requests): $SQL_ERROR");
# and redirect
print "Location: http://$queryhash.$db.$tld/\n\n";
# print the (trivial) form for queries
sub form_request {
my($db,$tld,$query,$queryhash) = @_;
print << "MARK";
<form method='POST' action='http://post.$db.$tld/'><table border>
<tr><th>Enter query below (must start w/ SELECT):</th></tr>
<tr><th><input type="submit" value="RUN QUERY"></th></tr>
<tr><th><textarea name="query" rows=20 cols=79>$query</textarea></th></tr>
<tr><th><input type="submit" value="RUN QUERY"></th></tr>
<p><a href='http://schema.$db.$tld/' target='_blank'>Schema</a>
<a href="http://$db.$tld/$db.db">Raw SQLite3 db</a>
if ($queryhash) {
print "<a href='http://rss.$queryhash.$db.$tld'>RSS feed for this query</a>\n";
=item schema
SQLite3 schema of tables <h>(sqlite3 is "strongly untyped?")</h>
CREATE TABLE requests ( -- stored query requests
-- the db column below is redundant but Im ok with that
query, -- stored query in MIME64 format
db, -- the database for the query
md5 -- the query hash
CREATE UNIQUE INDEX ui ON requests(md5);