cgit.sxemacs.org Git - sxemacs/blob - src/database/postgresql.c

   1 /** postgresql.c -- elisp binding to libpq.so
   2  *
   3  * Copyright (C) 2000 Electrotechnical Laboratory, JAPAN.
   4  * Copyright (C) 2005-2008 Sebastian Freundt <hroptatyr@sxemacs.org>
   5  *
   6  * Original author:  SL Baur <steve@beopen.com>
   7  *
   8  *
   9  * Redistribution and use in source and binary forms, with or without
  10  * modification, are permitted provided that the following conditions
  11  * are met:
  12  *
  13  * 1. Redistributions of source code must retain the above copyright
  14  *    notice, this list of conditions and the following disclaimer.
  15  *
  16  * 2. Redistributions in binary form must reproduce the above copyright
  17  *    notice, this list of conditions and the following disclaimer in the
  18  *    documentation and/or other materials provided with the distribution.
  19  *
  20  * 3. Neither the name of the author nor the names of any contributors
  21  *    may be used to endorse or promote products derived from this
  22  *    software without specific prior written permission.
  23  *
  24  * THIS SOFTWARE IS PROVIDED BY THE AUTHOR "AS IS" AND ANY EXPRESS OR
  25  * IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED
  26  * WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE
  27  * DISCLAIMED.  IN NO EVENT SHALL THE REGENTS OR CONTRIBUTORS BE LIABLE
  28  * FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
  29  * CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
  30  * SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR
  31  * BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY,
  32  * WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE
  33  * OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN
  34  * IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
  35  *
  36  *
  37  * This file is part of SXEmacs.
  38  */
  39 /*
  40
  41 Implementation notes (written by Steve Baur):
  42 0. Supported PostgreSQL versions
  43    This code was developed against libpq-8.0.1 and libpq-8.1.0-CVS.  Earlier
  44    versions do work.  V7 support is more complete than V6.5 support.
  45    V8 support is currently experimental.
  46 1. Mule
  47    Non-ASCII databases have been tested on 6.5, 7.3, 7.4 and 8.0.
  48 2. Asynchronous Operation
  49    Starting with libpq-7.0, an asynchronous interface is offered.  This
  50    binding supports the asynchronous calls to a limited extent.  Since the
  51    SXEmacs 22.1 core does not support a sensible interface to add managed but
  52    unreadable (by SXEmacs) file descriptors to the main select code, polling
  53    is required to drive the asynchronous calls.  XtAppAddInput would work
  54    fine, but we want to be able to use the database when running strictly in
  55    tty mode.
  56 3. Completeness
  57    Various calls have been deliberately not exported to Lisp.  The
  58    unexported calls are either left-over backwards compatibility code that
  59    aren't needed, calls that cannot be implemented sensibly, or calls that
  60    cannot be implemented safely.  A list of all global functions in libpq
  61    but not exported to Lisp is below.
  62 4. Policy
  63    This interface tries very hard to not set any policy towards how database
  64    code in Emacs Lisp will be written.
  65 5. Documentation
  66    For full lisp programming documentation, see the SXEmacs Lisp Reference
  67    Manual.  For PostgreSQL documentation, see the PostgreSQL distribution.
  68
  69 TODO (in rough order of priority):
  70 1. The large object interface needs work with Emacs buffers in addition
  71    to files.  Need two functions buffer->large_object, and large_object->
  72    buffer.
  73 - PQexecParams
  74 - PQprepare, PQexecPrepared
  75 - PQresultErrorField
  76
  77 - PQftable, PQftablecol, PQfformat
  78
  79 - PQsendQueryParams
  80 - PQsendPrepare, PQsendQueryPrepared
  81 - PQgetCancel, PQfreeCancel, PQcancel, PQrequestCancel
  82
  83 - PQputCopyData, PQputCopyEnd, PQgetCopyData
  84
  85 - notice receivers
  86 */
  87
  88 /*
  89   Unimplemented functions: [TODO]
  90   PQsetNoticeProcessor - done 2005/05/03 hroptatyr
  91
  92   Unsupported functions:
  93   PQsetdbLogin -- This function is deprecated, has a subset of the
  94    functionality of PQconnectdb, and is better done in Lisp.
  95    -- and I say, no it is not! I hate the single string interface!
  96   PQsetdb -- Same as for PQsetdbLogin
  97    -- same as my comment there :)
  98   PQsocket -- Abstraction error, file descriptors should not be leaked
  99    into Lisp code
 100   PQprint -- print to a file descriptor, deprecated, better done in Lisp
 101   PQdisplayTuples -- deprecated
 102   PQprintTuples -- really, really deprecated
 103   PQmblen -- Returns the length in bytes of multibyte character encoded
 104    string.
 105   PQtrace -- controls debug print tracing to a tty.
 106   PQuntrace -- Ditto.  I don't see any way to do this sensibly.
 107   PQoidStatus -- deprecated and nearly identical to PQoidValue
 108   PQfn -- "Fast path" interface; This is a trapdoor into system internals
 109     and can be a potential security hole.
 110     Most users will not need this feature.
 111
 112   lo_open (large object) [*]
 113   lo_close (large object) [*]
 114   lo_read (large object) [*]
 115   lo_write (large object) [*]
 116   lo_lseek (large object) [*]
 117   lo_creat (large object) [*]
 118   lo_tell (large object) [*]
 119   lo_unlink (large object) [*]
 120 */
 121
 122 #include <config.h>
 123 #include "lisp.h"
 124 #include "sysdep.h"
 125 #include "buffer.h"
 126 #include "postgresql.h"
 127
 128 #ifdef HAVE_OPENSSL
 129 #include "openssl.h"
 130 #endif
 131
 132 #ifdef MULE
 133 #define PG_OS_CODING Fget_coding_system(Vpg_coding_system)
 134 #else
 135 #define PG_OS_CODING Qnative
 136 #endif
 137 Lisp_Object Vpg_coding_system;
 138
 139 #define CHECK_CONNECTION_ALIVE(P)                               \
 140         if (P == NULL ||                                        \
 141             PQstatus(P) != CONNECTION_OK) {                     \
 142                 char *e = "bad value";                          \
 143                 if (P) {                                        \
 144                         e = PQerrorMessage(P);                  \
 145                 }                                               \
 146                 error("dead connection [%s]", e);               \
 147         }
 148 #define CHECK_CONNECTION_ELIGIBLE(P)                            \
 149         if (P == NULL ||                                        \
 150             PQstatus(P) == CONNECTION_BAD) {                    \
 151                 char *e = "bad value";                          \
 152                 if (P) {                                        \
 153                         e = PQerrorMessage(P);                  \
 154                 }                                               \
 155                 error("dead connection [%s]", e);               \
 156         }
 157 #define PUKE_IF_NULL(p)                         \
 158         if (p == NULL) {                        \
 159                 error ("bad value");            \
 160         }
 161
 162 static Lisp_Object VXPGHOST;
 163 static Lisp_Object VXPGUSER;
 164 static Lisp_Object VXPGOPTIONS;
 165 static Lisp_Object VXPGPORT;
 166 static Lisp_Object VXPGTTY;     /* This needs to be blanked! */
 167 static Lisp_Object VXPGDATABASE;
 168 static Lisp_Object VXPGREALM;
 169 #ifdef MULE
 170 static Lisp_Object VXPGCLIENTENCODING;
 171 #endif                          /* MULE */
 172
 173 /* Other variables:
 174    PGAUTHTYPE -- not used after PostgreSQL 6.5
 175    PGGEQO
 176    PGCOSTINDEX
 177    PGCOSTHEAP
 178    PGTZ
 179    PGDATESTYLE
 180 */
 181 #ifndef HAVE_POSTGRESQLV7
 182 static Lisp_Object VXPGAUTHTYPE;
 183 #endif
 184 static Lisp_Object VXPGGEQO, VXPGCOSTINDEX, VXPGCOSTHEAP, VXPGTZ, VXPGDATESTYLE;
 185
 186 static Lisp_Object Qpostgresql;
 187 static Lisp_Object Q_pg_connection_ok, Q_pg_connection_bad;
 188 static Lisp_Object Q_pg_connection_started, Q_pg_connection_made;
 189 static Lisp_Object Q_pg_connection_awaiting_response, Q_pg_connection_auth_ok;
 190 static Lisp_Object Q_pg_connection_setenv;
 191
 192 /* trans statuses */
 193 static Lisp_Object Q_pg_trans_idle, Q_pg_trans_active, Q_pg_trans_intrans;
 194 static Lisp_Object Q_pg_trans_inerror, Q_pg_trans_unknown;
 195
 196 static Lisp_Object Q_pq_db, Q_pq_user, Q_pq_pass, Q_pq_host, Q_pq_port;
 197 static Lisp_Object Q_pq_tty;
 198 static Lisp_Object Q_pq_options, Q_pq_error_message, Q_pq_backend_pid;
 199 static Lisp_Object Q_pq_status, Q_pq_transaction_status, Q_pq_parameter_status;
 200 static Lisp_Object Q_pq_protocol_version, Q_pq_server_version;
 201 #ifdef HAVE_OPENSSL
 202 static Lisp_Object Q_pq_getssl;
 203 #endif
 204
 205 static Lisp_Object Q_pgres_empty_query, Q_pgres_command_ok, Q_pgres_tuples_ok;
 206 static Lisp_Object Q_pgres_copy_out, Q_pgres_copy_in, Q_pgres_bad_response;
 207 static Lisp_Object Q_pgres_nonfatal_error, Q_pgres_fatal_error;
 208
 209 static Lisp_Object Q_pgres_polling_failed, Q_pgres_polling_reading;
 210 static Lisp_Object Q_pgres_polling_writing, Q_pgres_polling_ok;
 211 static Lisp_Object Q_pgres_polling_active;
 212 /****/
 213
 214 /* PGconn is an opaque object and we need to be able to store them in
 215    Lisp code because libpq supports multiple connections.
 216 */
 217 Lisp_Object Qpgconnp;
 218
 219 static Lisp_Object make_pgconn(Lisp_PGconn * pgconn)
 220 {
 221         Lisp_Object lisp_pgconn;
 222         XSETPGCONN(lisp_pgconn, pgconn);
 223         return lisp_pgconn;
 224 }
 225
 226 static Lisp_Object
 227 mark_pgconn(Lisp_Object obj)
 228 {
 229         return Qnil;
 230 }
 231
 232 static void
 233 print_pgconn(Lisp_Object obj, Lisp_Object printcharfun, int escapeflag)
 234 {
 235         PGconn *P;
 236         ConnStatusType cst;
 237         char *host = "", *db = "", *user = "", *port = "";
 238
 239         P = (XPGCONN(obj))->pgconn;
 240
 241         if (P == NULL) {
 242                 /* this may happen since we allow PQfinish() to be called */
 243                 write_c_string("#<PGconn DEAD>", printcharfun);
 244         } else if ((cst = PQstatus(P)) == CONNECTION_OK) {
 245                 if (!(host = PQhost(P)))
 246                         host = "";
 247                 port = PQport(P);
 248                 db = PQdb(P);
 249                 if (!(user = PQuser(P))) {
 250                         user = "";
 251                 }
 252                 write_fmt_string(printcharfun, "#<PGconn %s:%s %s/%s>",
 253                                  (!strlen(host) ?
 254                                   "localhost" : host) /* evil! */,
 255                                  port, user, db);
 256         } else if (cst == CONNECTION_BAD) {
 257                 write_c_string("#<PGconn BAD>", printcharfun);
 258         } else {
 259                 write_c_string("#<PGconn connecting>", printcharfun);
 260         }
 261         return;
 262 }
 263
 264 static Lisp_PGconn*
 265 allocate_pgconn(void)
 266 {
 267         Lisp_PGconn *pgconn =
 268                 alloc_lcrecord_type(Lisp_PGconn, &lrecord_pgconn);
 269         pgconn->pgconn = (PGconn *) NULL;
 270         return pgconn;
 271 }
 272
 273 static void
 274 finalize_pgconn(void *header, int for_disksave)
 275 {
 276         Lisp_PGconn *pgconn = (Lisp_PGconn *) header;
 277
 278         if (for_disksave) {
 279                 signal_simple_error
 280                         ("Can't dump an emacs containing PGconn objects",
 281                          make_pgconn(pgconn));
 282         }
 283
 284         if (pgconn->pgconn) {
 285                 PQfinish(pgconn->pgconn);
 286                 pgconn->pgconn = (PGconn *) NULL;
 287         }
 288 }
 289
 290 DEFINE_LRECORD_IMPLEMENTATION("pgconn", pgconn,
 291                               mark_pgconn, print_pgconn, finalize_pgconn,
 292                               NULL, NULL, 0, Lisp_PGconn);
 293
 294
 295 /* PGresult is an opaque object and we need to be able to store them in
 296    Lisp code.
 297 */
 298 Lisp_Object Qpgresultp;
 299
 300 static Lisp_Object
 301 make_pgresult(Lisp_PGresult * pgresult)
 302 {
 303         Lisp_Object lisp_pgresult;
 304         XSETPGRESULT(lisp_pgresult, pgresult);
 305         return lisp_pgresult;
 306 }
 307
 308 static Lisp_Object
 309 mark_pgresult(Lisp_Object obj)
 310 {
 311         return Qnil;
 312 }
 313
 314 #define RESULT_TUPLES_FMT "#<PGresult %s[%d] - %s>"
 315 #define RESULT_CMD_TUPLES_FMT "#<PGresult %s[%s] - %s>"
 316 #define RESULT_DEFAULT_FMT "#<PGresult %s - %s>"
 317
 318 static void
 319 print_pgresult(Lisp_Object obj, Lisp_Object printcharfun, int escapeflag)
 320 {
 321         PGresult *res;
 322
 323         res = (XPGRESULT(obj))->pgresult;
 324
 325         if (res) {
 326                 switch (PQresultStatus(res)) {
 327                 case PGRES_TUPLES_OK:
 328                         /* Add number of tuples of result to output */
 329                         write_fmt_string(printcharfun, RESULT_TUPLES_FMT,
 330                                          PQresStatus(PQresultStatus(res)),
 331                                          PQntuples(res), PQcmdStatus(res));
 332                         break;
 333                 case PGRES_COMMAND_OK:
 334                         /* Add number of tuples affected by output-less
 335                            command */
 336                         if (!strlen(PQcmdTuples(res)))
 337                                 goto notuples;
 338                         write_fmt_string(printcharfun, RESULT_CMD_TUPLES_FMT,
 339                                          PQresStatus(PQresultStatus(res)),
 340                                          PQcmdTuples(res), PQcmdStatus(res));
 341                         break;
 342                 default:
 343                 notuples:
 344                         /* No counts to print */
 345                         write_fmt_string(printcharfun, RESULT_DEFAULT_FMT,
 346                                          PQresStatus(PQresultStatus(res)),
 347                                          PQcmdStatus(res));
 348                         break;
 349                 }
 350         } else {
 351                 write_c_string("#<PGresult DEAD>", printcharfun);
 352         }
 353         return;
 354 }
 355
 356 #undef RESULT_TUPLES_FMT
 357 #undef RESULT_CMD_TUPLES_FMT
 358 #undef RESULT_DEFAULT_FMT
 359
 360 static Lisp_PGresult*
 361 allocate_pgresult(void)
 362 {
 363         Lisp_PGresult *pgresult = alloc_lcrecord_type(
 364                 Lisp_PGresult, &lrecord_pgresult);
 365         pgresult->pgresult = (PGresult *) NULL;
 366         return pgresult;
 367 }
 368
 369 static void
 370 finalize_pgresult(void *header, int for_disksave)
 371 {
 372         Lisp_PGresult *pgresult = (Lisp_PGresult *) header;
 373
 374         if (for_disksave) {
 375                 signal_simple_error
 376                     ("Can't dump an emacs containing PGresult objects",
 377                      make_pgresult(pgresult));
 378         }
 379
 380         if (pgresult->pgresult) {
 381                 PQclear(pgresult->pgresult);
 382                 pgresult->pgresult = (PGresult *) NULL;
 383         }
 384 }
 385
 386 DEFINE_LRECORD_IMPLEMENTATION("pgresult", pgresult,
 387                               mark_pgresult, print_pgresult, finalize_pgresult,
 388                               NULL, NULL, 0, Lisp_PGresult);
 389
 390 /***********************/
 391
 392 /* Notice Processor Stuff */
 393 /* Okay, let's imagine how such a notice processor wants to look like.
 394  * The only sensible thing I can imagine is a defun (like a sentinel for
 395  * processes)
 396  */
 397 static void
 398 sxemacs_notice_processor(Lisp_PGconn *conn, const char *msg)
 399 {
 400         /* (Lisp_PGconn *)conn; */
 401
 402         /* void *arg is my sentinel function */
 403         Lisp_Object sentinel = conn->notice_processor;
 404
 405         if (NILP(sentinel))
 406                 warn_when_safe(Qpostgresql, Qnotice, "%s", msg);
 407         else {
 408                 running_asynch_code = 1;
 409                 call2_trapping_errors("Error in notice processor",
 410                           sentinel, make_pgconn(conn),
 411                           build_string(msg));
 412                 running_asynch_code = 0;
 413         }
 414 }
 415
 416 /* HOWTO evoke notices:
 417  *   (let ((res (pq-exec <conn> "SELECT * FROM <sometable> LIMIT 0")))
 418  *     (pq-get-is-null res 0 0))
 419  * should result in:
 420  * msg <- `row number 0 is out of range 0..-1'
 421  */
 422 DEFUN("pq-set-notice-processor", Fpq_set_notice_processor, 2, 2, 0, /*
 423 Give CONN the notice processor SENTINEL; nil for none.
 424 The notice processor is called as a function whenever the pq backend
 425 has notices.
 426 It gets two arguments: the connection, and a message string.
 427 */
 428       (conn, sentinel))
 429 {
 430         CHECK_PGCONN(conn);
 431
 432         XPGCONN(conn)->notice_processor = sentinel;
 433
 434         return sentinel;
 435 }
 436
 437
 438 /* There are four ways (as of PostgreSQL v7) to connect to a database.
 439    Two of them, PQsetdb and PQsetdbLogin, are deprecated.  Both of those
 440    routines take a number of positional parameters and are better done in Lisp.
 441    Note that PQconnectStart does not exist prior to v7.
 442 */
 443
 444 DEFUN("pq-conn-defaults", Fpq_conn_defaults, 0, 0, 0,   /*
 445 Return a connection default structure.
 446 */
 447       ())
 448 {
 449         /* This function can GC */
 450         PQconninfoOption *pcio;
 451         Lisp_Object temp, temp1;
 452         int i;
 453
 454         /* WHAT A FOOKING MESS! */
 455         pcio = PQconndefaults();
 456         if (!pcio)
 457                 return Qnil;    /* can never happen in libpq-7.0 */
 458         temp = list1(Fcons(build_ext_string(pcio[0].keyword, PG_OS_CODING),
 459                            Fcons(build_ext_string(pcio[0].envvar, PG_OS_CODING),
 460                                  Fcons(build_ext_string
 461                                        (pcio[0].compiled, PG_OS_CODING),
 462                                        Fcons(build_ext_string
 463                                              (pcio[0].val, PG_OS_CODING),
 464                                              Fcons(build_ext_string
 465                                                    (pcio[0].label,
 466                                                     PG_OS_CODING),
 467                                                    Fcons(build_ext_string
 468                                                          (pcio[0].dispchar,
 469                                                           PG_OS_CODING),
 470                                                          Fcons(make_int
 471                                                                (pcio[0].
 472                                                                 dispsize),
 473                                                                Qnil))))))));
 474
 475         for (i = 1; pcio[i].keyword; i++) {
 476                 temp1 =
 477                     list1(Fcons
 478                           (build_ext_string(pcio[i].keyword, PG_OS_CODING),
 479                            Fcons(build_ext_string(pcio[i].envvar, PG_OS_CODING),
 480                                  Fcons(build_ext_string
 481                                        (pcio[i].compiled, PG_OS_CODING),
 482                                        Fcons(build_ext_string
 483                                              (pcio[i].val, PG_OS_CODING),
 484                                              Fcons(build_ext_string
 485                                                    (pcio[i].label,
 486                                                     PG_OS_CODING),
 487                                                    Fcons(build_ext_string
 488                                                          (pcio[i].dispchar,
 489                                                           PG_OS_CODING),
 490                                                          Fcons(make_int
 491                                                                (pcio[i].
 492                                                                 dispsize),
 493                                                                Qnil))))))));
 494                 {
 495                         Lisp_Object args[2];
 496                         args[0] = temp;
 497                         args[1] = temp1;
 498                         /* Fappend GCPROs its arguments */
 499                         temp = Fappend(2, args);
 500                 }
 501         }
 502
 503         return temp;
 504 }
 505
 506 /* PQconnectdb Makes a new connection to a backend.
 507 PGconn *PQconnectdb(const char *conninfo)
 508 */
 509
 510 DEFUN("pq-connectdb", Fpq_connectdb, 1, 1, 0,   /*
 511 Open and return a new database connection using the parameters from the
 512 string CONNINFO.
 513
 514 Unlike `pq-set-db-login' below, the parameter set can be extended without
 515 changing the function signature, so use of this function (or its nonblocking
 516 analogues `pq-connect-start' and `pq-connect-poll') is preferred for new
 517 application programming.
 518
 519 The passed string can be empty to use all default parameters, or it can
 520 contain one or more parameter settings separated by whitespace.  Each
 521 parameter setting is in the form `keyword = value'.  Spaces around the equal
 522 sign are optional.  To write an empty value or a value containing spaces,
 523 surround it with single quotes, e.g., `keyword = \'a value\''.  Single
 524 quotes and backslashes within the value must be escaped with a backslash,
 525 i.e., \\\' and \\\\.
 526
 527 The currently recognized parameter key words are:
 528
 529 - host
 530
 531 Name of host to connect to.  If this begins with a slash, it specifies
 532 Unix-domain communication rather than TCP/IP communication; the value is the
 533 name of the directory in which the socket file is stored.
 534
 535 The default behaviour when `host' is not specified is to connect to a
 536 Unix-domain socket in /tmp (or whatever socket directory was specified when
 537 PostgreSQL was built).
 538
 539 On machines without Unix-domain sockets, the default is to connect to
 540 localhost.
 541
 542
 543 - hostaddr
 544
 545 Numeric IP address of host to connect to.  This should be in the standard
 546 IPv4 address format, e.g., 172.28.40.9.
 547
 548 If your machine supports IPv6, you can also use those addresses.
 549
 550 TCP/IP communication is always used when a nonempty string is specified for
 551 this parameter.
 552
 553 Using `hostaddr' instead of `host' allows the application to avoid a host
 554 name look-up, which may be important in applications with time constraints.
 555 However, Kerberos authentication requires the host name.
 556
 557 The following therefore applies:
 558   - If `host' is specified without `hostaddr' a host name lookup occurs.
 559   - If `hostaddr' is specified without `host' the value for `hostaddr' gives
 560     the remote address.
 561   - When Kerberos is used, a reverse name query occurs to obtain the host
 562     name for Kerberos.
 563   - If both `host' and `hostaddr' are specified, the value for `hostaddr'
 564     gives the remote address; the value for `host' is ignored, unless
 565     Kerberos is used, in which case that value is used for Kerberos
 566     authentication.
 567
 568 Note: Authentication is likely to fail if libpq is passed a host name that
 569 is not the name of the machine at `hostaddr'.
 570 Also, `host' rather than `hostaddr' is used to identify the connection in
 571 ~/.pgpass.
 572
 573
 574 Without either a host name or host address, libpq will connect using a local
 575 Unix-domain socket; or on machines without Unix-domain sockets, it will
 576 attempt to connect to localhost.
 577
 578
 579 - port
 580
 581 Port number to connect to at the server host, or socket file name extension
 582 for Unix-domain connections.
 583
 584
 585 - dbname
 586
 587 The database name.
 588 Defaults to be the same as the user name.
 589
 590
 591 - user
 592
 593 PostgreSQL user name to connect as.
 594 Defaults to be the same as the operating system name of the user running the
 595 application.
 596
 597
 598 - password
 599
 600 Password to be used if the server demands password authentication.
 601
 602
 603 - connect_timeout
 604
 605 Maximum wait for connection, in seconds (write as a decimal integer string).
 606 Zero or not specified means wait indefinitely.
 607 It is not recommended to use a timeout of less than 2 seconds.
 608
 609
 610 - options
 611
 612 Command-line options to be sent to the server.
 613
 614
 615 - tty
 616
 617 Ignored (formerly, this specified where to send server debug output).
 618
 619
 620 - sslmode
 621
 622 This option determines whether or with what priority an SSL connection will
 623 be negotiated with the server.
 624 There are four modes:
 625   - `disable' will attempt only an unencrypted SSL connection;
 626   - `allow' will negotiate, trying first a non-SSL connection, then if that
 627     fails, trying an SSL connection;
 628   - `prefer' (the default) will negotiate, trying first an SSL connection,
 629     then if that fails, trying a regular non-SSL connection;
 630   - `require' will try only an SSL connection.
 631
 632 Note: If PostgreSQL is compiled without SSL support, using option require
 633 will cause an error, while options allow and prefer will be accepted but
 634 libpq will not in fact attempt an SSL connection.
 635
 636 - requiressl
 637
 638 This option is deprecated in favour of the sslmode setting.
 639
 640 If set to 1, an SSL connection to the server is required (this is equivalent
 641 to sslmode require). libpq will then refuse to connect if the server does
 642 not accept an SSL connection.
 643 If set to 0 (default), libpq will negotiate the connection type with the
 644 server (equivalent to sslmode prefer).
 645
 646 This option is only available if PostgreSQL is compiled with SSL support.
 647
 648
 649 - service
 650
 651 Service name to use for additional parameters.
 652 It specifies a service name in pg_service.conf that holds additional
 653 connection parameters. This allows applications to specify only a service
 654 name so connection parameters can be centrally maintained.
 655 See share/pg_service.conf.sample in the installation directory for
 656 information on how to set up the file.
 657
 658 General note:
 659 If any parameter is unspecified, then the corresponding environment variable
 660 is checked. If the environment variable is not set either, then the
 661 indicated built-in defaults are used.
 662 */
 663       (conninfo))
 664 {
 665         PGconn *P;
 666         Lisp_PGconn *lisp_pgconn;
 667         char *error_message = "Out of Memory?";
 668         char *c_conninfo;
 669         /* the result */
 670         Lisp_Object conn;
 671
 672         CHECK_STRING(conninfo);
 673
 674         TO_EXTERNAL_FORMAT(LISP_STRING, conninfo,
 675                            C_STRING_ALLOCA, c_conninfo, Qnative);
 676         P = PQconnectdb(c_conninfo);
 677         if (P && (PQstatus(P) == CONNECTION_OK)) {
 678                 lisp_pgconn = allocate_pgconn();
 679                 lisp_pgconn->pgconn = P;
 680                 lisp_pgconn->notice_processor = Qnil;
 681                 conn = make_pgconn(lisp_pgconn);
 682                 PQsetNoticeProcessor
 683                         (P,
 684                          (PQnoticeProcessor)sxemacs_notice_processor,
 685                          /* this is stupid, but libpq wants a void pointer */
 686                          (Lisp_PGconn *)lisp_pgconn);
 687                 return conn;
 688         } else {
 689                 /* Connection failed.  Destroy the connection and signal an
 690                  * error. */
 691                 char buf[BLCKSZ];
 692                 strncpy(buf, error_message, sizeof(buf)-1);
 693                 buf[sizeof(buf) - 1] = '\0';
 694                 if (P) {
 695                         /* storage for the error message gets erased when
 696                          * call PQfinish */
 697                         /* so we must temporarily stash it somewhere */
 698                         strncpy(buf, PQerrorMessage(P), sizeof(buf)-1);
 699                         buf[sizeof(buf) - 1] = '\0';
 700                         PQfinish(P);
 701                 }
 702                 error("libpq: %s", buf);
 703         }
 704 }
 705
 706 /* PQconnectStart Makes a new asynchronous connection to a backend.
 707 PGconn *PQconnectStart(const char *conninfo)
 708 */
 709
 710 #ifdef HAVE_POSTGRESQLV7
 711 DEFUN("pq-connect-start", Fpq_connect_start, 1, 1, 0,   /*
 712 Make a new asynchronous connection to a PostgreSQL backend.
 713
 714 See `pq-connectdb' for a complete description of conninfo.
 715 */
 716       (conninfo))
 717 {
 718         PGconn *P;
 719         Lisp_PGconn *lisp_pgconn;
 720         char *error_message = "Out of Memory?";
 721         char *c_conninfo;
 722         /* the result */
 723         Lisp_Object conn;
 724
 725         CHECK_STRING(conninfo);
 726         TO_EXTERNAL_FORMAT(LISP_STRING, conninfo,
 727                            C_STRING_ALLOCA, c_conninfo, Qnative);
 728         P = PQconnectStart(c_conninfo);
 729
 730         if (P && (PQstatus(P) != CONNECTION_BAD)) {
 731                 lisp_pgconn = allocate_pgconn();
 732                 lisp_pgconn->pgconn = P;
 733                 lisp_pgconn->notice_processor = Qnil;
 734                 conn = make_pgconn(lisp_pgconn);
 735                 PQsetNoticeProcessor
 736                         (P,
 737                          (PQnoticeProcessor)sxemacs_notice_processor,
 738                          (void *)&conn);
 739                 return conn;
 740         } else {
 741                 /* capture the error message before destroying the object */
 742                 char buf[BLCKSZ];
 743                 strncpy(buf, error_message, sizeof(buf)-1);
 744                 buf[sizeof(buf) - 1] = '\0';
 745                 if (P) {
 746                         strncpy(buf, PQerrorMessage(P), sizeof(buf)-1);
 747                         buf[sizeof(buf) - 1] = '\0';
 748                         PQfinish(P);
 749                 }
 750                 error("libpq: %s", buf);
 751         }
 752         return Qnil;
 753 }
 754
 755 DEFUN("pq-connect-poll", Fpq_connect_poll, 1, 1, 0,     /*
 756 Poll an asynchronous connection for completion
 757 */
 758       (conn))
 759 {
 760         PGconn *P;
 761         PostgresPollingStatusType polling_status;
 762
 763         CHECK_PGCONN(conn);
 764
 765         P = (XPGCONN(conn))->pgconn;
 766         CHECK_CONNECTION_ELIGIBLE(P);
 767
 768         polling_status = PQconnectPoll(P);
 769         switch (polling_status) {
 770         case PGRES_POLLING_FAILED:
 771                 /* Something Bad has happened */
 772                 {
 773                         char *e = PQerrorMessage(P);
 774                         error("libpq: %s", e);
 775                 }
 776         case PGRES_POLLING_OK:
 777                 return Q_pgres_polling_ok;
 778         case PGRES_POLLING_READING:
 779                 return Q_pgres_polling_reading;
 780         case PGRES_POLLING_WRITING:
 781                 return Q_pgres_polling_writing;
 782         case PGRES_POLLING_ACTIVE:
 783                 return Q_pgres_polling_active;
 784         default:
 785                 /* they've added a new field we don't know about */
 786                 error("Help!  Unknown status code %08x from backend!",
 787                       polling_status);
 788         }
 789 }
 790
 791 #ifdef MULE
 792 DEFUN("pq-client-encoding", Fpq_client_encoding, 1, 1, 0,       /*
 793 Return client coding system.
 794 */
 795       (conn))
 796 {
 797         PGconn *P;
 798
 799         CHECK_PGCONN(conn);
 800         P = (XPGCONN(conn))->pgconn;
 801         CHECK_CONNECTION_ALIVE(P);
 802
 803         return make_int(PQclientEncoding(P));
 804 }
 805
 806 DEFUN("pq-set-client-encoding", Fpq_set_client_encoding, 2, 2, 0,       /*
 807 Set client coding system.
 808 */
 809       (conn, encoding))
 810 {
 811         PGconn *P;
 812         int rc;
 813         char *c_encoding;
 814
 815         CHECK_PGCONN(conn);
 816         CHECK_STRING(encoding);
 817
 818         P = (XPGCONN(conn))->pgconn;
 819         CHECK_CONNECTION_ALIVE(P);
 820
 821         TO_EXTERNAL_FORMAT(LISP_STRING, encoding,
 822                            C_STRING_ALLOCA, c_encoding, Qnative);
 823
 824         if ((rc = PQsetClientEncoding(P, c_encoding)) < 0)
 825                 error("bad encoding");
 826         else
 827                 return make_int(rc);
 828 }
 829
 830 #endif
 831 #endif                          /* HAVE_POSTGRESQLV7 */
 832
 833 /* PQfinish Close the connection to the backend. Also frees memory
 834        used by the PGconn object.
 835 void PQfinish(PGconn *conn)
 836 */
 837 DEFUN("pq-finish", Fpq_finish, 1, 1, 0, /*
 838 Close the connection to the backend.
 839 */
 840       (conn))
 841 {
 842         PGconn *P;
 843
 844         CHECK_PGCONN(conn);
 845         P = (XPGCONN(conn))->pgconn;
 846         PUKE_IF_NULL(P);
 847
 848         PQfinish(P);
 849         /* #### PQfinish deallocates the PGconn structure, so we now have a
 850            dangling pointer. */
 851         /* Genocided all @'s ... */
 852         (XPGCONN(conn))->pgconn = (PGconn *) NULL;      /* You feel DEAD inside */
 853         return Qnil;
 854 }
 855
 856 DEFUN("pq-clear", Fpq_clear, 1, 1, 0,   /*
 857 Forcibly erase a PGresult object.
 858 */
 859       (res))
 860 {
 861         PGresult *R;
 862
 863         CHECK_PGRESULT(res);
 864         R = (XPGRESULT(res))->pgresult;
 865         PUKE_IF_NULL(R);
 866
 867         PQclear(R);
 868         /* Genocided all @'s ... */
 869         (XPGRESULT(res))->pgresult = (PGresult *) NULL; /* You feel DEAD inside */
 870
 871         return Qnil;
 872 }
 873
 874 DEFUN("pq-is-busy", Fpq_is_busy, 1, 1, 0,       /*
 875 Return t if PQgetResult would block waiting for input.
 876 */
 877       (conn))
 878 {
 879         PGconn *P;
 880
 881         CHECK_PGCONN(conn);
 882         P = (XPGCONN(conn))->pgconn;
 883         CHECK_CONNECTION_ALIVE(P);
 884
 885         return PQisBusy(P) ? Qt : Qnil;
 886 }
 887
 888 DEFUN("pq-consume-input", Fpq_consume_input, 1, 1, 0,   /*
 889 Consume any available input from the backend.
 890 Returns nil if something bad happened.
 891 */
 892       (conn))
 893 {
 894         PGconn *P;
 895
 896         CHECK_PGCONN(conn);
 897         P = (XPGCONN(conn))->pgconn;
 898         CHECK_CONNECTION_ALIVE(P);
 899
 900         return PQconsumeInput(P) ? Qt : Qnil;
 901 }
 902
 903 /* PQreset Reset the communication port with the backend.
 904 void PQreset(PGconn *conn)
 905 */
 906 DEFUN("pq-reset", Fpq_reset, 1, 1, 0,   /*
 907 Reset the connection to the backend.
 908 This function will close the connection to the backend and attempt to
 909 reestablish a new connection to the same postmaster, using all the same
 910 parameters previously used.  This may be useful for error recovery if a
 911 working connection is lost.
 912 */
 913       (conn))
 914 {
 915         PGconn *P;
 916
 917         CHECK_PGCONN(conn);
 918         P = (XPGCONN(conn))->pgconn;
 919         PUKE_IF_NULL(P);
 920         /* we can resurrect a BAD connection, but not a dead one. */
 921
 922         PQreset(P);
 923
 924         return Qnil;
 925 }
 926
 927 #ifdef HAVE_POSTGRESQLV7
 928 DEFUN("pq-reset-start", Fpq_reset_start, 1, 1, 0,       /*
 929 Reset connection to the backend asynchronously.
 930 */
 931       (conn))
 932 {
 933         PGconn *P;
 934
 935         CHECK_PGCONN(conn);
 936         P = (XPGCONN(conn))->pgconn;
 937         CHECK_CONNECTION_ALIVE(P);
 938
 939         if (PQresetStart(P))
 940                 return Qt;
 941         {
 942                 char *e = PQerrorMessage(P);
 943                 error("libpq: %s", e);
 944         }
 945 }
 946
 947 DEFUN("pq-reset-poll", Fpq_reset_poll, 1, 1, 0, /*
 948 Poll an asynchronous reset for completion.
 949 */
 950       (conn))
 951 {
 952         PGconn *P;
 953         PostgresPollingStatusType polling_status;
 954
 955         CHECK_PGCONN(conn);
 956
 957         P = (XPGCONN(conn))->pgconn;
 958         CHECK_CONNECTION_ELIGIBLE(P);
 959
 960         polling_status = PQresetPoll(P);
 961         switch (polling_status) {
 962         case PGRES_POLLING_FAILED:
 963                 /* Something Bad has happened */
 964                 {
 965                         char *e = PQerrorMessage(P);
 966                         error("libpq: %s", e);
 967                 }
 968         case PGRES_POLLING_OK:
 969                 return Q_pgres_polling_ok;
 970         case PGRES_POLLING_READING:
 971                 return Q_pgres_polling_reading;
 972         case PGRES_POLLING_WRITING:
 973                 return Q_pgres_polling_writing;
 974         case PGRES_POLLING_ACTIVE:
 975                 return Q_pgres_polling_active;
 976         default:
 977                 /* they've added a new field we don't know about */
 978                 error("Help!  Unknown status code %08x from backend!",
 979                       polling_status);
 980         }
 981 }
 982 #endif
 983
 984 DEFUN("pq-request-cancel", Fpq_request_cancel, 1, 1, 0, /*
 985 Attempt to request cancellation of the current operation.
 986
 987 The return value is t if the cancel request was successfully
 988 dispatched, nil if not (in which case conn->errorMessage is set).
 989 Note: successful dispatch is no guarantee that there will be any effect at
 990 the backend.  The application must read the operation result as usual.
 991 */
 992       (conn))
 993 {
 994         PGconn *P;
 995
 996         CHECK_PGCONN(conn);
 997         P = (XPGCONN(conn))->pgconn;
 998         CHECK_CONNECTION_ALIVE(P);
 999
1000         return PQrequestCancel(P) ? Qt : Qnil;
1001 }
1002
1003 /* accessor function for the PGconn object */
1004 DEFUN("pq-connection-status", Fpq_connection_status, 2, 2, 0,   /*
1005 Accessor function for the PGconn object.
1006 Currently recognized symbols for the field:
1007 :pq-db                  Database name
1008 :pq-user                Database user name
1009 :pq-pass                Database user's password
1010 :pq-host                Hostname of PostgreSQL backend connected to
1011 :pq-port                TCP port number of connection
1012 :pq-tty                 Debugging TTY (not used in Emacs)
1013 :pq-options             Additional backend options
1014 :pq-status              Connection status (either OK or BAD)
1015 :pq-transaction-status  Current in-transaction status of the server
1016 :pq-parameter-status    Current parameter setting of the server
1017 :pq-protocol-version    Frontend/Backend protocol
1018 :pq-server-version      Integer representing the backend version
1019 :pq-error-message       Last error message from the backend
1020 :pq-backend-pid         Process ID of backend process
1021 :pq-getssl              SSL session used in the connection
1022 */
1023       (conn, field))
1024 {
1025         PGconn *P;
1026
1027         CHECK_PGCONN(conn);
1028         P = (XPGCONN(conn))->pgconn;
1029         PUKE_IF_NULL(P);        /* BAD connections still have state to query */
1030
1031         if (EQ(field, Q_pq_db)) {
1032                 /* PQdb Returns the database name of the connection.
1033                    char *PQdb(PGconn *conn)
1034                  */
1035                 return build_ext_string(PQdb(P), PG_OS_CODING);
1036         } else if (EQ(field, Q_pq_user)) {
1037                 /* PQuser Returns the user name of the connection.
1038                    char *PQuser(PGconn *conn)
1039                  */
1040                 return build_ext_string(PQuser(P), PG_OS_CODING);
1041         } else if (EQ(field, Q_pq_pass)) {
1042                 /* PQpass Returns the password of the connection.
1043                    char *PQpass(PGconn *conn)
1044                  */
1045                 return build_ext_string(PQpass(P), PG_OS_CODING);
1046         } else if (EQ(field, Q_pq_host)) {
1047                 /* PQhost Returns the server host name of the connection.
1048                    char *PQhost(PGconn *conn)
1049                  */
1050                 return build_ext_string(PQhost(P), PG_OS_CODING);
1051         } else if (EQ(field, Q_pq_port)) {
1052                 char *p;
1053                 /* PQport Returns the port of the connection.
1054                    char *PQport(PGconn *conn)
1055                  */
1056                 if ((p = PQport(P)))
1057                         return make_int(atoi(p));
1058                 else
1059                         return make_int(-1);
1060         } else if (EQ(field, Q_pq_tty)) {
1061                 /* PQtty Returns the debug tty of the connection.
1062                    char *PQtty(PGconn *conn)
1063                  */
1064                 return build_ext_string(PQtty(P), PG_OS_CODING);
1065         } else if (EQ(field, Q_pq_options)) {
1066                 /* PQoptions Returns the backend options used in the connection.
1067                    char *PQoptions(PGconn *conn)
1068                  */
1069                 return build_ext_string(PQoptions(P), PG_OS_CODING);
1070         } else if (EQ(field, Q_pq_status)) {
1071                 ConnStatusType cst;
1072                 /* PQstatus Returns the status of the connection. The status can be
1073                    CONNECTION_OK or CONNECTION_BAD.
1074                    ConnStatusType PQstatus(PGconn *conn)
1075                  */
1076                 switch ((cst = PQstatus(P))) {
1077                 case CONNECTION_OK:
1078                         return Q_pg_connection_ok;
1079                 case CONNECTION_BAD:
1080                         return Q_pg_connection_bad;
1081 #ifdef HAVE_POSTGRESQLV7
1082                 case CONNECTION_STARTED:
1083                         return Q_pg_connection_started;
1084                 case CONNECTION_MADE:
1085                         return Q_pg_connection_made;
1086                 case CONNECTION_AWAITING_RESPONSE:
1087                         return Q_pg_connection_awaiting_response;
1088                 case CONNECTION_AUTH_OK:
1089                         return Q_pg_connection_auth_ok;
1090                 case CONNECTION_SETENV:
1091                         return Q_pg_connection_setenv;
1092 #endif                          /* HAVE_POSTGRESQLV7 */
1093                 default:
1094                         /* they've added a new field we don't know about */
1095                         error("Help!  Unknown connection status code %08x "
1096                               "from backend!",
1097                               cst);
1098                 }
1099         } else if (EQ(field, Q_pq_transaction_status)) {
1100                 PGTransactionStatusType ts;
1101                 switch ((ts = PQtransactionStatus(P))) {
1102                 case PQTRANS_IDLE:
1103                         return Q_pg_trans_idle;
1104                 case PQTRANS_ACTIVE:
1105                         return Q_pg_trans_active;
1106                 case PQTRANS_INTRANS:
1107                         return Q_pg_trans_intrans;
1108                 case PQTRANS_INERROR:
1109                         return Q_pg_trans_inerror;
1110                 case PQTRANS_UNKNOWN:
1111                         return Q_pg_trans_unknown;
1112                 default:
1113                         /* they've added a new field we don't know about */
1114                         error("Help!  Unknown transaction status code %08x "
1115                               "from backend!",
1116                               ts);
1117                 }
1118         } else if (EQ(field, Q_pq_parameter_status)) {
1119                 return Qnil;
1120         } else if (EQ(field, Q_pq_protocol_version)) {
1121                 return make_int(PQprotocolVersion(P));
1122 #if HAVE_PQSERVERVERSION
1123         } else if (EQ(field, Q_pq_server_version)) {
1124                 return make_int(PQserverVersion(P));
1125 #else
1126         } else if (EQ(field, Q_pq_server_version)) {
1127                 char *vstr = xstrdup(PQparameterStatus(P,"server_version"));
1128                 char *tmp, previous;
1129                 int major, minor, patch;
1130
1131                 if ( vstr == NULL )
1132                         return Qnil;
1133                 tmp = strtok(vstr,".");
1134                 major = atoi(tmp);
1135                 tmp = strtok(NULL,".");
1136                 minor = atoi(tmp);
1137                 tmp = strtok(NULL,".");
1138                 patch = atoi(tmp);
1139                 xfree(vstr);
1140                 return make_int(major*10000+minor*100+patch);
1141 #endif
1142         } else if (EQ(field, Q_pq_error_message)) {
1143                 /* PQerrorMessage Returns the error message most recently
1144                  * generated by an operation on the connection.
1145                  * char *PQerrorMessage(PGconn* conn);
1146                  */
1147                 return build_ext_string(PQerrorMessage(P), PG_OS_CODING);
1148         } else if (EQ(field, Q_pq_backend_pid)) {
1149                 /* PQbackendPID Returns the process ID of the backend server
1150                  * handling this connection.
1151                  * int PQbackendPID(PGconn *conn);
1152                  */
1153                 return make_int(PQbackendPID(P));
1154 #ifdef HAVE_OPENSSL
1155         } else if (EQ(field, Q_pq_getssl)) {
1156                 /* PQgetssl Returns the SSL structure used in the connection,
1157                  * or NULL if SSL is not in use.
1158                  * SSL *PQgetssl(PGconn *conn);
1159                  */
1160                 SSL *ssl_conn;
1161                 ssl_conn = (SSL*)PQgetssl(P);
1162                 if (ssl_conn == NULL)
1163                         return Qnil; /* meaning: no SSL in use */
1164                 else {
1165                         Lisp_SSL_CONN *pqssl = allocate_ssl_conn();
1166                         pqssl->ssl_conn = ssl_conn;
1167                         pqssl->parent = conn;
1168                         pqssl->protected_p = 1;
1169                         return make_ssl_conn(pqssl);
1170                         /* Should we use a copy of the SSL session here?
1171                          * Otherwise it's safe to obtain a nice segfault by:
1172                          *   (setq m (pq-pgconn foo \'pq::getssl))
1173                          *   (setq m \'something-else)
1174                          *   M-x garbage-collect RET
1175                          *   (pq-send-query foo ...)
1176                          * You will see SXE dump in ssl*_write or the like
1177                          * since the _original_ session handle has been gc'd
1178                          *
1179                          * Nah, _for the moment_ I assume our users to be
1180                          * smart enough to rethink twice before they do
1181                          * something like this.
1182                          */
1183                 }
1184 #endif
1185         }
1186
1187         /* else */
1188         message("bad PGconn accessor");
1189         return Qnil;
1190 }
1191
1192 DEFUN("pq-connection-alive-p", Fpq_connection_alive_p, 1, 1, 0, /*
1193 Return non-nil when CONN is considered alive.
1194
1195 This is roughly the same as calling (pq-connection-status CONN :status)
1196 */
1197       (conn))
1198 {
1199         PGconn *P;
1200
1201         CHECK_PGCONN(conn);
1202
1203         P = (XPGCONN(conn))->pgconn;
1204
1205         if (PQstatus(P) == CONNECTION_OK) {
1206                 return Qt;
1207         }
1208         return Qnil;
1209 }
1210
1211 DEFUN("pq-connection-p", Fpq_connection_p, 1, 1, 0, /*
1212 Return non-nil if OBJECT is a pq connection object.
1213 */
1214       (object))
1215 {
1216         return PGCONNP(object) ? Qt : Qnil;
1217 }
1218
1219 /* Query functions */
1220 DEFUN("pq-exec", Fpq_exec, 2, 2, 0,     /*
1221 Submit a query to Postgres and wait for the result.
1222 */
1223       (conn, query))
1224 {
1225         PGconn *P;
1226         Lisp_PGresult *lisp_pgresult;
1227         PGresult *R;
1228         char *c_query;
1229
1230         CHECK_PGCONN(conn);
1231         CHECK_STRING(query);
1232
1233         P = (XPGCONN(conn))->pgconn;
1234         CHECK_CONNECTION_ALIVE(P);
1235
1236         TO_EXTERNAL_FORMAT(LISP_STRING, query,
1237                            C_STRING_ALLOCA, c_query, Qnative);
1238
1239         R = PQexec(P, c_query);
1240         {
1241                 char *tag, buf[BLCKSZ];
1242
1243                 if (!R)
1244                         error("query: out of memory");
1245                 else
1246                         switch (PQresultStatus(R)) {
1247                         case PGRES_BAD_RESPONSE:
1248                                 tag = "bad response [%s]";
1249                                 goto err;
1250                         case PGRES_NONFATAL_ERROR:
1251                                 tag = "non-fatal error [%s]";
1252                                 goto err;
1253                         case PGRES_FATAL_ERROR:
1254                                 tag = "fatal error [%s]";
1255                               err:
1256                                 strncpy(buf, PQresultErrorMessage(R),
1257                                         sizeof(buf));
1258                                 buf[sizeof(buf) - 1] = '\0';
1259                                 PQclear(R);
1260                                 error(tag, buf);
1261                          /*NOTREACHED*/ default:
1262                                 break;
1263                         }
1264         }
1265
1266         lisp_pgresult = allocate_pgresult();
1267         lisp_pgresult->pgresult = R;
1268
1269         return make_pgresult(lisp_pgresult);
1270 }
1271
1272 DEFUN("pq-send-query", Fpq_send_query, 2, 2, 0, /*
1273 Submit a query to Postgres and don't wait for the result.
1274 Returns: t if successfully submitted
1275 nil if error (conn->errorMessage is set)
1276 */
1277       (conn, query))
1278 {
1279         PGconn *P;
1280         char *c_query;
1281
1282         CHECK_PGCONN(conn);
1283         CHECK_STRING(query);
1284
1285         P = (XPGCONN(conn))->pgconn;
1286         CHECK_CONNECTION_ALIVE(P);
1287
1288         TO_EXTERNAL_FORMAT(LISP_STRING, query,
1289                            C_STRING_ALLOCA, c_query, Qnative);
1290
1291         if (PQsendQuery(P, c_query))
1292                 return Qt;
1293         else
1294                 error("async query: %s", PQerrorMessage(P));
1295 }
1296
1297 DEFUN("pq-result-p", Fpq_result_p, 1, 1, 0, /*
1298 Return non-nil if OBJECT is a pq query result object.
1299 */
1300       (object))
1301 {
1302         return PGRESULTP(object) ? Qt : Qnil;
1303 }
1304
1305 DEFUN("pq-get-result", Fpq_get_result, 1, 1, 0, /*
1306 Retrieve an asynchronous result from a query.
1307 NIL is returned when no more query work remains.
1308 */
1309       (conn))
1310 {
1311         PGconn *P;
1312         Lisp_PGresult *lisp_pgresult;
1313         PGresult *R;
1314
1315         CHECK_PGCONN(conn);
1316
1317         P = (XPGCONN(conn))->pgconn;
1318         CHECK_CONNECTION_ALIVE(P);
1319
1320         R = PQgetResult(P);
1321         if (!R)
1322                 return Qnil;    /* not an error, there's no more data to get */
1323
1324         {
1325                 char *tag, buf[BLCKSZ];
1326
1327                 switch (PQresultStatus(R)) {
1328                 case PGRES_BAD_RESPONSE:
1329                         tag = "bad response [%s]";
1330                         goto err;
1331                 case PGRES_NONFATAL_ERROR:
1332                         tag = "non-fatal error [%s]";
1333                         goto err;
1334                 case PGRES_FATAL_ERROR:
1335                         tag = "fatal error [%s]";
1336                       err:
1337                         strncpy(buf, PQresultErrorMessage(R), sizeof(buf));
1338                         buf[sizeof(buf) - 1] = '\0';
1339                         PQclear(R);
1340                         error(tag, buf);
1341                  /*NOTREACHED*/ default:
1342                         break;
1343                 }
1344         }
1345
1346         lisp_pgresult = allocate_pgresult();
1347         lisp_pgresult->pgresult = R;
1348
1349         return make_pgresult(lisp_pgresult);
1350 }
1351
1352 DEFUN("pq-result-status", Fpq_result_status, 1, 1, 0,   /*
1353 Return result status of the query.
1354 */
1355       (result))
1356 {
1357         PGresult *R;
1358         ExecStatusType est;
1359
1360         CHECK_PGRESULT(result);
1361         R = (XPGRESULT(result))->pgresult;
1362         PUKE_IF_NULL(R);
1363
1364         switch ((est = PQresultStatus(R))) {
1365         case PGRES_EMPTY_QUERY:
1366                 return Q_pgres_empty_query;
1367         case PGRES_COMMAND_OK:
1368                 return Q_pgres_command_ok;
1369         case PGRES_TUPLES_OK:
1370                 return Q_pgres_tuples_ok;
1371         case PGRES_COPY_OUT:
1372                 return Q_pgres_copy_out;
1373         case PGRES_COPY_IN:
1374                 return Q_pgres_copy_in;
1375         case PGRES_BAD_RESPONSE:
1376                 return Q_pgres_bad_response;
1377         case PGRES_NONFATAL_ERROR:
1378                 return Q_pgres_nonfatal_error;
1379         case PGRES_FATAL_ERROR:
1380                 return Q_pgres_fatal_error;
1381         default:
1382                 /* they've added a new field we don't know about */
1383                 error("Help!  Unknown exec status code %08x from backend!",
1384                       est);
1385         }
1386 }
1387
1388 DEFUN("pq-result-status-string", Fpq_result_status_string, 1, 1, 0,     /*
1389 Return stringified result status of the query.
1390 */
1391       (result))
1392 {
1393         PGresult *R;
1394
1395         CHECK_PGRESULT(result);
1396         R = (XPGRESULT(result))->pgresult;
1397         PUKE_IF_NULL(R);
1398
1399         return build_ext_string(PQresStatus(PQresultStatus(R)), PG_OS_CODING);
1400 }
1401
1402 /* Sundry PGresult accessor functions */
1403 DEFUN("pq-result-error-message", Fpq_result_error_message, 1, 1, 0,     /*
1404 Return last message associated with the query.
1405 */
1406       (result))
1407 {
1408         PGresult *R;
1409
1410         CHECK_PGRESULT(result);
1411         R = (XPGRESULT(result))->pgresult;
1412         PUKE_IF_NULL(R);
1413
1414         return build_ext_string(PQresultErrorMessage(R), PG_OS_CODING);
1415 }
1416
1417 DEFUN("pq-ntuples", Fpq_ntuples, 1, 1, 0,       /*
1418 Return the number of tuples (instances) in the query result.
1419 */
1420       (result))
1421 {
1422         PGresult *R;
1423
1424         CHECK_PGRESULT(result);
1425         R = (XPGRESULT(result))->pgresult;
1426         PUKE_IF_NULL(R);
1427
1428         return make_int(PQntuples(R));
1429 }
1430
1431 DEFUN("pq-nfields", Fpq_nfields, 1, 1, 0,       /*
1432 Return the number of fields (attributes) in each tuple of the query result.
1433 */
1434       (result))
1435 {
1436         PGresult *R;
1437
1438         CHECK_PGRESULT(result);
1439         R = (XPGRESULT(result))->pgresult;
1440         PUKE_IF_NULL(R);
1441
1442         return make_int(PQnfields(R));
1443 }
1444
1445 DEFUN("pq-binary-tuples", Fpq_binary_tuples, 1, 1, 0,   /*
1446 Return t if the query result contains binary data, nil otherwise.
1447 */
1448       (result))
1449 {
1450         PGresult *R;
1451
1452         CHECK_PGRESULT(result);
1453         R = (XPGRESULT(result))->pgresult;
1454         PUKE_IF_NULL(R);
1455
1456         return (PQbinaryTuples(R)) ? Qt : Qnil;
1457 }
1458
1459 DEFUN("pq-fname", Fpq_fname, 2, 2, 0,   /*
1460 Return the field (attribute) name associated with the given field index.
1461 Field indices start at 0.
1462 */
1463       (result, field_index))
1464 {
1465         PGresult *R;
1466
1467         CHECK_PGRESULT(result);
1468         CHECK_INT(field_index);
1469         R = (XPGRESULT(result))->pgresult;
1470         PUKE_IF_NULL(R);
1471
1472         return build_ext_string(PQfname(R, XINT(field_index)), PG_OS_CODING);
1473 }
1474
1475 DEFUN("pq-fnumber", Fpq_fnumber, 2, 2, 0,       /*
1476 Return the number of fields (attributes) in each tuple of the query result.
1477 */
1478       (result, field_name))
1479 {
1480         PGresult *R;
1481         char *c_field_name;
1482
1483         CHECK_PGRESULT(result);
1484         CHECK_STRING(field_name);
1485         R = (XPGRESULT(result))->pgresult;
1486         PUKE_IF_NULL(R);
1487
1488         TO_EXTERNAL_FORMAT(LISP_STRING, field_name,
1489                            C_STRING_ALLOCA, c_field_name, Qnative);
1490
1491         return make_int(PQfnumber(R, c_field_name));
1492 }
1493
1494 DEFUN("pq-ftype", Fpq_ftype, 2, 2, 0,   /*
1495 Return the field type associated with the given field index.
1496 The integer returned is the internal coding of the type.  Field indices
1497 start at 0.
1498 */
1499       (result, field_num))
1500 {
1501         PGresult *R;
1502
1503         CHECK_PGRESULT(result);
1504         CHECK_INT(field_num);
1505         R = (XPGRESULT(result))->pgresult;
1506         PUKE_IF_NULL(R);
1507
1508         return make_int(PQftype(R, XINT(field_num)));
1509 }
1510
1511 DEFUN("pq-fsize", Fpq_fsize, 2, 2, 0,   /*
1512 Return the field size in bytes associated with the given field index.
1513 Field indices start at 0.
1514 */
1515       (result, field_index))
1516 {
1517         PGresult *R;
1518
1519         CHECK_PGRESULT(result);
1520         CHECK_INT(field_index);
1521         R = (XPGRESULT(result))->pgresult;
1522         PUKE_IF_NULL(R);
1523
1524         return make_int(PQftype(R, XINT(field_index)));
1525 }
1526
1527 DEFUN("pq-fmod", Fpq_fmod, 2, 2, 0,     /*
1528 Return the type modifier associated with a field.
1529 Field indices start at 0.
1530 */
1531       (result, field_index))
1532 {
1533         PGresult *R;
1534
1535         CHECK_PGRESULT(result);
1536         CHECK_INT(field_index);
1537         R = (XPGRESULT(result))->pgresult;
1538         PUKE_IF_NULL(R);
1539
1540         return make_int(PQfmod(R, XINT(field_index)));
1541 }
1542
1543 DEFUN("pq-get-value", Fpq_get_value, 3, 3, 0,   /*
1544 Return a single field (attribute) value of one tuple of a PGresult.
1545 Tuple and field indices start at 0.
1546 */
1547       (result, tup_num, field_num))
1548 {
1549         PGresult *R;
1550
1551         CHECK_PGRESULT(result);
1552         CHECK_INT(tup_num);
1553         CHECK_INT(field_num);
1554         R = (XPGRESULT(result))->pgresult;
1555         PUKE_IF_NULL(R);
1556
1557         return build_ext_string(PQgetvalue(R, XINT(tup_num), XINT(field_num)),
1558                                 PG_OS_CODING);
1559 }
1560
1561 DEFUN("pq-get-length", Fpq_get_length, 3, 3, 0, /*
1562 Returns the length of a field value in bytes.
1563 If result is binary, i.e. a result of a binary portal, then the
1564 length returned does NOT include the size field of the varlena.  (The
1565 data returned by PQgetvalue doesn't either.)
1566 */
1567       (result, tup_num, field_num))
1568 {
1569         PGresult *R;
1570
1571         CHECK_PGRESULT(result);
1572         CHECK_INT(tup_num);
1573         CHECK_INT(field_num);
1574         R = (XPGRESULT(result))->pgresult;
1575         PUKE_IF_NULL(R);
1576
1577         return make_int(PQgetlength(R, XINT(tup_num), XINT(field_num)));
1578 }
1579
1580 DEFUN("pq-get-is-null", Fpq_get_is_null, 3, 3, 0,       /*
1581 Returns the null status of a field value.
1582 */
1583       (result, tup_num, field_num))
1584 {
1585         PGresult *R;
1586
1587         CHECK_PGRESULT(result);
1588         CHECK_INT(tup_num);
1589         CHECK_INT(field_num);
1590         R = (XPGRESULT(result))->pgresult;
1591         PUKE_IF_NULL(R);
1592
1593         return PQgetisnull(R, XINT(tup_num), XINT(field_num)) ? Qt : Qnil;
1594 }
1595
1596 DEFUN("pq-cmd-status", Fpq_cmd_status, 1, 1, 0, /*
1597 Returns the command status string from the SQL command that generated the result.
1598 */
1599       (result))
1600 {
1601         PGresult *R;
1602
1603         CHECK_PGRESULT(result);
1604         R = (XPGRESULT(result))->pgresult;
1605         PUKE_IF_NULL(R);
1606
1607         return build_ext_string(PQcmdStatus(R), PG_OS_CODING);
1608 }
1609
1610 DEFUN("pq-cmd-tuples", Fpq_cmd_tuples, 1, 1, 0, /*
1611 Returns the number of rows affected by the SQL command.
1612 */
1613       (result))
1614 {
1615         PGresult *R;
1616
1617         CHECK_PGRESULT(result);
1618         R = (XPGRESULT(result))->pgresult;
1619         PUKE_IF_NULL(R);
1620
1621         return build_ext_string(PQcmdTuples(R), PG_OS_CODING);
1622 }
1623
1624 DEFUN("pq-oid-value", Fpq_oid_value, 1, 1, 0,   /*
1625 Returns the object id of the tuple inserted.
1626 */
1627       (result))
1628 {
1629         PGresult *R;
1630
1631         CHECK_PGRESULT(result);
1632         R = (XPGRESULT(result))->pgresult;
1633         PUKE_IF_NULL(R);
1634
1635 #ifdef HAVE_POSTGRESQLV7
1636         return make_int(PQoidValue(R));
1637 #else
1638         /* Use the old interface */
1639         return make_int(atoi(PQoidStatus(R)));
1640 #endif
1641 }
1642
1643 #ifdef HAVE_POSTGRESQLV7
1644 DEFUN("pq-set-nonblocking", Fpq_set_nonblocking, 2, 2, 0,       /*
1645 Sets the PGconn's database connection non-blocking if the arg is TRUE
1646 or makes it non-blocking if the arg is FALSE, this will not protect
1647 you from PQexec(), you'll only be safe when using the non-blocking API.
1648
1649 Needs to be called only on a connected database connection.
1650 */
1651       (conn, arg))
1652 {
1653         PGconn *P;
1654
1655         CHECK_PGCONN(conn);
1656         P = (XPGCONN(conn))->pgconn;
1657         CHECK_CONNECTION_ALIVE(P);
1658
1659         return make_int(PQsetnonblocking(P, !NILP(arg)));
1660 }
1661
1662 DEFUN("pq-is-nonblocking", Fpq_is_nonblocking, 1, 1, 0, /*
1663 Return the blocking status of the database connection.
1664 */
1665       (conn))
1666 {
1667         PGconn *P;
1668
1669         CHECK_PGCONN(conn);
1670         P = (XPGCONN(conn))->pgconn;
1671         CHECK_CONNECTION_ALIVE(P);
1672
1673         return PQisnonblocking(P) ? Qt : Qnil;
1674 }
1675
1676 DEFUN("pq-flush", Fpq_flush, 1, 1, 0,   /*
1677 Force the write buffer to be written (or at least try).
1678 */
1679       (conn))
1680 {
1681         PGconn *P;
1682
1683         CHECK_PGCONN(conn);
1684         P = (XPGCONN(conn))->pgconn;
1685         CHECK_CONNECTION_ALIVE(P);
1686
1687         return make_int(PQflush(P));
1688 }
1689 #endif
1690
1691 DEFUN("pq-notifies", Fpq_notifies, 1, 1, 0,     /*
1692 Return the latest async notification that has not yet been handled.
1693 If there has been a notification, then a list of two elements will be returned.
1694 The first element contains the relation name being notified, the second
1695 element contains the backend process ID number.  nil is returned if there
1696 aren't any notifications to process.
1697 */
1698       (conn))
1699 {
1700         /* This function cannot GC */
1701         PGconn *P;
1702         PGnotify *PGN;
1703
1704         CHECK_PGCONN(conn);
1705         P = (XPGCONN(conn))->pgconn;
1706         CHECK_CONNECTION_ALIVE(P);
1707
1708         PGN = PQnotifies(P);
1709         if (!PGN)
1710                 return Qnil;
1711         else {
1712                 Lisp_Object temp;
1713
1714                 temp = list2(build_ext_string(PGN->relname, PG_OS_CODING),
1715                              make_int(PGN->be_pid));
1716                 xfree(PGN);
1717                 return temp;
1718         }
1719 }
1720
1721 #if defined (HAVE_POSTGRESQLV7) && defined(MULE)
1722 DEFUN("pq-env-2-encoding", Fpq_env_2_encoding, 0, 0, 0, /*
1723 Get encoding id from environment variable PGCLIENTENCODING.
1724 */
1725       ())
1726 {
1727         return make_int(PQenv2encoding());
1728 }
1729 #endif                          /* MULE */
1730
1731 DEFUN("pq-lo-import", Fpq_lo_import, 2, 2, 0,   /*
1732 */
1733       (conn, filename))
1734 {
1735         PGconn *P;
1736         char *c_filename;
1737
1738         CHECK_PGCONN(conn);
1739         CHECK_STRING(filename);
1740
1741         P = (XPGCONN(conn))->pgconn;
1742         CHECK_CONNECTION_ALIVE(P);
1743
1744         TO_EXTERNAL_FORMAT(LISP_STRING, filename,
1745                            C_STRING_ALLOCA, c_filename, Qfile_name);
1746
1747         return make_int((int)lo_import(P, c_filename));
1748 }
1749
1750 DEFUN("pq-lo-export", Fpq_lo_export, 3, 3, 0,   /*
1751 */
1752       (conn, oid, filename))
1753 {
1754         PGconn *P;
1755         char *c_filename;
1756
1757         CHECK_PGCONN(conn);
1758         CHECK_INT(oid);
1759         CHECK_STRING(filename);
1760
1761         P = (XPGCONN(conn))->pgconn;
1762         CHECK_CONNECTION_ALIVE(P);
1763
1764         TO_EXTERNAL_FORMAT(LISP_STRING, filename,
1765                            C_STRING_ALLOCA, c_filename, Qfile_name);
1766
1767         return make_int((int)lo_export(P, XINT(oid), c_filename));
1768 }
1769
1770 DEFUN("pq-make-empty-pgresult", Fpq_make_empty_pgresult, 2, 2, 0,       /*
1771 Make an empty PGresult object with the given status.
1772 */
1773       (conn, status))
1774 {
1775         PGconn *P;
1776         Lisp_PGresult *lpgr;
1777         PGresult *R;
1778         ExecStatusType est;
1779
1780         CHECK_PGCONN(conn);
1781         P = (XPGCONN(conn))->pgconn;
1782         CHECK_CONNECTION_ALIVE(P);      /* needed here? */
1783
1784         if (EQ(status, Q_pgres_empty_query))
1785                 est = PGRES_EMPTY_QUERY;
1786         else if (EQ(status, Q_pgres_command_ok))
1787                 est = PGRES_COMMAND_OK;
1788         else if (EQ(status, Q_pgres_tuples_ok))
1789                 est = PGRES_TUPLES_OK;
1790         else if (EQ(status, Q_pgres_copy_out))
1791                 est = PGRES_COPY_OUT;
1792         else if (EQ(status, Q_pgres_copy_in))
1793                 est = PGRES_COPY_IN;
1794         else if (EQ(status, Q_pgres_bad_response))
1795                 est = PGRES_BAD_RESPONSE;
1796         else if (EQ(status, Q_pgres_nonfatal_error))
1797                 est = PGRES_NONFATAL_ERROR;
1798         else if (EQ(status, Q_pgres_fatal_error))
1799                 est = PGRES_FATAL_ERROR;
1800         else
1801                 signal_simple_error("bad status symbol", status);
1802
1803         R = PQmakeEmptyPGresult(P, est);
1804         if (!R)
1805                 error("out of memory?");
1806
1807         lpgr = allocate_pgresult();
1808         lpgr->pgresult = R;
1809
1810         return make_pgresult(lpgr);
1811 }
1812
1813 #ifdef HAVE_POSTGRESQLV7
1814 /* actually I don't know when this made its way to libpq
1815  * I just assume 7.4 here
1816  * Bite me, if that's wrong ;P
1817  */
1818 DEFUN("pq-escape-string", Fpq_escape_string, 1, 1, 0, /*
1819 Return an SQL-suited escaped version of STRING.
1820 */
1821       (string))
1822 {
1823         char *result;
1824         int result_len;
1825         /* buffers for our args */
1826         char *string_ext;
1827         int string_len;
1828
1829         TO_EXTERNAL_FORMAT(LISP_STRING, string,
1830                            C_STRING_ALLOCA, string_ext, PG_OS_CODING);
1831         string_len = (int)XSTRING_CHAR_LENGTH(string);
1832
1833         result = (char *)xmalloc_atomic(4*XSTRING_LENGTH(string));
1834
1835         result_len = PQescapeString(result, string_ext, string_len);
1836
1837         return make_ext_string(result, result_len, PG_OS_CODING);
1838 }
1839
1840 DEFUN("pq-escape-bytea", Fpq_escape_bytea, 1, 1, 0, /*
1841 Return an SQL-suited escaped version of binary DATA.
1842 */
1843       (data))
1844 {
1845         char *result;
1846         unsigned int result_len;
1847         /* buffers for our args */
1848         char *data_ext;
1849         int data_len;
1850
1851         TO_EXTERNAL_FORMAT(LISP_STRING, data,
1852                            C_STRING_ALLOCA, data_ext, PG_OS_CODING);
1853         data_len = (int)XSTRING_CHAR_LENGTH(data);
1854
1855         result = (char*)PQescapeBytea((unsigned char*)data_ext, data_len,
1856                                       &result_len);
1857
1858         if (result == NULL)
1859                 return Qnil;
1860         else
1861                 return make_ext_string(result,result_len-1,PG_OS_CODING);
1862 }
1863
1864 DEFUN("pq-unescape-bytea", Fpq_unescape_bytea, 1, 1, 0, /*
1865 Return the unescaped form of DATA (which may be binary).
1866 Such binary data may result from a BYTEA column.
1867
1868 Note: Of course, escaped SQL strings are elisp-escaped again
1869 so you may have to use `pq-unescape-bytea' twice.
1870 */
1871       (data))
1872 {
1873         char *result;
1874         unsigned int result_len;
1875         /* buffers for our args */
1876         char *data_ext;
1877
1878         TO_EXTERNAL_FORMAT(LISP_STRING, data,
1879                            C_STRING_ALLOCA, data_ext, PG_OS_CODING);
1880
1881         result = (char*)PQunescapeBytea((unsigned char*)data_ext,
1882                                         &result_len);
1883
1884         if (result == NULL)
1885                 return Qnil;
1886         else
1887                 return make_ext_string(result,result_len,PG_OS_CODING);
1888 }
1889 #endif
1890
1891 DEFUN("pq-get-line", Fpq_get_line, 1, 1, 0,     /*
1892 Retrieve a line from server in copy in operation.
1893 The return value is a dotted pair where the cons cell is an integer code:
1894 -1: Copying is complete
1895 0: A record is complete
1896 1: A record is incomplete, it will be continued in the next `pq-get-line'
1897 operation.
1898 and the cdr cell is returned string data.
1899
1900 The copy operation is complete when the value `\.' (backslash dot) is
1901 returned.
1902 */
1903       (conn))
1904 {
1905         char buffer[BLCKSZ];    /* size of a Postgres disk block */
1906         PGconn *P;
1907         int ret;
1908
1909         CHECK_PGCONN(conn);
1910         P = (XPGCONN(conn))->pgconn;
1911         CHECK_CONNECTION_ALIVE(P);
1912
1913         ret = PQgetline(P, buffer, sizeof(buffer));
1914
1915         return Fcons(make_int(ret), build_ext_string(buffer, PG_OS_CODING));
1916 }
1917
1918 DEFUN("pq-put-line", Fpq_put_line, 2, 2, 0,     /*
1919 Send a line to the server in copy out operation.
1920
1921 Returns t if the operation succeeded, nil otherwise.
1922 */
1923       (conn, string))
1924 {
1925         PGconn *P;
1926         char *c_string;
1927
1928         CHECK_PGCONN(conn);
1929         CHECK_STRING(string);
1930
1931         P = (XPGCONN(conn))->pgconn;
1932         CHECK_CONNECTION_ALIVE(P);
1933         TO_EXTERNAL_FORMAT(LISP_STRING, string,
1934                            C_STRING_ALLOCA, c_string, Qnative);
1935
1936         return !PQputline(P, c_string) ? Qt : Qnil;
1937 }
1938
1939 DEFUN("pq-get-line-async", Fpq_get_line_async, 1, 1, 0, /*
1940 Get a line from the server in copy in operation asynchronously.
1941
1942 This routine is for applications that want to do "COPY <rel> to stdout"
1943 asynchronously, that is without blocking.  Having issued the COPY command
1944 and gotten a PGRES_COPY_OUT response, the app should call PQconsumeInput
1945 and this routine until the end-of-data signal is detected.  Unlike
1946 PQgetline, this routine takes responsibility for detecting end-of-data.
1947
1948 On each call, PQgetlineAsync will return data if a complete newline-
1949 terminated data line is available in libpq's input buffer, or if the
1950 incoming data line is too long to fit in the buffer offered by the caller.
1951 Otherwise, no data is returned until the rest of the line arrives.
1952
1953 If -1 is returned, the end-of-data signal has been recognized (and removed
1954 from libpq's input buffer).  The caller *must* next call PQendcopy and
1955 then return to normal processing.
1956
1957 RETURNS:
1958 -1    if the end-of-copy-data marker has been recognized
1959 0         if no data is available
1960 >0    the number of bytes returned.
1961 The data returned will not extend beyond a newline character.  If possible
1962 a whole line will be returned at one time.  But if the buffer offered by
1963 the caller is too small to hold a line sent by the backend, then a partial
1964 data line will be returned.  This can be detected by testing whether the
1965 last returned byte is '\n' or not.
1966 The returned string is *not* null-terminated.
1967 */
1968       (conn))
1969 {
1970         PGconn *P;
1971         char buffer[BLCKSZ];
1972         int ret;
1973
1974         CHECK_PGCONN(conn);
1975
1976         P = (XPGCONN(conn))->pgconn;
1977         CHECK_CONNECTION_ALIVE(P);
1978
1979         ret = PQgetlineAsync(P, buffer, sizeof(buffer));
1980
1981         if (ret == -1)
1982                 return Qt;      /* done! */
1983         else if (!ret)
1984                 return Qnil;    /* no data yet */
1985         else
1986                 return Fcons(make_int(ret),
1987                              make_ext_string((Extbyte *) buffer, ret,
1988                                              PG_OS_CODING));
1989 }
1990
1991 DEFUN("pq-put-nbytes", Fpq_put_nbytes, 2, 2, 0, /*
1992 Asynchronous copy out.
1993 */
1994       (conn, data))
1995 {
1996         /* NULs are not allowed.  I don't think this matters at this time. */
1997         PGconn *P;
1998         char *c_data;
1999
2000         CHECK_PGCONN(conn);
2001         CHECK_STRING(data);
2002
2003         P = (XPGCONN(conn))->pgconn;
2004         CHECK_CONNECTION_ALIVE(P);
2005         TO_EXTERNAL_FORMAT(LISP_STRING, data, C_STRING_ALLOCA, c_data, Qnative);
2006
2007         return !PQputnbytes(P, c_data, strlen(c_data)) ? Qt : Qnil;
2008 }
2009
2010 DEFUN("pq-end-copy", Fpq_end_copy, 1, 1, 0,     /*
2011 End a copying operation.
2012 */
2013       (conn))
2014 {
2015         PGconn *P;
2016
2017         CHECK_PGCONN(conn);
2018         P = (XPGCONN(conn))->pgconn;
2019         CHECK_CONNECTION_ALIVE(P);
2020
2021         return PQendcopy(P) ? Qt : Qnil;
2022 }
2023
2024 \f
2025 void
2026 syms_of_postgresql(void)
2027 {
2028         INIT_LRECORD_IMPLEMENTATION(pgconn);
2029         INIT_LRECORD_IMPLEMENTATION(pgresult);
2030
2031         defsymbol(&Qpostgresql, "postgresql");
2032
2033         /* opaque exported types */
2034         defsymbol(&Qpgconnp, "pgconnp");
2035         defsymbol(&Qpgresultp, "pgresultp");
2036
2037         /* connection status types
2038          * now implemented as keywords */
2039         DEFKEYWORD(Q_pg_connection_ok);
2040         DEFKEYWORD(Q_pg_connection_bad);
2041         DEFKEYWORD(Q_pg_connection_started);
2042         DEFKEYWORD(Q_pg_connection_made);
2043         DEFKEYWORD(Q_pg_connection_awaiting_response);
2044         DEFKEYWORD(Q_pg_connection_auth_ok);
2045         DEFKEYWORD(Q_pg_connection_setenv);
2046
2047         /* transaction status types */
2048         DEFKEYWORD(Q_pg_trans_idle);
2049         DEFKEYWORD(Q_pg_trans_active);
2050         DEFKEYWORD(Q_pg_trans_intrans);
2051         DEFKEYWORD(Q_pg_trans_inerror);
2052         DEFKEYWORD(Q_pg_trans_unknown);
2053
2054         /* Fields of PGconn */
2055         DEFKEYWORD(Q_pq_db);
2056         DEFKEYWORD(Q_pq_user);
2057         DEFKEYWORD(Q_pq_pass);
2058         DEFKEYWORD(Q_pq_host);
2059         DEFKEYWORD(Q_pq_port);
2060         DEFKEYWORD(Q_pq_tty);
2061         DEFKEYWORD(Q_pq_options);
2062         DEFKEYWORD(Q_pq_status);
2063         DEFKEYWORD(Q_pq_transaction_status);
2064         DEFKEYWORD(Q_pq_parameter_status);
2065         DEFKEYWORD(Q_pq_protocol_version);
2066         DEFKEYWORD(Q_pq_server_version);
2067         DEFKEYWORD(Q_pq_error_message);
2068         DEFKEYWORD(Q_pq_backend_pid);
2069 #ifdef HAVE_OPENSSL
2070         DEFKEYWORD(Q_pq_getssl);
2071 #endif
2072
2073         /* Query status results */
2074         DEFKEYWORD(Q_pgres_empty_query);
2075         DEFKEYWORD(Q_pgres_command_ok);
2076         DEFKEYWORD(Q_pgres_tuples_ok);
2077         DEFKEYWORD(Q_pgres_copy_out);
2078         DEFKEYWORD(Q_pgres_copy_in);
2079         DEFKEYWORD(Q_pgres_bad_response);
2080         DEFKEYWORD(Q_pgres_nonfatal_error);
2081         DEFKEYWORD(Q_pgres_fatal_error);
2082
2083         /* Poll status results */
2084         DEFKEYWORD(Q_pgres_polling_failed);
2085         DEFKEYWORD(Q_pgres_polling_reading);
2086         DEFKEYWORD(Q_pgres_polling_writing);
2087         DEFKEYWORD(Q_pgres_polling_ok);
2088         DEFKEYWORD(Q_pgres_polling_active);
2089
2090 #ifdef HAVE_POSTGRESQLV7
2091         DEFSUBR(Fpq_connect_start);
2092         DEFSUBR(Fpq_connect_poll);
2093 #ifdef MULE
2094         DEFSUBR(Fpq_client_encoding);
2095         DEFSUBR(Fpq_set_client_encoding);
2096 #endif                          /* MULE */
2097 #endif                          /* HAVE_POSTGRESQLV7 */
2098         DEFSUBR(Fpq_set_notice_processor);
2099
2100         DEFSUBR(Fpq_connection_p);
2101         DEFSUBR(Fpq_conn_defaults);
2102         DEFSUBR(Fpq_connectdb);
2103         DEFSUBR(Fpq_finish);
2104         DEFSUBR(Fpq_clear);
2105         DEFSUBR(Fpq_is_busy);
2106         DEFSUBR(Fpq_consume_input);
2107
2108 #ifdef HAVE_POSTGRESQLV7
2109         DEFSUBR(Fpq_escape_string);
2110         DEFSUBR(Fpq_escape_bytea);
2111         DEFSUBR(Fpq_unescape_bytea);
2112 #endif
2113
2114         DEFSUBR(Fpq_reset);
2115 #ifdef HAVE_POSTGRESQLV7
2116         DEFSUBR(Fpq_reset_start);
2117         DEFSUBR(Fpq_reset_poll);
2118 #endif
2119         DEFSUBR(Fpq_request_cancel);
2120         DEFSUBR(Fpq_connection_status);
2121         DEFSUBR(Fpq_connection_alive_p);
2122
2123         DEFSUBR(Fpq_exec);
2124         DEFSUBR(Fpq_send_query);
2125         DEFSUBR(Fpq_result_p);
2126         DEFSUBR(Fpq_get_result);
2127         DEFSUBR(Fpq_result_status);
2128         DEFSUBR(Fpq_result_status_string);
2129         DEFSUBR(Fpq_result_error_message);
2130         DEFSUBR(Fpq_ntuples);
2131         DEFSUBR(Fpq_nfields);
2132         DEFSUBR(Fpq_binary_tuples);
2133         DEFSUBR(Fpq_fname);
2134         DEFSUBR(Fpq_fnumber);
2135         DEFSUBR(Fpq_ftype);
2136         DEFSUBR(Fpq_fsize);
2137         DEFSUBR(Fpq_fmod);
2138         /***/
2139         DEFSUBR(Fpq_get_value);
2140         DEFSUBR(Fpq_get_length);
2141         DEFSUBR(Fpq_get_is_null);
2142         DEFSUBR(Fpq_cmd_status);
2143         DEFSUBR(Fpq_cmd_tuples);
2144         DEFSUBR(Fpq_oid_value);
2145
2146 #ifdef HAVE_POSTGRESQLV7
2147         DEFSUBR(Fpq_set_nonblocking);
2148         DEFSUBR(Fpq_is_nonblocking);
2149         DEFSUBR(Fpq_flush);
2150 #endif
2151         DEFSUBR(Fpq_notifies);
2152
2153 #if defined (HAVE_POSTGRESQLV7) && defined(MULE)
2154         DEFSUBR(Fpq_env_2_encoding);
2155 #endif
2156
2157         DEFSUBR(Fpq_lo_import);
2158         DEFSUBR(Fpq_lo_export);
2159
2160         DEFSUBR(Fpq_make_empty_pgresult);
2161
2162         /* copy in/out functions */
2163         DEFSUBR(Fpq_get_line);
2164         DEFSUBR(Fpq_put_line);
2165         DEFSUBR(Fpq_get_line_async);
2166         DEFSUBR(Fpq_put_nbytes);
2167         DEFSUBR(Fpq_end_copy);
2168 }
2169
2170 void vars_of_postgresql(void)
2171 {
2172         Fprovide(Qpostgresql);
2173 #ifdef HAVE_POSTGRESQLV7
2174         Fprovide(intern("postgresqlv7"));
2175 #endif
2176         Vpg_coding_system = Qnative;
2177         DEFVAR_LISP("pg-coding-system", &Vpg_coding_system      /*
2178 Default Postgres client coding system.
2179                                                                 */ );
2180
2181         DEFVAR_LISP("pg:host", &VXPGHOST        /*
2182 Default PostgreSQL server name.
2183 If not set, the server running on the local host is used.  The
2184 initial value is set from the PGHOST environment variable.
2185                                                  */ );
2186
2187         DEFVAR_LISP("pg:user", &VXPGUSER        /*
2188 Default PostgreSQL user name.
2189 This value is used when connecting to a database for authentication.
2190 The initial value is set from the PGUSER environment variable.
2191                                                  */ );
2192
2193         DEFVAR_LISP("pg:options", &VXPGOPTIONS  /*
2194 Default PostgreSQL user name.
2195 This value is used when connecting to a database for authentication.
2196 The initial value is set from the PGUSER environment variable.
2197                                                  */ );
2198
2199         DEFVAR_LISP("pg:port", &VXPGPORT        /*
2200 Default port to connect to PostgreSQL backend.
2201 This value is used when connecting to a database.
2202 The initial value is set from the PGPORT environment variable.
2203                                                  */ );
2204
2205         DEFVAR_LISP("pg:tty", &VXPGTTY  /*
2206 Default debugging TTY.
2207 There is no useful setting of this variable in the XEmacs Lisp API.
2208 The initial value is set from the PGTTY environment variable.
2209                                          */ );
2210
2211         DEFVAR_LISP("pg:database", &VXPGDATABASE        /*
2212 Default database to connect to.
2213 The initial value is set from the PGDATABASE environment variable.
2214                                                          */ );
2215
2216         DEFVAR_LISP("pg:realm", &VXPGREALM      /*
2217 Default kerberos realm to use for authentication.
2218 The initial value is set from the PGREALM environment variable.
2219                                                  */ );
2220
2221 #ifdef MULE
2222         /* It's not clear whether this is any use.  My intent is to
2223            autodetect the coding system from the database. */
2224         DEFVAR_LISP("pg:client-encoding", &VXPGCLIENTENCODING   /*
2225 Default client encoding to use.
2226 The initial value is set from the PGCLIENTENCODING environment variable.
2227                                                                  */ );
2228 #endif
2229
2230 #if !defined(HAVE_POSTGRESQLV7)
2231         DEFVAR_LISP("pg:authtype", &VXPGAUTHTYPE        /*
2232 Default authentication to use.
2233 The initial value is set from the PGAUTHTYPE environment variable.
2234
2235 WARNING:  This variable has gone away in versions of PostgreSQL newer
2236 than 6.5.
2237                                                          */ );
2238 #endif
2239
2240         DEFVAR_LISP("pg:geqo", &VXPGGEQO        /*
2241 Genetic Query Optimizer options.
2242 The initial value is set from the PGGEQO environment variable.
2243                                                  */ );
2244
2245         DEFVAR_LISP("pg:cost-index", &VXPGCOSTINDEX     /*
2246 Default cost index options.
2247 The initial value is set from the PGCOSTINDEX environment variable.
2248                                                          */ );
2249
2250         DEFVAR_LISP("pg:cost-heap", &VXPGCOSTHEAP       /*
2251 Default cost heap options.
2252 The initial value is set from the PGCOSTHEAP environment variable.
2253                                                          */ );
2254
2255         DEFVAR_LISP("pg:tz", &VXPGTZ    /*
2256 Default timezone to use.
2257 The initial value is set from the PGTZ environment variable.
2258                                          */ );
2259
2260         DEFVAR_LISP("pg:date-style", &VXPGDATESTYLE     /*
2261 Default date style to use.
2262 The initial value is set from the PGDATESTYLE environment variable.
2263                                                          */ );
2264 }
2265
2266 /* These initializations should not be done at dump-time. */
2267 void
2268 init_postgresql_from_environment(void)
2269 {
2270         char *p;
2271
2272         if ((p = getenv("PGHOST"))) {
2273                 VXPGHOST = build_ext_string(p, PG_OS_CODING);
2274         } else {
2275                 VXPGHOST = Qnil;
2276         }
2277
2278         if ((p = getenv("PGUSER"))) {
2279                 VXPGUSER = build_ext_string(p, PG_OS_CODING);
2280         } else {
2281                 VXPGUSER = Qnil;
2282         }
2283
2284         if ((p = getenv("PGOPTIONS"))) {
2285                 VXPGOPTIONS = build_ext_string(p, PG_OS_CODING);
2286         } else {
2287                 VXPGOPTIONS = Qnil;
2288         }
2289
2290         if ((p = getenv("PGPORT"))) {
2291                 VXPGPORT = make_int(atoi(p));
2292         } else {
2293                 VXPGPORT = Qnil;
2294         }
2295
2296         if ((p = getenv("PGTTY"))) {
2297                 VXPGTTY = build_ext_string(p, PG_OS_CODING);
2298         } else {
2299                 VXPGTTY = Qnil;
2300         }
2301
2302         if ((p = getenv("PGDATABASE"))) {
2303                 VXPGDATABASE = build_ext_string(p, PG_OS_CODING);
2304         } else {
2305                 VXPGDATABASE = Qnil;
2306         }
2307
2308         if ((p = getenv("PGREALM"))) {
2309                 VXPGREALM = build_ext_string(p, PG_OS_CODING);
2310         } else {
2311                 VXPGREALM = Qnil;
2312         }
2313
2314 #ifdef MULE
2315         /* It's not clear whether this is any use.  My intent is to
2316            autodetect the coding system from the database. */
2317         if ((p = getenv("PGCLIENTENCODING"))) {
2318                 VXPGCLIENTENCODING = build_ext_string(p, PG_OS_CODING);
2319         } else {
2320                 VXPGCLIENTENCODING = Qnil;
2321         }
2322 #endif
2323
2324 #if !defined(HAVE_POSTGRESQLV7)
2325         if ((p = getenv("PGAUTHTYPE"))) {
2326                 VXPGAUTHTYPE = build_ext_string(p, PG_OS_CODING);
2327         } else {
2328                 VXPGAUTHTYPE = Qnil;
2329         }
2330 #endif
2331
2332         if ((p = getenv("PGGEQO"))) {
2333                 VXPGGEQO = build_ext_string(p, PG_OS_CODING);
2334         } else {
2335                 VXPGGEQO = Qnil;
2336         }
2337
2338         if ((p = getenv("PGCOSTINDEX"))) {
2339                 VXPGCOSTINDEX = build_ext_string(p, PG_OS_CODING);
2340         } else {
2341                 VXPGCOSTINDEX = Qnil;
2342         }
2343
2344         if ((p = getenv("PGCOSTHEAP"))) {
2345                 VXPGCOSTHEAP = build_ext_string(p, PG_OS_CODING);
2346         } else {
2347                 VXPGCOSTHEAP = Qnil;
2348         }
2349
2350         if ((p = getenv("PGTZ"))) {
2351                 VXPGTZ = build_ext_string(p, PG_OS_CODING);
2352         } else {
2353                 VXPGTZ = Qnil;
2354         }
2355
2356         if ((p = getenv("PGDATESTYLE"))) {
2357                 VXPGDATESTYLE = build_ext_string(p, PG_OS_CODING);
2358         } else {
2359                 VXPGDATESTYLE = Qnil;
2360         }
2361 }
2362
2363 /* postgresql.c ends here */