#!/usr/local/bin/oraperl
# or
#!/usr/local/bin/sybperl

# Copyright the Regents of University of Minnesota 1993
#
# See the file "Copyright" for terms of use..

#----------------------------------------------------------------------
# Read in cmd line arguments
#

require 'getopts.pl';
do Getopts('Dl:U:P:S:h:p:T:d:');

$DEBUG      = 1       if ($opt_D);
$Ghost      = $opt_h  if ($opt_h);
$Gport      = $opt_p  if ($opt_p);
$DBtype     = $opt_T  if ($opt_T);
$DBUser     = $opt_U  if ($opt_U);
$DBPassword = $opt_P  if ($opt_P);
$DBServer   = $opt_S  if ($opt_S);
$DBDatabase = $opt_d  if ($opt_d);
$DBauth     = $opt_a  if ($opt_a);

#----------------------------------------------------------------------
# variables to change, or use the command line
#

$DBtype = "oracle"                  if (!$DBtype);

$Ghost    = "mudhoney.micro.umn.edu" if (!$Ghost);
$Gport    = "8500"                  if (!$Gport);

$DBAdmin      = "Mole Hole Guardian";
$DBAdminEmail = "gopher@mole.hole.edu";
$DBLanguage   = "En_US";

$DBgatewaykey = "warbaby";

$DBModules  = "/home/mudhoney/lindner/gophersql/examples";
$DBglue     = "/home/mudhoney/lindner/gophersql";

$ENV{'PATH'} = $ENV{'PATH'} . ':/usr/local/bin';

#############################################################
# Put your defaults here
#
#############################################################


if ($DBtype eq "sybase") {
    $DBUser     = "guest1"      if (!$DBUser);
    $DBServer   = "idea"        if (!$DBServer);
    $DBDatabase = "pubs2"       if (!$DBDatabase);
}
if ($DBtype eq "oracle") {
    $DBUser     = "Three_Stooges"         if (!$DBUser);
    $DBPassword = "Three_Stooges"         if (!$DBPassword);
    $DBServer   = "mermaid.micro.umn.edu" if (!$DBServer);
    $DBDatabase = "oracle"                if (!$DBDatabase);
}

#----------------------------------------------------------------------
# Required files
#

push(@INC, $DBModules);
push(@INC, $DBglue);

chdir($DBModules);


#----------------------------------------------------------------------
# Necessary glue routines 
#

if ($DBtype eq "sybase") {
    require "sybaseglue.pl";
}

if ($DBtype eq "oracle") {
    require "oracleglue.pl";
}


#----------------------------------------------------------------------
# access controls
#

@DBacl=(
#   ipaddress   table      access + = allow, - = deny
    '^134.84\.  .*              +',
    '^128.101\. .*              +',
    '.*         .*              +'
);

#----------------------------------------------------------------------
# Error handlers..
# 

if( defined(&dbmsghandle))	# Is this a modern version of sybperl? ;-)
{
    &dbmsghandle ("DBsql_message_handler"); # Some user defined error handlers
    &dberrhandle ("DBsql_error_handler");
}


$SIG{'INT'} = 'CLEANUP';
$SIG{'HUP'} = 'CLEANUP';
$SIG{'QUIT'} = 'CLEANUP';
$SIG{'PIPE'} = 'CLEANUP';
$SIG{'ALRM'} = 'CLEANUP';



&DBinit;

#-------------------------------------------------------------
# Get a command
#

$_ = <STDIN>;

s/\r//; s/\n//;

#
#Parse Gopher+
#

($first, $second, $third, $fourth) = split('\t', $_, 4);

#
# Check for an ask block..
#

if ($fourth) {
    # Four parameters specified...
    #
    $search = $second;
    $gpluscmd = $third;
    $ask = 1;
}

elsif ($third) {
    # Three paramaters passed
    #
    if ($third eq "1") {
	$search = "";
	$gpluscmd = $second;
	$ask = 1;
    } else {
	$search   = $second;
	$gpluscmd = $third;
    }
}

