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                 xstrncpy(buf, error_message, sizeof(buf));
 693                 if (P) {
 694                         /* storage for the error message gets erased when
 695                          * call PQfinish */
 696                         /* so we must temporarily stash it somewhere */
 697                         xstrncpy(buf, PQerrorMessage(P), sizeof(buf));
 698                         PQfinish(P);
 699                 }
 700                 error("libpq: %s", buf);
 701         }
 702 }
 703
 704 /* PQconnectStart Makes a new asynchronous connection to a backend.
 705 PGconn *PQconnectStart(const char *conninfo)
 706 */
 707
 708 #ifdef HAVE_POSTGRESQLV7
 709 DEFUN("pq-connect-start", Fpq_connect_start, 1, 1, 0,   /*
 710 Make a new asynchronous connection to a PostgreSQL backend.
 711
 712 See `pq-connectdb' for a complete description of conninfo.
 713 */
 714       (conninfo))
 715 {
 716         PGconn *P;
 717         Lisp_PGconn *lisp_pgconn;
 718         char *error_message = "Out of Memory?";
 719         char *c_conninfo;
 720         /* the result */
 721         Lisp_Object conn;
 722
 723         CHECK_STRING(conninfo);
 724         TO_EXTERNAL_FORMAT(LISP_STRING, conninfo,
 725                            C_STRING_ALLOCA, c_conninfo, Qnative);
 726         P = PQconnectStart(c_conninfo);
 727
 728         if (P && (PQstatus(P) != CONNECTION_BAD)) {
 729                 lisp_pgconn = allocate_pgconn();
 730                 lisp_pgconn->pgconn = P;
 731                 lisp_pgconn->notice_processor = Qnil;
 732                 conn = make_pgconn(lisp_pgconn);
 733                 PQsetNoticeProcessor
 734                         (P,
 735                          (PQnoticeProcessor)sxemacs_notice_processor,
 736                          (void *)&conn);
 737                 return conn;
 738         } else {
 739                 /* capture the error message before destroying the object */
 740                 char buf[BLCKSZ];
 741                 xstrncpy(buf, error_message, sizeof(buf));
 742                 if (P) {
 743                         xstrncpy(buf, PQerrorMessage(P), sizeof(buf));
 744                         PQfinish(P);
 745                 }
 746                 error("libpq: %s", buf);
 747         }
 748         return Qnil;
 749 }
 750
 751 DEFUN("pq-connect-poll", Fpq_connect_poll, 1, 1, 0,     /*
 752 Poll an asynchronous connection for completion
 753 */
 754       (conn))
 755 {
 756         PGconn *P;
 757         PostgresPollingStatusType polling_status;
 758
 759         CHECK_PGCONN(conn);
 760
 761         P = (XPGCONN(conn))->pgconn;
 762         CHECK_CONNECTION_ELIGIBLE(P);
 763
 764         polling_status = PQconnectPoll(P);
 765         switch (polling_status) {
 766         case PGRES_POLLING_FAILED:
 767                 /* Something Bad has happened */
 768                 {
 769                         char *e = PQerrorMessage(P);
 770                         error("libpq: %s", e);
 771                 }
 772         case PGRES_POLLING_OK:
 773                 return Q_pgres_polling_ok;
 774         case PGRES_POLLING_READING:
 775                 return Q_pgres_polling_reading;
 776         case PGRES_POLLING_WRITING:
 777                 return Q_pgres_polling_writing;
 778         case PGRES_POLLING_ACTIVE:
 779                 return Q_pgres_polling_active;
 780         default:
 781                 /* they've added a new field we don't know about */
 782                 error("Help!  Unknown status code %08x from backend!",
 783                       polling_status);
 784         }
 785 }
 786
 787 #ifdef MULE
 788 DEFUN("pq-client-encoding", Fpq_client_encoding, 1, 1, 0,       /*
 789 Return client coding system.
 790 */
 791       (conn))
 792 {
 793         PGconn *P;
 794
 795         CHECK_PGCONN(conn);
 796         P = (XPGCONN(conn))->pgconn;
 797         CHECK_CONNECTION_ALIVE(P);
 798
 799         return make_int(PQclientEncoding(P));
 800 }
 801
 802 DEFUN("pq-set-client-encoding", Fpq_set_client_encoding, 2, 2, 0,       /*
 803 Set client coding system.
 804 */
 805       (conn, encoding))
 806 {
 807         PGconn *P;
 808         int rc;
 809         char *c_encoding;
 810
 811         CHECK_PGCONN(conn);
 812         CHECK_STRING(encoding);
 813
 814         P = (XPGCONN(conn))->pgconn;
 815         CHECK_CONNECTION_ALIVE(P);
 816
 817         TO_EXTERNAL_FORMAT(LISP_STRING, encoding,
 818                            C_STRING_ALLOCA, c_encoding, Qnative);
 819
 820         if ((rc = PQsetClientEncoding(P, c_encoding)) < 0)
 821                 error("bad encoding");
 822         else
 823                 return make_int(rc);
 824 }
 825
 826 #endif
 827 #endif                          /* HAVE_POSTGRESQLV7 */
 828
 829 /* PQfinish Close the connection to the backend. Also frees memory
 830        used by the PGconn object.
 831 void PQfinish(PGconn *conn)
 832 */
 833 DEFUN("pq-finish", Fpq_finish, 1, 1, 0, /*
 834 Close the connection to the backend.
 835 */
 836       (conn))
 837 {
 838         PGconn *P;
 839
 840         CHECK_PGCONN(conn);
 841         P = (XPGCONN(conn))->pgconn;
 842         PUKE_IF_NULL(P);
 843
 844         PQfinish(P);
 845         /* #### PQfinish deallocates the PGconn structure, so we now have a
 846            dangling pointer. */
 847         /* Genocided all @'s ... */
 848         (XPGCONN(conn))->pgconn = (PGconn *) NULL;      /* You feel DEAD inside */
 849         return Qnil;
 850 }
 851
 852 DEFUN("pq-clear", Fpq_clear, 1, 1, 0,   /*
 853 Forcibly erase a PGresult object.
 854 */
 855       (res))
 856 {
 857         PGresult *R;
 858
 859         CHECK_PGRESULT(res);
 860         R = (XPGRESULT(res))->pgresult;
 861         PUKE_IF_NULL(R);
 862
 863         PQclear(R);
 864         /* Genocided all @'s ... */
 865         (XPGRESULT(res))->pgresult = (PGresult *) NULL; /* You feel DEAD inside */
 866
 867         return Qnil;
 868 }
 869
 870 DEFUN("pq-is-busy", Fpq_is_busy, 1, 1, 0,       /*
 871 Return t if PQgetResult would block waiting for input.
 872 */
 873       (conn))
 874 {
 875         PGconn *P;
 876
 877         CHECK_PGCONN(conn);
 878         P = (XPGCONN(conn))->pgconn;
 879         CHECK_CONNECTION_ALIVE(P);
 880
 881         return PQisBusy(P) ? Qt : Qnil;
 882 }
 883
 884 DEFUN("pq-consume-input", Fpq_consume_input, 1, 1, 0,   /*
 885 Consume any available input from the backend.
 886 Returns nil if something bad happened.
 887 */
 888       (conn))
 889 {
 890         PGconn *P;
 891
 892         CHECK_PGCONN(conn);
 893         P = (XPGCONN(conn))->pgconn;
 894         CHECK_CONNECTION_ALIVE(P);
 895
 896         return PQconsumeInput(P) ? Qt : Qnil;
 897 }
 898
 899 /* PQreset Reset the communication port with the backend.
 900 void PQreset(PGconn *conn)
 901 */
 902 DEFUN("pq-reset", Fpq_reset, 1, 1, 0,   /*
 903 Reset the connection to the backend.
 904 This function will close the connection to the backend and attempt to
 905 reestablish a new connection to the same postmaster, using all the same
 906 parameters previously used.  This may be useful for error recovery if a
 907 working connection is lost.
 908 */
 909       (conn))
 910 {
 911         PGconn *P;
 912
 913         CHECK_PGCONN(conn);
 914         P = (XPGCONN(conn))->pgconn;
 915         PUKE_IF_NULL(P);
 916         /* we can resurrect a BAD connection, but not a dead one. */
 917
 918         PQreset(P);
 919
 920         return Qnil;
 921 }
 922
 923 #ifdef HAVE_POSTGRESQLV7
 924 DEFUN("pq-reset-start", Fpq_reset_start, 1, 1, 0,       /*
 925 Reset connection to the backend asynchronously.
 926 */
 927       (conn))
 928 {
 929         PGconn *P;
 930
 931         CHECK_PGCONN(conn);
 932         P = (XPGCONN(conn))->pgconn;
 933         CHECK_CONNECTION_ALIVE(P);
 934
 935         if (PQresetStart(P))
 936                 return Qt;
 937         {
 938                 char *e = PQerrorMessage(P);
 939                 error("libpq: %s", e);
 940         }
 941 }
 942
 943 DEFUN("pq-reset-poll", Fpq_reset_poll, 1, 1, 0, /*
 944 Poll an asynchronous reset for completion.
 945 */
 946       (conn))
 947 {
 948         PGconn *P;
 949         PostgresPollingStatusType polling_status;
 950
 951         CHECK_PGCONN(conn);
 952
 953         P = (XPGCONN(conn))->pgconn;
 954         CHECK_CONNECTION_ELIGIBLE(P);
 955
 956         polling_status = PQresetPoll(P);
 957         switch (polling_status) {
 958         case PGRES_POLLING_FAILED:
 959                 /* Something Bad has happened */
 960                 {
 961                         char *e = PQerrorMessage(P);
 962                         error("libpq: %s", e);
 963                 }
 964         case PGRES_POLLING_OK:
 965                 return Q_pgres_polling_ok;
 966         case PGRES_POLLING_READING:
 967                 return Q_pgres_polling_reading;
 968         case PGRES_POLLING_WRITING:
 969                 return Q_pgres_polling_writing;
 970         case PGRES_POLLING_ACTIVE:
 971                 return Q_pgres_polling_active;
 972         default:
 973                 /* they've added a new field we don't know about */
 974                 error("Help!  Unknown status code %08x from backend!",
 975                       polling_status);
 976         }
 977 }
 978 #endif
 979
 980 DEFUN("pq-request-cancel", Fpq_request_cancel, 1, 1, 0, /*
 981 Attempt to request cancellation of the current operation.
 982
 983 The return value is t if the cancel request was successfully
 984 dispatched, nil if not (in which case conn->errorMessage is set).
 985 Note: successful dispatch is no guarantee that there will be any effect at
 986 the backend.  The application must read the operation result as usual.
 987 */
 988       (conn))
 989 {
 990         PGconn *P;
 991
 992         CHECK_PGCONN(conn);
 993         P = (XPGCONN(conn))->pgconn;
 994         CHECK_CONNECTION_ALIVE(P);
 995
 996         return PQrequestCancel(P) ? Qt : Qnil;
 997 }
 998
 999 /* accessor function for the PGconn object */
