2007-04-12 20:24:50 +00:00
# postgresql-lib.pl
# Common PostgreSQL functions
# XXX updating date field
2009-03-01 20:54:07 +00:00
BEGIN { push ( @ INC , ".." ) ; } ;
use WebminCore ;
2007-04-12 20:24:50 +00:00
& init_config ( ) ;
2012-07-28 17:45:15 -07:00
do 'view-lib.pl' ;
2007-04-12 20:24:50 +00:00
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" ;
}
2011-12-11 15:21:41 -08:00
$ pg_shadow_cols = "usename,usesysid,usecreatedb,usesuper,usecatupd,passwd,valuntil" ;
2007-04-12 20:24:50 +00:00
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 ( ) ;
2023-02-25 23:24:25 -08:00
& set_login_pass ( 0 , $ userconfig { 'login' } , $ userconfig { 'pass' } ) ;
2007-04-12 20:24:50 +00:00
% access = ( 'backup' = > 1 ,
'restore' = > 1 ,
'tables' = > 1 ,
'cmds' = > 1 , ) ;
$ max_dbs = $ userconfig { 'max_dbs' } ;
2009-01-08 23:16:37 +00:00
$ commands_file = "$user_module_config_directory/commands" ;
2008-01-07 23:33:13 +00:00
% displayconfig = % userconfig ;
2007-04-12 20:24:50 +00:00
}
else {
# Login and password is determined by ACL in Webmin
% access = & get_module_acl ( ) ;
if ( $ access { 'user' } && ! $ use_global_login ) {
2023-02-25 23:24:25 -08:00
& set_login_pass (
$ access { 'sameunix' } , $ access { 'user' } , $ access { 'pass' } ) ;
2007-04-12 20:24:50 +00:00
}
else {
2023-02-25 23:24:25 -08:00
& set_login_pass (
$ config { 'sameunix' } , $ config { 'login' } , $ config { 'pass' } ) ;
2007-04-12 20:24:50 +00:00
}
$ max_dbs = $ config { 'max_dbs' } ;
2009-01-08 23:16:37 +00:00
$ commands_file = "$module_config_directory/commands" ;
2008-01-07 23:33:13 +00:00
% displayconfig = % config ;
2007-04-12 20:24:50 +00:00
}
2007-11-29 19:29:35 +00:00
foreach my $ hba ( split ( /\t+/ , $ config { 'hba_conf' } ) ) {
2008-04-30 21:02:30 +00:00
if ( $ hba =~ /\*|\?/ ) {
( $ hba ) = glob ( $ hba ) ;
}
if ( $ hba && - r $ hba ) {
2007-11-29 19:29:35 +00:00
$ hba_conf_file = $ hba ;
last ;
}
}
2007-04-12 20:24:50 +00:00
$ 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. When called in an array context, returns the full error
# message too.
sub is_postgresql_running
{
local $ temp = & transname ( ) ;
local $ cmd = & quote_path ( $ config { 'psql' } ) .
2023-02-24 15:28:10 -08:00
& host_port_flags ( ) .
2007-04-12 20:24:50 +00:00
( ! & supports_pgpass ( ) ? " -u" : " -U $postgres_login" ) .
2023-02-24 15:28:10 -08:00
" -c ''" .
" " . $ config { 'basedb' } ;
2007-04-12 20:24:50 +00:00
if ( $ postgres_sameunix && defined ( getpwnam ( $ postgres_login ) ) ) {
$ cmd = "su $postgres_login -c " . quotemeta ( $ cmd ) ;
}
$ cmd = & command_with_login ( $ cmd ) ;
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 2>&1 |" ) ;
while ( <OUT> ) { $ out . = $ _ ; }
close ( OUT ) ;
unlink ( $ temp ) ;
local $ rv ;
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 ) {
$ rv = - 1 ;
}
elsif ( $ out =~ /connect.*failed/i || $ out =~ /could not connect to server:/ ) {
$ rv = 0 ;
}
elsif ( $ out =~ /lib\S+\.so/i ) {
$ rv = - 2 ;
}
else {
$ rv = 1 ;
}
return wantarray ? ( $ rv , $ out ) : $ rv ;
}
# get_postgresql_version([from-command])
sub get_postgresql_version
{
2023-02-25 19:14:05 -08:00
my ( $ fromcmd ) = @ _ ;
2007-04-12 20:24:50 +00:00
return $ postgresql_version_cache if ( defined ( $ postgresql_version_cache ) ) ;
2023-02-25 19:14:05 -08:00
my $ rv ;
2007-04-12 20:24:50 +00:00
if ( ! $ fromcmd ) {
eval {
2023-02-25 19:14:05 -08:00
local $ main:: error_must_die = 1 ;
2007-04-12 20:24:50 +00:00
local $ v = & execute_sql_safe ( $ config { 'basedb' } ,
'select version()' ) ;
$ v = $ v - > { 'data' } - > [ 0 ] - > [ 0 ] ;
if ( $ v =~ /postgresql\s+([0-9\.]+)/i ) {
$ rv = $ 1 ;
}
} ;
}
if ( ! $ rv || $@ ) {
2023-02-25 19:14:05 -08:00
my $ out = & backquote_command (
& quote_path ( $ config { 'psql' } ) . " -V 2>&1 <$null_file" ) ;
2007-04-12 20:24:50 +00:00
$ rv = $ out =~ /\s([0-9\.]+)/ ? $ 1 : undef ;
}
$ postgresql_version_cache = $ rv ;
return $ rv ;
}
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 ;
2019-12-01 18:50:38 -08:00
local $ t = & execute_sql_safe ( $ config { 'basedb' } , 'select datname from pg_database order by datname' ) ;
2010-11-29 23:16:04 -08:00
return sort { lc ( $ a ) cmp lc ( $ b ) } map { $ _ - > [ 0 ] } @ { $ t - > { 'data' } } ;
2007-04-12 20:24:50 +00:00
}
# supports_schemas(database)
# Returns 1 if schemas are supported
sub supports_schemas
{
local $ t = & execute_sql_safe ( $ _ [ 0 ] , "select a.attname FROM pg_class c, pg_attribute a, pg_type t WHERE c.relname = 'pg_tables' and a.attnum > 0 and a.attrelid = c.oid and a.atttypid = t.oid and a.attname = 'schemaname' order by attnum" ) ;
return $ t - > { 'data' } - > [ 0 ] - > [ 0 ] ? 1 : 0 ;
}
# list_tables(database)
# Returns a list of tables in some database
sub list_tables
{
if ( & supports_schemas ( $ _ [ 0 ] ) ) {
2015-06-17 19:55:13 -07:00
local $ t = & execute_sql_safe ( $ _ [ 0 ] , 'select schemaname,tablename from pg_tables order by tablename' ) ;
return map { ( $ _ - > [ 0 ] eq "public" ? "" : $ _ - > [ 0 ] . "." ) . $ _ - > [ 1 ] }
grep { $ _ - > [ 1 ] !~ /^(pg|sql)_/ } @ { $ t - > { 'data' } } ;
2007-04-12 20:24:50 +00:00
}
else {
2015-06-17 19:55:13 -07:00
local $ t = & execute_sql_safe ( $ _ [ 0 ] , 'select tablename from pg_tables order by tablename' ) ;
return map { $ _ - > [ 0 ] } grep { $ _ - > [ 0 ] !~ /^(pg|sql)_/ } @ { $ t - > { 'data' } } ;
2007-04-12 20:24:50 +00:00
}
}
# list_types()
# Returns a list of all available field types
sub list_types
{
local $ t = & execute_sql_safe ( $ 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
{
if ( & supports_schemas ( $ _ [ 0 ] ) ) {
# Find the schema and table
local ( $ tn , $ ns ) ;
if ( $ _ [ 1 ] =~ /^(\S+)\.(\S+)$/ ) {
$ ns = $ 1 ;
$ tn = $ 2 ;
}
else {
$ ns = "public" ;
$ tn = $ _ [ 1 ] ;
}
$ tn =~ s/^([^\.]+)\.// ;
local $ t = & execute_sql_safe ( $ _ [ 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, pg_namespace ns WHERE c.relname = '$tn' and ns.nspname = '$ns' and a.attnum > 0 and a.attrelid = c.oid and a.atttypid = t.oid and a.attname not like '%pg.dropped%' and c.relnamespace = ns.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' } ) ;
}
# Work out which fields are the primary key
if ( & supports_indexes ( ) ) {
2007-11-02 21:55:05 +00:00
local ( $ keyidx ) = grep { $ _ eq $ _ [ 1 ] . "_pkey" ||
$ _ eq "pk_" . $ _ [ 1 ] }
2007-04-12 20:24:50 +00:00
& list_indexes ( $ _ [ 0 ] ) ;
if ( $ keyidx ) {
local $ istr = & index_structure ( $ _ [ 0 ] , $ keyidx ) ;
foreach my $ r ( @ rv ) {
if ( & indexof ( $ r - > { 'field' } ,
@ { $ istr - > { 'cols' } } ) >= 0 ) {
$ r - > { 'key' } = 'PRI' ;
}
}
}
}
return @ rv ;
}
else {
# Just look by table name
local $ t = & execute_sql_safe ( $ _ [ 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 = '$_[1]' 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
{
if ( & is_readonly_mode ( ) ) {
return { } ;
}
& execute_sql_safe ( @ _ ) ;
}
# execute_sql_safe(database, sql, [param, ...])
sub execute_sql_safe
{
local $ sql = $ _ [ 1 ] ;
local @ params = @ _ [ 2 .. $# _ ] ;
2008-04-30 21:02:30 +00:00
if ( $ gconfig { 'debug_what_sql' } ) {
# Write to Webmin debug log
local $ params ;
for ( my $ i = 0 ; $ i < @ params ; $ i + + ) {
$ params . = " " . $ i . "=" . $ params [ $ i ] ;
}
& webmin_debug_log ( 'SQL' , "db=$_[0] sql=$sql" . $ params ) ;
}
2012-03-10 10:08:47 -08:00
if ( $ sql !~ /^\s*\\/ && ! $ main:: disable_postgresql_escaping ) {
2011-02-25 21:23:26 -08:00
$ sql =~ s/\\/\\\\/g ;
}
2007-04-12 20:24:50 +00:00
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' } ) ;
2023-02-24 15:28:10 -08:00
local $ sslmode = $ config { 'sslmode' } ;
$ sslmode =~ s/_/-/g ;
$ cstr . = ";sslmode=$sslmode" if ( $ sslmode ) ;
2007-04-12 20:24:50 +00:00
local @ uinfo ;
if ( $ postgres_sameunix &&
2010-12-17 11:49:53 -08:00
( @ uinfo = getpwnam ( $ postgres_login ) ) ) {
2007-04-12 20:24:50 +00:00
# DBI call which must run in subprocess
pipe ( OUTr , OUTw ) ;
if ( ! ( $ pid = fork ( ) ) ) {
2009-05-30 21:25:02 +00:00
& switch_to_unix_user ( \ @ uinfo ) ;
2007-04-12 20:24:50 +00:00
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 ;
2011-02-25 21:23:26 -08:00
if ( $ sql =~ /^\s*\\l\s*$/ ) {
# \l command to list encodings needs no special handling
}
elsif ( $ sql =~ /^\s*\\/ ) {
$ break_f = 1 ;
if ( $ sql !~ /^\s*\\copy\s+/ &&
$ sql !~ /^\s*\\i\s+/ ) {
& error ( & text ( 'r_command' , ) ) ;
}
}
2007-04-12 20:24:50 +00:00
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 ;
if ( $ qp !~ /^[bB]'\d+'$/ ) {
# Quote value, except for bits
$ 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
2007-04-29 05:13:08 +00:00
local $ cmd = & quote_path ( $ config { 'psql' } ) . " --html" .
2023-02-24 15:28:10 -08:00
& host_port_flags ( ) .
2007-04-12 20:24:50 +00:00
( ! & supports_pgpass ( ) ? " -u" : " -U $postgres_login" ) .
2023-02-24 15:28:10 -08:00
" -c " . & quote_path ( $ sql ) .
" " . $ _ [ 0 ] ;
2007-04-12 20:24:50 +00:00
if ( $ postgres_sameunix && defined ( getpwnam ( $ postgres_login ) ) ) {
2008-12-29 18:54:08 +00:00
$ cmd = & command_as_user ( $ postgres_login , 0 , $ cmd ) ;
2007-04-12 20:24:50 +00:00
}
$ cmd = & command_with_login ( $ cmd ) ;
delete ( $ ENV { 'LANG' } ) ; # to force output to english
delete ( $ ENV { 'LANGUAGE' } ) ;
2011-02-25 21:23:26 -08:00
if ( $ break_f == 0 ) {
2007-04-12 20:24:50 +00:00
# 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 2>&1 |" ) ;
local ( $ line , $ rv , @ data ) ;
do {
$ line = <OUT> ;
} while ( $ line =~ /^(username|password|user name):/i ||
2008-12-29 18:54:08 +00:00
$ line =~ /(warning|notice):/i ||
$ line !~ /\S/ && defined ( $ line ) ) ;
2007-04-12 20:24:50 +00:00
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 {
2007-04-29 05:13:08 +00:00
# Read HTML-format output
local $ row ;
local @ data ;
while ( $ line = <OUT> ) {
if ( $ line =~ /^\s*<tr>/ ) {
# Start of a row
$ row = [ ] ;
2007-04-12 20:24:50 +00:00
}
2007-04-29 05:13:08 +00:00
elsif ( $ line =~ /^\s*<\/tr>/ ) {
# End of a row
push ( @ data , $ row ) ;
$ row = undef ;
}
2007-04-29 19:33:07 +00:00
elsif ( $ line =~ /^\s*<(td|th)[^>]*>(.*)<\/(td|th)>/ ) {
2007-04-29 05:13:08 +00:00
# Value in a row
2007-04-29 19:33:07 +00:00
local $ v = $ 2 ;
$ v =~ s/<br>/\n/g ;
push ( @$ row , & entities_to_ascii ( $ v ) ) ;
2007-04-12 20:24:50 +00:00
}
}
2007-04-29 05:13:08 +00:00
$ rv = { 'titles' = > shift ( @ data ) ,
'data' = > \ @ data } ;
2007-04-12 20:24:50 +00:00
}
close ( OUT ) ;
return $ rv ;
}
else {
# Running a special \ command
local ( @ titles , @ row , @ data , $ rc , $ emsgf , $ emsg ) ;
$ emsgf = & transname ( ) ;
$ rc = & system_logged ( "$cmd >$emsgf 2>&1" ) ;
2011-02-25 21:23:26 -08:00
$ emsg = & read_file_contents ( $ emsgf ) ;
& unlink_file ( $ emsgf ) ;
2007-04-12 20:24:50 +00:00
if ( $ rc ) {
2011-02-25 21:23:26 -08:00
& error ( "<pre>$emsg</pre>" ) ;
2007-04-12 20:24:50 +00:00
}
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 ( @ _ ) ;
}
sub can_edit_db
{
if ( $ module_info { 'usermin' } ) {
# Check access control list in configuration
local $ rv ;
DB: 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 ;
if ( $ d eq '*' || $ _ [ 0 ] =~ /^$d$/ ) {
$ rv = 1 ;
last DB ;
}
}
$ rv = 0 ;
last DB ;
}
}
if ( $ rv && $ config { 'access_own' } ) {
# Check ownership on DB - first get login ID
if ( ! defined ( $ postgres_login_id ) ) {
local $ d = & execute_sql ( $ config { 'basedb' } , "select usesysid from pg_user where usename = ?" , $ postgres_login ) ;
$ postgres_login_id = $ d - > { 'data' } - > [ 0 ] - > [ 0 ] ;
}
# Get database owner
local $ d = & execute_sql ( $ config { 'basedb' } , "select datdba from pg_database where datname = ?" , $ _ [ 0 ] ) ;
if ( $ d - > { 'data' } - > [ 0 ] - > [ 0 ] != $ postgres_login_id ) {
$ rv = 0 ;
}
}
return $ rv ;
}
else {
# Check Webmin ACL
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 ;
2020-03-14 17:20:54 -07:00
open ( HBA , "<" . $ hba_conf_file ) ;
2007-04-12 20:24:50 +00:00
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+))?/ ) {
# Host/cidr format
push ( @ rv , { 'type' = > $ 1 ,
'index' = > scalar ( @ rv ) ,
'line' = > $ lnum ,
'db' = > $ 2 ,
'user' = > $ 3 ,
'address' = > $ 4 ,
'cidr' = > $ 5 ,
'auth' = > $ 6 ,
'arg' = > $ 8 } ) ;
}
elsif ( /^\s*(host|hostssl)\s+(\S+)\s+(\S+)\s+(\S+)\s+(\S+)\s+(\S+)(\s+(\S+))?/ ) {
# Host netmask format
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
{
2007-11-29 19:29:35 +00:00
local $ lref = & read_file_lines ( $ hba_conf_file ) ;
2007-04-12 20:24:50 +00:00
push ( @$ lref , & hba_line ( $ _ [ 0 ] , $ _ [ 1 ] ) ) ;
& flush_file_lines ( ) ;
}
# delete_hba(&hba, version)
sub delete_hba
{
2007-11-29 19:29:35 +00:00
local $ lref = & read_file_lines ( $ hba_conf_file ) ;
2007-04-12 20:24:50 +00:00
splice ( @$ lref , $ _ [ 0 ] - > { 'line' } , 1 ) ;
& flush_file_lines ( ) ;
}
# modify_hba(&hba, version)
sub modify_hba
{
2007-11-29 19:29:35 +00:00
local $ lref = & read_file_lines ( $ hba_conf_file ) ;
2007-04-12 20:24:50 +00:00
splice ( @$ lref , $ _ [ 0 ] - > { 'line' } , 1 , & hba_line ( $ _ [ 0 ] , $ _ [ 1 ] ) ) ;
& flush_file_lines ( ) ;
}
# swap_hba(&hba1, &hba2)
sub swap_hba
{
2007-11-29 19:29:35 +00:00
local $ lref = & read_file_lines ( $ hba_conf_file ) ;
2007-04-12 20:24:50 +00:00
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 ] - > { 'cidr' } eq '' ?
( $ _ [ 0 ] - > { 'address' } ,
$ _ [ 0 ] - > { 'netmask' } ) :
( "$_[0]->{'address'}/$_[0]->{'cidr'}" ) ) ,
$ _ [ 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
{
2011-12-10 11:20:40 -08:00
foreach my $ pidfile ( glob ( $ config { 'pid_file' } ) ) {
local $ pid = & check_pid_file ( $ pidfile ) ;
if ( $ pid ) {
& kill_logged ( 'HUP' , $ pid ) ;
}
2007-04-12 20:24:50 +00:00
}
}
# date_subs(filename)
# Does strftime-style date substitutions on a filename, if enabled
sub date_subs
{
2012-01-06 14:33:27 -08:00
local ( $ path ) = @ _ ;
local $ rv ;
2007-04-12 20:24:50 +00:00
if ( $ config { 'date_subs' } ) {
eval "use POSIX" ;
eval "use posix" if ( $@ ) ;
local @ tm = localtime ( time ( ) ) ;
2009-02-27 00:21:42 +00:00
& clear_time_locale ( ) ;
2012-01-06 14:33:27 -08:00
$ rv = strftime ( $ path , @ tm ) ;
2009-02-27 00:21:42 +00:00
& reset_time_locale ( ) ;
2007-04-12 20:24:50 +00:00
}
else {
2012-01-06 14:33:27 -08:00
$ rv = $ path ;
2007-04-12 20:24:50 +00:00
}
2012-01-06 14:33:27 -08:00
if ( $ config { 'webmin_subs' } ) {
$ rv = & substitute_template ( $ rv , { } ) ;
}
return $ rv ;
2007-04-12 20:24:50 +00:00
}
# 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 ;
local $ rv = & execute_command ( $ cmd , undef , \ $ out , \ $ out ) ;
if ( $ h && $ out ) {
print $ h $ _ [ 2 ] ? "<pre>" . & html_escape ( $ out ) . "</pre>" : $ out ;
}
return ! $ rv ;
}
return 1 ;
}
# 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 ;
local $ rv = & execute_command ( $ cmd , undef , \ $ out , \ $ out ) ;
if ( $ h && $ out ) {
print $ h $ _ [ 2 ] ? "<pre>" . & html_escape ( $ out ) . "</pre>" : $ out ;
}
return ! $ rv ;
}
return 1 ;
}
2011-03-05 17:31:43 -08:00
# make_backup_dir(directory)
# Create a directory that PostgreSQL can backup into
sub make_backup_dir
{
local ( $ dir ) = @ _ ;
if ( ! - d $ dir ) {
& make_dir ( $ dir , 0755 ) ;
if ( $ postgres_sameunix && defined ( getpwnam ( $ postgres_login ) ) ) {
& set_ownership_permissions ( $ postgres_login , undef , undef , $ dir ) ;
}
}
}
2007-04-12 20:24:50 +00:00
sub quote_table
{
local @ tn = split ( /\./ , $ _ [ 0 ] ) ;
return join ( "." , map { "\"$_\"" } @ tn ) ;
}
sub quotestr
{
return "\"$_[0]\"" ;
}
2009-07-02 23:24:56 +00:00
# execute_sql_file(database, file, [user, pass], [unix-user])
2007-04-12 20:24:50 +00:00
# Executes some file of SQL statements, and returns the exit status and output
sub execute_sql_file
{
2009-07-02 23:24:56 +00:00
local ( $ db , $ file , $ user , $ pass , $ unixuser ) = @ _ ;
2007-04-12 20:24:50 +00:00
if ( & is_readonly_mode ( ) ) {
return ( 0 , undef ) ;
}
if ( ! defined ( $ user ) ) {
$ user = $ postgres_login ;
$ pass = $ postgres_pass ;
}
local $ cmd = & quote_path ( $ config { 'psql' } ) . " -f " . & quote_path ( $ file ) .
2023-02-24 15:28:10 -08:00
& host_port_flags ( ) .
2007-04-12 20:24:50 +00:00
( & supports_pgpass ( ) ? " -U $user" : " -u" ) .
2023-02-24 15:28:10 -08:00
" " . $ db ;
2009-01-08 23:16:37 +00:00
if ( $ postgres_sameunix && defined ( getpwnam ( $ postgres_login ) ) ) {
$ cmd = & command_as_user ( $ postgres_login , 0 , $ cmd ) ;
}
2009-07-02 23:24:56 +00:00
elsif ( $ unixuser && $ unixuser ne 'root' && $< == 0 ) {
$ cmd = & command_as_user ( $ unixuser , 0 , $ cmd ) ;
}
2007-04-12 20:24:50 +00:00
$ cmd = & command_with_login ( $ cmd , $ user , $ pass ) ;
local $ out = & backquote_logged ( "$cmd 2>&1" ) ;
return ( $ out =~ /ERROR/i ? 1 : 0 , $ out ) ;
}
# split_table(&titles, &checkboxes, &links, &col1, &col2, ...)
# Outputs a table that is split into two parts
sub split_table
{
2008-01-07 23:33:13 +00:00
local $ mid = int ( ( @ { $ _ [ 2 ] } + 1 ) / 2 ) ;
2007-04-12 20:24:50 +00:00
local ( $ i , $ j ) ;
print "<table width=100%><tr>\n" ;
2008-01-07 23:33:13 +00:00
foreach $ s ( [ 0 , $ mid - 1 ] , [ $ mid , @ { $ _ [ 2 ] } - 1 ] ) {
2007-04-12 20:24:50 +00:00
print "<td width=50% valign=top>\n" ;
# Header
2008-01-07 23:33:13 +00:00
local @ tds = $ _ [ 1 ] ? ( "width=5" ) : ( ) ;
2007-04-12 20:24:50 +00:00
if ( $ s - > [ 0 ] <= $ s - > [ 1 ] ) {
local @ hcols ;
foreach $ t ( @ { $ _ [ 0 ] } ) {
push ( @ hcols , $ t ) ;
}
print & ui_columns_start ( \ @ hcols , 100 , 0 , \ @ tds ) ;
}
for ( $ i = $ s - > [ 0 ] ; $ i <=$s-> [ 1 ] ; $ i + + ) {
local @ cols ;
push ( @ cols , "<a href='$_[2]->[$i]'>$_[3]->[$i]</a>" ) ;
for ( $ j = 4 ; $ j < @ _ ; $ j + + ) {
push ( @ cols , $ _ [ $ j ] - > [ $ i ] ) ;
}
2008-01-07 23:33:13 +00:00
if ( $ _ [ 1 ] ) {
print & ui_checked_columns_row ( \ @ cols , \ @ tds , "d" , $ _ [ 1 ] - > [ $ i ] ) ;
}
else {
print & ui_columns_row ( \ @ cols , \ @ tds ) ;
}
2007-04-12 20:24:50 +00:00
}
if ( $ s - > [ 0 ] <= $ s - > [ 1 ] ) {
print & ui_columns_end ( ) ;
}
print "</td>\n" ;
}
print "</tr></table>\n" ;
}
# accepting_connections(db)
# Returns 1 if some database is accepting connections, 0 if not
sub accepting_connections
{
if ( ! defined ( $ has_connections ) ) {
$ has_connections = 0 ;
local @ str = & table_structure ( $ config { 'basedb' } ,
"pg_catalog.pg_database" ) ;
foreach my $ f ( @ str ) {
$ has_connections = 1 if ( $ f - > { 'field' } eq 'datallowconn' ) ;
}
}
if ( $ has_connections ) {
$ rv = & execute_sql_safe ( $ config { 'basedb' } , "select datallowconn from pg_database where datname = '$_[0]'" ) ;
if ( $ rv - > { 'data' } - > [ 0 ] - > [ 0 ] !~ /^(t|1)/i ) {
return 0 ;
}
}
return 1 ;
}
# start_postgresql()
# Starts the PostgreSQL database server. Returns an error message on failure
# or undef on success.
sub start_postgresql
{
if ( $ gconfig { 'os_type' } eq 'windows' && & foreign_check ( "init" ) ) {
# On Windows, always try to sc start the pgsql- service
& foreign_require ( "init" , "init-lib.pl" ) ;
local ( $ pg ) = grep { $ _ - > { 'name' } =~ /^pgsql-/ }
& init:: list_win32_services ( ) ;
if ( $ pg ) {
return & init:: start_win32_service ( $ pg - > { 'name' } ) ;
}
}
local $ temp = & transname ( ) ;
local $ rv = & system_logged ( "($config{'start_cmd'}) >$temp 2>&1" ) ;
local $ out = `cat $temp` ; unlink ( $ temp ) ;
unlink ( $ temp ) ;
if ( $ rv || $ out =~ /failed|error/i ) {
return "<pre>$out</pre>" ;
}
return undef ;
}
# stop_postgresql()
# Stops the PostgreSQL database server. Returns an error message on failure
# or undef on success.
sub stop_postgresql
{
if ( $ gconfig { 'os_type' } eq 'windows' && & foreign_check ( "init" ) ) {
# On Windows, always try to sc stop the pgsql- service
& foreign_require ( "init" , "init-lib.pl" ) ;
local ( $ pg ) = grep { $ _ - > { 'name' } =~ /^pgsql-/ }
& init:: list_win32_services ( ) ;
if ( $ pg ) {
return & init:: stop_win32_service ( $ pg - > { 'name' } ) ;
}
}
if ( $ config { 'stop_cmd' } ) {
local $ out = & backquote_logged ( "$config{'stop_cmd'} 2>&1" ) ;
if ( $? || $ out =~ /failed|error/i ) {
return "<pre>$?\n$out</pre>" ;
}
}
else {
2011-12-10 11:20:40 -08:00
local $ pidcount = 0 ;
foreach my $ pidfile ( glob ( $ config { 'pid_file' } ) ) {
local $ pid = & check_pid_file ( $ pidfile ) ;
if ( $ pid ) {
& kill_logged ( 'TERM' , $ pid ) ||
return & text ( 'stop_ekill' , "<tt>$pid</tt>" ,
"<tt>$!</tt>" ) ;
$ pidcount + + ;
}
}
$ pidcount || return & text ( 'stop_epidfile' ,
"<tt>$config{'pid_file'}</tt>" ) ;
2007-04-12 20:24:50 +00:00
}
return undef ;
}
# setup_postgresql()
# Performs initial postgreSQL configuration. Returns an error message on failure
# or undef on success.
sub setup_postgresql
{
return undef if ( ! $ config { 'setup_cmd' } ) ;
local $ temp = & transname ( ) ;
local $ rv = & system_logged ( "($config{'setup_cmd'}) >$temp 2>&1" ) ;
local $ out = `cat $temp` ;
unlink ( $ temp ) ;
if ( $ rv ) {
return "<pre>$out</pre>" ;
}
return undef ;
}
# list_indexes(db)
# Returns the names of all indexes in some database
sub list_indexes
{
local ( $ db ) = @ _ ;
local ( @ rv , $ r ) ;
local % tables = map { $ _ , 1 } & list_tables ( $ db ) ;
if ( & supports_schemas ( $ db ) ) {
local $ t = & execute_sql_safe ( $ db , "select schemaname,indexname,tablename from pg_indexes" ) ;
return map { ( $ _ - > [ 0 ] eq "public" ? "" : $ _ - > [ 0 ] . "." ) . $ _ - > [ 1 ] }
grep { $ tables { ( $ _ - > [ 0 ] eq "public" ? "" : $ _ - > [ 0 ] . "." ) . $ _ - > [ 2 ] } }
@ { $ t - > { 'data' } } ;
}
else {
local $ t = & execute_sql_safe ( $ db , "select indexname,tablename from pg_indexes" ) ;
return map { $ _ - > [ 0 ] } grep { $ tables { $ t - > [ 1 ] } } @ { $ t - > { 'data' } } ;
}
}
# index_structure(db, indexname)
# Returns information on an index
sub index_structure
{
local ( $ db , $ index ) = @ _ ;
local $ info = { 'name' = > $ index } ;
if ( & supports_schemas ( $ db ) ) {
local ( $ sn , $ in ) ;
if ( $ index =~ /^(\S+)\.(\S+)$/ ) {
( $ sn , $ in ) = ( $ 1 , $ 2 ) ;
}
else {
( $ sn , $ in ) = ( "public" , $ index ) ;
}
local $ t = & execute_sql_safe ( $ db , "select schemaname,tablename,indexdef from pg_indexes where indexname = '$in' and schemaname = '$sn'" ) ;
local $ r = $ t - > { 'data' } - > [ 0 ] ;
if ( $ r - > [ 0 ] eq "public" ) {
$ info - > { 'table' } = $ r - > [ 1 ] ;
}
else {
$ info - > { 'table' } = $ r - > [ 0 ] . "." . $ r - > [ 1 ] ;
}
$ info - > { 'create' } = $ r - > [ 2 ] ;
}
else {
local $ t = & execute_sql_safe ( $ db , "select tablename,indexdef from pg_indexes where indexname = '$index'" ) ;
local $ r = $ t - > { 'data' } - > [ 0 ] ;
$ info - > { 'table' } = $ r - > [ 0 ] ;
$ info - > { 'create' } = $ r - > [ 1 ] ;
}
# Parse create expression
if ( $ info - > { 'create' } =~ /^create\s+unique/i ) {
$ info - > { 'type' } = 'unique' ;
}
if ( $ info - > { 'create' } =~ /using\s+(\S+)\s/ ) {
$ info - > { 'using' } = lc ( $ 1 ) ;
}
if ( $ info - > { 'create' } =~ /\((.*)\)/ ) {
$ info - > { 'cols' } = [ split ( /\s*,\s*/ , $ 1 ) ] ;
2022-10-21 19:48:02 -07:00
foreach my $ c ( @ { $ info - > { 'cols' } } ) {
$ c =~ s/^"(.*)"$/$1/ ;
}
2007-04-12 20:24:50 +00:00
}
return $ info ;
}
sub supports_indexes
{
return & get_postgresql_version ( ) >= 7.3 ;
}
# list_views(db)
# Returns the names of all views in some database
sub list_views
{
local ( $ db ) = @ _ ;
local ( @ rv , $ r ) ;
if ( & supports_schemas ( $ db ) ) {
local $ t = & execute_sql_safe ( $ db , "select schemaname,viewname from pg_views where schemaname != 'pg_catalog' and schemaname != 'information_schema'" ) ;
return map { ( $ _ - > [ 0 ] eq "public" ? "" : $ _ - > [ 0 ] . "." ) . $ _ - > [ 1 ] }
@ { $ t - > { 'data' } } ;
}
else {
local $ t = & execute_sql_safe ( $ db , "select viewname from pg_indexes" ) ;
return map { $ _ - > [ 0 ] } @ { $ t - > { 'data' } } ;
}
}
# view_structure(db, viewname)
# Returns information about a view
sub view_structure
{
local ( $ db , $ view ) = @ _ ;
local $ info = { 'name' = > $ view } ;
if ( & supports_schemas ( $ db ) ) {
local ( $ sn , $ in ) ;
if ( $ view =~ /^(\S+)\.(\S+)$/ ) {
( $ sn , $ in ) = ( $ 1 , $ 2 ) ;
}
else {
( $ sn , $ in ) = ( "public" , $ view ) ;
}
local $ t = & execute_sql_safe ( $ db , "select schemaname,viewname,definition from pg_views where viewname = '$in' and schemaname = '$sn'" ) ;
local $ r = $ t - > { 'data' } - > [ 0 ] ;
$ info - > { 'query' } = $ r - > [ 2 ] ;
}
else {
local $ t = & execute_sql_safe ( $ db , "select viewname,definition from pg_views where viewname = '$index'" ) ;
local $ r = $ t - > { 'data' } - > [ 0 ] ;
$ info - > { 'query' } = $ r - > [ 1 ] ;
}
$ info - > { 'query' } =~ s/;$// ;
return $ info ;
}
sub supports_views
{
return & get_postgresql_version ( ) >= 7.3 ;
}
# list_sequences(db)
# Returns the names of all sequences in some database
sub list_sequences
{
local ( $ db ) = @ _ ;
local ( @ rv , $ r ) ;
if ( & supports_schemas ( $ db ) ) {
local $ t = & execute_sql_safe ( $ db , "select schemaname,relname from pg_statio_user_sequences" ) ;
return map { ( $ _ - > [ 0 ] eq "public" ? "" : $ _ - > [ 0 ] . "." ) . $ _ - > [ 1 ] }
@ { $ t - > { 'data' } } ;
}
else {
local $ t = & execute_sql_safe ( $ db , "select relname from pg_statio_user_sequences" ) ;
return map { $ _ - > [ 0 ] } @ { $ t - > { 'data' } } ;
}
}
# sequence_structure(db, name)
# Returns details of a sequence
sub sequence_structure
{
local ( $ db , $ seq ) = @ _ ;
local $ info = { 'name' = > $ seq } ;
local $ t = & execute_sql_safe ( $ db , "select * from " . & quote_table ( $ seq ) ) ;
local $ r = $ t - > { 'data' } - > [ 0 ] ;
local $ i = 0 ;
foreach my $ c ( @ { $ t - > { 'titles' } } ) {
$ info - > { $ c } = $ r - > [ $ i + + ] ;
}
return $ info ;
}
sub supports_sequences
{
return & get_postgresql_version ( ) >= 7.4 ? 1 :
& get_postgresql_version ( ) >= 7.3 ? 2 : 0 ;
}
# Returns 1 if the postgresql server being managed is on this system
sub is_postgresql_local
{
return $ config { 'host' } eq '' || $ config { 'host' } eq 'localhost' ||
$ config { 'host' } eq & get_system_hostname ( ) ||
& to_ipaddress ( $ config { 'host' } ) eq & to_ipaddress ( & get_system_hostname ( ) ) ;
}
2023-02-23 19:52:32 -08:00
# backup_database(database, dest-path, format, [&only-tables], [run-as-user],
# [compress-mode])
2007-04-12 20:24:50 +00:00
# Executes the pg_dump command to backup the specified database to the
# given destination path. Returns undef on success, or an error message
# on failure.
sub backup_database
{
2023-02-23 19:52:32 -08:00
my ( $ db , $ path , $ format , $ tables , $ user , $ compress ) = @ _ ;
my $ tablesarg = join ( " " , map { " -t " . quotemeta ( '"' . $ _ . '"' ) } @$ tables ) ;
my $ writer ;
if ( $ compress == 0 ) {
$ writer = "cat >" . quotemeta ( $ path ) ;
}
elsif ( $ compress == 1 ) {
$ writer = "gzip -c >" . quotemeta ( $ path ) ;
}
elsif ( $ compress == 2 ) {
$ writer = "bzip2 -c >" . quotemeta ( $ path ) ;
}
my $ cmd = & quote_path ( $ config { 'dump_cmd' } ) .
2023-02-24 15:28:10 -08:00
& host_port_flags ( ) .
2007-04-12 20:24:50 +00:00
( ! $ postgres_login ? "" :
& supports_pgpass ( ) ? " -U $postgres_login" : " -u" ) .
( $ format eq 'p' ? "" : " -b" ) .
$ tablesarg .
2023-02-23 19:52:32 -08:00
" -F$format $db | $writer" ;
2007-04-12 20:24:50 +00:00
if ( $ postgres_sameunix && defined ( getpwnam ( $ postgres_login ) ) ) {
2014-12-17 14:54:32 -08:00
# Postgres connections have to be made as the 'postgres' Unix user
2007-04-12 20:24:50 +00:00
$ cmd = & command_as_user ( $ postgres_login , 0 , $ cmd ) ;
}
2014-12-17 14:54:32 -08:00
elsif ( $ user ) {
# Run as a specific Unix user
$ cmd = & command_as_user ( $ user , 0 , $ cmd ) ;
}
2007-04-12 20:24:50 +00:00
$ cmd = & command_with_login ( $ cmd ) ;
2023-02-23 19:52:32 -08:00
my $ out = & backquote_logged ( "$cmd 2>&1" ) ;
2007-04-12 20:24:50 +00:00
if ( $? || $ out =~ /could not|error|failed/i ) {
return $ out ;
}
return undef ;
}
2023-02-25 23:00:46 -08:00
# restore_database(database, source-path, only-data, clear-db, [&only-tables],
# [login, password])
2007-04-12 20:24:50 +00:00
# Restores the contents of a PostgreSQL backup into the specified database.
# Returns undef on success, or an error message on failure.
sub restore_database
{
2023-02-25 23:00:46 -08:00
my ( $ db , $ path , $ only , $ clean , $ tables , $ login , $ pass ) = @ _ ;
2023-02-23 19:52:32 -08:00
my $ tablesarg = join ( " " , map { " -t " . quotemeta ( '"' . $ _ . '"' ) } @$ tables ) ;
2023-02-25 23:00:46 -08:00
$ login || = $ postgres_login ;
$ pass || = $ postgres_pass ;
2023-02-23 19:52:32 -08:00
my $ cmd = & quote_path ( $ config { 'rstr_cmd' } ) .
2023-02-24 15:28:10 -08:00
& host_port_flags ( ) .
2023-02-25 23:00:46 -08:00
( ! $ login ? "" :
& supports_pgpass ( ) ? " -U $login" : " -u" ) .
2007-04-12 20:24:50 +00:00
( $ only ? " -a" : "" ) .
( $ clean ? " -c" : "" ) .
2010-12-05 22:48:54 -08:00
$ tablesarg .
2007-04-12 20:24:50 +00:00
" -d $db " . & quote_path ( $ path ) ;
2023-02-25 23:00:46 -08:00
if ( $ postgres_sameunix && defined ( getpwnam ( $ login ) ) ) {
$ cmd = & command_as_user ( $ login , 0 , $ cmd ) ;
2007-04-12 20:24:50 +00:00
}
2023-02-25 23:00:46 -08:00
$ cmd = & command_with_login ( $ cmd , $ login , $ pass ) ;
2023-02-23 19:52:32 -08:00
my $ out = & backquote_logged ( "$cmd 2>&1" ) ;
2007-04-12 20:24:50 +00:00
if ( $? || $ out =~ /could not|error|failed/i ) {
return $ out ;
}
return undef ;
}
# PostgreSQL versions below 7.3 don't support .pgpass, and version 8.0.*
# don't allow it to be located via $HOME or $PGPASSFILE.
sub supports_pgpass
{
local $ ver = & get_postgresql_version ( 1 ) ;
return $ ver >= 7.3 && $ ver < 8.0 ||
$ ver >= 8.1 ;
}
# command_with_login(command, [user, pass])
# Given a command that talks to postgresql (like psql or pg_dump), sets up
# the environment so that it can login to the database. Returns a modified
# command to execute.
sub command_with_login
{
local ( $ cmd , $ user , $ pass ) = @ _ ;
if ( ! defined ( $ user ) ) {
$ user = $ postgres_login ;
$ pass = $ postgres_pass ;
}
local $ loginfile ;
if ( & supports_pgpass ( ) ) {
# Can use .pgpass file
local $ pgpass ;
if ( $ gconfig { 'os_type' } eq 'windows' ) {
# On Windows, the file is under ~/application data
local $ appdata = "$ENV{'HOME'}/application data" ;
& make_dir ( $ appdata , 0755 ) ;
local $ postgresql = "$appdata/postgresql" ;
& make_dir ( $ postgresql , 0755 ) ;
$ pgpass = "$postgresql/pgpass.conf" ;
}
else {
local $ temphome = & transname ( ) ;
& make_dir ( $ temphome , 0755 ) ;
$ pgpass = "$temphome/.pgpass" ;
2013-01-30 13:23:12 -08:00
push ( @ main:: temporary_files , $ pgpass ) ;
2020-07-11 09:39:33 -07:00
$ cmd = "HOME=$temphome $cmd" ;
2007-04-12 20:24:50 +00:00
}
$ ENV { 'PGPASSFILE' } = $ pgpass ;
open ( PGPASS , ">$pgpass" ) ;
print PGPASS "*:*:*:$user:$pass\n" ;
close ( PGPASS ) ;
& set_ownership_permissions (
$ postgres_sameunix ? $ user : undef ,
undef , 0600 , $ pgpass ) ;
}
else {
# Need to put login and password in temp file
$ loginfile = & transname ( ) ;
open ( TEMP , ">$loginfile" ) ;
print TEMP "$user\n$pass\n" ;
close ( TEMP ) ;
$ cmd . = " <$loginfile" ;
}
return $ cmd ;
}
2023-02-24 15:28:10 -08:00
# host_port_flags()
# Returns flags to set the correct host and post for postgreSQL CLI commands
sub host_port_flags
{
local $ sslmode = $ config { 'sslmode' } ;
$ sslmode =~ s/_/-/g ;
if ( $ sslmode ) {
my @ rv ;
push ( @ rv , "host=" . $ config { 'host' } ) if ( $ config { 'host' } ) ;
push ( @ rv , "port=" . $ config { 'port' } ) if ( $ config { 'port' } ) ;
push ( @ rv , "sslmode=" . $ sslmode ) if ( $ sslmode ) ;
return @ rv ? " '" . join ( " " , @ rv ) . "'" : "" ;
}
else {
my $ rv = "" ;
$ rv . = " -h $config{'host'}" if ( $ config { 'host' } ) ;
$ rv . = " -p $config{'port'}" if ( $ config { 'port' } ) ;
return $ rv ;
}
}
2013-12-30 11:13:25 -08:00
# extract_grants(field)
# Given a field from pg_class that contains grants either as a comma-separated
# list or an array, return a list of tuples in user,grant format
sub extract_grants
{
my ( $ f ) = @ _ ;
my @ rv ;
if ( ref ( $ f ) ) {
@ rv = map { [ split ( /=/ , $ _ , 2 ) ] } @$ f ;
}
else {
$ f =~ s/^\{// ;
$ f =~ s/\}$// ;
@ rv = map { [ split ( /=/ , $ _ , 2 ) ] } map { s/\\"/"/g ; s/"//g ; $ _ } grep { /=\S/ } split ( /,/ , $ f ) ;
}
return @ rv ;
}
2014-09-01 14:37:24 -07:00
# delete_database_backup_job(db)
# If there is a backup scheduled for some database, remove it
sub delete_database_backup_job
{
my ( $ db ) = @ _ ;
& foreign_require ( "cron" ) ;
my @ jobs = & cron:: list_cron_jobs ( ) ;
my $ cmd = "$cron_cmd $db" ;
my ( $ job ) = grep { $ _ - > { 'command' } eq $ cmd } @ jobs ;
if ( $ job ) {
& lock_file ( & cron:: cron_file ( $ job ) ) ;
& cron:: delete_cron_job ( $ job ) ;
& unlock_file ( & cron:: cron_file ( $ job ) ) ;
}
}
2016-03-27 16:26:19 -07:00
# get_pg_shadow_table()
# Returns the table containing users, and the list of columns (comma-separated)
sub get_pg_shadow_table
{
2016-05-29 11:09:46 -07:00
if ( & get_postgresql_version ( ) >= 9.5 ) {
my $ cols = $ pg_shadow_cols ;
$ cols =~ s/usecatupd/'t'/g ;
return ( "pg_user" , $ cols ) ;
}
elsif ( & get_postgresql_version ( ) >= 9.4 ) {
2016-03-27 16:26:19 -07:00
return ( "pg_user" , $ pg_shadow_cols ) ;
}
else {
return ( "pg_shadow" , $ pg_shadow_cols ) ;
}
}
2023-02-23 23:42:00 -08:00
# compression_format(file)
# Returns 0 if uncompressed, 1 for gzip, 2 for compress, 3 for bzip2 or
# 4 for zip
sub compression_format
{
open ( BACKUP , "<" . $ _ [ 0 ] ) ;
local $ two ;
read ( BACKUP , $ two , 2 ) ;
close ( BACKUP ) ;
return $ two eq "\037\213" ? 1 :
$ two eq "\037\235" ? 2 :
$ two eq "PK" ? 4 :
$ two eq "BZ" ? 3 : 0 ;
}
2023-02-25 23:24:25 -08:00
# set_login_pass(same-unix, login, password)
# Sets the credentials to be used for all SQL commands
sub set_login_pass
{
my ( $ sameunix , $ login , $ pass ) = @ _ ;
$ postgres_sameunix = $ sameunix ;
$ postgres_login = $ login ;
$ postgres_pass = $ pass ;
}
2007-04-12 20:24:50 +00:00
1 ;