elsif ($second) {
    # Two parameters passed
    #
    $char = substr($second,0,1);
    if ($char eq "+" || $char eq "!" || $char eq "\$") {
	$gpluscmd = $second;
	$search = "";
    } else {
	$search = $second;
    }
}

if ($ask) {
    $header = <>;
    $i = 0;

    while (<>) {
        s/\r//; s/\n//;

	last if (/^\.$/);
	$ASKBlock[$i++] = $_;
    }
}



#
# Check and see if there is a user/password supplied..
#

if ($first =~ /^0x/) { 
    $first =~ /^0x([^:]+)\:(.+)$/;

    # Aha, a password is being used..
    $pw = $1;
    $first = $2;
    
    $DBcryptedUserPass = "0x" . "$1:";

    # Decrypt the password...
    $clearpw = &Gdecrypt($pw);

    $clearpw =~ /^([^ ]*)\s*([^ ]+)$/;
    $DBUser     = $2;
    $DBPassword = $1; 
    print "cpw is $clearpw, User is $DBUser, pass is $DBPassword" if ($DEBUG);
}


#
# Parse Gopher+
#

if ($gpluscmd) {
    if ($gpluscmd =~ /^\+(.*)$/) {
	$gplusview = $1;
    }
    
    if ($gpluscmd =~ /^\$/) {
	$Gpluslongdir = 1;
    }

    if ($gpluscmd =~ /^\!/) {
	if (!($first =~ /^validate/)) {
	    &DBLogin;
	}

	print "+-1\r\n";
	&DBitem_info($first);
	print ".\r\n";
	exit;
    }
}	



#
# This section of code does the gopher+ ask forms for authentication
#

if ($first eq "validate") {

    # Get the values from the Ask block..
    $DBUser     = $ASKBlock[0] if ($ASKBlock[0]) ;
    $DBPassword = $ASKBlock[1] if ($ASKBlock[1]) ;

    # Okay, let's try validating..
    &DBLogin;
    # Okay, must have succeeded, set the global userpass
    $DBcryptedUserPass = "0x" . &Gcrypt($DBUser, $DBPassword). ":";

    &Gdirreply("1", "Raw Database Access", "tables");
    print ".\r\n";
    exit;
}


#
# Siphon off the command and args
#

($command, $table, $fromtables, $query) = split(' ', $first, 4);


#
# Add a % to the end of the search and replace *'s with %'s
# 
if ($search) {
    $search =~ s/\*/%/;
    if (!( $search =~ /\%$/)) {
	$search = $search . "%";
    }
}

if (length($command) == 0) {
    if ($DBauth) {
	&Gdirreply("1", "SQL Validation Required", "validate");
	print ".\r\n";
	exit;
    } else {
	&Gdirreply("1", "Raw Database Access", "tables");
	print ".\r\n";
	exit;
    }
}



#
# All the following commands require a DB connection
#

&DBLogin;

if ($command eq "tables") {
    
    foreach $table (&DBtableList($search)) {
	$name = &DBprettyName($table, $table);
	&Gdirreply("1", $name, "columns $table");
    }
}
    
if ($command eq "columns") {

    $num = &DBnumRecords($table, $table, "");
    &Gdirreply("0", "All Records ($num)", "get $table $table");
    &Gdirreply("0", "Add a Record", "insert $table");
    @columns = &DBcolumnList($table, $search);
    foreach $column (@columns) {
	$name = &DBprettyName("$table.$column", $column);
	&Gdirreply("1", $name, "list $table.$column");
    }
    
    foreach $column (@columns) {
	$name = &DBprettyName("$table.$column", $column);
	if ($gpluscmd) {
	    &Gdirreply("1", "Multiple Field Search, sorted by $name", "asklist $table.$column");
	} else {
	    &Gdirreply("7", "Search $name", "list $table.$column");
	}
    }
}

