src/sql

   1 #!/usr/bin/perl -w
   2
   3 # Copyright (C) 2008-2010 Ole Tange, http://ole.tange.dk
   4 #
   5 # Copyright (C) 2010-2021 Ole Tange, http://ole.tange.dk and
   6 # Free Software Foundation, Inc.
   7 #
   8 # This program is free software; you can redistribute it and/or modify
   9 # it under the terms of the GNU General Public License as published by
  10 # the Free Software Foundation; either version 3 of the License, or
  11 # (at your option) any later version.
  12 #
  13 # This program is distributed in the hope that it will be useful, but
  14 # WITHOUT ANY WARRANTY; without even the implied warranty of
  15 # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
  16 # General Public License for more details.
  17 #
  18 # You should have received a copy of the GNU General Public License
  19 # along with this program; if not, see <http://www.gnu.org/licenses/>
  20 # or write to the Free Software Foundation, Inc., 51 Franklin St,
  21 # Fifth Floor, Boston, MA 02110-1301 USA
  22 #
  23 # SPDX-FileCopyrightText: 2008-2021 Ole Tange, http://ole.tange.dk and Free Software and Foundation, Inc.
  24 # SPDX-License-Identifier: GPL-3.0-or-later
  25 # SPDX-License-Identifier: GFDL-1.3-or-later
  26
  27 =head1 NAME
  28
  29 sql - execute a command on a database determined by a dburl
  30
  31 =head1 SYNOPSIS
  32
  33 B<sql> [options] I<dburl> [I<commands>]
  34
  35 B<sql> [options] I<dburl> < commandfile
  36
  37 B<#!/usr/bin/sql> B<--shebang> [options] I<dburl>
  38
  39 =head1 DESCRIPTION
  40
  41 GNU B<sql> aims to give a simple, unified interface for accessing
  42 databases through all the different databases' command line
  43 clients. So far the focus has been on giving a common way to specify
  44 login information (protocol, username, password, hostname, and port
  45 number), size (database and table size), and running queries.
  46
  47 The database is addressed using a DBURL. If I<commands> are left out
  48 you will get that database's interactive shell.
  49
  50 GNU B<sql> is often used in combination with GNU B<parallel>.
  51
  52 =over 9
  53
  54 =item I<dburl>
  55
  56 A DBURL has the following syntax:
  57 [sql:]vendor://
  58 [[user][:password]@][host][:port]/[database][?sqlquery]
  59
  60 See the section DBURL below.
  61
  62 =item I<commands>
  63
  64 The SQL commands to run. Each argument will have a newline
  65 appended.
  66
  67 Example: "SELECT * FROM foo;" "SELECT * FROM bar;"
  68
  69 If the arguments contain '\n' or '\x0a' this will be replaced with a
  70 newline:
  71
  72 Example: "SELECT * FROM foo;\n SELECT * FROM bar;"
  73
  74 If no commands are given SQL is read from the keyboard or STDIN.
  75
  76 Example: echo 'SELECT * FROM foo;' | sql mysql:///
  77
  78
  79 =item B<--db-size>
  80
  81 =item B<--dbsize>
  82
  83 Size of database. Show the size of the database on disk. For Oracle
  84 this requires access to read the table I<dba_data_files> - the user
  85 I<system> has that.
  86
  87
  88 =item B<--help>
  89
  90 =item B<-h>
  91
  92 Print a summary of the options to GNU B<sql> and exit.
  93
  94
  95 =item B<--html>
  96
  97 HTML output. Turn on HTML tabular output.
  98
  99
 100 =item B<--show-processlist>
 101
 102 =item B<--proclist>
 103
 104 =item B<--listproc>
 105
 106 Show the list of running queries.
 107
 108
 109 =item B<--show-databases>
 110
 111 =item B<--showdbs>
 112
 113 =item B<--list-databases>
 114
 115 =item B<--listdbs>
 116
 117 List the databases (table spaces) in the database.
 118
 119
 120 =item B<--show-tables>
 121
 122 =item B<--list-tables>
 123
 124 =item B<--table-list>
 125
 126 List the tables in the database.
 127
 128
 129 =item B<--noheaders>
 130
 131 =item B<--no-headers>
 132
 133 =item B<-n>
 134
 135 Remove headers and footers and print only tuples. Bug in Oracle: it
 136 still prints number of rows found.
 137
 138
 139 =item B<-p> I<pass-through>
 140
 141 The string following -p will be given to the database connection
 142 program as arguments. Multiple -p's will be joined with
 143 space. Example: pass '-U' and the user name to the program:
 144
 145 I<-p "-U scott"> can also be written I<-p -U -p scott>.
 146
 147
 148 =item B<-r>
 149
 150 Try 3 times. Short version of I<--retries 3>.
 151
 152
 153 =item B<--retries> I<ntimes>
 154
 155 Try I<ntimes> times. If the client program returns with an error,
 156 retry the command. Default is I<--retries 1>.
 157
 158
 159 =item B<--sep> I<string>
 160
 161 =item B<-s> I<string>
 162
 163 Field separator. Use I<string> as separator between columns.
 164
 165
 166 =item B<--skip-first-line>
 167
 168 Do not use the first line of input (used by GNU B<sql> itself
 169 when called with B<--shebang>).
 170
 171
 172 =item B<--table-size>
 173
 174 =item B<--tablesize>
 175
 176 Size of tables. Show the size of the tables in the database.
 177
 178
 179 =item B<--verbose>
 180
 181 =item B<-v>
 182
 183 Print which command is sent.
 184
 185
 186 =item B<--version>
 187
 188 =item B<-V>
 189
 190 Print the version GNU B<sql> and exit.
 191
 192
 193 =item B<--shebang>
 194
 195 =item B<-Y>
 196
 197 GNU B<sql> can be called as a shebang (#!) command as the first line of a script. Like this:
 198
 199   #!/usr/bin/sql -Y mysql:///
 200
 201   SELECT * FROM foo;
 202
 203 For this to work B<--shebang> or B<-Y> must be set as the first option.
 204
 205 =back
 206
 207 =head1 DBURL
 208
 209 A DBURL has the following syntax:
 210 [sql:]vendor://
 211 [[user][:password]@][host][:port]/[database][?sqlquery]
 212
 213 To quote special characters use %-encoding specified in
 214 http://tools.ietf.org/html/rfc3986#section-2.1 (E.g. a password
 215 containing '/' would contain '%2F').
 216
 217 Examples:
 218  mysql://scott:tiger@my.example.com/mydb
 219  sql:oracle://scott:tiger@ora.example.com/xe
 220  postgresql://scott:tiger@pg.example.com/pgdb
 221  pg:///
 222  postgresqlssl://scott@pg.example.com:3333/pgdb
 223  sql:sqlite2:////tmp/db.sqlite?SELECT * FROM foo;
 224  sqlite3:///../db.sqlite3?SELECT%20*%20FROM%20foo;
 225
 226 Currently supported vendors: MySQL (mysql), MySQL with SSL (mysqls,
 227 mysqlssl), Oracle (oracle, ora), PostgreSQL (postgresql, pg, pgsql,
 228 postgres), PostgreSQL with SSL (postgresqlssl, pgs, pgsqlssl,
 229 postgresssl, pgssl, postgresqls, pgsqls, postgress), SQLite2 (sqlite,
 230 sqlite2), SQLite3 (sqlite3).
 231
 232 Aliases must start with ':' and are read from
 233 /etc/sql/aliases and ~/.sql/aliases. The user's own
 234 ~/.sql/aliases should only be readable by the user.
 235
 236 Example of aliases:
 237
 238  :myalias1 pg://scott:tiger@pg.example.com/pgdb
 239  :myalias2 ora://scott:tiger@ora.example.com/xe
 240  # Short form of mysql://`whoami`:nopassword@localhost:3306/`whoami`
 241  :myalias3 mysql:///
 242  # Short form of mysql://`whoami`:nopassword@localhost:33333/mydb
 243  :myalias4 mysql://:33333/mydb
 244  # Alias for an alias
 245  :m      :myalias4
 246  # the sortest alias possible
 247  :       sqlite2:////tmp/db.sqlite
 248  # Including an SQL query
 249  :query  sqlite:////tmp/db.sqlite?SELECT * FROM foo;
 250
 251 =head1 EXAMPLES
 252
 253 =head2 Get an interactive prompt
 254
 255 The most basic use of GNU B<sql> is to get an interactive prompt:
 256
 257 B<sql sql:oracle://scott:tiger@ora.example.com/xe>
 258
 259 If you have setup an alias you can do:
 260
 261 B<sql :myora>
 262
 263
 264 =head2 Run a query
 265
 266 To run a query directly from the command line:
 267
 268 B<sql :myalias "SELECT * FROM foo;">
 269
 270 Oracle requires newlines after each statement. This can be done like
 271 this:
 272
 273 B<sql :myora "SELECT * FROM foo;" "SELECT * FROM bar;">
 274
 275 Or this:
 276
 277 B<sql :myora "SELECT * FROM foo;\nSELECT * FROM bar;">
 278
 279
 280 =head2 Copy a PostgreSQL database
 281
 282 To copy a PostgreSQL database use pg_dump to generate the dump and GNU
 283 B<sql> to import it:
 284
 285 B<pg_dump pg_database | sql pg://scott:tiger@pg.example.com/pgdb>
 286
 287
 288 =head2 Empty all tables in a MySQL database
 289
 290 Using GNU B<parallel> it is easy to empty all tables without dropping them:
 291
 292 B<sql -n mysql:/// 'show tables' | parallel sql mysql:/// DELETE FROM {};>
 293
 294
 295 =head2 Drop all tables in a PostgreSQL database
 296
 297 To drop all tables in a PostgreSQL database do:
 298
 299 B<sql -n pg:/// '\dt' | parallel --colsep '\|' -r sql pg:/// DROP TABLE {2};>
 300
 301
 302 =head2 Run as a script
 303
 304 Instead of doing:
 305
 306 B<sql mysql:/// < sqlfile>
 307
 308 you can combine the sqlfile with the DBURL to make a
 309 UNIX-script. Create a script called I<demosql>:
 310
 311 B<#!/usr/bin/sql -Y mysql:///>
 312
 313 B<SELECT * FROM foo;>
 314
 315 Then do:
 316
 317 B<chmod +x demosql; ./demosql>
 318
 319
 320 =head2 Use --colsep to process multiple columns
 321
 322 Use GNU B<parallel>'s B<--colsep> to separate columns:
 323
 324 B<sql -s '\t' :myalias 'SELECT * FROM foo;' | parallel --colsep '\t' do_stuff {4} {1}>
 325
 326
 327 =head2 Retry if the connection fails
 328
 329 If the access to the database fails occasionally B<--retries> can help
 330 make sure the query succeeds:
 331
 332 B<sql --retries 5 :myalias 'SELECT * FROM really_big_foo;'>
 333
 334
 335 =head2 Get info about the running database system
 336
 337 Show how big the database is:
 338
 339 B<sql --db-size :myalias>
 340
 341 List the tables:
 342
 343 B<sql --list-tables :myalias>
 344
 345 List the size of the tables:
 346
 347 B<sql --table-size :myalias>
 348
 349 List the running processes:
 350
 351 B<sql --show-processlist :myalias>
 352
 353
 354 =head1 REPORTING BUGS
 355
 356 GNU B<sql> is part of GNU B<parallel>. Report bugs to <bug-parallel@gnu.org>.
 357
 358
 359 =head1 AUTHOR
 360
 361 When using GNU B<sql> for a publication please cite:
 362
 363 O. Tange (2011): GNU SQL - A Command Line Tool for Accessing Different
 364 Databases Using DBURLs, ;login: The USENIX Magazine, April 2011:29-32.
 365
 366 Copyright (C) 2008-2010 Ole Tange http://ole.tange.dk
 367
 368 Copyright (C) 2010-2021 Ole Tange, http://ole.tange.dk and Free
 369 Software Foundation, Inc.
 370
 371 =head1 LICENSE
 372
 373 This program is free software; you can redistribute it and/or modify
 374 it under the terms of the GNU General Public License as published by
 375 the Free Software Foundation; either version 3 of the License, or
 376 at your option any later version.
 377
 378 This program is distributed in the hope that it will be useful,
 379 but WITHOUT ANY WARRANTY; without even the implied warranty of
 380 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
 381 GNU General Public License for more details.
 382
 383 You should have received a copy of the GNU General Public License
 384 along with this program.  If not, see <http://www.gnu.org/licenses/>.
 385
 386 =head2 Documentation license I
 387
 388 Permission is granted to copy, distribute and/or modify this
 389 documentation under the terms of the GNU Free Documentation License,
 390 Version 1.3 or any later version published by the Free Software
 391 Foundation; with no Invariant Sections, with no Front-Cover Texts, and
 392 with no Back-Cover Texts.  A copy of the license is included in the
 393 file LICENSES/GFDL-1.3-or-later.txt.
 394
 395
 396 =head2 Documentation license II
 397
 398 You are free:
 399
 400 =over 9
 401
 402 =item B<to Share>
 403
 404 to copy, distribute and transmit the work
 405
 406 =item B<to Remix>
 407
 408 to adapt the work
 409
 410 =back
 411
 412 Under the following conditions:
 413
 414 =over 9
 415
 416 =item B<Attribution>
 417
 418 You must attribute the work in the manner specified by the author or
 419 licensor (but not in any way that suggests that they endorse you or
 420 your use of the work).
 421
 422 =item B<Share Alike>
 423
 424 If you alter, transform, or build upon this work, you may distribute
 425 the resulting work only under the same, similar or a compatible
 426 license.
 427
 428 =back
 429
 430 With the understanding that:
 431
 432 =over 9
 433
 434 =item B<Waiver>
 435
 436 Any of the above conditions can be waived if you get permission from
 437 the copyright holder.
 438
 439 =item B<Public Domain>
 440
 441 Where the work or any of its elements is in the public domain under
 442 applicable law, that status is in no way affected by the license.
 443
 444 =item B<Other Rights>
 445
 446 In no way are any of the following rights affected by the license:
 447
 448 =over 9
 449
 450 =item *
 451
 452 Your fair dealing or fair use rights, or other applicable
 453 copyright exceptions and limitations;
 454
 455 =item *
 456
 457 The author's moral rights;
 458
 459 =item *
 460
 461 Rights other persons may have either in the work itself or in
 462 how the work is used, such as publicity or privacy rights.
 463
 464 =back
 465
 466 =item B<Notice>
 467
 468 For any reuse or distribution, you must make clear to others the
 469 license terms of this work.
 470
 471 =back
 472
 473 A copy of the full license is included in the file as cc-by-sa.txt.
 474
 475 =head1 DEPENDENCIES
 476
 477 GNU B<sql> uses Perl. If B<mysql> is installed, MySQL dburls will
 478 work. If B<psql> is installed, PostgreSQL dburls will work.  If
 479 B<sqlite> is installed, SQLite2 dburls will work.  If B<sqlite3> is
 480 installed, SQLite3 dburls will work. If B<sqlplus> is installed,
 481 Oracle dburls will work. If B<rlwrap> is installed, GNU B<sql> will
 482 have a command history for Oracle.
 483
 484
 485 =head1 FILES
 486
 487 ~/.sql/aliases - user's own aliases with DBURLs
 488
 489 /etc/sql/aliases - common aliases with DBURLs
 490
 491
 492 =head1 SEE ALSO
 493
 494 B<mysql>(1), B<psql>(1), B<rlwrap>(1), B<sqlite>(1), B<sqlite3>(1), B<sqlplus>(1)
 495
 496 =cut
 497
 498 use Getopt::Long;
 499 use strict;
 500 use File::Temp qw/tempfile tempdir/;
 501
 502 parse_options();
 503
 504 my $pass_through_options = (defined $::opt_p) ? join(" ",@{$::opt_p}) : "";
 505 my $dburl_or_alias = shift;
 506 if (not defined $dburl_or_alias) {
 507     Usage("No DBURL given");
 508     exit -1;
 509 }
 510 my %dburl = parse_dburl(get_alias($dburl_or_alias));
 511
 512 my $interactive_command;
 513 my $batch_command;
 514
 515 my $database_driver = database_driver_alias($dburl{'databasedriver'});
 516 if($database_driver eq "mysql" or
 517    $database_driver eq "mysqlssl") {
 518     ($batch_command,$interactive_command) = mysql_commands($database_driver,%dburl);
 519 } elsif($database_driver eq "postgresql" or
 520         $database_driver eq "postgresqlssl") {
 521     ($batch_command,$interactive_command) = postgresql_commands($database_driver,%dburl);
 522 } elsif($database_driver eq "oracle") {
 523     ($batch_command,$interactive_command) = oracle_commands($database_driver,%dburl);
 524 } elsif($database_driver eq "sqlite" or
 525         $database_driver eq "sqlite3") {
 526     ($batch_command,$interactive_command) = sqlite_commands($database_driver,%dburl);
 527 }
 528
 529 my $err;
 530 my $retries;
 531 $retries ||= defined $::opt_retries ? $::opt_retries : undef;
 532 $retries ||= defined $::opt_retry ? $::opt_retry * 3 : undef;
 533 $retries ||= 1;
 534
 535 if(defined $::opt_processlist) {
 536     unshift @ARGV, processlist($database_driver,%dburl);
 537 }
 538
 539 if(defined $::opt_tablelist) {
 540     unshift @ARGV, tablelist($database_driver,%dburl);
 541 }
 542
 543 if(defined $::opt_dblist) {
 544     unshift @ARGV, dblist($database_driver,%dburl);
 545 }
 546
 547 if(defined $::opt_dbsize) {
 548     unshift @ARGV, dbsize($database_driver,%dburl);
 549 }
 550
 551 if(defined $::opt_tablesize) {
 552     unshift @ARGV, tablesize($database_driver,%dburl);
 553 }
 554
 555 my $queryfile = "";
 556 if($dburl{'query'}) {
 557     my $fh;
 558     ($fh,$queryfile) = tempfile(SUFFIX => ".sql");
 559     print $fh $dburl{'query'},"\n";
 560     close $fh;
 561     $batch_command = "(cat $queryfile;rm $queryfile; cat) | $batch_command";
 562 }
 563
 564 do {
 565     if (is_stdin_terminal()) {
 566         if(@ARGV) {
 567             open(M,"| $batch_command") || die("mysql/psql/sqlplus not in path");
 568             for(@ARGV) {
 569                 s/\\n/\n/g;
 570                 s/\\x0a/\n/gi;
 571                 print M "$_\n";
 572             }
 573             close M;
 574         } else {
 575             $::opt_debug and print "$interactive_command\n";
 576             $::opt_verbose and print "$interactive_command\n";
 577             system("$interactive_command");
 578         }
 579     } else {
 580         if(@ARGV) {
 581             open(M,"| $batch_command") || die("mysql/psql/sqlplus not in path");
 582             for(@ARGV) {
 583                 s/\\n/\n/g;
 584                 s/\\x0a/\n/gi;
 585                 print M "$_\n";
 586             }
 587             close M;
 588         } else {
 589             $::opt_debug and print "$batch_command\n";
 590             $::opt_verbose and print "$batch_command\n";
 591             system("$batch_command");
 592         }
 593     }
 594     $err = $?>>8;
 595 } while (--$retries and $err);
 596
 597 $queryfile and unlink $queryfile;
 598
 599 $Global::Initfile && unlink $Global::Initfile;
 600 exit ($err);
 601
 602 sub parse_options {
 603     $Global::version = 20210223;
 604     $Global::progname = 'sql';
 605
 606     # This must be done first as this may exec myself
 607     if(defined $ARGV[0] and ($ARGV[0]=~/^-Y/ or $ARGV[0]=~/^--shebang /)) {
 608         # Program is called from #! line in script
 609         $ARGV[0]=~s/^-Y //; # remove -Y if on its own
 610         $ARGV[0]=~s/^-Y/-/; # remove -Y if bundled with other options
 611         $ARGV[0]=~s/^--shebang //; # remove --shebang if it is set
 612         my $argfile = pop @ARGV;
 613         # exec myself to split @ARGV into separate fields
 614         exec "$0 --skip-first-line < $argfile @ARGV";
 615     }
 616     Getopt::Long::Configure ("bundling","require_order");
 617     GetOptions("passthrough|p=s@" => \$::opt_p,
 618                "sep|s=s" => \$::opt_s,
 619                "html" => \$::opt_html,
 620                "show-processlist|proclist|listproc" => \$::opt_processlist,
 621                "show-tables|showtables|listtables|list-tables|tablelist|table-list"
 622                => \$::opt_tablelist,
 623                "dblist|".
 624                "listdb|listdbs|list-db|list-dbs|list-database|".
 625                "list-databases|listdatabases|listdatabase|showdb|".
 626                "showdbs|show-db|show-dbs|show-database|show-databases|".
 627                "showdatabases|showdatabase" => \$::opt_dblist,
 628                "db-size|dbsize" => \$::opt_dbsize,
 629                "table-size|tablesize" => \$::opt_tablesize,
 630                "noheaders|no-headers|n" => \$::opt_n,
 631                "r" => \$::opt_retry,
 632                "retries=s" => \$::opt_retries,
 633                "debug|D" => \$::opt_debug,
 634                # Shebang #!/usr/bin/parallel -Yotheroptions
 635                "Y|shebang" => \$::opt_shebang,
 636                "skip-first-line" => \$::opt_skip_first_line,
 637                # GNU requirements
 638                "help|h" => \$::opt_help,
 639                "version|V" => \$::opt_version,
 640                "verbose|v" => \$::opt_verbose,
 641         ) || die_usage();
 642
 643     if(defined $::opt_help) { die_usage(); }
 644     if(defined $::opt_version) { version(); exit(0); }
 645     $Global::debug = $::opt_debug;
 646 }
 647
 648 sub database_driver_alias {
 649     my $driver = shift;
 650     my %database_driver_alias = ("mysql" => "mysql",
 651                                  "mysqls" => "mysqlssl",
 652                                  "mysqlssl" => "mysqlssl",
 653                                  "oracle" => "oracle",
 654                                  "ora" => "oracle",
 655                                  "oracles" => "oraclessl",
 656                                  "oras" => "oraclessl",
 657                                  "oraclessl" => "oraclessl",
 658                                  "orassl" => "oraclessl",
 659                                  "postgresql" => "postgresql",
 660                                  "pgsql" => "postgresql",
 661                                  "postgres" => "postgresql",
 662                                  "pg" => "postgresql",
 663                                  "postgresqlssl" => "postgresqlssl",
 664                                  "pgsqlssl" => "postgresqlssl",
 665                                  "postgresssl" => "postgresqlssl",
 666                                  "pgssl" => "postgresqlssl",
 667                                  "postgresqls" => "postgresqlssl",
 668                                  "pgsqls" => "postgresqlssl",
 669                                  "postgress" => "postgresqlssl",
 670                                  "pgs" => "postgresqlssl",
 671                                  "sqlite" => "sqlite",
 672                                  "sqlite2" => "sqlite",
 673                                  "sqlite3" => "sqlite3",
 674         );
 675     return $database_driver_alias{$driver};
 676 }
 677
 678 sub mysql_commands {
 679     my ($database_driver,%opt) = (@_);
 680     find_command_in_path("mysql") || die ("mysql not in path");
 681     if(defined($::opt_s)) { die "Field separator not implemented for mysql" }
 682     my $password = defined($opt{'password'}) ? "--password=".$opt{'password'} : "";
 683     my $host = defined($opt{'host'}) ? "--host=".$opt{'host'} : "";
 684     my $port = defined($opt{'port'}) ? "--port=".$opt{'port'} : "";
 685     my $user = defined($opt{'user'}) ? "--user=".$opt{'user'} : "";
 686     my $database = defined($opt{'database'}) ? $opt{'database'} : $ENV{'USER'};
 687     my $html = defined($::opt_html) ? "--html" : "";
 688     my $no_headers = defined($::opt_n) ? "--skip-column-names" : "";
 689     my $ssl = "";
 690     if ($database_driver eq "mysqlssl") {
 691         $ssl="--ssl";
 692     }
 693     my($credential_fh,$tmp) = tempfile(SUFFIX => ".sql");
 694     chmod (0600,$tmp);
 695     print $credential_fh ("[client]\n",
 696                           $user && "user=$opt{'user'}\n",
 697                           $password && "password=$opt{'password'}\n",
 698                           $host && "host=$opt{'host'}\n");
 699     close $credential_fh;
 700
 701     # Prepend with a remover of the credential tempfile
 702     # -C: Compression if both ends support it
 703     $batch_command =
 704         "((sleep 1; rm $tmp) & ".
 705         "mysql --defaults-extra-file=$tmp -C $pass_through_options $no_headers $html $ssl $host $user $port  $database)";
 706     $interactive_command = $batch_command;
 707     return($batch_command,$interactive_command);
 708 }
 709
 710 sub postgresql_commands {
 711     my ($database_driver,%opt) = (@_);
 712     find_command_in_path("psql") || die ("psql not in path");
 713     my $sep = ($::opt_s) ? "-A --field-separator '$::opt_s'" : "";
 714     my $password = defined($opt{'password'}) ? "PGPASSWORD=".$opt{'password'} : "";
 715     my $host = defined($opt{'host'}) ? "-h ".$opt{'host'} : "";
 716     my $port = defined($opt{'port'}) ? "-p ".$opt{'port'} : "";
 717     my $user = defined($opt{'user'}) ? "-U ".$opt{'user'} : "";
 718     my $database = defined($opt{'database'}) ? "-d ".$opt{'database'} : "";
 719     my $html = defined($::opt_html) ? "--html" : "";
 720     my $no_headers = defined($::opt_n) ? "--tuples-only" : "";
 721     my $ssl = "";
 722     if ($database_driver eq "postgresqlssl") {
 723         $ssl="PGSSLMODE=require";
 724     }
 725     $batch_command =
 726         "$ssl $password psql $pass_through_options $sep $no_headers $html $host $user $port $database";
 727     $interactive_command = $batch_command;
 728
 729     return($batch_command,$interactive_command);
 730 }
 731
 732 sub oracle_commands {
 733     my ($database_driver,%opt) = (@_);
 734     # oracle://user:pass@grum:1521/XE becomes:
 735     # sqlplus 'user/pass@(DESCRIPTION = (ADDRESS = (PROTOCOL = TCP)(HOST = grum)(PORT = 1521)) (CONNECT_DATA =(SERVER = DEDICATED)(SERVICE_NAME = XE) ))'
 736     my $sqlplus = find_command_in_path("sqlplus") ||
 737         find_command_in_path("sqlplus64") or
 738         die ("sqlplus/sqlplus64 not in path");
 739
 740     # Readline support: if rlwrap installed run rlwrap sqlplus
 741     my $rlwrap = find_command_in_path("rlwrap");
 742
 743     # Set good defaults in the inifile
 744     $Global::Initfile = "/tmp/$$.sql.init";
 745     open(INIT,">".$Global::Initfile) || die;
 746     print INIT "SET LINESIZE 32767\n";
 747     $::opt_debug and print "SET LINESIZE 32767\n";
 748     print INIT "SET WRAP OFF\n";
 749     $::opt_debug and print "SET WRAP OFF\n";
 750     if(defined($::opt_html)) {
 751         print INIT "SET MARK HTML ON\n";
 752         $::opt_debug and print "SET MARK HTML ON\n";
 753     }
 754     if(defined($::opt_n)) {
 755         print INIT "SET PAGES 0\n";
 756         $::opt_debug and print "SET PAGES 0\n";
 757     } else {
 758         print INIT "SET PAGES 50000\n";
 759         $::opt_debug and print "SET PAGES 50000\n";
 760     }
 761     if(defined($::opt_s)) {
 762         print INIT "SET COLSEP $::opt_s\n";
 763         $::opt_debug and print "SET COLSEP $::opt_s\n";
 764     }
 765     close INIT;
 766
 767     my $password = defined($opt{'password'}) ? "/".$opt{'password'} : "";
 768     my $host = defined($opt{'host'}) ? $opt{'host'} : "localhost";
 769     my $port = defined($opt{'port'}) ? $opt{'port'} : "1521";
 770     my $user = defined($opt{'user'}) ? $opt{'user'} : "";
 771     # Database is called service in Oracle lingo
 772     my $service = defined($opt{'database'}) ? "(SERVICE_NAME = ".$opt{'database'}.")" : "";
 773     my $tns = "(DESCRIPTION = (ADDRESS = (PROTOCOL = TCP)(HOST = $host)(PORT = $port)) ".
 774         "(CONNECT_DATA =(SERVER = DEDICATED)$service ))";
 775     my $ssl = "";
 776     # -L: Do not re-ask for password if it is wrong
 777     my $common_options = "-L $pass_through_options '$user$password\@$tns' \@$Global::Initfile";
 778     my $batch_command = "$sqlplus -S ".$common_options;
 779     my $interactive_command = "$rlwrap $sqlplus ".$common_options;
 780     return($batch_command,$interactive_command);
 781 }
 782
 783 sub sqlite_commands {
 784     my ($database_driver,%opt) = (@_);
 785     if(not find_command_in_path($database_driver)) {
 786         print STDERR "Database driver '$database_driver' not supported\n";
 787         exit -1;
 788     }
 789     my $sep = defined($::opt_s) ? "-separator '$::opt_s'" : "";
 790     my $password = defined($opt{'password'}) ? "--password=".$opt{'password'} : "";
 791     my $host = defined($opt{'host'}) ? "--host=".$opt{'host'} : "";
 792     my $port = defined($opt{'port'}) ? "--port=".$opt{'port'} : "";
 793     my $user = defined($opt{'user'}) ? "--user=".$opt{'user'} : "";
 794     my $database = defined($opt{'database'}) ? $opt{'database'} : "";
 795     my $html = defined($::opt_html) ? "-html" : "";
 796     my $no_headers = defined($::opt_n) ? "-noheader" : "-header";
 797     my $ssl = "";
 798     $batch_command =
 799         "$database_driver $pass_through_options $sep $no_headers $html $database";
 800     $interactive_command = $batch_command;
 801     return($batch_command,$interactive_command);
 802 }
 803
 804
 805 # Return the code for 'show processlist' in the chosen database dialect
 806 sub processlist {
 807     my $dbdriver = shift;
 808     my %dburl = @_;
 809     my %statement =
 810         ("mysql" => "show processlist;",
 811          "postgresql" => ("SELECT ".
 812                           "    datname AS database,".
 813                           "    usename AS username,".
 814                           "    now()-xact_start AS runtime,".
 815                           "    current_query ".
 816                           "FROM pg_stat_activity ".
 817                           "ORDER BY runtime DESC;"),
 818          "oracle" => ("SELECT ".
 819                       '    CPU_TIME/100000, SYS.V_$SQL.SQL_TEXT, USERNAME '.
 820                       "FROM ".
 821                       '    SYS.V_$SQL, SYS.V_$SESSION '.
 822                       "WHERE ".
 823                       '    SYS.V_$SQL.SQL_ID = SYS.V_$SESSION.SQL_ID(+) '.
 824                       "AND username IS NOT NULL ".
 825                       "ORDER BY CPU_TIME DESC;"),
 826         );
 827     if($statement{$dbdriver}) {
 828         return $statement{$dbdriver};
 829     } else {
 830         print STDERR "processlist is not implemented for $dbdriver\n";
 831         exit 1;
 832     }
 833 }
 834
 835 # Return the code for 'show tables' in the chosen database dialect
 836 sub tablelist {
 837     my $dbdriver = shift;
 838     my %dburl = @_;
 839     my %statement =
 840         ("mysql" => "show tables;",
 841          "postgresql" => '\dt',
 842          "oracle" => ("SELECT object_name FROM user_objects WHERE object_type = 'TABLE';"),
 843          "sqlite" => ".tables",
 844          "sqlite3" => ".tables",
 845         );
 846     if($statement{$dbdriver}) {
 847         return $statement{$dbdriver};
 848     } else {
 849         print STDERR "tablelist is not implemented for $dbdriver\n";
 850         exit 1;
 851     }
 852 }
 853
 854 # Return the code for 'show databases' in the chosen database dialect
 855 sub dblist {
 856     my $dbdriver = shift;
 857     my %dburl = @_;
 858     my %statement =
 859         ("mysql" => "show databases;",
 860          "postgresql" => ("SELECT datname FROM pg_database ".
 861                           "WHERE datname NOT IN ('template0','template1','postgres') ".
 862                           "ORDER BY datname ASC;"),
 863          "oracle" => ("select * from user_tablespaces;"),
 864         );
 865     if($statement{$dbdriver}) {
 866         return $statement{$dbdriver};
 867     } else {
 868         print STDERR "dblist is not implemented for $dbdriver\n";
 869         exit 1;
 870     }
 871 }
 872
 873 # Return the code for 'show database size' in the chosen database dialect
 874 sub dbsize {
 875     my $dbdriver = shift;
 876     my %dburl = @_;
 877     my %statement;
 878     if(defined $dburl{'database'}) {
 879         %statement =
 880             ("mysql" => (
 881                  'SELECT '.
 882                  '    table_schema "database", '.
 883                  '    SUM(data_length+index_length) "bytes", '.
 884                  '    SUM(data_length+index_length)/1024/1024 "megabytes" '.
 885                  'FROM information_schema.TABLES '.
 886                  "WHERE table_schema = '$dburl{'database'}'".
 887                  'GROUP BY table_schema;'),
 888              "postgresql" => (
 889                  "SELECT '$dburl{'database'}' AS database, ".
 890                  "pg_database_size('$dburl{'database'}') AS bytes, ".
 891                  "pg_size_pretty(pg_database_size('$dburl{'database'}')) AS human_readabable "),
 892              "sqlite" => (
 893                  "SELECT ".(undef_as_zero(-s $dburl{'database'}))." AS bytes;"),
 894              "sqlite3" => (
 895                  "SELECT ".(undef_as_zero(-s $dburl{'database'}))." AS bytes;"),
 896             );
 897     } else {
 898         %statement =
 899             ("mysql" => (
 900                  'SELECT '.
 901                  '    table_schema "database", '.
 902                  '    SUM(data_length+index_length) "bytes", '.
 903                  '    SUM(data_length+index_length)/1024/1024 "megabytes" '.
 904                  'FROM information_schema.TABLES '.
 905                  'GROUP BY table_schema;'),
 906              "postgresql" => (
 907                  'SELECT datname AS database, pg_database_size(datname) AS bytes, '.
 908                  'pg_size_pretty(pg_database_size(datname)) AS human_readabable '.
 909                  'FROM (SELECT datname FROM pg_database) a;'),
 910              "sqlite" => (
 911                  "SELECT 0 AS bytes;"),
 912              "sqlite3" => (
 913                  "SELECT 0 AS bytes;"),
 914             );
 915     }
 916     if($statement{$dbdriver}) {
 917         return $statement{$dbdriver};
 918     } else {
 919         print STDERR "dbsize is not implemented for $dbdriver\n";
 920         exit 1;
 921     }
 922 }
 923
 924
 925 # Return the code for 'show table size' in the chosen database dialect
 926 sub tablesize {
 927     my $dbdriver = shift;
 928     my $database = shift;
 929     my %statement =
 930         ("postgresql" => (
 931              "SELECT relname, relpages*8 AS kb, reltuples::int AS \"live+dead rows\" ".
 932              "FROM pg_class c ".
 933              "ORDER BY relpages DESC;"),
 934          "mysql" => (
 935              "select table_name, TABLE_ROWS, DATA_LENGTH,INDEX_LENGTH from INFORMATION_SCHEMA.tables;"),
 936         );
 937     if($statement{$dbdriver}) {
 938         return $statement{$dbdriver};
 939     } else {
 940         print STDERR "table size is not implemented for $dbdriver\n";
 941         exit 1;
 942     }
 943 }
 944
 945 sub is_stdin_terminal {
 946     return (-t STDIN);
 947 }
 948
 949 sub find_command_in_path {
 950     # Find the command if it exists in the current path
 951     my $command = shift;
 952     my $path = `which $command`;
 953     chomp $path;
 954     return $path;
 955 }
 956
 957 sub Usage {
 958     if(@_) {
 959         print "Error:\n";
 960         print map{ "$_\n" } @_;
 961         print "\n";
 962     }
 963     print "sql [-hnr] [--table-size] [--db-size] [-p pass-through] [-s string] dburl [command]\n";
 964 }
 965
 966 sub get_alias {
 967     my $alias = shift;
 968     $alias =~ s/^(sql:)*//; # Accept aliases prepended with sql:
 969     if ($alias !~ /^:/) {
 970         return $alias;
 971     }
 972
 973     # Find the alias
 974     my $path;
 975     if (-l $0) {
 976         ($path) = readlink($0) =~ m|^(.*)/|;
 977     } else {
 978         ($path) = $0 =~ m|^(.*)/|;
 979     }
 980
 981     my @deprecated = ("$ENV{HOME}/.dburl.aliases",
 982                       "$path/dburl.aliases", "$path/dburl.aliases.dist");
 983     for (@deprecated) {
 984         if(-r $_) {
 985             print STDERR "$_ is deprecated. Use .sql/aliases instead (read man sql)\n";
 986         }
 987     }
 988     my @urlalias=();
 989     check_permissions("$ENV{HOME}/.sql/aliases");
 990     check_permissions("$ENV{HOME}/.dburl.aliases");
 991     my @search = ("$ENV{HOME}/.sql/aliases",
 992                   "$ENV{HOME}/.dburl.aliases", "/etc/sql/aliases",
 993                   "$path/dburl.aliases", "$path/dburl.aliases.dist");
 994     for my $alias_file (@search) {
 995         if(-r $alias_file) {
 996             push @urlalias, `cat "$alias_file"`;
 997         }
 998     }
 999     my ($alias_part,$rest) = $alias=~/(:\w*)(.*)/;
1000     # If we saw this before: we have an alias loop
1001     if(grep {$_ eq $alias_part } @Private::seen_aliases) {
1002         print STDERR "$alias_part is a cyclic alias\n";
1003         exit -1;
1004     } else {
1005         push @Private::seen_aliases, $alias_part;
1006     }
1007
1008     my $dburl;
1009     for (@urlalias) {
1010         /^$alias_part\s+(\S+.*)/ and do { $dburl = $1; last; }
1011     }
1012
1013     if($dburl) {
1014         return get_alias($dburl.$rest);
1015     } else {
1016         Usage("$alias is not defined in @search");
1017         exit(-1);
1018     }
1019 }
1020
1021 sub check_permissions {
1022     my $file = shift;
1023
1024     if(-e $file) {
1025         if(not -o $file) {
1026             my $username = (getpwuid($<))[0];
1027             print STDERR "$file should be owned by $username: chown $username $file\n";
1028         }
1029         my ($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$size,
1030             $atime,$mtime,$ctime,$blksize,$blocks) = stat($file);
1031         if($mode & 077) {
1032             my $username = (getpwuid($<))[0];
1033             print STDERR "$file should be only be readable by $username: chmod 600 $file\n";
1034         }
1035     }
1036 }
1037
1038 sub parse_dburl {
1039     my $url = shift;
1040     my %options = ();
1041     # sql:mysql://[[user][:password]@][host][:port]/[database[?sql query]]
1042
1043     if($url=~m!(?:sql:)? # You can prefix with 'sql:'
1044                ((?:oracle|ora|mysql|pg|postgres|postgresql)(?:s|ssl|)|
1045                  (?:sqlite|sqlite2|sqlite3)):// # Databasedriver ($1)
1046                (?:
1047                 ([^:@/][^:@]*|) # Username ($2)
1048                 (?:
1049                  :([^@]*) # Password ($3)
1050                 )?
1051                @)?
1052                ([^:/]*)? # Hostname ($4)
1053                (?:
1054                 :
1055                 ([^/]*)? # Port ($5)
1056                )?
1057                (?:
1058                 /
1059                 ([^?/]*)? # Database ($6)
1060                )?
1061                (?:
1062                 /?
1063                 \?
1064                 (.*)? # Query ($7)
1065                )?
1066               !x) {
1067         $options{databasedriver} = undef_if_empty(uri_unescape($1));
1068         $options{user} = undef_if_empty(uri_unescape($2));
1069         $options{password} = undef_if_empty(uri_unescape($3));
1070         $options{host} = undef_if_empty(uri_unescape($4));
1071         $options{port} = undef_if_empty(uri_unescape($5));
1072         $options{database} = undef_if_empty(uri_unescape($6))
1073             || $options{user};
1074         $options{query} = undef_if_empty(uri_unescape($7));
1075         debug("dburl $url\n");
1076         debug("databasedriver ",$options{databasedriver}, " user ", $options{user},
1077               " password ", $options{password}, " host ", $options{host},
1078               " port ", $options{port}, " database ", $options{database},
1079               " query ",$options{query}, "\n");
1080     } else {
1081         Usage("$url is not a valid DBURL");
1082         exit -1;
1083     }
1084     return %options;
1085 }
1086
1087 sub uri_unescape {
1088     # Copied from http://cpansearch.perl.org/src/GAAS/URI-1.55/URI/Escape.pm
1089     # to avoid depending on URI::Escape
1090     # This section is (C) Gisle Aas.
1091     # Note from RFC1630:  "Sequences which start with a percent sign
1092     # but are not followed by two hexadecimal characters are reserved
1093     # for future extension"
1094     my $str = shift;
1095     if (@_ && wantarray) {
1096         # not executed for the common case of a single argument
1097         my @str = ($str, @_);  # need to copy
1098         foreach (@str) {
1099             s/%([0-9A-Fa-f]{2})/chr(hex($1))/eg;
1100         }
1101         return @str;
1102     }
1103     $str =~ s/%([0-9A-Fa-f]{2})/chr(hex($1))/eg if defined $str;
1104     $str;
1105 }
1106
1107 sub undef_if_empty {
1108     if(defined($_[0]) and $_[0] eq "") {
1109         return undef;
1110     }
1111     return $_[0];
1112 }
1113
1114 sub undef_as_zero {
1115     my $a = shift;
1116     return $a ? $a : 0;
1117 }
1118
1119 sub version {
1120     # Returns: N/A
1121     print join("\n",
1122                "GNU $Global::progname $Global::version",
1123                "Copyright (C) 2009,2010,2011,2012,2013,2014,2015,2016,2017",
1124                "Ole Tange and Free Software Foundation, Inc.",
1125                "License GPLv3+: GNU GPL version 3 or later <http://gnu.org/licenses/gpl.html>",
1126                "This is free software: you are free to change and redistribute it.",
1127                "GNU $Global::progname comes with no warranty.",
1128                "",
1129                "Web site: http://www.gnu.org/software/${Global::progname}\n",
1130                "When using GNU $Global::progname for a publication please cite:\n",
1131                "O. Tange (2011): GNU SQL - A Command Line Tool for Accessing Different",
1132                "Databases Using DBURLs, ;login: The USENIX Magazine, April 2011:29-32.\n"
1133         );
1134 }
1135
1136 sub die_usage {
1137     # Returns: N/A
1138     usage();
1139     exit(255);
1140 }
1141
1142 sub usage {
1143     # Returns: N/A
1144     print "Usage:\n";
1145     print "$Global::progname [options] dburl [sqlcommand]\n";
1146     print "$Global::progname [options] dburl < sql_command_file\n";
1147     print "\n";
1148     print "See 'man $Global::progname' for the options\n";
1149 }
1150
1151 sub debug {
1152     # Returns: N/A
1153     $Global::debug or return;
1154     @_ = grep { defined $_ ? $_ : "" } @_;
1155     print @_;
1156 }
1157
1158 $::opt_skip_first_line = $::opt_shebang = 0;