postgresql/postgresql-lib.pl

   1 # postgresql-lib.pl
   2 # Common PostgreSQL functions
   3 # XXX updating date field
   4
   5 BEGIN { push(@INC, ".."); };
   6 use WebminCore;
   7 &init_config();
   8 if ($config{'plib'}) {
   9         $ENV{$gconfig{'ld_env'}} .= ':' if ($ENV{$gconfig{'ld_env'}});
  10         $ENV{$gconfig{'ld_env'}} .= $config{'plib'};
  11         }
  12 if ($config{'psql'} =~ /^(.*)\/bin\/psql$/ && $1 ne '' && $1 ne '/usr') {
  13         $ENV{$gconfig{'ld_env'}} .= ':' if ($ENV{$gconfig{'ld_env'}});
  14         $ENV{$gconfig{'ld_env'}} .= "$1/lib";
  15         }
  16
  17 if ($module_info{'usermin'}) {
  18         # Login and password is set by user in Usermin, and the module always
  19         # runs as the Usermin user
  20         &switch_to_remote_user();
  21         &create_user_config_dirs();
  22         $postgres_login = $userconfig{'login'};
  23         $postgres_pass = $userconfig{'pass'};
  24         $postgres_sameunix = 0;
  25         %access = ( 'backup' => 1,
  26                     'restore' => 1,
  27                     'tables' => 1,
  28                     'cmds' => 1, );
  29         $max_dbs = $userconfig{'max_dbs'};
  30         $commands_file = "$user_module_config_directory/commands";
  31         %displayconfig = %userconfig;
  32         }
  33 else {
  34         # Login and password is determined by ACL in Webmin
  35         %access = &get_module_acl();
  36         if ($access{'user'} && !$use_global_login) {
  37                 $postgres_login = $access{'user'};
  38                 $postgres_pass = $access{'pass'};
  39                 $postgres_sameunix = $access{'sameunix'};
  40                 }
  41         else {
  42                 $postgres_login = $config{'login'};
  43                 $postgres_pass = $config{'pass'};
  44                 $postgres_sameunix = $config{'sameunix'};
  45                 }
  46         $max_dbs = $config{'max_dbs'};
  47         $commands_file = "$module_config_directory/commands";
  48         %displayconfig = %config;
  49         }
  50 foreach my $hba (split(/\t+/, $config{'hba_conf'})) {
  51         if ($hba =~ /\*|\?/) {
  52                 ($hba) = glob($hba);
  53                 }
  54         if ($hba && -r $hba) {
  55                 $hba_conf_file = $hba;
  56                 last;
  57                 }
  58         }
  59 $cron_cmd = "$module_config_directory/backup.pl";
  60
  61 if (!$config{'nodbi'}) {
  62         # Check if we have DBD::Pg
  63         eval <<EOF;
  64 use DBI;
  65 \$driver_handle = DBI->install_driver("Pg");
  66 EOF
  67         }
  68
  69 # is_postgresql_running()
  70 # Returns 1 if yes, 0 if no, -1 if the login is invalid, -2 if there
  71 # is a library problem. When called in an array context, returns the full error
  72 # message too.
  73 sub is_postgresql_running
  74 {
  75 local $temp = &transname();
  76 local $host = $config{'host'} ? "-h $config{'host'}" : "";
  77 $host .= " -p $config{'port'}" if ($config{'port'});
  78 local $cmd = &quote_path($config{'psql'}).
  79              (!&supports_pgpass() ? " -u" : " -U $postgres_login").
  80              " -c '' $host $config{'basedb'}";
  81 if ($postgres_sameunix && defined(getpwnam($postgres_login))) {
  82         $cmd = "su $postgres_login -c ".quotemeta($cmd);
  83         }
  84 $cmd = &command_with_login($cmd);
  85 if (&foreign_check("proc")) {
  86         &foreign_require("proc", "proc-lib.pl");
  87         if (defined(&proc::close_controlling_pty)) {
  88                 # Detach from tty if possible, so that the psql
  89                 # command doesn't prompt for a login
  90                 &proc::close_controlling_pty();
  91                 }
  92         }
  93 open(OUT, "$cmd 2>&1 |");
  94 while(<OUT>) { $out .= $_; }
  95 close(OUT);
  96 unlink($temp);
  97 local $rv;
  98 if ($out =~ /setuserid:/i || $out =~ /no\s+password\s+supplied/i ||
  99     $out =~ /no\s+postgres\s+username/i || $out =~ /authentication\s+failed/i ||
 100     $out =~ /password:.*password:/i || $out =~ /database.*does.*not/i ||
 101     $out =~ /user.*does.*not/i) {
 102         $rv = -1;
 103         }
 104 elsif ($out =~ /connect.*failed/i || $out =~ /could not connect to server:/) {
 105         $rv = 0;
 106         }
 107 elsif ($out =~ /lib\S+\.so/i) {
 108         $rv = -2;
 109         }
 110 else {
 111         $rv = 1;
 112         }
 113 return wantarray ? ($rv, $out) : $rv;
 114 }
 115
 116 # get_postgresql_version([from-command])
 117 sub get_postgresql_version
 118 {
 119 local ($fromcmd) = @_;
 120 local $main::error_must_die = 1;
 121 return $postgresql_version_cache if (defined($postgresql_version_cache));
 122 local $rv;
 123 if (!$fromcmd) {
 124         eval {
 125                 local $v = &execute_sql_safe($config{'basedb'},
 126                                              'select version()');
 127                 $v = $v->{'data'}->[0]->[0];
 128                 if ($v =~ /postgresql\s+([0-9\.]+)/i) {
 129                         $rv = $1;
 130                         }
 131                 };
 132         }
 133 if (!$rv || $@) {
 134         local $out = &backquote_command(&quote_path($config{'psql'})." -V 2>&1 <$null_file");
 135         $rv = $out =~ /\s([0-9\.]+)/ ? $1 : undef;
 136         }
 137 $postgresql_version_cache = $rv;
 138 return $rv;
 139 }
 140
 141 sub can_drop_fields
 142 {
 143 return &get_postgresql_version() >= 7.3;
 144 }
 145
 146 # list_databases()
 147 # Returns a list of all databases
 148 sub list_databases
 149 {
 150 local $force_nodbi = 1;
 151 local $t = &execute_sql_safe($config{'basedb'}, 'select * from pg_database order by datname');
 152 return sort { lc($a) cmp lc($b) } map { $_->[0] } @{$t->{'data'}};
 153 }
 154
 155 # supports_schemas(database)
 156 # Returns 1 if schemas are supported
 157 sub supports_schemas
 158 {
 159 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");
 160 return $t->{'data'}->[0]->[0] ? 1 : 0;
 161 }
 162
 163 # list_tables(database)
 164 # Returns a list of tables in some database
 165 sub list_tables
 166 {
 167 if (&supports_schemas($_[0])) {
 168         local $t = &execute_sql_safe($_[0], 'select schemaname,tablename from pg_tables where tablename not like \'pg_%\' and tablename not like \'sql_%\' order by tablename');
 169         return map { ($_->[0] eq "public" ? "" : $_->[0].".").$_->[1] } @{$t->{'data'}};
 170         }
 171 else {
 172         local $t = &execute_sql_safe($_[0], 'select tablename from pg_tables where tablename not like \'pg_%\' and tablename not like \'sql_%\' order by tablename');
 173         return map { $_->[0] } @{$t->{'data'}};
 174         }
 175 }
 176
 177 # list_types()
 178 # Returns a list of all available field types
 179 sub list_types
 180 {
 181 local $t = &execute_sql_safe($config{'basedb'}, 'select typname from pg_type where typrelid = 0 and typname !~ \'^_.*\' order by typname');
 182 local @types = map { $_->[0] } @{$t->{'data'}};
 183 push(@types, "serial", "bigserial") if (&get_postgresql_version() >= 7.4);
 184 return sort { $a cmp $b } &unique(@types);
 185 }
 186
 187 # table_structure(database, table)
 188 # Returns a list of hashes detailing the structure of a table
 189 sub table_structure
 190 {
 191 if (&supports_schemas($_[0])) {
 192         # Find the schema and table
 193         local ($tn, $ns);
 194         if ($_[1] =~ /^(\S+)\.(\S+)$/) {
 195                 $ns = $1;
 196                 $tn = $2;
 197                 }
 198         else {
 199                 $ns = "public";
 200                 $tn = $_[1];
 201                 }
 202         $tn =~ s/^([^\.]+)\.//;
 203         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");
 204         local (@rv, $r);
 205         foreach $r (@{$t->{'data'}}) {
 206                 local $arr;
 207                 $arr++ if ($r->[2] =~ s/^_//);
 208                 local $sz = $r->[4] - 4;
 209                 if ($sz >= 65536 && $r->[2] =~ /numeric/i) {
 210                         $sz = int($sz/65536).",".($sz%65536);
 211                         }
 212                 push(@rv, { 'field' => $r->[1],
 213                             'arr' => $arr ? 'YES' : 'NO',
 214                             'type' => $r->[4] < 0 ? $r->[2]
 215                                                   : $r->[2]."($sz)",
 216                             'null' => $r->[5] =~ /f|0/ ? 'YES' : 'NO' } );
 217                 }
 218
 219         # Work out which fields are the primary key
 220         if (&supports_indexes()) {
 221                 local ($keyidx) = grep { $_ eq $_[1]."_pkey" ||
 222                                          $_ eq "pk_".$_[1] }
 223                                        &list_indexes($_[0]);
 224                 if ($keyidx) {
 225                         local $istr = &index_structure($_[0], $keyidx);
 226                         foreach my $r (@rv) {
 227                                 if (&indexof($r->{'field'},
 228                                              @{$istr->{'cols'}}) >= 0) {
 229                                         $r->{'key'} = 'PRI';
 230                                         }
 231                                 }
 232                         }
 233                 }
 234
 235         return @rv;
 236         }
 237 else {
 238         # Just look by table name
 239         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");
 240         local (@rv, $r);
 241         foreach $r (@{$t->{'data'}}) {
 242                 local $arr;
 243                 $arr++ if ($r->[2] =~ s/^_//);
 244                 local $sz = $r->[4] - 4;
 245                 if ($sz >= 65536 && $r->[2] =~ /numeric/i) {
 246                         $sz = int($sz/65536).",".($sz%65536);
 247                         }
 248                 push(@rv, { 'field' => $r->[1],
 249                             'arr' => $arr ? 'YES' : 'NO',
 250                             'type' => $r->[4] < 0 ? $r->[2]
 251                                                   : $r->[2]."($sz)",
 252                             'null' => $r->[5] =~ /f|0/ ? 'YES' : 'NO' } );
 253                 }
 254         return @rv;
 255         }
 256 }
 257
 258 # execute_sql(database, sql, [param, ...])
 259 sub execute_sql
 260 {
 261 if (&is_readonly_mode()) {
 262         return { };
 263         }
 264 &execute_sql_safe(@_);
 265 }
 266
 267 # execute_sql_safe(database, sql, [param, ...])
 268 sub execute_sql_safe
 269 {
 270 local $sql = $_[1];
 271 local @params = @_[2..$#_];
 272 if ($gconfig{'debug_what_sql'}) {
 273         # Write to Webmin debug log
 274         local $params;
 275         for(my $i=0; $i<@params; $i++) {
 276                 $params .= " ".$i."=".$params[$i];
 277                 }
 278         &webmin_debug_log('SQL', "db=$_[0] sql=$sql".$params);
 279         }
 280 if ($sql !~ /^\s*\\/) {
 281         $sql =~ s/\\/\\\\/g;
 282         }
 283 if ($driver_handle &&
 284     $sql !~ /^\s*(create|drop)\s+database/ && $sql !~ /^\s*\\/ &&
 285     !$force_nodbi) {
 286         # Use the DBI interface
 287         local $pid;
 288         local $cstr = "dbname=$_[0]";
 289         $cstr .= ";host=$config{'host'}" if ($config{'host'});
 290         $cstr .= ";port=$config{'port'}" if ($config{'port'});
 291         local @uinfo;
 292         if ($postgres_sameunix &&
 293             (@uinfo = getpwnam($postgres_login))) {
 294                 # DBI call which must run in subprocess
 295                 pipe(OUTr, OUTw);
 296                 if (!($pid = fork())) {
 297                         &switch_to_unix_user(\@uinfo);
 298                         close(OUTr);
 299                         local $dbh = $driver_handle->connect($cstr,
 300                                         $postgres_login, $postgres_pass);
 301                         if (!$dbh) {
 302                                 print OUTw &serialise_variable(
 303                                     "DBI connect failed : ".$DBI::errstr);
 304                                 exit(0);
 305                                 }
 306                         $dbh->{'AutoCommit'} = 0;
 307                         local $cmd = $dbh->prepare($sql);
 308                         #foreach (@params) {    # XXX dbd quoting is broken!
 309                         #       s/\\/\\\\/g;
 310                         #       }
 311                         if (!$cmd->execute(@params)) {
 312                                 print OUTw &serialise_variable(&text('esql',
 313                                     "<tt>".&html_escape($sql)."</tt>",
 314                                     "<tt>".&html_escape($dbh->errstr)."</tt>"));
 315                                 $dbh->disconnect();
 316                                 exit(0);
 317                                 }
 318                         local (@data, @row);
 319                         local @titles = @{$cmd->{'NAME'}};
 320                         while(@row = $cmd->fetchrow()) {
 321                                 push(@data, [ @row ]);
 322                                 }
 323                         $cmd->finish();
 324                         $dbh->commit();
 325                         $dbh->disconnect();
 326                         print OUTw &serialise_variable(
 327                                               { 'titles' => \@titles,
 328                                                 'data' => \@data });
 329                         exit(0);
 330                         }
 331                 close(OUTw);
 332                 local $line = <OUTr>;
 333                 local $rv = &unserialise_variable($line);
 334                 if (ref($rv)) {
 335                         return $rv;
 336                         }
 337                 else {
 338                         &error($rv || "$sql : Unknown DBI error");
 339                         }
 340                 }
 341         else {
 342                 # Just normal DBI call
 343                 local $dbh = $driver_handle->connect($cstr,
 344                                 $postgres_login, $postgres_pass);
 345                 $dbh || &error("DBI connect failed : ",$DBI::errstr);
 346                 $dbh->{'AutoCommit'} = 0;
 347                 local $cmd = $dbh->prepare($sql);
 348                 if (!$cmd->execute(@params)) {
 349                         &error(&text('esql', "<tt>".&html_escape($sql)."</tt>",
 350                                      "<tt>".&html_escape($dbh->errstr)."</tt>"));
 351                         }
 352                 local (@data, @row);
 353                 local @titles = @{$cmd->{'NAME'}};
 354                 while(@row = $cmd->fetchrow()) {
 355                         push(@data, [ @row ]);
 356                         }
 357                 $cmd->finish();
 358                 $dbh->commit();
 359                 $dbh->disconnect();
 360                 return { 'titles' => \@titles,
 361                          'data' => \@data };
 362                 }
 363         }
 364 else {
 365         # Check for a \ command
 366         my $break_f = 0 ;
 367         if ($sql =~ /^\s*\\l\s*$/) {
 368                 # \l command to list encodings needs no special handling
 369                 }
 370         elsif ($sql =~ /^\s*\\/ ) {
 371                 $break_f = 1 ;
 372                 if ($sql !~ /^\s*\\copy\s+/ &&
 373                     $sql !~ /^\s*\\i\s+/) {
 374                         &error ( &text ( 'r_command', ) ) ;
 375                         }
 376                 }
 377
 378         if (@params) {
 379                 # Sub in ? parameters
 380                 local $p;
 381                 local $pos = -1;
 382                 foreach $p (@params) {
 383                         $pos = index($sql, '?', $pos+1);
 384                         &error("Incorrect number of parameters in $_[1] (".scalar(@params).")") if ($pos < 0);
 385                         local $qp = $p;
 386                         if ($qp !~ /^[bB]'\d+'$/) {
 387                                 # Quote value, except for bits
 388                                 $qp =~ s/\\/\\\\/g;
 389                                 $qp =~ s/'/''/g;
 390                                 $qp =~ s/\$/\\\$/g;
 391                                 $qp =~ s/\n/\\n/g;
 392                                 $qp = $qp eq '' ? "NULL" : "'$qp'";
 393                                 }
 394                         $sql = substr($sql, 0, $pos).$qp.substr($sql, $pos+1);
 395                         $pos += length($qp)-1;
 396                         }
 397                 }
 398
 399         # Call the psql program
 400         local $host = $config{'host'} ? "-h $config{'host'}" : "";
 401         $host .= " -p $config{'port'}" if ($config{'port'});
 402         local $cmd = &quote_path($config{'psql'})." --html".
 403                      (!&supports_pgpass() ? " -u" : " -U $postgres_login").
 404                      " -c ".&quote_path($sql)." $host $_[0]";
 405         if ($postgres_sameunix && defined(getpwnam($postgres_login))) {
 406                 $cmd = &command_as_user($postgres_login, 0, $cmd);
 407                 }
 408         $cmd = &command_with_login($cmd);
 409
 410         delete($ENV{'LANG'});           # to force output to english
 411         delete($ENV{'LANGUAGE'});
 412         if ($break_f == 0) {
 413                 # Running a normal SQL command, not one with a \
 414                 #$ENV{'PAGER'} = "cat";
 415                 if (&foreign_check("proc")) {
 416                         &foreign_require("proc", "proc-lib.pl");
 417                         if (defined(&proc::close_controlling_pty)) {
 418                                 # Detach from tty if possible, so that the psql
 419                                 # command doesn't prompt for a login
 420                                 &proc::close_controlling_pty();
 421                                 }
 422                         }
 423                 open(OUT, "$cmd 2>&1 |");
 424                 local ($line, $rv, @data);
 425                 do {
 426                         $line = <OUT>;
 427                         } while($line =~ /^(username|password|user name):/i ||
 428                                 $line =~ /(warning|notice):/i ||
 429                                 $line !~ /\S/ && defined($line));
 430                 unlink($temp);
 431                 if ($line =~ /^ERROR:\s+(.*)/ || $line =~ /FATAL.*:\s+(.*)/) {
 432                         &error(&text('esql', "<tt>$sql</tt>", "<tt>$1</tt>"));
 433                         }
 434                 elsif (!defined($line)) {
 435                         # Un-expected end of output ..
 436                         &error(&text('esql', "<tt>$sql</tt>",
 437                                      "<tt>$config{'psql'} failed</tt>"));
 438                         }
 439                 else {
 440                         # Read HTML-format output
 441                         local $row;
 442                         local @data;
 443                         while($line = <OUT>) {
 444                                 if ($line =~ /^\s*<tr>/) {
 445                                         # Start of a row
 446                                         $row = [ ];
 447                                         }
 448                                 elsif ($line =~ /^\s*<\/tr>/) {
 449                                         # End of a row
 450                                         push(@data, $row);
 451                                         $row = undef;
 452                                         }
 453                                 elsif ($line =~ /^\s*<(td|th)[^>]*>(.*)<\/(td|th)>/) {
 454                                         # Value in a row
 455                                         local $v = $2;
 456                                         $v =~ s/<br>/\n/g;
 457                                         push(@$row, &entities_to_ascii($v));
 458                                         }
 459                                 }
 460                         $rv = { 'titles' => shift(@data),
 461                                 'data' => \@data };
 462                         }
 463                 close(OUT);
 464                 return $rv;
 465                 }
 466         else {
 467                 # Running a special \ command
 468                 local ( @titles, @row, @data, $rc, $emsgf, $emsg ) ;
 469
 470                 $emsgf = &transname();
 471                 $rc = &system_logged ( "$cmd >$emsgf 2>&1");
 472                 $emsg  = &read_file_contents($emsgf);
 473                 &unlink_file($emsgf) ;
 474                 if ($rc) {
 475                         &error("<pre>$emsg</pre>");
 476                         }
 477                 else {
 478                         @titles = ( "     Command Invocation      " ) ;
 479                         @row    = ( "   Done ( return code : $rc )" ) ;
 480                         map { s/^\s+//; s/\s+$// } @row ;
 481                         push ( @data, \@row ) ;
 482                         return { 'titles' => \@titles, 'data' => \@data } ;
 483                         }
 484                 }
 485         }
 486 }
 487
 488 # execute_sql_logged(database, command)
 489 sub execute_sql_logged
 490 {
 491 &additional_log('sql', $_[0], $_[1]);
 492 return &execute_sql(@_);
 493 }
 494
 495 sub can_edit_db
 496 {
 497 if ($module_info{'usermin'}) {
 498         # Check access control list in configuration
 499         local $rv;
 500         DB: foreach $l (split(/\t/, $config{'access'})) {
 501                 if ($l =~ /^(\S+):\s*(.*)$/ &&
 502                     ($1 eq $remote_user || $1 eq '*')) {
 503                         local @dbs = split(/\s+/, $2);
 504                         foreach $d (@dbs) {
 505                                 $d =~ s/\$REMOTE_USER/$remote_user/g;
 506                                 if ($d eq '*' || $_[0] =~ /^$d$/) {
 507                                         $rv = 1;
 508                                         last DB;
 509                                         }
 510                                 }
 511                         $rv = 0;
 512                         last DB;
 513                         }
 514                 }
 515         if ($rv && $config{'access_own'}) {
 516                 # Check ownership on DB - first get login ID
 517                 if (!defined($postgres_login_id)) {
 518                         local $d = &execute_sql($config{'basedb'}, "select usesysid from pg_user where usename = ?", $postgres_login);
 519                         $postgres_login_id = $d->{'data'}->[0]->[0];
 520                         }
 521                 # Get database owner
 522                 local $d = &execute_sql($config{'basedb'}, "select datdba from pg_database where datname = ?", $_[0]);
 523                 if ($d->{'data'}->[0]->[0] != $postgres_login_id) {
 524                         $rv = 0;
 525                         }
 526                 }
 527         return $rv;
 528         }
 529 else {
 530         # Check Webmin ACL
 531         local $d;
 532         return 1 if ($access{'dbs'} eq '*');
 533         foreach $d (split(/\s+/, $access{'dbs'})) {
 534                 return 1 if ($d && $d eq $_[0]);
 535                 }
 536         return 0;
 537         }
 538 }
 539
 540 # get_hba_config(version)
 541 # Parses the postgres host access config file
 542 sub get_hba_config
 543 {
 544 local $lnum = 0;
 545 open(HBA, $hba_conf_file);
 546 while(<HBA>) {
 547         s/\r|\n//g;
 548         s/^\s*#.*$//g;
 549         if ($_[0] >= 7.3) {
 550                 # New file format
 551                 if (/^\s*(host|hostssl)\s+(\S+)\s+(\S+)\s+(\S+)\/(\S+)\s+(\S+)(\s+(\S+))?/) {
 552                         # Host/cidr format
 553                         push(@rv, { 'type' => $1,
 554                                     'index' => scalar(@rv),
 555                                     'line' => $lnum,
 556                                     'db' => $2,
 557                                     'user' => $3,
 558                                     'address' => $4,
 559                                     'cidr' => $5,
 560                                     'auth' => $6,
 561                                     'arg' => $8 } );
 562                         }
 563                 elsif (/^\s*(host|hostssl)\s+(\S+)\s+(\S+)\s+(\S+)\s+(\S+)\s+(\S+)(\s+(\S+))?/) {
 564                         # Host netmask format
 565                         push(@rv, { 'type' => $1,
 566                                     'index' => scalar(@rv),
 567                                     'line' => $lnum,
 568                                     'db' => $2,
 569                                     'user' => $3,
 570                                     'address' => $4,
 571                                     'netmask' => $5,
 572                                     'auth' => $6,
 573                                     'arg' => $8 } );
 574                         }
 575                 elsif (/^\s*local\s+(\S+)\s+(\S+)\s+(\S+)(\s+(\S+))?/) {
 576                         push(@rv, { 'type' => 'local',
 577                                     'index' => scalar(@rv),
 578                                     'line' => $lnum,
 579                                     'db' => $1,
 580                                     'user' => $2,
 581                                     'auth' => $3,
 582                                     'arg' => $5 } );
 583                         }
 584                 }
 585         else {
 586                 # Old file format
 587                 if (/^\s*host\s+(\S+)\s+(\S+)\s+(\S+)\s+(\S+)(\s+(\S+))?/) {
 588                         push(@rv, { 'type' => 'host',
 589                                     'index' => scalar(@rv),
 590                                     'line' => $lnum,
 591                                     'db' => $1,
 592                                     'address' => $2,
 593                                     'netmask' => $3,
 594                                     'auth' => $4,
 595                                     'arg' => $6 } );
 596                         }
 597                 elsif (/^\s*local\s+(\S+)\s+(\S+)(\s+(\S+))?/) {
 598                         push(@rv, { 'type' => 'local',
 599                                     'index' => scalar(@rv),
 600                                     'line' => $lnum,
 601                                     'db' => $1,
 602                                     'auth' => $2,
 603                                     'arg' => $4 } );
 604                         }
 605                 }
 606         $lnum++;
 607         }
 608 close(HBA);
 609 return @rv;
 610 }
 611
 612 # create_hba(&hba, version)
 613 sub create_hba
 614 {
 615 local $lref = &read_file_lines($hba_conf_file);
 616 push(@$lref, &hba_line($_[0], $_[1]));
 617 &flush_file_lines();
 618 }
 619
 620 # delete_hba(&hba, version)
 621 sub delete_hba
 622 {
 623 local $lref = &read_file_lines($hba_conf_file);
 624 splice(@$lref, $_[0]->{'line'}, 1);
 625 &flush_file_lines();
 626 }
 627
 628 # modify_hba(&hba, version)
 629 sub modify_hba
 630 {
 631 local $lref = &read_file_lines($hba_conf_file);
 632 splice(@$lref, $_[0]->{'line'}, 1, &hba_line($_[0], $_[1]));
 633 &flush_file_lines();
 634 }
 635
 636 # swap_hba(&hba1, &hba2)
 637 sub swap_hba
 638 {
 639 local $lref = &read_file_lines($hba_conf_file);
 640 local $line0 = $lref->[$_[0]->{'line'}];
 641 local $line1 = $lref->[$_[1]->{'line'}];
 642 $lref->[$_[1]->{'line'}] = $line0;
 643 $lref->[$_[0]->{'line'}] = $line1;
 644 &flush_file_lines();
 645 }
 646
 647 # hba_line(&hba, version)
 648 sub hba_line
 649 {
 650 if ($_[0]->{'type'} eq 'host' || $_[0]->{'type'} eq 'hostssl') {
 651         return join(" ", $_[0]->{'type'}, $_[0]->{'db'},
 652                          ( $_[1] >= 7.3 ? ( $_[0]->{'user'} ) : ( ) ),
 653                          ($_[0]->{'cidr'} eq '' ?
 654                                  ( $_[0]->{'address'},
 655                                    $_[0]->{'netmask'} ) :
 656                                  ( "$_[0]->{'address'}/$_[0]->{'cidr'}" )),
 657                          $_[0]->{'auth'},
 658                          $_[0]->{'arg'} ? ( $_[0]->{'arg'} ) : () );
 659         }
 660 else {
 661         return join(" ", 'local', $_[0]->{'db'},
 662                          ( $_[1] >= 7.3 ? ( $_[0]->{'user'} ) : ( ) ),
 663                          $_[0]->{'auth'},
 664                          $_[0]->{'arg'} ? ( $_[0]->{'arg'} ) : () );
 665         }
 666 }
 667
 668 # split_array(value)
 669 sub split_array
 670 {
 671 if ($_[0] =~ /^\{(.*)\}$/) {
 672         local @a = split(/,/, $1);
 673         return @a;
 674         }
 675 else {
 676         return ( $_[0] );
 677         }
 678 }
 679
 680 # join_array(values ..)
 681 sub join_array
 682 {
 683 local $alpha;
 684 map { $alpha++ if (!/^-?[0-9\.]+/) } @_;
 685 return $alpha ? '{'.join(',', map { "'$_'" } @_).'}'
 686               : '{'.join(',', @_).'}';
 687 }
 688
 689 sub is_blob
 690 {
 691 return $_[0]->{'type'} eq 'text' || $_[0]->{'type'} eq 'bytea';
 692 }
 693
 694 # restart_postgresql()
 695 # HUP postmaster if running, so that hosts file changes take effect
 696 sub restart_postgresql
 697 {
 698 if (open(PID, $config{'pid_file'})) {
 699         ($pid = <PID>) =~ s/\r|\n//g;
 700         close(PID);
 701         &kill_logged('HUP', $pid) if ($pid);
 702         }
 703 }
 704
 705 # date_subs(filename)
 706 # Does strftime-style date substitutions on a filename, if enabled
 707 sub date_subs
 708 {
 709 if ($config{'date_subs'}) {
 710         eval "use POSIX";
 711         eval "use posix" if ($@);
 712         local @tm = localtime(time());
 713         &clear_time_locale();
 714         local $rv = strftime($_[0], @tm);
 715         &reset_time_locale();
 716         return $rv;
 717         }
 718 else {
 719         return $_[0];
 720         }
 721 }
 722
 723 # execute_before(db, handle, escape, path, db-for-config)
 724 sub execute_before
 725 {
 726 local $cmd = $config{'backup_before_'.$_[4]};
 727 if ($cmd) {
 728         $ENV{'BACKUP_FILE'} = $_[3];
 729         local $h = $_[1];
 730         local $out;
 731         local $rv = &execute_command($cmd, undef, \$out, \$out);
 732         if ($h && $out) {
 733                 print $h $_[2] ? "<pre>".&html_escape($out)."</pre>" : $out;
 734                 }
 735         return !$rv;
 736         }
 737 return 1;
 738 }
 739
 740 # execute_after(db, handle, escape, path, db-for-config)
 741 sub execute_after
 742 {
 743 local $cmd = $config{'backup_after_'.$_[4]};
 744 if ($cmd) {
 745         $ENV{'BACKUP_FILE'} = $_[3];
 746         local $h = $_[1];
 747         local $out;
 748         local $rv = &execute_command($cmd, undef, \$out, \$out);
 749         if ($h && $out) {
 750                 print $h $_[2] ? "<pre>".&html_escape($out)."</pre>" : $out;
 751                 }
 752         return !$rv;
 753         }
 754 return 1;
 755 }
 756
 757 # make_backup_dir(directory)
 758 # Create a directory that PostgreSQL can backup into
 759 sub make_backup_dir
 760 {
 761 local ($dir) = @_;
 762 if (!-d $dir) {
 763         &make_dir($dir, 0755);
 764         if ($postgres_sameunix && defined(getpwnam($postgres_login))) {
 765                 &set_ownership_permissions($postgres_login, undef, undef, $dir);
 766                 }
 767         }
 768 }
 769
 770 sub quote_table
 771 {
 772 local @tn = split(/\./, $_[0]);
 773 return join(".", map { "\"$_\"" } @tn);
 774 }
 775
 776 sub quotestr
 777 {
 778 return "\"$_[0]\"";
 779 }
 780
 781 # execute_sql_file(database, file, [user, pass], [unix-user])
 782 # Executes some file of SQL statements, and returns the exit status and output
 783 sub execute_sql_file
 784 {
 785 local ($db, $file, $user, $pass, $unixuser) = @_;
 786 if (&is_readonly_mode()) {
 787         return (0, undef);
 788         }
 789 if (!defined($user)) {
 790         $user = $postgres_login;
 791         $pass = $postgres_pass;
 792         }
 793 local $cmd = &quote_path($config{'psql'})." -f ".&quote_path($file).
 794              (&supports_pgpass() ? " -U $user" : " -u").
 795              ($config{'host'} ? " -h $config{'host'}" : "").
 796              ($config{'port'} ? " -h $config{'port'}" : "").
 797              " $db";
 798 if ($postgres_sameunix && defined(getpwnam($postgres_login))) {
 799         $cmd = &command_as_user($postgres_login, 0, $cmd);
 800         }
 801 elsif ($unixuser && $unixuser ne 'root' && $< == 0) {
 802         $cmd = &command_as_user($unixuser, 0, $cmd);
 803         }
 804 $cmd = &command_with_login($cmd, $user, $pass);
 805 local $out = &backquote_logged("$cmd 2>&1");
 806 return ($out =~ /ERROR/i ? 1 : 0, $out);
 807 }
 808
 809 # split_table(&titles, &checkboxes, &links, &col1, &col2, ...)
 810 # Outputs a table that is split into two parts
 811 sub split_table
 812 {
 813 local $mid = int((@{$_[2]}+1) / 2);
 814 local ($i, $j);
 815 print "<table width=100%><tr>\n";
 816 foreach $s ([0, $mid-1], [$mid, @{$_[2]}-1]) {
 817         print "<td width=50% valign=top>\n";
 818
 819         # Header
 820         local @tds = $_[1] ? ( "width=5" ) : ( );
 821         if ($s->[0] <= $s->[1]) {
 822                 local @hcols;
 823                 foreach $t (@{$_[0]}) {
 824                         push(@hcols, $t);
 825                         }
 826                 print &ui_columns_start(\@hcols, 100, 0, \@tds);
 827                 }
 828
 829         for($i=$s->[0]; $i<=$s->[1]; $i++) {
 830                 local @cols;
 831                 push(@cols, "<a href='$_[2]->[$i]'>$_[3]->[$i]</a>");
 832                 for($j=4; $j<@_; $j++) {
 833                         push(@cols, $_[$j]->[$i]);
 834                         }
 835                 if ($_[1]) {
 836                         print &ui_checked_columns_row(\@cols, \@tds, "d", $_[1]->[$i]);
 837                         }
 838                 else {
 839                         print &ui_columns_row(\@cols, \@tds);
 840                         }
 841                 }
 842         if ($s->[0] <= $s->[1]) {
 843                 print &ui_columns_end();
 844                 }
 845         print "</td>\n";
 846         }
 847 print "</tr></table>\n";
 848 }
 849
 850 # accepting_connections(db)
 851 # Returns 1 if some database is accepting connections, 0 if not
 852 sub accepting_connections
 853 {
 854 if (!defined($has_connections)) {
 855         $has_connections = 0;
 856         local @str = &table_structure($config{'basedb'},
 857                                       "pg_catalog.pg_database");
 858         foreach my $f (@str) {
 859                 $has_connections = 1 if ($f->{'field'} eq 'datallowconn');
 860                 }
 861         }
 862 if ($has_connections) {
 863         $rv = &execute_sql_safe($config{'basedb'}, "select datallowconn from pg_database where datname = '$_[0]'");
 864         if ($rv->{'data'}->[0]->[0] !~ /^(t|1)/i) {
 865                 return 0;
 866                 }
 867         }
 868 return 1;
 869 }
 870
 871 # start_postgresql()
 872 # Starts the PostgreSQL database server. Returns an error message on failure
 873 # or undef on success.
 874 sub start_postgresql
 875 {
 876 if ($gconfig{'os_type'} eq 'windows' && &foreign_check("init")) {
 877         # On Windows, always try to sc start the pgsql- service
 878         &foreign_require("init", "init-lib.pl");
 879         local ($pg) = grep { $_->{'name'} =~ /^pgsql-/ }
 880                            &init::list_win32_services();
 881         if ($pg) {
 882                 return &init::start_win32_service($pg->{'name'});
 883                 }
 884         }
 885 local $temp = &transname();
 886 local $rv = &system_logged("($config{'start_cmd'}) >$temp 2>&1");
 887 local $out = `cat $temp`; unlink($temp);
 888 unlink($temp);
 889 if ($rv || $out =~ /failed|error/i) {
 890         return "<pre>$out</pre>";
 891         }
 892 return undef;
 893 }
 894
 895 # stop_postgresql()
 896 # Stops the PostgreSQL database server. Returns an error message on failure
 897 # or undef on success.
 898 sub stop_postgresql
 899 {
 900 if ($gconfig{'os_type'} eq 'windows' && &foreign_check("init")) {
 901         # On Windows, always try to sc stop the pgsql- service
 902         &foreign_require("init", "init-lib.pl");
 903         local ($pg) = grep { $_->{'name'} =~ /^pgsql-/ }
 904                            &init::list_win32_services();
 905         if ($pg) {
 906                 return &init::stop_win32_service($pg->{'name'});
 907                 }
 908         }
 909 if ($config{'stop_cmd'}) {
 910         local $out = &backquote_logged("$config{'stop_cmd'} 2>&1");
 911         if ($? || $out =~ /failed|error/i) {
 912                 return "<pre>$?\n$out</pre>";
 913                 }
 914         }
 915 else {
 916         local $pid;
 917         open(PID, $config{'pid_file'});
 918         ($pid = <PID>) =~ s/\r|\n//g;
 919         close(PID);
 920         $pid || return &text('stop_epidfile', "<tt>$config{'pid_file'}</tt>");
 921         &kill_logged('TERM', $pid) ||
 922                 return &text('stop_ekill', "<tt>$pid</tt>", "<tt>$!</tt>");
 923         }
 924 return undef;
 925 }
 926
 927 # setup_postgresql()
 928 # Performs initial postgreSQL configuration. Returns an error message on failure
 929 # or undef on success.
 930 sub setup_postgresql
 931 {
 932 return undef if (!$config{'setup_cmd'});
 933 local $temp = &transname();
 934 local $rv = &system_logged("($config{'setup_cmd'}) >$temp 2>&1");
 935 local $out = `cat $temp`;
 936 unlink($temp);
 937 if ($rv) {
 938         return "<pre>$out</pre>";
 939         }
 940 return undef;
 941 }
 942
 943 # list_indexes(db)
 944 # Returns the names of all indexes in some database
 945 sub list_indexes
 946 {
 947 local ($db) = @_;
 948 local (@rv, $r);
 949 local %tables = map { $_, 1 } &list_tables($db);
 950 if (&supports_schemas($db)) {
 951         local $t = &execute_sql_safe($db, "select schemaname,indexname,tablename from pg_indexes");
 952         return map { ($_->[0] eq "public" ? "" : $_->[0].".").$_->[1] }
 953                 grep { $tables{($_->[0] eq "public" ? "" : $_->[0].".").$_->[2]} }
 954                    @{$t->{'data'}};
 955         }
 956 else {
 957         local $t = &execute_sql_safe($db, "select indexname,tablename from pg_indexes");
 958         return map { $_->[0] } grep { $tables{$t->[1]} } @{$t->{'data'}};
 959         }
 960 }
 961
 962 # index_structure(db, indexname)
 963 # Returns information on an index
 964 sub index_structure
 965 {
 966 local ($db, $index) = @_;
 967 local $info = { 'name' => $index };
 968 if (&supports_schemas($db)) {
 969         local ($sn, $in);
 970         if ($index =~ /^(\S+)\.(\S+)$/) {
 971                 ($sn, $in) = ($1, $2);
 972                 }
 973         else {
 974                 ($sn, $in) = ("public", $index);
 975                 }
 976         local $t = &execute_sql_safe($db, "select schemaname,tablename,indexdef from pg_indexes where indexname = '$in' and schemaname = '$sn'");
 977         local $r = $t->{'data'}->[0];
 978         if ($r->[0] eq "public") {
 979                 $info->{'table'} = $r->[1];
 980                 }
 981         else {
 982                 $info->{'table'} = $r->[0].".".$r->[1];
 983                 }
 984         $info->{'create'} = $r->[2];
 985         }
 986 else {
 987         local $t = &execute_sql_safe($db, "select tablename,indexdef from pg_indexes where indexname = '$index'");
 988         local $r = $t->{'data'}->[0];
 989         $info->{'table'} = $r->[0];
 990         $info->{'create'} = $r->[1];
 991         }
 992
 993 # Parse create expression
 994 if ($info->{'create'} =~ /^create\s+unique/i) {
 995         $info->{'type'} = 'unique';
 996         }
 997 if ($info->{'create'} =~ /using\s+(\S+)\s/) {
 998         $info->{'using'} = lc($1);
 999         }
1000 if ($info->{'create'} =~ /\((.*)\)/) {
1001         $info->{'cols'} = [ split(/\s*,\s*/, $1) ];
1002         }
1003
1004 return $info;
1005 }
1006
1007 sub supports_indexes
1008 {
1009 return &get_postgresql_version() >= 7.3;
1010 }
1011
1012 # list_views(db)
1013 # Returns the names of all views in some database
1014 sub list_views
1015 {
1016 local ($db) = @_;
1017 local (@rv, $r);
1018 if (&supports_schemas($db)) {
1019         local $t = &execute_sql_safe($db, "select schemaname,viewname from pg_views where schemaname != 'pg_catalog' and schemaname != 'information_schema'");
1020         return map { ($_->[0] eq "public" ? "" : $_->[0].".").$_->[1] }
1021                    @{$t->{'data'}};
1022         }
1023 else {
1024         local $t = &execute_sql_safe($db, "select viewname from pg_indexes");
1025         return map { $_->[0] } @{$t->{'data'}};
1026         }
1027 }
1028
1029 # view_structure(db, viewname)
1030 # Returns information about a view
1031 sub view_structure
1032 {
1033 local ($db, $view) = @_;
1034 local $info = { 'name' => $view };
1035 if (&supports_schemas($db)) {
1036         local ($sn, $in);
1037         if ($view =~ /^(\S+)\.(\S+)$/) {
1038                 ($sn, $in) = ($1, $2);
1039                 }
1040         else {
1041                 ($sn, $in) = ("public", $view);
1042                 }
1043         local $t = &execute_sql_safe($db, "select schemaname,viewname,definition from pg_views where viewname = '$in' and schemaname = '$sn'");
1044         local $r = $t->{'data'}->[0];
1045         $info->{'query'} = $r->[2];
1046         }
1047 else {
1048         local $t = &execute_sql_safe($db, "select viewname,definition from pg_views where viewname = '$index'");
1049         local $r = $t->{'data'}->[0];
1050         $info->{'query'} = $r->[1];
1051         }
1052
1053 $info->{'query'} =~ s/;$//;
1054
1055 return $info;
1056 }
1057
1058 sub supports_views
1059 {
1060 return &get_postgresql_version() >= 7.3;
1061 }
1062
1063 # list_sequences(db)
1064 # Returns the names of all sequences in some database
1065 sub list_sequences
1066 {
1067 local ($db) = @_;
1068 local (@rv, $r);
1069 if (&supports_schemas($db)) {
1070         local $t = &execute_sql_safe($db, "select schemaname,relname from pg_statio_user_sequences");
1071         return map { ($_->[0] eq "public" ? "" : $_->[0].".").$_->[1] }
1072                    @{$t->{'data'}};
1073         }
1074 else {
1075         local $t = &execute_sql_safe($db, "select relname from pg_statio_user_sequences");
1076         return map { $_->[0] } @{$t->{'data'}};
1077         }
1078 }
1079
1080 # sequence_structure(db, name)
1081 # Returns details of a sequence
1082 sub sequence_structure
1083 {
1084 local ($db, $seq) = @_;
1085 local $info = { 'name' => $seq };
1086
1087 local $t = &execute_sql_safe($db, "select * from ".&quote_table($seq));
1088 local $r = $t->{'data'}->[0];
1089 local $i = 0;
1090 foreach my $c (@{$t->{'titles'}}) {
1091         $info->{$c} = $r->[$i++];
1092         }
1093
1094 return $info;
1095 }
1096
1097 sub supports_sequences
1098 {
1099 return &get_postgresql_version() >= 7.4 ? 1 :
1100        &get_postgresql_version() >= 7.3 ? 2 : 0;
1101 }
1102
1103 # Returns 1 if the postgresql server being managed is on this system
1104 sub is_postgresql_local
1105 {
1106 return $config{'host'} eq '' || $config{'host'} eq 'localhost' ||
1107        $config{'host'} eq &get_system_hostname() ||
1108        &to_ipaddress($config{'host'}) eq &to_ipaddress(&get_system_hostname());
1109 }
1110
1111 # backup_database(database, dest-path, format, [&only-tables])
1112 # Executes the pg_dump command to backup the specified database to the
1113 # given destination path. Returns undef on success, or an error message
1114 # on failure.
1115 sub backup_database
1116 {
1117 local ($db, $path, $format, $tables) = @_;
1118 local $tablesarg = join(" ", map { " -t ".quotemeta($_) } @$tables);
1119 local $cmd = &quote_path($config{'dump_cmd'}).
1120              (!$postgres_login ? "" :
1121               &supports_pgpass() ? " -U $postgres_login" : " -u").
1122              ($config{'host'} ? " -h $config{'host'}" : "").
1123              ($format eq 'p' ? "" : " -b").
1124              $tablesarg.
1125              " -F$format -f ".&quote_path($path)." $db";
1126 if ($postgres_sameunix && defined(getpwnam($postgres_login))) {
1127         $cmd = &command_as_user($postgres_login, 0, $cmd);
1128         }
1129 $cmd = &command_with_login($cmd);
1130 local $out = &backquote_logged("$cmd 2>&1");
1131 if ($? || $out =~ /could not|error|failed/i) {
1132         return $out;
1133         }
1134 return undef;
1135 }
1136
1137 # restore_database(database, source-path, only-data, clear-db, [&only-tables])
1138 # Restores the contents of a PostgreSQL backup into the specified database.
1139 # Returns undef on success, or an error message on failure.
1140 sub restore_database
1141 {
1142 local ($db, $path, $only, $clean, $tables) = @_;
1143 local $tablesarg = join(" ", map { " -t ".quotemeta($_) } @$tables);
1144 local $cmd = &quote_path($config{'rstr_cmd'}).
1145              (!$postgres_login ? "" :
1146               &supports_pgpass() ? " -U $postgres_login" : " -u").
1147              ($config{'host'} ? " -h $config{'host'}" : "").
1148              ($only ? " -a" : "").
1149              ($clean ? " -c" : "").
1150              $tablesarg.
1151              " -d $db ".&quote_path($path);
1152 if ($postgres_sameunix && defined(getpwnam($postgres_login))) {
1153         $cmd = &command_as_user($postgres_login, 0, $cmd);
1154         }
1155 $cmd = &command_with_login($cmd);
1156 local $out = &backquote_logged("$cmd 2>&1");
1157 if ($? || $out =~ /could not|error|failed/i) {
1158         return $out;
1159         }
1160 return undef;
1161 }
1162
1163 # PostgreSQL versions below 7.3 don't support .pgpass, and version 8.0.*
1164 # don't allow it to be located via $HOME or $PGPASSFILE.
1165 sub supports_pgpass
1166 {
1167 local $ver = &get_postgresql_version(1);
1168 return $ver >= 7.3 && $ver < 8.0 ||
1169        $ver >= 8.1;
1170 }
1171
1172 # command_with_login(command, [user, pass])
1173 # Given a command that talks to postgresql (like psql or pg_dump), sets up
1174 # the environment so that it can login to the database. Returns a modified
1175 # command to execute.
1176 sub command_with_login
1177 {
1178 local ($cmd, $user, $pass) = @_;
1179 if (!defined($user)) {
1180         $user = $postgres_login;
1181         $pass = $postgres_pass;
1182         }
1183 local $loginfile;
1184 if (&supports_pgpass()) {
1185         # Can use .pgpass file
1186         local $pgpass;
1187         if ($gconfig{'os_type'} eq 'windows') {
1188                 # On Windows, the file is under ~/application data
1189                 local $appdata = "$ENV{'HOME'}/application data";
1190                 &make_dir($appdata, 0755);
1191                 local $postgresql = "$appdata/postgresql";
1192                 &make_dir($postgresql, 0755);
1193                 $pgpass = "$postgresql/pgpass.conf";
1194                 }
1195         else {
1196                 local $temphome = &transname();
1197                 &make_dir($temphome, 0755);
1198                 $pgpass = "$temphome/.pgpass";
1199                 $ENV{'HOME'} = $temphome;
1200                 }
1201         $ENV{'PGPASSFILE'} = $pgpass;
1202         open(PGPASS, ">$pgpass");
1203         print PGPASS "*:*:*:$user:$pass\n";
1204         close(PGPASS);
1205         &set_ownership_permissions(
1206                 $postgres_sameunix ? $user : undef,
1207                 undef, 0600, $pgpass);
1208         }
1209 else {
1210         # Need to put login and password in temp file
1211         $loginfile = &transname();
1212         open(TEMP, ">$loginfile");
1213         print TEMP "$user\n$pass\n";
1214         close(TEMP);
1215         $cmd .= " <$loginfile";
1216         }
1217 return $cmd;
1218 }
1219
1220 1;
1221