if ($command eq "list" || $command eq "asklist") {
    # Find out the column...
    &DBGopherDir($table, $query, $fromtables, $search);
}

if ($command eq "get") {
    if ($gplusview =~ /^text\/tab-separated-values /i) {
	&DBdisplayRecord_tsv($table,$fromtables,$query);
    }
    else {
	&DBdisplayRecord($table,$fromtables,$query);
    }

}

if ($command eq "insert") {
    &DBinsertBlock($table, $ASKBlock);
}

&DBLogoff;
print ".\r\n";



#---------------------------------------------------------
# Close everything down..
#

sub CLEANUP {
    &DBclose($DB) if ($DB);
    &DBLogoff;
}

#---------------------------------------------------------
# Respond to gopher+ info requests and for long directory
# listings
#


sub DBitem_info {
    local($selstr, $type, $name, $ask) = @_;
    
    if (! $type) {
	$type = '1';
	$type = '0' if ($selstr =~ /^get/ || $selstr =~ /^insert/);
    }

    if (! $name) {
	$name = "Moo";
    }

    print "+INFO: $type$name\t$DBcryptedUserPass$selstr\t$Ghost\t$Gport\t";

    if (($selstr =~ /^insert /) || ($selstr =~ /^asklist /)) {
	$tbl = $selstr;
	$tbl =~ s/^\S+ //;
	$tbl =~ s/\..*//;
	print "?\r\n";
	print "+ASK:\r\n";
	@columns = &DBcolumnList($tbl);
	foreach $i (@columns) {
	    $name = &DBprettyName("$tbl.$i", $i);
	    print " Ask: $name\r\n";
	}
    } elsif ($selstr =~ /^validate/) {
	print "?\r\n+ASK:\r\n";
	print " Note: Access to this database requires authentication\r\n";
	print " Ask: Username\r\n";
	print " AskP: Password\r\n";
    }else {
	print "+\r\n";
    }
    print "+ADMIN:\r\n Admin: $DBAdmin <$DBAdminEmail>\r\n";

    print "+VIEWS:\r\n";

    if ($selstr =~ /^get /) {
	print " text/plain $DBLanguage: <0k>\r\n";
	print " text/tab-separated-values $DBLanguage: <0k>\r\n";
    }
    elsif ($selstr =~ /^insert /) {
	print " text/plain $DBLanguage: <0k>\r\n";
    }
    else {
	print " Directory En_US: <0k>\r\n";
	print " Directory+ En_US: <0k>\r\n";
    }

    if ($ask) {
	print "+ASK:\r\n";
	# Now print out the ask stuff...
    }
}


#----------------------------------------------------------------------
# Display a record.  Optionally load up a module to display the record
#

sub DBdisplayRecord {
    
    local($table, $fromtables, $args) = @_;

    local($where) ="";

    $fromtables = $table if (!$fromtables);
    $where      = "where $args" if ($args);

    if (-e "$table.module") {

	require "$table.module";
	$main = "${table}_main";

	print "+-1\r\n" if ($gpluscmd);

	&$main($fromtables, $args);
    } else {
	#
	# Default record display routine..
	#

	#
	# Find Maximum column name width
	#
	
	@colnames = &DBcolumnList($table);
	$maxwidth = 0;

	# Add pretty names

	$i = 0;
	while ($colnames[$i]) {
	    $colnames[$i] = &DBprettyName("$table.$colnames[$i]", $colnames[$i]);
	    $i++;
	}

       	foreach $col (@colnames) {

	    if ($maxwidth < length($col)) {
		$maxwidth = length($col);
	    }
	}

	print "+-1\r\n" if ($gpluscmd);

	foreach $rec (&sql($DB, "select $table.* from $fromtables $where")) {
	    $i = 0;
	    print "-----------------------------------------\r\n";
	    foreach $col (split(/~/, $rec)) {
		print $colnames[$i];
		print " "x($maxwidth - length($colnames[$i])+1);
		print ": ";
			   
		print $col . "\r\n";
		$i++;
	    }
	}
	
    }
    
}


