# postgresql-lib.pl
# Common PostgreSQL functions
# XXX dropping fields from schema table
#	XXX maybe can only rename within schema?
# XXX updating date field
# XXX access control and schema tables

do '../web-lib.pl';
&init_config();
require '../ui-lib.pl';
if ($config{'plib'}) {
	$ENV{$gconfig{'ld_env'}} .= ':' if ($ENV{$gconfig{'ld_env'}});
	$ENV{$gconfig{'ld_env'}} .= $config{'plib'};
	}
if ($config{'psql'} =~ /^(.*)\/bin\/psql$/ && $1 ne '' && $1 ne '/usr') {
	$ENV{$gconfig{'ld_env'}} .= ':' if ($ENV{$gconfig{'ld_env'}});
	$ENV{$gconfig{'ld_env'}} .= "$1/lib";
	}

if ($module_info{'usermin'}) {
	# Login and password is set by user in Usermin, and the module always
	# runs as the Usermin user
	&switch_to_remote_user();
	&create_user_config_dirs();
	$postgres_login = $userconfig{'login'};
	$postgres_pass = $userconfig{'pass'};
	$postgres_sameunix = 0;
	%access = ( 'backup' => 1,
		    'restore' => 1 );
	}
else {
	# Login and password is determined by ACL in Webmin
	%access = &get_module_acl();
	if ($access{'user'} && !$use_global_login) {
		$postgres_login = $access{'user'};
		$postgres_pass = $access{'pass'};
		$postgres_sameunix = $access{'sameunix'};
		}
	else {
		$postgres_login = $config{'login'};
		$postgres_pass = $config{'pass'};
		$postgres_sameunix = $config{'sameunix'};
		}
	}
$cron_cmd = "$module_config_directory/backup.pl";

if (!$config{'nodbi'}) {
	# Check if we have DBD::Pg
	eval <<EOF;
use DBI;
\$driver_handle = DBI->install_driver("Pg");
EOF
	}

# is_postgresql_running()
# Returns 1 if yes, 0 if no, -1 if the login is invalid, -2 if there
# is a library problem
sub is_postgresql_running
{
local $temp = &tempname();
local $host = $config{'host'} ? "-h $config{'host'}" : "";
$host .= " -p $config{'port'}" if ($config{'port'});
local $cmd;
if ($postgres_login) {
	open(TEMP, ">$temp");
	print TEMP "$postgres_login\n$postgres_pass\n";
	close(TEMP);
	local $out;
	$cmd = "$config{'psql'} -u -c '' $host $config{'basedb'} <$temp";
	}
else {
	$cmd = "$config{'psql'} -c '' $host $config{'basedb'}";
	}
if ($postgres_sameunix && defined(getpwnam($postgres_login))) {
	$cmd = "su $postgres_login -c ".quotemeta($cmd);
	}
open(OUT, "$cmd 2>&1 |");
while(<OUT>) { $out .= $_; }
close(OUT);
unlink($temp);
if ($out =~ /setuserid:/i || $out =~ /no\s+password\s+supplied/i ||
    $out =~ /no\s+postgres\s+username/i || $out =~ /authentication\s+failed/i ||
    $out =~ /password:.*password:/i || $out =~ /database.*does.*not/i ||
    $out =~ /user.*does.*not/i) {
	return -1;
	}
elsif ($out =~ /connect.*failed/i || $out =~ /could not connect to server:/) {
	return 0;
	}
elsif ($out =~ /lib\S+\.so/i) {
	return -2;
	}
else {
	return 1;
	}
}

# get_postgresql_version()
sub get_postgresql_version
{
local $v = &execute_sql($config{'basedb'}, 'select version()');
$v = $v->{'data'}->[0]->[0];
if ($v =~ /postgresql\s+([0-9\.]+)/i) {
	return $1;
	}
else {
	return undef;
	}
}

sub can_drop_fields
{
return &get_postgresql_version() >= 7.3;
}

# list_databases()
# Returns a list of all databases
sub list_databases
{
local $force_nodbi = 1;
local $t = &execute_sql($config{'basedb'}, 'select * from pg_database order by datname');
return map { $_->[0] } @{$t->{'data'}};
}