1000 DEFUN("pq-connection-status", Fpq_connection_status, 2, 2, 0,   /*
1001 Accessor function for the PGconn object.
1002 Currently recognized symbols for the field:
1003 :pq-db                  Database name
1004 :pq-user                Database user name
1005 :pq-pass                Database user's password
1006 :pq-host                Hostname of PostgreSQL backend connected to
1007 :pq-port                TCP port number of connection
1008 :pq-tty                 Debugging TTY (not used in Emacs)
1009 :pq-options             Additional backend options
1010 :pq-status              Connection status (either OK or BAD)
1011 :pq-transaction-status  Current in-transaction status of the server
1012 :pq-parameter-status    Current parameter setting of the server
1013 :pq-protocol-version    Frontend/Backend protocol
1014 :pq-server-version      Integer representing the backend version
1015 :pq-error-message       Last error message from the backend
1016 :pq-backend-pid         Process ID of backend process
1017 :pq-getssl              SSL session used in the connection
1018 */
1019       (conn, field))
1020 {
1021         PGconn *P;
1022
1023         CHECK_PGCONN(conn);
1024         P = (XPGCONN(conn))->pgconn;
1025         PUKE_IF_NULL(P);        /* BAD connections still have state to query */
1026
1027         if (EQ(field, Q_pq_db)) {
1028                 /* PQdb Returns the database name of the connection.
1029                    char *PQdb(PGconn *conn)
1030                  */
1031                 return build_ext_string(PQdb(P), PG_OS_CODING);
1032         } else if (EQ(field, Q_pq_user)) {
1033                 /* PQuser Returns the user name of the connection.
1034                    char *PQuser(PGconn *conn)
1035                  */
1036                 return build_ext_string(PQuser(P), PG_OS_CODING);
1037         } else if (EQ(field, Q_pq_pass)) {
1038                 /* PQpass Returns the password of the connection.
1039                    char *PQpass(PGconn *conn)
1040                  */
1041                 return build_ext_string(PQpass(P), PG_OS_CODING);
1042         } else if (EQ(field, Q_pq_host)) {
1043                 /* PQhost Returns the server host name of the connection.
1044                    char *PQhost(PGconn *conn)
1045                  */
1046                 return build_ext_string(PQhost(P), PG_OS_CODING);
1047         } else if (EQ(field, Q_pq_port)) {
1048                 char *p;
1049                 /* PQport Returns the port of the connection.
1050                    char *PQport(PGconn *conn)
1051                  */
1052                 if ((p = PQport(P)))
1053                         return make_int(atoi(p));
1054                 else
1055                         return make_int(-1);
1056         } else if (EQ(field, Q_pq_tty)) {
1057                 /* PQtty Returns the debug tty of the connection.
1058                    char *PQtty(PGconn *conn)
1059                  */
1060                 return build_ext_string(PQtty(P), PG_OS_CODING);
1061         } else if (EQ(field, Q_pq_options)) {
1062                 /* PQoptions Returns the backend options used in the connection.
1063                    char *PQoptions(PGconn *conn)
1064                  */
1065                 return build_ext_string(PQoptions(P), PG_OS_CODING);
1066         } else if (EQ(field, Q_pq_status)) {
1067                 ConnStatusType cst;
1068                 /* PQstatus Returns the status of the connection. The status can be
1069                    CONNECTION_OK or CONNECTION_BAD.
1070                    ConnStatusType PQstatus(PGconn *conn)
1071                  */
1072                 switch ((cst = PQstatus(P))) {
1073                 case CONNECTION_OK:
1074                         return Q_pg_connection_ok;
1075                 case CONNECTION_BAD:
1076                         return Q_pg_connection_bad;
1077 #ifdef HAVE_POSTGRESQLV7
1078                 case CONNECTION_STARTED:
1079                         return Q_pg_connection_started;
1080                 case CONNECTION_MADE:
1081                         return Q_pg_connection_made;
1082                 case CONNECTION_AWAITING_RESPONSE:
1083                         return Q_pg_connection_awaiting_response;
1084                 case CONNECTION_AUTH_OK:
1085                         return Q_pg_connection_auth_ok;
1086                 case CONNECTION_SETENV:
1087                         return Q_pg_connection_setenv;
1088 #endif                          /* HAVE_POSTGRESQLV7 */
1089                 default:
1090                         /* they've added a new field we don't know about */
1091                         error("Help!  Unknown connection status code %08x "
1092                               "from backend!",
1093                               cst);
1094                 }
1095         } else if (EQ(field, Q_pq_transaction_status)) {
1096                 PGTransactionStatusType ts;
1097                 switch ((ts = PQtransactionStatus(P))) {
1098                 case PQTRANS_IDLE:
1099                         return Q_pg_trans_idle;
1100                 case PQTRANS_ACTIVE:
1101                         return Q_pg_trans_active;
1102                 case PQTRANS_INTRANS:
1103                         return Q_pg_trans_intrans;
1104                 case PQTRANS_INERROR:
1105                         return Q_pg_trans_inerror;
1106                 case PQTRANS_UNKNOWN:
1107                         return Q_pg_trans_unknown;
1108                 default:
1109                         /* they've added a new field we don't know about */
1110                         error("Help!  Unknown transaction status code %08x "
1111                               "from backend!",
1112                               ts);
1113                 }
1114         } else if (EQ(field, Q_pq_parameter_status)) {
1115                 return Qnil;
1116         } else if (EQ(field, Q_pq_protocol_version)) {
1117                 return make_int(PQprotocolVersion(P));
1118 #if HAVE_PQSERVERVERSION
1119         } else if (EQ(field, Q_pq_server_version)) {
1120                 return make_int(PQserverVersion(P));
1121 #else
1122         } else if (EQ(field, Q_pq_server_version)) {
1123                 char *vstr = xstrdup(PQparameterStatus(P,"server_version"));
1124                 char *tmp, previous;
1125                 int major, minor, patch;
1126
1127                 if ( vstr == NULL )
1128                         return Qnil;
1129                 tmp = strtok(vstr,".");
1130                 major = atoi(tmp);
1131                 tmp = strtok(NULL,".");
1132                 minor = atoi(tmp);
1133                 tmp = strtok(NULL,".");
1134                 patch = atoi(tmp);
1135                 xfree(vstr);
1136                 return make_int(major*10000+minor*100+patch);
1137 #endif
1138         } else if (EQ(field, Q_pq_error_message)) {
1139                 /* PQerrorMessage Returns the error message most recently
1140                  * generated by an operation on the connection.
1141                  * char *PQerrorMessage(PGconn* conn);
1142                  */
1143                 return build_ext_string(PQerrorMessage(P), PG_OS_CODING);
1144         } else if (EQ(field, Q_pq_backend_pid)) {
1145                 /* PQbackendPID Returns the process ID of the backend server
1146                  * handling this connection.
1147                  * int PQbackendPID(PGconn *conn);
1148                  */
1149                 return make_int(PQbackendPID(P));
1150 #ifdef HAVE_OPENSSL
1151         } else if (EQ(field, Q_pq_getssl)) {
1152                 /* PQgetssl Returns the SSL structure used in the connection,
1153                  * or NULL if SSL is not in use.
1154                  * SSL *PQgetssl(PGconn *conn);
1155                  */
1156                 SSL *ssl_conn;
1157                 ssl_conn = (SSL*)PQgetssl(P);
1158                 if (ssl_conn == NULL)
1159                         return Qnil; /* meaning: no SSL in use */
1160                 else {
1161                         Lisp_SSL_CONN *pqssl = allocate_ssl_conn();
1162                         pqssl->ssl_conn = ssl_conn;
1163                         pqssl->parent = conn;
1164                         pqssl->protected_p = 1;
1165                         return make_ssl_conn(pqssl);
1166                         /* Should we use a copy of the SSL session here?
1167                          * Otherwise it's safe to obtain a nice segfault by:
1168                          *   (setq m (pq-pgconn foo \'pq::getssl))
1169                          *   (setq m \'something-else)
1170                          *   M-x garbage-collect RET
1171                          *   (pq-send-query foo ...)
1172                          * You will see SXE dump in ssl*_write or the like
1173                          * since the _original_ session handle has been gc'd
1174                          *
1175                          * Nah, _for the moment_ I assume our users to be
1176                          * smart enough to rethink twice before they do
1177                          * something like this.
1178                          */
1179                 }
1180 #endif
1181         }
1182
1183         /* else */
1184         message("bad PGconn accessor");
1185         return Qnil;
1186 }
1187
1188 DEFUN("pq-connection-alive-p", Fpq_connection_alive_p, 1, 1, 0, /*
1189 Return non-nil when CONN is considered alive.
1190
1191 This is roughly the same as calling (pq-connection-status CONN :status)
1192 */
1193       (conn))
1194 {
1195         PGconn *P;
1196
1197         CHECK_PGCONN(conn);
1198
1199         P = (XPGCONN(conn))->pgconn;
1200
1201         if (PQstatus(P) == CONNECTION_OK) {
1202                 return Qt;
1203         }
1204         return Qnil;
1205 }
1206
1207 DEFUN("pq-connection-p", Fpq_connection_p, 1, 1, 0, /*
1208 Return non-nil if OBJECT is a pq connection object.
1209 */
1210       (object))
1211 {
1212         return PGCONNP(object) ? Qt : Qnil;
1213 }
1214
1215 /* Query functions */
1216 DEFUN("pq-exec", Fpq_exec, 2, 2, 0,     /*
1217 Submit a query to Postgres and wait for the result.
1218 */
1219       (conn, query))
1220 {
1221         PGconn *P;
1222         Lisp_PGresult *lisp_pgresult;
1223         PGresult *R;
1224         char *c_query;
1225
1226         CHECK_PGCONN(conn);
1227         CHECK_STRING(query);
1228
1229         P = (XPGCONN(conn))->pgconn;
1230         CHECK_CONNECTION_ALIVE(P);
1231
1232         TO_EXTERNAL_FORMAT(LISP_STRING, query,
1233                            C_STRING_ALLOCA, c_query, Qnative);
1234
1235         R = PQexec(P, c_query);
1236         {
1237                 char *tag, buf[BLCKSZ];
1238
1239                 if (!R)
1240                         error("query: out of memory");
1241                 else
1242                         switch (PQresultStatus(R)) {
1243                         case PGRES_BAD_RESPONSE:
1244                                 tag = "bad response [%s]";
1245                                 goto err;
1246                         case PGRES_NONFATAL_ERROR:
1247                                 tag = "non-fatal error [%s]";
1248                                 goto err;
1249                         case PGRES_FATAL_ERROR:
1250                                 tag = "fatal error [%s]";
1251                               err:
1252                                 xstrncpy(buf, PQresultErrorMessage(R),
1253                                         sizeof(buf));
1254                                 PQclear(R);
1255                                 error(tag, buf);
1256                          /*NOTREACHED*/ default:
1257                                 break;
1258                         }
1259         }
1260
1261         lisp_pgresult = allocate_pgresult();
1262         lisp_pgresult->pgresult = R;
1263
1264         return make_pgresult(lisp_pgresult);
1265 }
1266
1267 DEFUN("pq-send-query", Fpq_send_query, 2, 2, 0, /*
1268 Submit a query to Postgres and don't wait for the result.
1269 Returns: t if successfully submitted
1270 nil if error (conn->errorMessage is set)
1271 */
1272       (conn, query))
1273 {
1274         PGconn *P;
1275         char *c_query;
1276
1277         CHECK_PGCONN(conn);
1278         CHECK_STRING(query);
1279
1280         P = (XPGCONN(conn))->pgconn;
1281         CHECK_CONNECTION_ALIVE(P);
1282
1283         TO_EXTERNAL_FORMAT(LISP_STRING, query,
1284                            C_STRING_ALLOCA, c_query, Qnative);
1285
1286         if (PQsendQuery(P, c_query))
1287                 return Qt;
1288         else
1289                 error("async query: %s", PQerrorMessage(P));
1290 }
1291
1292 DEFUN("pq-result-p", Fpq_result_p, 1, 1, 0, /*
1293 Return non-nil if OBJECT is a pq query result object.
1294 */
1295       (object))
1296 {
1297         return PGRESULTP(object) ? Qt : Qnil;
1298 }
1299
1300 DEFUN("pq-get-result", Fpq_get_result, 1, 1, 0, /*
1301 Retrieve an asynchronous result from a query.
1302 NIL is returned when no more query work remains.
1303 */
1304       (conn))
1305 {
1306         PGconn *P;
1307         Lisp_PGresult *lisp_pgresult;
1308         PGresult *R;
1309
1310         CHECK_PGCONN(conn);
1311
1312         P = (XPGCONN(conn))->pgconn;
1313         CHECK_CONNECTION_ALIVE(P);
1314
1315         R = PQgetResult(P);
1316         if (!R)
1317                 return Qnil;    /* not an error, there's no more data to get */
1318
1319         {
1320                 char *tag, buf[BLCKSZ];
1321
1322                 switch (PQresultStatus(R)) {
1323                 case PGRES_BAD_RESPONSE:
1324                         tag = "bad response [%s]";
1325                         goto err;
1326                 case PGRES_NONFATAL_ERROR:
1327                         tag = "non-fatal error [%s]";
1328                         goto err;
1329                 case PGRES_FATAL_ERROR:
1330                         tag = "fatal error [%s]";
1331                       err:
1332                         xstrncpy(buf, PQresultErrorMessage(R), sizeof(buf));
1333                         PQclear(R);
1334                         error(tag, buf);
1335                  /*NOTREACHED*/ default:
1336                         break;
1337                 }
1338         }
1339
1340         lisp_pgresult = allocate_pgresult();
1341         lisp_pgresult->pgresult = R;
1342
1343         return make_pgresult(lisp_pgresult);
1344 }
1345
1346 DEFUN("pq-result-status", Fpq_result_status, 1, 1, 0,   /*
1347 Return result status of the query.
1348 */
1349       (result))
1350 {
1351         PGresult *R;
1352         ExecStatusType est;
1353
1354         CHECK_PGRESULT(result);
1355         R = (XPGRESULT(result))->pgresult;
1356         PUKE_IF_NULL(R);
1357
1358         switch ((est = PQresultStatus(R))) {
1359         case PGRES_EMPTY_QUERY:
1360                 return Q_pgres_empty_query;
1361         case PGRES_COMMAND_OK:
1362                 return Q_pgres_command_ok;
1363         case PGRES_TUPLES_OK:
1364                 return Q_pgres_tuples_ok;
1365         case PGRES_COPY_OUT:
1366                 return Q_pgres_copy_out;
1367         case PGRES_COPY_IN:
1368                 return Q_pgres_copy_in;
1369         case PGRES_BAD_RESPONSE:
1370                 return Q_pgres_bad_response;
1371         case PGRES_NONFATAL_ERROR:
1372                 return Q_pgres_nonfatal_error;
1373         case PGRES_FATAL_ERROR:
1374                 return Q_pgres_fatal_error;
1375         default:
1376                 /* they've added a new field we don't know about */
1377                 error("Help!  Unknown exec status code %08x from backend!",
1378                       est);
1379         }
1380 }
1381
1382 DEFUN("pq-result-status-string", Fpq_result_status_string, 1, 1, 0,     /*
1383 Return stringified result status of the query.
1384 */
1385       (result))
1386 {
1387         PGresult *R;
1388
1389         CHECK_PGRESULT(result);
1390         R = (XPGRESULT(result))->pgresult;
1391         PUKE_IF_NULL(R);
1392
1393         return build_ext_string(PQresStatus(PQresultStatus(R)), PG_OS_CODING);
1394 }
1395
1396 /* Sundry PGresult accessor functions */
1397 DEFUN("pq-result-error-message", Fpq_result_error_message, 1, 1, 0,     /*
1398 Return last message associated with the query.
1399 */
1400       (result))
1401 {
1402         PGresult *R;
1403
1404         CHECK_PGRESULT(result);
1405         R = (XPGRESULT(result))->pgresult;
1406         PUKE_IF_NULL(R);
1407
1408         return build_ext_string(PQresultErrorMessage(R), PG_OS_CODING);
1409 }
1410
1411 DEFUN("pq-ntuples", Fpq_ntuples, 1, 1, 0,       /*
1412 Return the number of tuples (instances) in the query result.
1413 */
1414       (result))
1415 {
1416         PGresult *R;
1417
1418         CHECK_PGRESULT(result);
1419         R = (XPGRESULT(result))->pgresult;
1420         PUKE_IF_NULL(R);
1421
1422         return make_int(PQntuples(R));
1423 }
1424
1425 DEFUN("pq-nfields", Fpq_nfields, 1, 1, 0,       /*
1426 Return the number of fields (attributes) in each tuple of the query result.
1427 */
1428       (result))
1429 {
1430         PGresult *R;
1431
1432         CHECK_PGRESULT(result);
1433         R = (XPGRESULT(result))->pgresult;
1434         PUKE_IF_NULL(R);
1435
1436         return make_int(PQnfields(R));
1437 }
1438
1439 DEFUN("pq-binary-tuples", Fpq_binary_tuples, 1, 1, 0,   /*
1440 Return t if the query result contains binary data, nil otherwise.
1441 */
1442       (result))
1443 {
1444         PGresult *R;
1445
1446         CHECK_PGRESULT(result);
1447         R = (XPGRESULT(result))->pgresult;
1448         PUKE_IF_NULL(R);
1449
1450         return (PQbinaryTuples(R)) ? Qt : Qnil;
1451 }
1452
1453 DEFUN("pq-fname", Fpq_fname, 2, 2, 0,   /*
1454 Return the field (attribute) name associated with the given field index.
1455 Field indices start at 0.
1456 */
1457       (result, field_index))
1458 {
1459         PGresult *R;
1460
1461         CHECK_PGRESULT(result);
1462         CHECK_INT(field_index);
1463         R = (XPGRESULT(result))->pgresult;
1464         PUKE_IF_NULL(R);
1465
1466         return build_ext_string(PQfname(R, XINT(field_index)), PG_OS_CODING);
1467 }
1468
1469 DEFUN("pq-fnumber", Fpq_fnumber, 2, 2, 0,       /*
1470 Return the number of fields (attributes) in each tuple of the query result.
1471 */
1472       (result, field_name))
1473 {
1474         PGresult *R;
1475         char *c_field_name;
1476
1477         CHECK_PGRESULT(result);
1478         CHECK_STRING(field_name);
1479         R = (XPGRESULT(result))->pgresult;
1480         PUKE_IF_NULL(R);
1481
1482         TO_EXTERNAL_FORMAT(LISP_STRING, field_name,
1483                            C_STRING_ALLOCA, c_field_name, Qnative);
1484
1485         return make_int(PQfnumber(R, c_field_name));
1486 }
1487
1488 DEFUN("pq-ftype", Fpq_ftype, 2, 2, 0,   /*
1489 Return the field type associated with the given field index.
1490 The integer returned is the internal coding of the type.  Field indices
1491 start at 0.
1492 */
1493       (result, field_num))
1494 {
1495         PGresult *R;
1496
1497         CHECK_PGRESULT(result);
1498         CHECK_INT(field_num);
1499         R = (XPGRESULT(result))->pgresult;
1500         PUKE_IF_NULL(R);
1501
1502         return make_int(PQftype(R, XINT(field_num)));
1503 }
1504
1505 DEFUN("pq-fsize", Fpq_fsize, 2, 2, 0,   /*
1506 Return the field size in bytes associated with the given field index.
1507 Field indices start at 0.
1508 */
1509       (result, field_index))
1510 {
1511         PGresult *R;
1512
1513         CHECK_PGRESULT(result);
1514         CHECK_INT(field_index);
1515         R = (XPGRESULT(result))->pgresult;
1516         PUKE_IF_NULL(R);
1517
1518         return make_int(PQftype(R, XINT(field_index)));
1519 }
1520
1521 DEFUN("pq-fmod", Fpq_fmod, 2, 2, 0,     /*
1522 Return the type modifier associated with a field.
1523 Field indices start at 0.
1524 */
1525       (result, field_index))
1526 {
1527         PGresult *R;
1528
1529         CHECK_PGRESULT(result);
1530         CHECK_INT(field_index);
1531         R = (XPGRESULT(result))->pgresult;
1532         PUKE_IF_NULL(R);
1533
1534         return make_int(PQfmod(R, XINT(field_index)));
1535 }
1536
1537 DEFUN("pq-get-value", Fpq_get_value, 3, 3, 0,   /*
1538 Return a single field (attribute) value of one tuple of a PGresult.
1539 Tuple and field indices start at 0.
1540 */
1541       (result, tup_num, field_num))
1542 {
1543         PGresult *R;
1544
1545         CHECK_PGRESULT(result);
1546         CHECK_INT(tup_num);
1547         CHECK_INT(field_num);
1548         R = (XPGRESULT(result))->pgresult;
1549         PUKE_IF_NULL(R);
1550
1551         return build_ext_string(PQgetvalue(R, XINT(tup_num), XINT(field_num)),
1552                                 PG_OS_CODING);
1553 }
1554
1555 DEFUN("pq-get-length", Fpq_get_length, 3, 3, 0, /*
1556 Returns the length of a field value in bytes.
1557 If result is binary, i.e. a result of a binary portal, then the
1558 length returned does NOT include the size field of the varlena.  (The
1559 data returned by PQgetvalue doesn't either.)
1560 */
1561       (result, tup_num, field_num))
1562 {
1563         PGresult *R;
1564
1565         CHECK_PGRESULT(result);
1566         CHECK_INT(tup_num);
1567         CHECK_INT(field_num);
1568         R = (XPGRESULT(result))->pgresult;
1569         PUKE_IF_NULL(R);
1570
1571         return make_int(PQgetlength(R, XINT(tup_num), XINT(field_num)));
1572 }
1573
1574 DEFUN("pq-get-is-null", Fpq_get_is_null, 3, 3, 0,       /*
1575 Returns the null status of a field value.
1576 */
1577       (result, tup_num, field_num))
1578 {
1579         PGresult *R;
1580
1581         CHECK_PGRESULT(result);
1582         CHECK_INT(tup_num);
1583         CHECK_INT(field_num);
1584         R = (XPGRESULT(result))->pgresult;
1585         PUKE_IF_NULL(R);
1586
1587         return PQgetisnull(R, XINT(tup_num), XINT(field_num)) ? Qt : Qnil;
1588 }
1589
1590 DEFUN("pq-cmd-status", Fpq_cmd_status, 1, 1, 0, /*
1591 Returns the command status string from the SQL command that generated the result.
1592 */
1593       (result))
1594 {
1595         PGresult *R;
1596
1597         CHECK_PGRESULT(result);
1598         R = (XPGRESULT(result))->pgresult;
1599         PUKE_IF_NULL(R);
1600
1601         return build_ext_string(PQcmdStatus(R), PG_OS_CODING);
1602 }
1603
1604 DEFUN("pq-cmd-tuples", Fpq_cmd_tuples, 1, 1, 0, /*
1605 Returns the number of rows affected by the SQL command.
1606 */
1607       (result))
1608 {
1609         PGresult *R;
1610
1611         CHECK_PGRESULT(result);
1612         R = (XPGRESULT(result))->pgresult;
1613         PUKE_IF_NULL(R);
1614
1615         return build_ext_string(PQcmdTuples(R), PG_OS_CODING);
1616 }
1617
1618 DEFUN("pq-oid-value", Fpq_oid_value, 1, 1, 0,   /*
1619 Returns the object id of the tuple inserted.
1620 */
1621       (result))
1622 {
1623         PGresult *R;
1624
1625         CHECK_PGRESULT(result);
1626         R = (XPGRESULT(result))->pgresult;
1627         PUKE_IF_NULL(R);
1628
1629 #ifdef HAVE_POSTGRESQLV7
1630         return make_int(PQoidValue(R));
1631 #else
1632         /* Use the old interface */
1633         return make_int(atoi(PQoidStatus(R)));
1634 #endif
1635 }
1636
1637 #ifdef HAVE_POSTGRESQLV7
1638 DEFUN("pq-set-nonblocking", Fpq_set_nonblocking, 2, 2, 0,       /*
1639 Sets the PGconn's database connection non-blocking if the arg is TRUE
1640 or makes it non-blocking if the arg is FALSE, this will not protect
1641 you from PQexec(), you'll only be safe when using the non-blocking API.
1642
1643 Needs to be called only on a connected database connection.
1644 */
1645       (conn, arg))
1646 {
1647         PGconn *P;
1648
1649         CHECK_PGCONN(conn);
1650         P = (XPGCONN(conn))->pgconn;
1651         CHECK_CONNECTION_ALIVE(P);
1652
1653         return make_int(PQsetnonblocking(P, !NILP(arg)));
1654 }
1655
1656 DEFUN("pq-is-nonblocking", Fpq_is_nonblocking, 1, 1, 0, /*
1657 Return the blocking status of the database connection.
1658 */
1659       (conn))
1660 {
1661         PGconn *P;
1662
1663         CHECK_PGCONN(conn);
1664         P = (XPGCONN(conn))->pgconn;
1665         CHECK_CONNECTION_ALIVE(P);
1666
1667         return PQisnonblocking(P) ? Qt : Qnil;
1668 }
1669
1670 DEFUN("pq-flush", Fpq_flush, 1, 1, 0,   /*
1671 Force the write buffer to be written (or at least try).
1672 */
1673       (conn))
1674 {
1675         PGconn *P;
1676
1677         CHECK_PGCONN(conn);
1678         P = (XPGCONN(conn))->pgconn;
1679         CHECK_CONNECTION_ALIVE(P);
1680
1681         return make_int(PQflush(P));
1682 }
1683 #endif
1684
1685 DEFUN("pq-notifies", Fpq_notifies, 1, 1, 0,     /*
1686 Return the latest async notification that has not yet been handled.
1687 If there has been a notification, then a list of two elements will be returned.
1688 The first element contains the relation name being notified, the second
1689 element contains the backend process ID number.  nil is returned if there
1690 aren't any notifications to process.
1691 */
1692       (conn))
1693 {
1694         /* This function cannot GC */
1695         PGconn *P;
1696         PGnotify *PGN;
1697
1698         CHECK_PGCONN(conn);
1699         P = (XPGCONN(conn))->pgconn;
1700         CHECK_CONNECTION_ALIVE(P);
1701
1702         PGN = PQnotifies(P);
1703         if (!PGN)
1704                 return Qnil;
1705         else {
1706                 Lisp_Object temp;
1707
1708                 temp = list2(build_ext_string(PGN->relname, PG_OS_CODING),
1709                              make_int(PGN->be_pid));
1710                 xfree(PGN);
1711                 return temp;
1712         }
1713 }
1714
1715 #if defined (HAVE_POSTGRESQLV7) && defined(MULE)
1716 DEFUN("pq-env-2-encoding", Fpq_env_2_encoding, 0, 0, 0, /*
1717 Get encoding id from environment variable PGCLIENTENCODING.
1718 */
1719       ())
1720 {
1721         return make_int(PQenv2encoding());
1722 }
1723 #endif                          /* MULE */
1724
1725 DEFUN("pq-lo-import", Fpq_lo_import, 2, 2, 0,   /*
1726 */
1727       (conn, filename))
1728 {
1729         PGconn *P;
1730         char *c_filename;
1731
1732         CHECK_PGCONN(conn);
1733         CHECK_STRING(filename);
1734
1735         P = (XPGCONN(conn))->pgconn;
1736         CHECK_CONNECTION_ALIVE(P);
1737
1738         TO_EXTERNAL_FORMAT(LISP_STRING, filename,
1739                            C_STRING_ALLOCA, c_filename, Qfile_name);
1740
1741         return make_int((int)lo_import(P, c_filename));
1742 }
1743
1744 DEFUN("pq-lo-export", Fpq_lo_export, 3, 3, 0,   /*
1745 */
1746       (conn, oid, filename))
1747 {
1748         PGconn *P;
1749         char *c_filename;
1750
1751         CHECK_PGCONN(conn);
1752         CHECK_INT(oid);
1753         CHECK_STRING(filename);
1754
1755         P = (XPGCONN(conn))->pgconn;
1756         CHECK_CONNECTION_ALIVE(P);
1757
1758         TO_EXTERNAL_FORMAT(LISP_STRING, filename,
1759                            C_STRING_ALLOCA, c_filename, Qfile_name);
1760
1761         return make_int((int)lo_export(P, XINT(oid), c_filename));
1762 }
1763
1764 DEFUN("pq-make-empty-pgresult", Fpq_make_empty_pgresult, 2, 2, 0,       /*
1765 Make an empty PGresult object with the given status.
1766 */
1767       (conn, status))
1768 {
1769         PGconn *P;
1770         Lisp_PGresult *lpgr;
1771         PGresult *R;
1772         ExecStatusType est;
1773
1774         CHECK_PGCONN(conn);
1775         P = (XPGCONN(conn))->pgconn;
1776         CHECK_CONNECTION_ALIVE(P);      /* needed here? */
1777
1778         if (EQ(status, Q_pgres_empty_query))
1779                 est = PGRES_EMPTY_QUERY;
1780         else if (EQ(status, Q_pgres_command_ok))
1781                 est = PGRES_COMMAND_OK;
1782         else if (EQ(status, Q_pgres_tuples_ok))
1783                 est = PGRES_TUPLES_OK;
1784         else if (EQ(status, Q_pgres_copy_out))
1785                 est = PGRES_COPY_OUT;
1786         else if (EQ(status, Q_pgres_copy_in))
1787                 est = PGRES_COPY_IN;
1788         else if (EQ(status, Q_pgres_bad_response))
1789                 est = PGRES_BAD_RESPONSE;
1790         else if (EQ(status, Q_pgres_nonfatal_error))
1791                 est = PGRES_NONFATAL_ERROR;
1792         else if (EQ(status, Q_pgres_fatal_error))
1793                 est = PGRES_FATAL_ERROR;
1794         else
1795                 signal_simple_error("bad status symbol", status);
1796
1797         R = PQmakeEmptyPGresult(P, est);
1798         if (!R)
1799                 error("out of memory?");
1800
1801         lpgr = allocate_pgresult();
1802         lpgr->pgresult = R;
1803
1804         return make_pgresult(lpgr);
1805 }
1806
1807 #ifdef HAVE_POSTGRESQLV7
1808 /* actually I don't know when this made its way to libpq
1809  * I just assume 7.4 here
1810  * Bite me, if that's wrong ;P
1811  */
1812 DEFUN("pq-escape-string", Fpq_escape_string, 1, 1, 0, /*
1813 Return an SQL-suited escaped version of STRING.
1814 */
1815       (string))
1816 {
1817         char *result;
1818         int result_len;
1819         /* buffers for our args */
1820         char *string_ext;
1821         int string_len;
1822
1823         TO_EXTERNAL_FORMAT(LISP_STRING, string,
1824                            C_STRING_ALLOCA, string_ext, PG_OS_CODING);
1825         string_len = (int)XSTRING_CHAR_LENGTH(string);
1826
1827         result = (char *)xmalloc_atomic(4*XSTRING_LENGTH(string));
1828
1829         result_len = PQescapeString(result, string_ext, string_len);
1830
1831         return make_ext_string(result, result_len, PG_OS_CODING);
1832 }
1833
1834 DEFUN("pq-escape-bytea", Fpq_escape_bytea, 1, 1, 0, /*
1835 Return an SQL-suited escaped version of binary DATA.
1836 */
1837       (data))
1838 {
1839         char *result;
1840         size_t result_len;
1841         /* buffers for our args */
1842         char *data_ext;
1843         int data_len;
1844
1845         TO_EXTERNAL_FORMAT(LISP_STRING, data,
1846                            C_STRING_ALLOCA, data_ext, PG_OS_CODING);
1847         data_len = (int)XSTRING_CHAR_LENGTH(data);
1848
1849         result = (char*)PQescapeBytea(
1850                 (unsigned char*)data_ext, data_len, &result_len);
1851
1852         if (result == NULL)
1853                 return Qnil;
1854         else
1855                 return make_ext_string(result,result_len-1,PG_OS_CODING);
1856 }
1857
1858 DEFUN("pq-unescape-bytea", Fpq_unescape_bytea, 1, 1, 0, /*
1859 Return the unescaped form of DATA (which may be binary).
1860 Such binary data may result from a BYTEA column.
1861
1862 Note: Of course, escaped SQL strings are elisp-escaped again
1863 so you may have to use `pq-unescape-bytea' twice.
1864 */
1865       (data))
1866 {
1867         char *result;
1868         size_t result_len;
1869         /* buffers for our args */
1870         char *data_ext;
1871
1872         TO_EXTERNAL_FORMAT(LISP_STRING, data,
1873                            C_STRING_ALLOCA, data_ext, PG_OS_CODING);
1874
1875         result = (char*)PQunescapeBytea(
1876                 (unsigned char*)data_ext, &result_len);
1877
1878         if (result == NULL)
1879                 return Qnil;
1880         else
1881                 return make_ext_string(result,result_len,PG_OS_CODING);
1882 }
1883 #endif
1884
1885 DEFUN("pq-get-line", Fpq_get_line, 1, 1, 0,     /*
1886 Retrieve a line from server in copy in operation.
1887 The return value is a dotted pair where the cons cell is an integer code:
1888 -1: Copying is complete
1889 0: A record is complete
1890 1: A record is incomplete, it will be continued in the next `pq-get-line'
1891 operation.
1892 and the cdr cell is returned string data.
1893
1894 The copy operation is complete when the value `\.' (backslash dot) is
1895 returned.
1896 */
1897       (conn))
1898 {
1899         char buffer[BLCKSZ];    /* size of a Postgres disk block */
1900         PGconn *P;
1901         int ret;
1902
1903         CHECK_PGCONN(conn);
1904         P = (XPGCONN(conn))->pgconn;
1905         CHECK_CONNECTION_ALIVE(P);
1906
1907         ret = PQgetline(P, buffer, sizeof(buffer));
1908
1909         return Fcons(make_int(ret), build_ext_string(buffer, PG_OS_CODING));
1910 }
1911
1912 DEFUN("pq-put-line", Fpq_put_line, 2, 2, 0,     /*
1913 Send a line to the server in copy out operation.
1914
1915 Returns t if the operation succeeded, nil otherwise.
1916 */
1917       (conn, string))
1918 {
1919         PGconn *P;
1920         char *c_string;
1921
1922         CHECK_PGCONN(conn);
1923         CHECK_STRING(string);
1924
1925         P = (XPGCONN(conn))->pgconn;
1926         CHECK_CONNECTION_ALIVE(P);
1927         TO_EXTERNAL_FORMAT(LISP_STRING, string,
1928                            C_STRING_ALLOCA, c_string, Qnative);
1929
1930         return !PQputline(P, c_string) ? Qt : Qnil;
1931 }
1932
1933 DEFUN("pq-get-line-async", Fpq_get_line_async, 1, 1, 0, /*
1934 Get a line from the server in copy in operation asynchronously.
1935
1936 This routine is for applications that want to do "COPY <rel> to stdout"
1937 asynchronously, that is without blocking.  Having issued the COPY command
1938 and gotten a PGRES_COPY_OUT response, the app should call PQconsumeInput
1939 and this routine until the end-of-data signal is detected.  Unlike
1940 PQgetline, this routine takes responsibility for detecting end-of-data.
1941
1942 On each call, PQgetlineAsync will return data if a complete newline-
1943 terminated data line is available in libpq's input buffer, or if the
1944 incoming data line is too long to fit in the buffer offered by the caller.
1945 Otherwise, no data is returned until the rest of the line arrives.
1946
1947 If -1 is returned, the end-of-data signal has been recognized (and removed
1948 from libpq's input buffer).  The caller *must* next call PQendcopy and
1949 then return to normal processing.
1950
1951 RETURNS:
1952 -1    if the end-of-copy-data marker has been recognized
1953 0         if no data is available
1954 >0    the number of bytes returned.
1955 The data returned will not extend beyond a newline character.  If possible
1956 a whole line will be returned at one time.  But if the buffer offered by
1957 the caller is too small to hold a line sent by the backend, then a partial
1958 data line will be returned.  This can be detected by testing whether the
1959 last returned byte is '\n' or not.
1960 The returned string is *not* null-terminated.
1961 */
1962       (conn))
1963 {
1964         PGconn *P;
1965         char buffer[BLCKSZ];
1966         int ret;
1967
1968         CHECK_PGCONN(conn);
1969
1970         P = (XPGCONN(conn))->pgconn;
1971         CHECK_CONNECTION_ALIVE(P);
1972
1973         ret = PQgetlineAsync(P, buffer, sizeof(buffer));
1974
1975         if (ret == -1)
1976                 return Qt;      /* done! */
1977         else if (!ret)
1978                 return Qnil;    /* no data yet */
1979         else
1980                 return Fcons(make_int(ret),
1981                              make_ext_string((Extbyte *) buffer, ret,
1982                                              PG_OS_CODING));
1983 }
1984
1985 DEFUN("pq-put-nbytes", Fpq_put_nbytes, 2, 2, 0, /*
1986 Asynchronous copy out.
1987 */
1988       (conn, data))
1989 {
1990         /* NULs are not allowed.  I don't think this matters at this time. */
1991         PGconn *P;
1992         char *c_data;
1993
1994         CHECK_PGCONN(conn);
1995         CHECK_STRING(data);
1996
1997         P = (XPGCONN(conn))->pgconn;
1998         CHECK_CONNECTION_ALIVE(P);
1999         TO_EXTERNAL_FORMAT(LISP_STRING, data, C_STRING_ALLOCA, c_data, Qnative);
2000
2001         return !PQputnbytes(P, c_data, strlen(c_data)) ? Qt : Qnil;
2002 }
2003
2004 DEFUN("pq-end-copy", Fpq_end_copy, 1, 1, 0,     /*
2005 End a copying operation.
2006 */
2007       (conn))
2008 {
2009         PGconn *P;
2010
2011         CHECK_PGCONN(conn);
2012         P = (XPGCONN(conn))->pgconn;
2013         CHECK_CONNECTION_ALIVE(P);
2014
2015         return PQendcopy(P) ? Qt : Qnil;
2016 }
2017
2018 \f
2019 void
2020 syms_of_postgresql(void)
2021 {
2022         INIT_LRECORD_IMPLEMENTATION(pgconn);
2023         INIT_LRECORD_IMPLEMENTATION(pgresult);
2024
2025         defsymbol(&Qpostgresql, "postgresql");
2026
2027         /* opaque exported types */
2028         defsymbol(&Qpgconnp, "pgconnp");
2029         defsymbol(&Qpgresultp, "pgresultp");
2030
2031         /* connection status types
2032          * now implemented as keywords */
2033         DEFKEYWORD(Q_pg_connection_ok);
2034         DEFKEYWORD(Q_pg_connection_bad);
2035         DEFKEYWORD(Q_pg_connection_started);
2036         DEFKEYWORD(Q_pg_connection_made);
2037         DEFKEYWORD(Q_pg_connection_awaiting_response);
2038         DEFKEYWORD(Q_pg_connection_auth_ok);
2039         DEFKEYWORD(Q_pg_connection_setenv);
2040
2041         /* transaction status types */
2042         DEFKEYWORD(Q_pg_trans_idle);
2043         DEFKEYWORD(Q_pg_trans_active);
2044         DEFKEYWORD(Q_pg_trans_intrans);
2045         DEFKEYWORD(Q_pg_trans_inerror);
2046         DEFKEYWORD(Q_pg_trans_unknown);
2047
2048         /* Fields of PGconn */
2049         DEFKEYWORD(Q_pq_db);
2050         DEFKEYWORD(Q_pq_user);
2051         DEFKEYWORD(Q_pq_pass);
2052         DEFKEYWORD(Q_pq_host);
2053         DEFKEYWORD(Q_pq_port);
2054         DEFKEYWORD(Q_pq_tty);
2055         DEFKEYWORD(Q_pq_options);
2056         DEFKEYWORD(Q_pq_status);
2057         DEFKEYWORD(Q_pq_transaction_status);
2058         DEFKEYWORD(Q_pq_parameter_status);
2059         DEFKEYWORD(Q_pq_protocol_version);
2060         DEFKEYWORD(Q_pq_server_version);
2061         DEFKEYWORD(Q_pq_error_message);
2062         DEFKEYWORD(Q_pq_backend_pid);
2063 #ifdef HAVE_OPENSSL
2064         DEFKEYWORD(Q_pq_getssl);
2065 #endif
2066
2067         /* Query status results */
2068         DEFKEYWORD(Q_pgres_empty_query);
2069         DEFKEYWORD(Q_pgres_command_ok);
2070         DEFKEYWORD(Q_pgres_tuples_ok);
2071         DEFKEYWORD(Q_pgres_copy_out);
2072         DEFKEYWORD(Q_pgres_copy_in);
2073         DEFKEYWORD(Q_pgres_bad_response);
2074         DEFKEYWORD(Q_pgres_nonfatal_error);
2075         DEFKEYWORD(Q_pgres_fatal_error);
2076
2077         /* Poll status results */
2078         DEFKEYWORD(Q_pgres_polling_failed);
2079         DEFKEYWORD(Q_pgres_polling_reading);
2080         DEFKEYWORD(Q_pgres_polling_writing);
2081         DEFKEYWORD(Q_pgres_polling_ok);
2082         DEFKEYWORD(Q_pgres_polling_active);
2083
2084 #ifdef HAVE_POSTGRESQLV7
2085         DEFSUBR(Fpq_connect_start);
2086         DEFSUBR(Fpq_connect_poll);
2087 #ifdef MULE
2088         DEFSUBR(Fpq_client_encoding);
2089         DEFSUBR(Fpq_set_client_encoding);
2090 #endif                          /* MULE */
2091 #endif                          /* HAVE_POSTGRESQLV7 */
2092         DEFSUBR(Fpq_set_notice_processor);
2093
2094         DEFSUBR(Fpq_connection_p);
2095         DEFSUBR(Fpq_conn_defaults);
2096         DEFSUBR(Fpq_connectdb);
2097         DEFSUBR(Fpq_finish);
2098         DEFSUBR(Fpq_clear);
2099         DEFSUBR(Fpq_is_busy);
2100         DEFSUBR(Fpq_consume_input);
2101
2102 #ifdef HAVE_POSTGRESQLV7
2103         DEFSUBR(Fpq_escape_string);
2104         DEFSUBR(Fpq_escape_bytea);
2105         DEFSUBR(Fpq_unescape_bytea);
2106 #endif
2107
2108         DEFSUBR(Fpq_reset);
2109 #ifdef HAVE_POSTGRESQLV7
2110         DEFSUBR(Fpq_reset_start);
2111         DEFSUBR(Fpq_reset_poll);
2112 #endif
2113         DEFSUBR(Fpq_request_cancel);
2114         DEFSUBR(Fpq_connection_status);
2115         DEFSUBR(Fpq_connection_alive_p);
2116
2117         DEFSUBR(Fpq_exec);
2118         DEFSUBR(Fpq_send_query);
2119         DEFSUBR(Fpq_result_p);
2120         DEFSUBR(Fpq_get_result);
2121         DEFSUBR(Fpq_result_status);
2122         DEFSUBR(Fpq_result_status_string);
2123         DEFSUBR(Fpq_result_error_message);
2124         DEFSUBR(Fpq_ntuples);
2125         DEFSUBR(Fpq_nfields);
2126         DEFSUBR(Fpq_binary_tuples);
2127         DEFSUBR(Fpq_fname);
2128         DEFSUBR(Fpq_fnumber);
2129         DEFSUBR(Fpq_ftype);
2130         DEFSUBR(Fpq_fsize);
2131         DEFSUBR(Fpq_fmod);
2132         /***/
2133         DEFSUBR(Fpq_get_value);
2134         DEFSUBR(Fpq_get_length);
2135         DEFSUBR(Fpq_get_is_null);
2136         DEFSUBR(Fpq_cmd_status);
2137         DEFSUBR(Fpq_cmd_tuples);
2138         DEFSUBR(Fpq_oid_value);
2139
2140 #ifdef HAVE_POSTGRESQLV7
2141         DEFSUBR(Fpq_set_nonblocking);
2142         DEFSUBR(Fpq_is_nonblocking);
2143         DEFSUBR(Fpq_flush);
2144 #endif
2145         DEFSUBR(Fpq_notifies);
2146
2147 #if defined (HAVE_POSTGRESQLV7) && defined(MULE)
2148         DEFSUBR(Fpq_env_2_encoding);
2149 #endif
2150
2151         DEFSUBR(Fpq_lo_import);
2152         DEFSUBR(Fpq_lo_export);
2153
2154         DEFSUBR(Fpq_make_empty_pgresult);
2155
2156         /* copy in/out functions */
2157         DEFSUBR(Fpq_get_line);
2158         DEFSUBR(Fpq_put_line);
2159         DEFSUBR(Fpq_get_line_async);
2160         DEFSUBR(Fpq_put_nbytes);
2161         DEFSUBR(Fpq_end_copy);
2162 }
2163
2164 void vars_of_postgresql(void)
2165 {
2166         Fprovide(Qpostgresql);
2167 #ifdef HAVE_POSTGRESQLV7
2168         Fprovide(intern("postgresqlv7"));
2169 #endif
2170         Vpg_coding_system = Qnative;
2171         DEFVAR_LISP("pg-coding-system", &Vpg_coding_system      /*
2172 Default Postgres client coding system.
2173                                                                 */ );
2174
2175         DEFVAR_LISP("pg:host", &VXPGHOST        /*
2176 Default PostgreSQL server name.
2177 If not set, the server running on the local host is used.  The
2178 initial value is set from the PGHOST environment variable.
2179                                                  */ );
2180
2181         DEFVAR_LISP("pg:user", &VXPGUSER        /*
2182 Default PostgreSQL user name.
2183 This value is used when connecting to a database for authentication.
2184 The initial value is set from the PGUSER environment variable.
2185                                                  */ );
2186
2187         DEFVAR_LISP("pg:options", &VXPGOPTIONS  /*
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:port", &VXPGPORT        /*
2194 Default port to connect to PostgreSQL backend.
2195 This value is used when connecting to a database.
2196 The initial value is set from the PGPORT environment variable.
2197                                                  */ );
2198
2199         DEFVAR_LISP("pg:tty", &VXPGTTY  /*
2200 Default debugging TTY.
2201 There is no useful setting of this variable in the XEmacs Lisp API.
2202 The initial value is set from the PGTTY environment variable.
2203                                          */ );
2204
2205         DEFVAR_LISP("pg:database", &VXPGDATABASE        /*
2206 Default database to connect to.
2207 The initial value is set from the PGDATABASE environment variable.
2208                                                          */ );
2209
2210         DEFVAR_LISP("pg:realm", &VXPGREALM      /*
2211 Default kerberos realm to use for authentication.
2212 The initial value is set from the PGREALM environment variable.
2213                                                  */ );
2214
2215 #ifdef MULE
2216         /* It's not clear whether this is any use.  My intent is to
2217            autodetect the coding system from the database. */
2218         DEFVAR_LISP("pg:client-encoding", &VXPGCLIENTENCODING   /*
2219 Default client encoding to use.
2220 The initial value is set from the PGCLIENTENCODING environment variable.
2221                                                                  */ );
2222 #endif
2223
2224 #if !defined(HAVE_POSTGRESQLV7)
2225         DEFVAR_LISP("pg:authtype", &VXPGAUTHTYPE        /*
2226 Default authentication to use.
2227 The initial value is set from the PGAUTHTYPE environment variable.
2228
2229 WARNING:  This variable has gone away in versions of PostgreSQL newer
2230 than 6.5.
2231                                                          */ );
2232 #endif
2233
2234         DEFVAR_LISP("pg:geqo", &VXPGGEQO        /*
2235 Genetic Query Optimizer options.
2236 The initial value is set from the PGGEQO environment variable.
2237                                                  */ );
2238
2239         DEFVAR_LISP("pg:cost-index", &VXPGCOSTINDEX     /*
2240 Default cost index options.
2241 The initial value is set from the PGCOSTINDEX environment variable.
2242                                                          */ );
2243
2244         DEFVAR_LISP("pg:cost-heap", &VXPGCOSTHEAP       /*
2245 Default cost heap options.
2246 The initial value is set from the PGCOSTHEAP environment variable.
2247                                                          */ );
2248
2249         DEFVAR_LISP("pg:tz", &VXPGTZ    /*
2250 Default timezone to use.
2251 The initial value is set from the PGTZ environment variable.
2252                                          */ );
2253
2254         DEFVAR_LISP("pg:date-style", &VXPGDATESTYLE     /*
2255 Default date style to use.
2256 The initial value is set from the PGDATESTYLE environment variable.
2257                                                          */ );
2258 }
2259
2260 /* These initializations should not be done at dump-time. */
2261 void
2262 init_postgresql_from_environment(void)
2263 {
2264         char *p;
2265
2266         if ((p = getenv("PGHOST"))) {
2267                 VXPGHOST = build_ext_string(p, PG_OS_CODING);
2268         } else {
2269                 VXPGHOST = Qnil;
2270         }
2271
2272         if ((p = getenv("PGUSER"))) {
2273                 VXPGUSER = build_ext_string(p, PG_OS_CODING);
2274         } else {
2275                 VXPGUSER = Qnil;
2276         }
2277
2278         if ((p = getenv("PGOPTIONS"))) {
2279                 VXPGOPTIONS = build_ext_string(p, PG_OS_CODING);
2280         } else {
2281                 VXPGOPTIONS = Qnil;
2282         }
2283
2284         if ((p = getenv("PGPORT"))) {
2285                 VXPGPORT = make_int(atoi(p));
2286         } else {
2287                 VXPGPORT = Qnil;
2288         }
2289
2290         if ((p = getenv("PGTTY"))) {
2291                 VXPGTTY = build_ext_string(p, PG_OS_CODING);
2292         } else {
2293                 VXPGTTY = Qnil;
2294         }
2295
2296         if ((p = getenv("PGDATABASE"))) {
2297                 VXPGDATABASE = build_ext_string(p, PG_OS_CODING);
2298         } else {
2299                 VXPGDATABASE = Qnil;
2300         }
2301
2302         if ((p = getenv("PGREALM"))) {
2303                 VXPGREALM = build_ext_string(p, PG_OS_CODING);
2304         } else {
2305                 VXPGREALM = Qnil;
2306         }
2307
2308 #ifdef MULE
2309         /* It's not clear whether this is any use.  My intent is to
2310            autodetect the coding system from the database. */
2311         if ((p = getenv("PGCLIENTENCODING"))) {
2312                 VXPGCLIENTENCODING = build_ext_string(p, PG_OS_CODING);
2313         } else {
2314                 VXPGCLIENTENCODING = Qnil;
2315         }
2316 #endif
2317
2318 #if !defined(HAVE_POSTGRESQLV7)
2319         if ((p = getenv("PGAUTHTYPE"))) {
2320                 VXPGAUTHTYPE = build_ext_string(p, PG_OS_CODING);
2321         } else {
2322                 VXPGAUTHTYPE = Qnil;
2323         }
2324 #endif
2325
2326         if ((p = getenv("PGGEQO"))) {
2327                 VXPGGEQO = build_ext_string(p, PG_OS_CODING);
2328         } else {
2329                 VXPGGEQO = Qnil;
2330         }
2331
2332         if ((p = getenv("PGCOSTINDEX"))) {
2333                 VXPGCOSTINDEX = build_ext_string(p, PG_OS_CODING);
2334         } else {
2335                 VXPGCOSTINDEX = Qnil;
2336         }
2337
2338         if ((p = getenv("PGCOSTHEAP"))) {
2339                 VXPGCOSTHEAP = build_ext_string(p, PG_OS_CODING);
2340         } else {
2341                 VXPGCOSTHEAP = Qnil;
2342         }
2343
2344         if ((p = getenv("PGTZ"))) {
2345                 VXPGTZ = build_ext_string(p, PG_OS_CODING);
2346         } else {
2347                 VXPGTZ = Qnil;
2348         }
2349
2350         if ((p = getenv("PGDATESTYLE"))) {
2351                 VXPGDATESTYLE = build_ext_string(p, PG_OS_CODING);
2352         } else {
2353                 VXPGDATESTYLE = Qnil;
2354         }
2355 }
2356
2357 /* postgresql.c ends here */