#----------------------------------------------------------------------
# Send data as TAB separated values
#

sub DBdisplayRecord_tsv {
   local($table, $fromtables, $args) = @_;
   local($where) = "";

   $fromtables = $table if (!$fromtables);
   $where      = "where $args" if ($args);

   print "+-1\r\n" if ($gpluscmd);
   
   @colnames = &DBcolumnList($table, "");


   # Find Pretty Names

   $i = 0;
   while ($colnames[$i]) {
       $colnames[$i] = &DBprettyName("$table.$colnames[$i]", $colnames[$i]);
       $i++;
   }

   $col = shift(@colnames);
   print $col;

   foreach $col (@colnames) {
       print "\t$col";
   }
   
   print "\r\n";
   

   foreach $rec (&sql($DB, "select $table.* from $fromtables $where")) {
       $i = 0;
       @columns = split(/~/, $rec);
       $col = shift(@columns);
       print $col;
       foreach $col (@columns) {
	   print "\t$col";
       }
       print "\r\n";
   }
   
}


#----------------------------------------------------------------------
# Standard Gopher routines..
#

sub Greply { print "$_[0]\r\n"; }

sub Gdirreply {
    local($type,$name,$selector) = @_;


    if ($gpluscmd && ! $Gdirsentheader) {
	print "+-1\r\n";
	$Gdirsentheader = 1;
    }

    if ($Gpluslongdir) {
	&DBitem_info($selector, $type, $name);
    } else {
	print "$type$name\t$DBcryptedUserPass$selector\t$Ghost\t$Gport\t";
	if ($selector =~ /^insert/ || $selector =~ /^asklist/ ||
	    $selector =~ /^validate/) {
	    print "?\r\n";
	} else {
	    print "+\r\n";
	}

    }
}

sub Gerrmsg {
    local ($mesg) = @_;

    if ($gpluscmd && !$firstGerrmsg) {
	print "--1\r\n";
	$firstGerrmsg = 1;
    }

    if ($command eq "get" || $gpluscmd) {
	print "$mesg\r\n";
    }
    else {
	print "0$mesg\t\tdon't.select.me.fool\t70\r\n";
    }
}


sub Gabort { print "3$_[0]\r\n.\r\n"; exit; }


#-----------------------------------------------------------
# This function encrypts the username and password using des
#

sub Gcrypt {
    local ($pw, $user) = @_;
    local ($Cryptedpw);
    #  use a temp file to keep clear password out of process table
    local($tempfile)  = "/tmp/gcrypt$$";
    
    umask(077);
    open(TEMP, ">$tempfile");
    print TEMP "$user $pw";
    close(TEMP);

    local($key) = &Gmakekey;

    $Cryptedpw = `descrypt -e -k $key -a $tempfile`;
 
    unlink($tempfile);
    $Cryptedpw =~ /^(\w*)\s*(\w*)\s*(\w*)\s*/;
    $Cryptedpw = $1 . $2 . $3;
    return $Cryptedpw;
}

#------------------------------------------------------
# This function decrypts a password...
#

sub Gdecrypt {
    local ($pw) = @_;
    local ($tempfile) = "/tmp/gdecrypt$$";
    local ($key) = &Gmakekey;
    local ($Clearpw);
    
    umask(077);
    open(TEMP, ">$tempfile");
    $pw =~ /^(.{16})(.{16})(.{0,16})/;
    print TEMP "$1\n$2\n$3\n";
    close(TEMP);
    
    $Clearpw = `descrypt -d -k $key -a $tempfile`;
    unlink $tempfile;
    return($Clearpw);
}

#-----------------------------------------------------
#Returns the IPnum of STDIN  (if it exists..)
#

sub GgetIPnum {
    local($sockaddr)             = 'S n a4 x8';
    local($mysockaddr)           = getpeername(STDIN);
    local($ramily,$rport,$raddr) = unpack($sockaddr,$mysockaddr);
    local($a,$b,$c,$d)           = unpack('C4',$raddr);
    return("$a.$b.$c.$d");
}