# list_tables(database)
# Returns a list of tables in some database
sub list_tables
{
local @str = &table_structure($_[0], "pg_tables");
local %fields = map { $_->{'field'}, 1 } @str;
if ($fields{'schemaname'}) {
	local $t = &execute_sql($_[0], 'select schemaname,tablename from pg_tables where tablename not like \'pg_%\' and tablename not like \'sql_%\' order by tablename');
	return map { ($_->[0] eq "public" ? "" : $_->[0].".").$_->[1] } @{$t->{'data'}};
	}
else {
	local $t = &execute_sql($_[0], 'select tablename from pg_tables where tablename not like \'pg_%\' and tablename not like \'sql_%\' order by tablename');
	return map { $_->[0] } @{$t->{'data'}};
	}
}

# list_types()
# Returns a list of all available field types
sub list_types
{
local $t = &execute_sql($config{'basedb'}, 'select typname from pg_type where typrelid = 0 and typname !~ \'^_.*\' order by typname');
local @types = map { $_->[0] } @{$t->{'data'}};
push(@types, "serial", "bigserial") if (&get_postgresql_version() >= 7.4);
return sort { $a cmp $b } &unique(@types);
}

# table_structure(database, table)
# Returns a list of hashes detailing the structure of a table
sub table_structure
{
local $tn = $_[1];
$tn =~ s/^([^\.]+)\.//;
local $t = &execute_sql($_[0], "select a.attnum, a.attname, t.typname, a.attlen, a.atttypmod, a.attnotnull, a.atthasdef FROM pg_class c, pg_attribute a, pg_type t WHERE c.relname = '$tn'    and a.attnum > 0     and a.attrelid = c.oid     and a.atttypid = t.oid order by attnum");
local (@rv, $r);
foreach $r (@{$t->{'data'}}) {
	local $arr;
	$arr++ if ($r->[2] =~ s/^_//);
	local $sz = $r->[4] - 4;
	if ($sz >= 65536 && $r->[2] =~ /numeric/i) {
		$sz = int($sz/65536).",".($sz%65536);
		}
	push(@rv, { 'field' => $r->[1],
		    'arr' => $arr ? 'YES' : 'NO',
		    'type' => $r->[4] < 0 ? $r->[2]
					  : $r->[2]."($sz)",
		    'null' => $r->[5] =~ /f|0/ ? 'YES' : 'NO' } );
	}
return @rv;
}

# execute_sql(database, sql, [param, ...])
sub execute_sql
{
local $sql = $_[1];
local @params = @_[2..$#_];
if ($driver_handle &&
    $sql !~ /^\s*(create|drop)\s+database/ && $sql !~ /^\s*\\/ &&
    !$force_nodbi) {
	# Use the DBI interface
	local $pid;
	local $cstr = "dbname=$_[0]";
	$cstr .= ";host=$config{'host'}" if ($config{'host'});
	$cstr .= ";port=$config{'port'}" if ($config{'port'});
	local @uinfo;
	if ($postgres_sameunix &&
	    defined(@uinfo = getpwnam($postgres_login))) {
		# DBI call which must run in subprocess
		pipe(OUTr, OUTw);
		if (!($pid = fork())) {
			($(, $)) = ( $uinfo[3], $uinfo[3] );
			($>, $<) = ( $uinfo[2], $uinfo[2] );
			close(OUTr);
			local $dbh = $driver_handle->connect($cstr,
					$postgres_login, $postgres_pass);
			if (!$dbh) {
				print OUTw &serialise_variable(
				    "DBI connect failed : ".$DBI::errstr);
				exit(0);
				}
			$dbh->{'AutoCommit'} = 0;
			local $cmd = $dbh->prepare($sql);
			#foreach (@params) {	# XXX dbd quoting is broken!
			#	s/\\/\\\\/g;
			#	}
			if (!$cmd->execute(@params)) {
				print OUTw &serialise_variable(&text('esql',
				    "<tt>".&html_escape($sql)."</tt>",
				    "<tt>".&html_escape($dbh->errstr)."</tt>"));
				$dbh->disconnect();
				exit(0);
				}
			local (@data, @row);
			local @titles = @{$cmd->{'NAME'}};
			while(@row = $cmd->fetchrow()) {
				push(@data, [ @row ]);
				}
			$cmd->finish();
			$dbh->commit();
			$dbh->disconnect();
			print OUTw &serialise_variable(
					      { 'titles' => \@titles,
						'data' => \@data });
			exit(0);
			}
		close(OUTw);
		local $line = <OUTr>;
		local $rv = &unserialise_variable($line);
		if (ref($rv)) {
			return $rv;
			}
		else {
			&error($rv || "$sql : Unknown DBI error");
			}
		}
	else {
		# Just normal DBI call
		local $dbh = $driver_handle->connect($cstr,
				$postgres_login, $postgres_pass);
		$dbh || &error("DBI connect failed : ",$DBI::errstr);
		$dbh->{'AutoCommit'} = 0;
		local $cmd = $dbh->prepare($sql);
		if (!$cmd->execute(@params)) {
			&error(&text('esql', "<tt>".&html_escape($sql)."</tt>",
				     "<tt>".&html_escape($dbh->errstr)."</tt>"));
			}
		local (@data, @row);
		local @titles = @{$cmd->{'NAME'}};
		while(@row = $cmd->fetchrow()) {
			push(@data, [ @row ]);
			}
		$cmd->finish();
		$dbh->commit();
		$dbh->disconnect();
		return { 'titles' => \@titles,
			 'data' => \@data };
		}
	}
else {
	# Check for a \ command
        my $break_f = 0 ;
        if ( $sql =~ /^\s*\\/ ) {
            $break_f = 1 ;
            if ( $sql !~ /^\s*\\copy\s+/ &&
                 $sql !~ /^\s*\\i\s+/ ) {
                &error ( &text ( 'r_command', ) ) ;
            }
        }

	if (@params) {
		# Sub in ? parameters
		local $p;
		local $pos = -1;
		foreach $p (@params) {
			$pos = index($sql, '?', $pos+1);
			&error("Incorrect number of parameters in $_[1] (".scalar(@params).")") if ($pos < 0);
			local $qp = $p;
			$qp =~ s/\\/\\\\/g;
			$qp =~ s/'/''/g;
			$qp =~ s/\$/\\\$/g;
			$qp =~ s/\n/\\n/g;
			$qp = $qp eq '' ? "NULL" : "'$qp'";
			$sql = substr($sql, 0, $pos).$qp.substr($sql, $pos+1);
			$pos += length($qp)-1;
			}
		}

	# Call the psql program
	local $temp = &tempname();
	open(TEMP, ">$temp");
	print TEMP "$postgres_login\n$postgres_pass\n";
	close(TEMP);
	local $host = $config{'host'} ? "-h $config{'host'}" : "";
	$host .= " -p $config{'port'}" if ($config{'port'});
	local $cmd = "$config{'psql'} -u -c ".quotemeta($sql)." $host $_[0]";
	if ($postgres_sameunix && defined(getpwnam($postgres_login))) {
		$cmd = "su $postgres_login -c ".quotemeta($cmd);
		}

        if ( $break_f == 0 ) {
		# Running a normal SQL command, not one with a \
		#$ENV{'PAGER'} = "cat";
		if (&foreign_check("proc")) {
			&foreign_require("proc", "proc-lib.pl");
			if (defined(&proc::close_controlling_pty)) {
				# Detach from tty if possible, so that the psql
				# command doesn't prompt for a login
				&proc::close_controlling_pty();
				}
			}
		open(OUT, "$cmd <$temp 2>&1 |");
		local ($line, $rv, @data);
		do {
			$line = <OUT>;
			last if (!defined($line));
			} while($line =~ /^(username|password|user name):/i ||
				$line =~ /(warning|notice):/i || $line !~ /\S/);
		unlink($temp);
		if ($line =~ /^ERROR:\s+(.*)/ || $line =~ /FATAL.*:\s+(.*)/) {
			&error(&text('esql', "<tt>$sql</tt>", "<tt>$1</tt>"));
			}
		elsif (!defined($line)) {
			# Un-expected end of output ..
			&error(&text('esql', "<tt>$sql</tt>", "<tt>$config{'psql'} failed</tt>"));
			}
		else {
			local $dash = <OUT>;
			if ($dash =~ /^\s*\+\-/) {
				# mysql-style output
				$line = <OUT>;
				$line =~ s/^[\s\|]+//; $line =~ s/[\s\|]+$//;
				local @titles = split(/\|/, $line);
				map { s/^\s+//; s/\s+$// } @titles;
				$line = <OUT>;	# skip useless dashes
				while(1) {
					$line = <OUT>;
					last if (!$line || $line =~ /^\s*\+/);
					$line =~ s/^[\s\|]+//;
					$line =~ s/[\s\|]+$//;
					local @row = split(/\|/, $line);
					map { s/^\s+//; s/\s+$// } @row;
					push(@data, \@row);
					}
				$rv = { 'titles' => \@titles, 'data' => \@data };
				}
			elsif ($dash !~ /^-/) {
				# no output, such as from an insert
				$rv = undef;
				}
			else {
				# psql-style output
				local @titles = split(/\|/, $line);
				map { s/^\s+//; s/\s+$// } @titles;
				while(1) {
					$line = <OUT>;
					last if (!$line ||
						 $line =~ /^\(\d+\s+\S+\)/);
					local @row = split(/\|/, $line);
					map { s/^\s+//; s/\s+$// } @row;
					push(@data, \@row);
					}
				$rv = { 'titles' => \@titles,
					'data' => \@data };
				}
			}
		close(OUT);
		return $rv;
		}
	else {
		# Running a special \ command
		local ( @titles, @row, @data, $rc, $emsgf, $emsg ) ;

		$emsgf = &tempname();
		$rc = &system_logged ( "$cmd < $temp >$emsgf 2>&1");
		$emsg  = `cat $emsgf` ;
		unlink ( $emsgf ) ;
		if ($rc) {
			&error ( "<pre>$emsg</pre>" );
			}
		else {
			@titles = ( "     Command Invocation      " ) ;
			@row    = ( "   Done ( return code : $rc )" ) ;
			map { s/^\s+//; s/\s+$// } @row ;
			push ( @data, \@row ) ;
			return { 'titles' => \@titles, 'data' => \@data } ;
			}
		}
	}
}

# execute_sql_logged(database, command)
sub execute_sql_logged
{
&additional_log('sql', $_[0], $_[1]);
return &execute_sql(@_);
}

# run_as_postgres(command)
sub run_as_postgres
{
pipe(OUTr, OUTw);
local $pid = fork();
if (!$pid) {
	untie(*STDIN);
	untie(*STDOUT);
	untie(*STDERR);
	close(STDIN);
	open(STDOUT, ">&OUTw");
	open(STDERR, ">&OUTw");

	local @u = getpwnam($config{'user'});
	$( = $u[3]; $) = "$u[3] $u[3]";
	($>, $<) = ($u[2], $u[2]);

	exec(@_);
	print "Exec failed : $!\n";
	exit 1;
	}
close(OUTw);
return OUTr;
}

sub can_edit_db
{
if ($module_info{'usermin'}) {
	foreach $l (split(/\t/, $config{'access'})) {
		if ($l =~ /^(\S+):\s*(.*)$/ &&
		    ($1 eq $remote_user || $1 eq '*')) {
			local @dbs = split(/\s+/, $2);
			foreach $d (@dbs) {
				$d =~ s/\$REMOTE_USER/$remote_user/g;
				return 1 if ($d eq '*' || $_[0] =~ /^$d$/);
				}
			return 0;
			}
		}
	return 0;
	}
else {
	local $d;
	return 1 if ($access{'dbs'} eq '*');
	foreach $d (split(/\s+/, $access{'dbs'})) {
		return 1 if ($d && $d eq $_[0]);
		}
	return 0;
	}
}

# get_hba_config(version)
# Parses the postgres host access config file
sub get_hba_config
{
local $lnum = 0;
open(HBA, $config{'hba_conf'});
while(<HBA>) {
	s/\r|\n//g;
	s/^\s*#.*$//g;
	if ($_[0] >= 7.3) {
		# New file format
		if (/^\s*(host|hostssl)\s+(\S+)\s+(\S+)\s+(\S+)\s+(\S+)\s+(\S+)(\s+(\S+))?/) {
			push(@rv, { 'type' => $1,
				    'index' => scalar(@rv),
				    'line' => $lnum,
				    'db' => $2,
				    'user' => $3,
				    'address' => $4,
				    'netmask' => $5,
				    'auth' => $6,
				    'arg' => $8 } );
			}
		elsif (/^\s*local\s+(\S+)\s+(\S+)\s+(\S+)(\s+(\S+))?/) {
			push(@rv, { 'type' => 'local',
				    'index' => scalar(@rv),
				    'line' => $lnum,
				    'db' => $1,
				    'user' => $2,
				    'auth' => $3,
				    'arg' => $5 } );
			}
		}
	else {
		# Old file format
		if (/^\s*host\s+(\S+)\s+(\S+)\s+(\S+)\s+(\S+)(\s+(\S+))?/) {
			push(@rv, { 'type' => 'host',
				    'index' => scalar(@rv),
				    'line' => $lnum,
				    'db' => $1,
				    'address' => $2,
				    'netmask' => $3,
				    'auth' => $4,
				    'arg' => $6 } );
			}
		elsif (/^\s*local\s+(\S+)\s+(\S+)(\s+(\S+))?/) {
			push(@rv, { 'type' => 'local',
				    'index' => scalar(@rv),
				    'line' => $lnum,
				    'db' => $1,
				    'auth' => $2,
				    'arg' => $4 } );
			}
		}
	$lnum++;
	}
close(HBA);
return @rv;
}

# create_hba(&hba, version)
sub create_hba
{
local $lref = &read_file_lines($config{'hba_conf'});
push(@$lref, &hba_line($_[0], $_[1]));
&flush_file_lines();
}

# delete_hba(&hba, version)
sub delete_hba
{
local $lref = &read_file_lines($config{'hba_conf'});
splice(@$lref, $_[0]->{'line'}, 1);
&flush_file_lines();
}

# modify_hba(&hba, version)
sub modify_hba
{
local $lref = &read_file_lines($config{'hba_conf'});
splice(@$lref, $_[0]->{'line'}, 1, &hba_line($_[0], $_[1]));
&flush_file_lines();
}

# swap_hba(&hba1, &hba2)
sub swap_hba
{
local $lref = &read_file_lines($config{'hba_conf'});
local $line0 = $lref->[$_[0]->{'line'}];
local $line1 = $lref->[$_[1]->{'line'}];
$lref->[$_[1]->{'line'}] = $line0;
$lref->[$_[0]->{'line'}] = $line1;
&flush_file_lines();
}

# hba_line(&hba, version)
sub hba_line
{
if ($_[0]->{'type'} eq 'host' || $_[0]->{'type'} eq 'hostssl') {
	return join(" ", $_[0]->{'type'}, $_[0]->{'db'},
			 ( $_[1] >= 7.3 ? ( $_[0]->{'user'} ) : ( ) ),
			 $_[0]->{'address'},
		         $_[0]->{'netmask'},
			 $_[0]->{'auth'},
			 $_[0]->{'arg'} ? ( $_[0]->{'arg'} ) : () );
	}
else {
	return join(" ", 'local', $_[0]->{'db'},
			 ( $_[1] >= 7.3 ? ( $_[0]->{'user'} ) : ( ) ),
			 $_[0]->{'auth'},
			 $_[0]->{'arg'} ? ( $_[0]->{'arg'} ) : () );
	}
}

# split_array(value)
sub split_array
{
if ($_[0] =~ /^\{(.*)\}$/) {
	local @a = split(/,/, $1);
	return @a;
	}
else {
	return ( $_[0] );
	}
}

# join_array(values ..)
sub join_array
{
local $alpha;
map { $alpha++ if (!/^-?[0-9\.]+/) } @_;
return $alpha ? '{'.join(',', map { "'$_'" } @_).'}'
	      : '{'.join(',', @_).'}';
}

sub is_blob
{
return $_[0]->{'type'} eq 'text' || $_[0]->{'type'} eq 'bytea';
}

# restart_postgresql()
# HUP postmaster if running, so that hosts file changes take effect
sub restart_postgresql
{
if (open(PID, $config{'pid_file'})) {
	($pid = <PID>) =~ s/\r|\n//g;
	close(PID);
	&kill_logged('HUP', $pid) if ($pid);
	}
}

# date_subs(filename)
# Does strftime-style date substitutions on a filename, if enabled
sub date_subs
{
if ($config{'date_subs'}) {
        eval "use POSIX";
	eval "use posix" if ($@);
        local @tm = localtime(time());
        return strftime($_[0], @tm);
        }
else {
        return $_[0];
        }
}

# execute_before(db, handle, escape, path, db-for-config)
sub execute_before
{
local $cmd = $config{'backup_before_'.$_[4]};
if ($cmd) {
	$ENV{'BACKUP_FILE'} = $_[3];
	local $h = $_[1];
	local $out = `($cmd) 2>&1 </dev/null`;
	if ($h && $out) {
		print $h $_[2] ? "<pre>".&html_escape($out)."</pre>" : $out;
		}
	}
}

# execute_after(db, handle, escape, path, db-for-config)
sub execute_after
{
local $cmd = $config{'backup_after_'.$_[4]};
if ($cmd) {
	$ENV{'BACKUP_FILE'} = $_[3];
	local $h = $_[1];
	local $out = `($cmd) 2>&1 </dev/null`;
	if ($h && $out) {
		print $h $_[2] ? "<pre>".&html_escape($out)."</pre>" : $out;
		}
	}
}

sub quote_table
{
local @tn = split(/\./, $_[0]);
return join(".", map { "\"$_\"" } @tn);
}

sub quotestr
{
return "\"$_[0]\"";
}

1;