#------------------------------------------------------
# Generate a connection specific des key to use..
#

sub Gmakekey {
    ($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst) = localtime(time);
    # You can manipluate how long a key is valid by incorporating
    # the proper above elements to form a key
    # default is a one day key..
    
    $ipadress = &GgetIPnum;
    
    return($DBgatewaykey.$mday.$mon.$ipaddress);
}

#----------------------------------------------------------------------
# Take a table.column value and generate sql that will 
# select only those from the database
#
# An optional query will limit selections in the table
#

sub DBGopherDir {
    
    local($tablecolumn, $query, $fromtables, $search) = @_;
    
    local($table, $column) = split(/\./, $tablecolumn);

    #
    # Add the search, if it exists to the query
    #
    if ($search) {
	$query = "$query and" if ($query);
	$query = "$query $tablecolumn like \'$search\'";
    }
    
    # Now add the ask block stuff to query

    if (@ASKBlock) {
	@columns = &DBcolumnList($table);
	foreach $i (@ASKBlock) {
	    $col = shift(@columns);

	    if ($i) {
		#
		# change search crit if first letter is <, >, =
		#

		$operation = "=";
		
		$i =~ s/(^[<>=])//;
		$operation = $1 if ($1);
		if ($i =~ /\*/) {
		    $i =~ s/\*/%/;
		    $operation = "like ";
		}

		$quoted = &DBquoteSQL($i,"$table.$col");
		$query = "$query and" if ($query);
		$query = "$query $col $operation $quoted";
	    }
	}
    }
		
    $where = "where $query" if ($query);
    $fromtables = $table if (!$fromtables);

    #
    # Find distinct values in a column, and a count of the items
    #

    @results = &sql($DB, "
	select count(*), $tablecolumn
	from $fromtables
        $where
        group by $tablecolumn
	");
#	order by $tablecolumn

    $query = "and $query"  if (length($query) != 0);

    foreach $x (@results) {
	($num, $val) = split(/~/,$x);
	$quoted = &DBquoteSQL($val, $tablecolumn);
	
	&GopherSQLreply($val, 
			"$table.$column = $quoted $query",
			$table,
			$column,
			$fromtables,
		        $num
			);
    }
}



#----------------------------------------------------------------
#
#

sub GopherSQLreply {
    local($title, $query, $table, $column, $fromtables,$num) = @_;

    $title = "$title ($num)" if ($num > 1);

    # Text entry

    &Gdirreply("0", $title, "get $table $fromtables $query");
}


#----------------------------------------------------------------------
# Check to see if the client is allowed access
#
# Based on table/ipnumber
#

sub DBcheckAccess {
    local($table) = @_;
    local($ipacl,$tableacl,$access);
    local($sockaddr);

    return '+' if (-t STDIN);
    $sockaddr = 'S n a4 x8';
    $mysockaddr = getpeername(STDIN);
    ($ramily,$rport,$raddr) = unpack($sockaddr,$mysockaddr);
    ($a,$b,$c,$d) = unpack('C4',$raddr);
    $ipaddress = "$a.$b.$c.$d";
    
    foreach (@DBacl) {
	($ipacl,$tableacl,$access)=split;
	return $access if  ($ipaddress =~ /$ipacl/) && ($table =~ /$tableacl/);
    }
    return '-'; #default is to restrict access
}


#----------------------------------------------------------------------
# Return a pretty name for a table or a column..
#
sub DBprettyName {
    local($value, $default) = @_;
    local($name, $tablecol, $letter, $rest);

    #
    # Load up the pretty names that we want to use (first time only..)
    #
    if (!%PrettyNames) {
	if (open(pretty, "<namelist.$DBDatabase")) {
	    while (<pretty>) {
		chop;
		next if /^$/ || /^#/;
		($tablecol, $name) = split(/:/);
		$PrettyNames{$tablecol} = $name;
	    }
	    close(pretty);
	} else {
	    $PrettyNames{""} = "";
	}
    }
    
    $name = $PrettyNames{$value};
    
    #
    #  Try searching for .column if table.column not found..
    #

    if (!$name) {
	if ($value =~ s/^.*\.//) {
	    $name = $PrettyNames{".$value"};
	}
    }

    #
    # Capitalize first letter.. Lowercase rest, 
    # replace _ with ' '
    #
    
    if (!$name) {
	$name = $default;
	$letter = substr($name, 0, 1);
	$rest   = substr($name, 1);

	$letter =~ tr/a-z/A-Z/;
	$rest   =~ tr/A-Z/a-z/;
	$name = $letter . $rest;
	$name =~ s/_/ /g;
    }

    return($name);
}

    
	    

	

#----------------------------------------------------------------------
# Return the number of records a given SQL statement will return
#

sub DBnumRecords {
    local($tables, $fromtables, $query) = @_;
    local($where) = "";
    $where = "where $query" if ($where);

    local(@results) = &sql($DB, "
	select count(*)
	from $fromtables
        $where
	");

    return($results[0]);
}

#----------------------------------------------------------------------
# Quote values for SQL that have a ' in them, also put "'" things around
# non number values.. and numbers that are character type columns
#

sub DBquoteSQL {
    local($quoted, $tablecol) = @_;

    local($type) = &DBcolumnType($tablecol) if ($tablecol);

    if ($quoted =~ /\'/) {
	# ***Gross****
	$quoted =~ s/\'/\' + \"\'\" + \'/g;
    }
    
    # Put quotes around the argument iff non-number & non-null or 
    # type is char
    
    if (! ($quoted =~ /^[\d+-.][\d\|.]*$/ || $quoted eq "NULL") || 
	$type eq "char") {
	$quoted = "\'$quoted\'";
    }
    return($quoted);
}

#----------------------------------------------------------------------
# Insert some values into a table
#

sub DBinsertBlock {
    local($tables) = @_;
    local($values) = "(";
    local($i);

    foreach $i (@ASKBlock) {
	$quoted = &DBquoteSQL($i);
	$values = "$values $quoted,";
    }
    chop($values);		# Remove extra ,
    $values = "$values)";

    print "insert into $table values $values\r\n";

    local(@results) = &sql($DB, "
        insert into $table values $values
	");

    foreach $i (@results) {
	print "$i\r\n";
    }
    print "Succeeded, (I think)...\r\n";
}
    



#----------------------------------------------------------------------
# Message and error handlers
#

sub DBsql_message_handler
{
    local ($db, $message, $state, $severity, $text, $server, $procedure, $line)
	= @_;


    if ($severity > 0)
    {
	&Gerrmsg("Sybase message $message Severity $severity, state $state");
	&Gerrmsg("Server \`$server\'") if defined ($server);
	&Gerrmsg("Procedure \`$procedure\'") if defined ($procedure);
	&Gerrmsg("Line $line") if defined ($line);
	&Gerrmsg("    $text");

        # &dbstrcpy returns the command buffer.

	local ($lineno) = 1;	# 
	foreach $row (split (/\n/, &dbstrcpy ($db)))
	{
	    $num = sprintf ("%4d", $lineno ++);
	    $row =~ s/\t//;
	    &Gerrmsg("$num> $row");
	}
    }
    elsif ($message == 0)
    {
	&Gerrmsg($text);
    }
    
    0;
}

sub DBsql_error_handler {
    # Check the error code to see if we should report this.

    if ($_[2] != &SYBESMSG) {
	local ($db, $severity, $error, $os_error, $error_msg, $os_error_msg)
	    = @_;
	&Gerrmsg("Sybase error: ", $error_msg, "\n");
	&Gerrmsg("OS Error: ", $os_error_msg, "\n") if defined ($os_error_msg);
    }

    &INT_CANCEL;
}


