pax_global_header00006660000000000000000000000064150053524150014512gustar00rootroot0000000000000052 comment=4f2d0cf8e7a0d3b1ffbfe84989f38eabea5589b4 pg-el-0.54/000077500000000000000000000000001500535241500124465ustar00rootroot00000000000000pg-el-0.54/.github/000077500000000000000000000000001500535241500140065ustar00rootroot00000000000000pg-el-0.54/.github/workflows/000077500000000000000000000000001500535241500160435ustar00rootroot00000000000000pg-el-0.54/.github/workflows/elisp-check.yml000066400000000000000000000013601500535241500207550ustar00rootroot00000000000000name: elisp-check on: [push] jobs: check: runs-on: ubuntu-latest timeout-minutes: 15 strategy: fail-fast: false matrix: # Emacs versions 26.3 and 28.2 are raising spurious "wrong number of arguments" errors, so # don't test with them. emacs_version: - 27.2 - 29.1 - snapshot ignore_warnings: - true include: - emacs_version: snapshot ignore_warnings: false steps: - uses: actions/checkout@v4 - uses: purcell/setup-emacs@master with: version: ${{ matrix.emacs_version }} - uses: leotaku/elisp-check@master with: file: pg.el ignore_warnings: ${{ matrix.ignore_warnings }} pg-el-0.54/.github/workflows/mdbook.yml000066400000000000000000000024741500535241500200500ustar00rootroot00000000000000# Build our user documentation using mdbook and publish to GitHub Pages # # The default build of highlight.js bundled with mdbook does not support Emacs Lisp syntax # highlighting, so we use a custom build downloaded from https://highlightjs.org/download with the # "lisp" language enabled. This is placed at theme/highlight.js to override the bundled version. name: Build documentation on: workflow_dispatch jobs: build-mdbook: runs-on: ubuntu-latest permissions: contents: write pages: write id-token: write # To update the deployment status name: Build documentation with mdbook and deploy to GitHub pages steps: - uses: dtolnay/rust-toolchain@nightly - name: Checkout uses: actions/checkout@v4 with: fetch-depth: 0 - name: Install latest mdbook run: | cargo install mdbook cargo install mdbook-admonish - name: Build book run: | (cd doc && mdbook-admonish install .) (cd doc && mdbook build ) - name: Setup GitHub Pages uses: actions/configure-pages@v4 - name: Upload artifact uses: actions/upload-pages-artifact@v3 with: path: 'doc/book' - name: Deploy to GitHub Pages id: deployment uses: actions/deploy-pages@v4 pg-el-0.54/.github/workflows/test-macos.yml000066400000000000000000000016711500535241500206520ustar00rootroot00000000000000name: test-macos on: push jobs: runner-job: # using the PostgreSQL version pre-installed on GitHub's MacOS virtual images runs-on: macos-latest timeout-minutes: 20 steps: - name: Set runner timezone uses: szenius/set-timezone@v2.0 with: timezoneLinux: "UTC-01:00" timezoneMacos: "UTC-01:00" timezoneWindows: "UTC-01:00" - name: Set up pre-installed PostgreSQL uses: ikalnytskyi/action-setup-postgres@v6 with: username: pgeltestuser password: pgeltest database: pgeltestdb id: postgres env: TZ: UTC-01:00 - name: Install Emacs uses: purcell/setup-emacs@master with: version: 29.4 - name: Check out repository code uses: actions/checkout@v4 - name: Run tests over network run: make -C test test env: TZ: UTC-01:00 pg-el-0.54/.github/workflows/test-pgv12.yml000066400000000000000000000020641500535241500205040ustar00rootroot00000000000000name: test-pgv12 on: push jobs: runner-job: runs-on: ubuntu-24.04 timeout-minutes: 15 services: postgres: # Docker Hub image image: postgres:12-alpine env: TZ: UTC-01:00 POSTGRES_DB: pgeltestdb POSTGRES_USER: pgeltestuser POSTGRES_PASSWORD: pgeltest # Set health checks to wait until postgres has started options: >- --health-cmd pg_isready --health-interval 10s --health-timeout 5s --health-retries 5 ports: # Maps tcp port 5432 on service container to the host - 5432:5432 volumes: - /var/run/postgresql:/var/run/postgresql steps: - name: Install Emacs uses: purcell/setup-emacs@master with: version: 29.4 - name: Check out repository code uses: actions/checkout@v4 - name: Run connection tests over TCP run: make -C test - name: Run connection tests over local Unix socket run: make -C test test-local pg-el-0.54/.github/workflows/test-pgv15.yml000066400000000000000000000024301500535241500205040ustar00rootroot00000000000000name: test-pgv15 on: push jobs: runner-job: runs-on: ubuntu-latest timeout-minutes: 15 services: # Label used to access the service container postgres: # Docker Hub image image: postgres:15 env: TZ: UTC-01:00 POSTGRES_DB: pgeltestdb POSTGRES_USER: pgeltestuser POSTGRES_PASSWORD: pgeltest # Set health checks to wait until postgres has started options: >- --health-cmd pg_isready --health-interval 10s --health-timeout 5s --health-retries 5 ports: # Maps tcp port 5432 on service container to the host - 5432:5432 volumes: - /var/run/postgresql:/var/run/postgresql steps: # The version of Emacs available in the ancient Ubuntu distribution used by GitHub # actions is too old. - name: Install Emacs uses: purcell/setup-emacs@master with: version: 29.4 - name: Check out repository code uses: actions/checkout@v4 - name: Run tests over TCP socket run: make -C test test env: TZ: UTC-01:00 - name: Run tests over local Unix socket run: make -C test test-local env: TZ: UTC-01:00 pg-el-0.54/.github/workflows/test-pgv15b-docker.yml000066400000000000000000000020351500535241500221140ustar00rootroot00000000000000name: test-pgv15b-docker on: push jobs: runner-job: runs-on: ubuntu-latest timeout-minutes: 15 steps: - name: Install Emacs run: | sudo apt-get update sudo apt-get install emacs podman - name: Start Docker/Podman image of PostgreSQL run: sudo docker run --detach \ --name pgsql \ --publish 5432:5432 \ -e POSTGRES_DB=pgeltestdb \ -e POSTGRES_USER=pgeltestuser \ -e POSTGRES_PASSWORD=pgeltest \ docker.io/library/postgres:15 # -c ssl=on \ # -c ssl_cert_file=/etc/ssl/certs/ssl-cert-snakeoil.pem \ # -c ssl_key_file=/etc/ssl/private/ssl-cert-snakeoil.key # --health-cmd pg_isready \ # --health-interval 10s \ # --health-timeout 5s \ # --health-retries 5 \ - name: Check out repository code uses: actions/checkout@v4 - name: Run connection tests from Emacs run: make -C test test test-tls pg-el-0.54/.github/workflows/test-pgv16.yml000066400000000000000000000021261500535241500205070ustar00rootroot00000000000000name: test-pgv16 on: push jobs: runner-job: runs-on: ubuntu-24.04 timeout-minutes: 15 services: # Label used to access the service container postgres: # Docker Hub image image: postgres:16 env: TZ: UTC-01:00 POSTGRES_DB: pgeltestdb POSTGRES_USER: pgeltestuser POSTGRES_PASSWORD: pgeltest # Set health checks to wait until postgres has started options: >- --health-cmd pg_isready --health-interval 10s --health-timeout 5s --health-retries 5 ports: # Maps tcp port 5432 on service container to the host - 5432:5432 volumes: - /var/run/postgresql:/var/run/postgresql steps: - name: Install Emacs uses: purcell/setup-emacs@master with: version: 29.4 - name: Check out repository code uses: actions/checkout@v4 - name: Run tests over TCP socket run: make -C test test - name: Run tests over local Unix socket run: make -C test test-local pg-el-0.54/.github/workflows/test-windows.yml000066400000000000000000000014321500535241500212350ustar00rootroot00000000000000name: test-windows on: push jobs: runner-job: runs-on: windows-latest timeout-minutes: 20 steps: - name: Set runner timezone uses: szenius/set-timezone@v2.0 with: timezoneLinux: "UTC-01:00" timezoneMacos: "UTC-01:00" timezoneWindows: "UTC-01:00" - name: Set up pre-installed PostgreSQL uses: ikalnytskyi/action-setup-postgres@v6 with: username: pgeltestuser password: pgeltest database: pgeltestdb id: postgres env: TZ: UTC-01:00 - name: Install Emacs run: choco install --no-progress -y emacs - name: Check out repository code uses: actions/checkout@v4 - name: Run tests run: make -C test test pg-el-0.54/.justfile000066400000000000000000000011341500535241500142730ustar00rootroot00000000000000# For use with the just command runner, https://just.systems/ default: @just --list export INSTALL_EL := ''' (unless (package-installed-p 'pg) (package-vc-install "https://github.com/emarsden/pg-el" nil nil 'pg)) (require 'pg) ''' tmpdir := `mktemp -d` init-el := tmpdir / "init.el" # Check whether our package-vc-install instructions work on a pristine install. installability: printf '%s' "$INSTALL_EL" > {{ init-el }} ls -l {{ init-el }} cat {{ init-el }} podman run --rm -ti -v {{ tmpdir }}:/tmp docker.io/silex/emacs:29.4-ci \ ${EMACS:-emacs} -l /tmp/init.el pg-el-0.54/CHANGELOG.md000077500000000000000000000571311500535241500142710ustar00rootroot00000000000000# Changelog ## [0.54] - Unreleased - Handle `ParameterStatus` and `NotificationResponse` messages in `pg-fetch`. - New function `pg-set-client-encoding` to set the client-side encoding for data sent to the backend. Calling this function sends an SQL request to the backend telling it of the new client encoding, and sets the per-connection client encoding (accessible via `pgcon-client-encoding`). It also checks that the requested client encoding is one supported by PostgreSQL. Note that most of the PostgreSQL variants only support UTF8 as a client-encoding. - Implement workaround for `pg-column-default` for Google Spanner and QuestDB. - Fix for parsing empty arrays. - New subclass of `pg-error` `pg-transaction-missing` triggered by an attempt to rollback with no transaction in progress. - Add preliminary support for the ReadySet PostgreSQL proxy as a PostgreSQL variant. - Add preliminary support for the YottaDB Octo database as a PostgreSQL variant. ## [0.53] - 2025-04-19 - In `pg-sync`, try to read the `ReadyForQuery` message sent by the backend. - Add test code for the PgDog and PgCat sharding connection poolers. - Implement workarounds for the RisingWave variant in `pg-table-comment` and `pg-column-comment` and their companion setf functions. - Populate our oid<->typname mappings with predefined data for variants that lack a properly populated `pg_type` table (this is the case for GreptimeDB, which contains invalud information such as `UInt8` <-> 7). Although strictly speaking there is no guarantee that this internal information will remain unchanged in future PostgreSQL releases, it is unlikely to change. ## [0.52] - 2025-04-06 - In `pg-fetch-prepared`, close the portal after fetching the tuple data. - Provide a basic stub implementation for `pg-table-owner` for CrateDB. - Add code to detect the Greenplum PostgreSQL variant. ## [0.51] - 2025-03-29 - In `pg-connect/uri`, call `url-unhex-string` on user/password only if non-nil. This restores the ability to fall back to `PGUSER` and `PGPASSWORD` environment variables. Patch from @akurth. - Fix bug in `pg-table-comment` function and in the associated setf function. - Provide an empty implementation of `pg-column-default` and `pg-table-comment` for the YDB variant. - New error types `pg-invalid-catalog` name and `pg-timeout`. ## [0.50] - 2025-03-22 - Implement new function `pg-column-comment` with a defsetf. - Improve `cl-print-object` for a connection object when the pid and database slots are unbound. - Further workarounds in `pg-table-comment` for QuestDB and Spanner variants. - Add workarounds in `pg-column-comment` for CrateDB and QuestDB. - Add workaround in `pg-function-p` for QuestDB. - Add a custom SQL query for `pg-column-autogenerated-p` to handle limitations in the CrateDB variant. - Add workaround for variant YDB in `pg-tables`. ## [0.49] - 2025-03-08 - Implement hex-decoding for the username and password in `pg-connect/uri`. - New error classes `pg-character-not-in-repertoire` and `pg-plpgsl-error`. - New error subclasses of `pg-error`: `pg-database-error`, `pg-operational-error`, `pg-programming-error`, `pg-data-error`, `pg-integrity-error`. These are superclasses of some of the leaf error subclasses: for example the errors related to integrity violations `pg-restrict-violation`, `pg-not-null-violation` and `pg-foreign-key-violation` are all subclasses of `pg-integrity-error`. - Filter out system-internal tables in the list returned by `pg-tables` for the Clickhouse variant. - New function `pg-current-schema` which returns the value of `current_schema()` (or equivalent on PostgreSQL variants that do not implement that function). - Implement custom logic for `pg-table-comment` for the semi-compatible PostgreSQL variant CockroachDB. - Provide parsing and serialization support for the types defined by the vchord_bm25 extension, which implements the BM25 ranking algorithm that is useful for information retrieval applications. See file `pg-bm25.el`. ## [0.48] - 2025-02-22 - The error hierarchy has been enriched with many subclasses of `pg-error`, distinguishing between an SQL syntax error, a division by zero, a numerical overflow, and so on. See the pg-el manual for details. - Added logic to recognize the PostgreSQL variant Materialize. - Error reporting: if the constraint name field is present, it is saved in the pgerror struct and reported to the user. ## [0.47] - 2025-01-25 - New variable `pg-new-connection-hook` contains a list of functions to be run when a new PostgreSQL connection is established. Each function will be called with the new connection as the single argument. The default value of this variable includes the function `pg-detect-server-variant`, which attempts to determine the type of semi-compatible PostgreSQL variant that we are connected to. - New generic function `pg-do-variant-specific-setup` that allows you to specify setup operations to run for a particular semi-compatible PostgreSQL variant. - Added logic to recognize the PostgreSQL variant AlloyDB Omni. ## [0.46] - 2025-01-12 - Fixes to the handling of timezones when parsing and serializing `time` and `timetz` data. Timezone information was previously lost during parsing and serialization. Patch from @akurth. - Further workarounds in `pg-table-column` and `pg-column-default` to tolerate deficiencies in the PostgreSQL compatibility of CrateDB and CockroachDB. - Add a workaround in `pg-schemas` for RisingWave database. ## [0.45] - 2024-12-22 - When supported by Emacs, enable `TCP_NODELAY` on the network connections to PostgreSQL to disable Nagle's algorithm (network segments are sent as soon as possible, even when they contain little data). This is done by libpq and results in a 12x (!) speedup on some benchmarks. This is a new feature available in (currently unreleased) Emacs 31 (bug#74793). - New function `pg-schemas` which returns the list of the schemas in a PostgreSQL database. Schemas are a form of namespace, which can contain elements such as tables, sequences, indexes and views. The default schema name is `public`. - Add support for detecting the RisingWave database, which is compatible with the PostgreSQL wire protocol, with certain limitations. For this database, `pgcon-server-variant` returns the symbol `risingwave`. - When parsing timestamp and time data, preserve the fractional part of a second (patch from @akurth). ## [0.44] - 2024-12-04 - Detect the PostgreSQL variant TimescaleDB. Implement a specific SQL query for `pg-tables` for this variant to avoid returning TimescaleDB-internal tables alongside user tables. - Detect the PostgreSQL variant OrioleDB (really an extension that provides an additional storage mechanism). - Implement a specific SQL query for `pg-tables` for the CrateDB variant, to avoid returning system tables alongside user tables. - The serialization function for floating point values accepts non-float numeric values. - When parsing a PostgreSQL connection URI or connection string, additional environment variables `PGHOST`, `PGHOSTADDR`, `PGPORT`, `PGDATABASE`, `PGUSER`, `PGPASSWORD` and `PGSSLMODE` are used as default values when a value has not been explicitly set in the string. ## [0.43] - 2024-10-15 - Fix serialization for `UUID` types in prepared statements. - The serialization of key/value pairs in an `HSTORE` object now respects the client encoding, so will work correctly with non-ASCII characters. - Improved error reporting in the pg-geometry library (signalling a subclass of pg-error instead of triggering an assertion). - Additional checks on connection startup to identify the PostgreSQL variant IvorySQL (currently a very compatible variant with additional Oracle compatibility functions). - Fix bug in startup sequence exposed by very short usernames (reported by Ákos Kiss aka `ak`). ## [0.42] - 2024-09-21 - Fix serialization and deserialization for `CHARACTER` and `BPCHAR` types for non-ASCII values. PostgreSQL stores these as a single octet, an integer < 256. Characters that are below this limit but not in the ASCII range (such as many accented characters if your Emacs uses a Latin-1 charset) need to be encoded and decoded. - Add support for parameters `connect_timeout` and (nonstandard extension) `read_timeout` when parsing PostgreSQL connection URIs and connection strings. - Add functionality to detect the “flavour” variant of (potentially semi-compatible) PostgreSQL database that we are connected to. The variant is accessible via `pgcon-server-variant` on a connection object. Detected variants are 'cratedb, 'xata, 'cockroachdb, 'yugabyte, 'questdb, 'greptimedb, 'immudb, 'ydb. This functionality is used to work around certain bugs or incomplete emulation of PostgreSQL system tables by some of these semi-compatible database implementations. ## [0.41] - 2024-08-31 - User errors in serialization functions (arguments supplied to `pg-exec-prepared` whose type does not correspond to the SQL-defined type) now signal an error of type `pg-type-error`, which is a subclass of `pg-user-error`, instead of triggering an assertion failure. This means that they can be handled using `condition-case`. - Delete all uses of variable `pg--MAX_MESSAGE_LEN`, because PostgreSQL no longer has such low limits on message sizes (the only limit being the 4-octet size fields in many message types). - Support for TLS authentication using client certificates (see the documentation for function `pg-connect`). The `test-certificates` Makefile target in the `test` directory illustrates the creation of a working certificate authority and signed client certificates; depending on the value of connection parameter `clientcert`, PostgreSQL is careful to check that the `CN` field of the client certificate corresponds to the PostgreSQL user you are connecting as. ## [0.40] - 2024-08-22 - Serialization and deserialization support for [JSONPATH expressions](https://www.postgresql.org/docs/current/functions-json.html#FUNCTIONS-SQLJSON-PATH). These expressions are represented in Emacs Lisp as strings. - Serialization functions now take a second argument `ENCODING` specifying the client-encoding in use, in the same way as for deserialization functions. - The mappings `pg--parser-by-oid`, `pg--oid-by-typname` and `pg--type-name-by-oid` have been moved into the pgcon object, rather than being local variables. This makes it possible to connect from the same Emacs instance to PostgreSQL-compatible databases that have different OID values for builtin or user-defined types. - `pgcon` objects are now defined using `defclass` from EIEIO, instead of using `cl-defstruct`. This makes it possible to customize the way they are printed, making use in an interactive REPL more pleasant. ## [0.39] - 2024-07-29 - New function `pg-fetch-prepared` to bind arguments to a prepared statement and fetch results. Preparing a statement once then reusing it multiple times with different argument values allows you to avoid the overhead of sending and parsing the SQL query and calculating the query plan. This is a simple convenience wrapper around functions `pg-bind`, `pg-describe-portal` and `pg-fetch`. - New function `pg-ensure-prepared-statement` that either returns the previously prepared statement saved in the prepared statement cache of our PostgreSQL connection, or prepares the statement and saves it in the cache. This simplifies the use of cached prepared statements. - New function `pg-column-autogenerated-p`, which returns non-nil for columns for which you can insert a row without specifying a value for the column. That includes columns: - with a specified `DEFAULT` (including `SERIAL` columns) - specified as `BIGINT GENERATED ALWAYS AS IDENTITY` - specified as `GENERATED ALWAYS AS expr STORED` (calculated from other columns) - Fix serialization for the PostgreSQL `BPCHAR` type. - Move to GPL v3 or later licence (from GPL-2.0-or-later). ## [0.38] - 2024-07-21 - The network connection timeout functionality is disabled on Microsoft Windows platforms, where it does not function correctly. This is implemented by setting the variable `pg-connect-timeout` to 0. This setting can also be used to disable the connection timeout on other platforms. - Fix the deserialization of `TIMESTAMP WITH TIMEZONE` and `TIMESTAMP WITHOUT TIMEZONE` values when the timezone is not explicitly specified. - Preliminary serialization and deserialization support for the types used by the PostGIS extension (types `GEOMETRY`, `GEOGRAPHY`, `SPHEROID`, `BOX2D`, `BOX3D`). Some of these types are deserialized from the native hex encoding of EWKB returned by PostGIS to text format using the `geosop` commandline utility, if the variable `pg-gis-use-geosop` is non-nil (which is the default). ## [0.37] - 2024-07-08 - Fix serialization of JSONB parameters in prepared statements. - Preliminary serialization and deserialization support for the PostgreSQL `POINT`, `LINE`, `LSEG`, `BOX`, `PATH` and `POLYGON` geometric types. - Parsing support for the PostgreSQL `timetz` type (simply parsed as text). - New function `pg-serialize` converts an Emacs Lisp object to its serialized text format, playing the inverse role to `pg-parse`. - Source code split into multiple source files to improve maintainability. ## [0.36] - 2024-06-23 - New utility function `pg-function-p` which checks whether a function with a specified name is defined in PostgreSQL. - Better support for the dynamic creation of PostgreSQL types. The cache used to map between PostgreSQL type names and the corresponding OIDs is now only used for builtin PostgreSQL types, which should not change over time. Values of all other PostgreSQL types, in particular new types created using `CREATE TYPE`, will be sent over the wire using the pseudo-OID of 0, telling PostgreSQL to look up the OID on the backend. This avoids the possibility of invalid cached OID values caused by type creation or destruction on other connections to PostgreSQL. - Parse the PostgreSQL UUID type as text. - Parse the PostgreSQL XML type as text. - Fix deserialization for the PostgreSQL BPCHAR type. - Fix serialization and deserialization for the PostgreSQL VECTOR type used by the `pgvector` extension. Vector embeddings can be floating point numbers, not just integers. - Implement some workarounds better to support CrateDB. ## [0.35] - 2024-06-08 - New variable `pg-read-timeout` allows you to specify a timeout expressed in seconds when reading data from PostgreSQL over the network. A complement to the variable `pg-connect-timeout`. - Accept a `server_version` backend parameter of the form "17beta1", in addition to the standard format of the form "16.3". Tests pass with PostgreSQL 17 beta1. ## [0.34] - 2024-05-20 - Add deserialization support for the `tsvector` type, used by the PostgreSQL full text search functionality. They will now be parsed into a list of `pg-ts` structures. ## [0.33] - 2024-05-14 - Add serialization support for the PostgreSQL `date` type. - Add serialization support for the `vector` type used by the pgvector extension. ## [0.32] - 2024-04-14 - Integer datatypes are now parsed with `cl-parse-integer` instead of `string-to-number` to provide error detection. - Add serialization support for the PostgreSQL `timestamp`, `timestamptz` and `datetime` types. - New feature: logging of SQL queries sent to PostgreSQL on a per-connection basis. Call function `pg-enable-query-log` on a connection object, and SQL sent to the backend by `pg-exec` and `pg-exec-prepared` will be logged to a buffer named ` *PostgreSQL query log*` (made unique if multiple pg-el connections have been made). The name of the buffer is given by accessor function `pgcon-query-log` on the connection object. - New variable `pg-connect-timeout` to set a timeout (in seconds) for attempts to connect to PostgreSQL over the network (does not apply to Unix socket connections). ## [0.31] - 2024-03-28 - Add serialization support for the `hstore` datatype from Emacs Lisp hashtables. - Add support for schema-qualified names for tables and roles. These are names of the form `public.tablename` or `username.tablename` (see the PostgreSQL documentation for `CREATE SCHEMA`). “Ordinary” table names in the `public` schema can be specified as a simple string. Table names with a different schema are represented by `pg-qualified-name` objects (these are cl-defstruct objects). Functions that take a table name as an argument (such as `pg-columns` accept either a normal string or a `pg-qualified-name` object. Functions that return table names, in particular `pg-tables`, will return strings for tables in the normal `public` schema, and `pg-qualified-name` objects otherwise. - Fix bug in the parsing of `pgcon-server-version-major`. ## [0.30] - 2024-03-11 - Add for receiving data in Emacs using the COPY protocol, as a complement to the existing functionality which uses the COPY protocol to send data from Emacs to PostgreSQL. This allows you to dump a PostgreSQL table or query result in TSV or CSV format into an Emacs buffer. See function `pg-copy-to-buffer`. - Preliminary implementation of connection to PostgreSQL via a connection string of the form `host=localhost port=5432 dbname=mydb` (see function `pg-connect/string`). - Preliminary implementation of connection to PostgreSQL via a connection URI of the form `postgresql://other@localhost/otherdb?connect_timeout=10&application_name=myapp&ssl=true` (see function `pg-connect/uri`). - Add serialization function for the `bpchar` type. - If the environment variable `PGAPPNAME` is set, it will override the default value of variable `pg-application-name`. ## [0.29] - 2024-03-02 - New function `pg-table-owner`. - New functions `pg-table-comment` and `(setf pg-table-comment)`. - New function `pg-column-default` which returns the default value for a column. ## [0.28] - 2024-02-21 - New functions `pg-escape-identifier` and `pg-escape-literal` to escape an SQL identifier (table, column or function name) or a string in an SQL command. These functions are similar respectively to libpq functions `PQescapeIdentifier` and `PQescapeLiteral`. These functions help to prevent SQL injection attacks. However, you should use prepared statements (elisp function `pg-exec-prepared`) instead of these functions whenever possible. ## [0.27] - 2024-01-10 - Improvements to the internal parsing functionality to use a hashtable instead of an alist to look up parsing functions (performance should be improved). - Improved support for user-defined parsing for custom PostgreSQL types (see the function `pg-register-parser`). - Add support for the pgvector extension for vector embeddings. ## [0.26] - 2023-12-18 - API change for `pg-fetch` when using prepared statements with a suspended portal. The second argument is a pgresult structure, rather than the portal name. This changes improves performance by making it possible to avoid redundant DescribeRow messages. - The extended query flow used by `pg-exec-prepared` has been modified to be more asynchronous to improve performance: instead of waiting for a response after the Prepare and Bind phases, only wait a single time after the Execute phase. ## [0.25] - 2023-12-14 - Add support for the extended query syntax, which helps to avoid the risk of SQL injection attacks. See function `pg-exec-prepared`. This also makes it easier to fetch partial results from a query that returns a large number of rows. - Fix parsing of PostgreSQL `CHAR` type to an Emacs character instead of a string of length 1. - Various internal functions and variables renamed with the `pg--` prefix instead of `pg-`. ## [0.24] - 2023-11-15 ### New - Add function `pg-add-notification-handler` to add a function to the list of handlers for `NotificationResponse` messages from PostgreSQL. A handler takes two arguments, the channel and the payload, which correspond to SQL-level `NOTIFY channel, 'payload'`. - Add support for asynchronous processing of messages from PostgreSQL, in particular for use of LISTEN/NOTIFY. This allows PostgreSQL and Emacs to be used in a publish-subscribe pattern which decouples event publication from the number and the speed of event processing nodes. See the notification-publisher.el and notification-subscriber.el tests for a basic example. ### Fixed - Fix the implementation of `pg-tables` and `pg-columns` to use the information schema instead of historical alternative SQL queries. ## [0.23] - 2023-08-20 ### New - Preliminary support for the COPY protocol. See function `pg-copy-from-buffer`. ## [0.22] - 2023-07-16 ### Fixed - The backend can send NoticeResponse messages during connection startup, for example indicating a collation version mismatch between your database and the operating system. ## [0.21] - 2023-04-23 ### Fixed - Declare some autoloaded functions to avoid warning from the bytecode compiler. ## [0.20] - 2022-12-10 ### Fixed - Wait for further data from the network in `pg-read-chars` if the process buffer doesn't yet contain the necessary data (fix from swilsons). ## [0.19] - 2022-11-19 ### New - Add support for parsing the `BIT` and `VARBIT` datatypes. - Add support for parsing ARRAY datatypes. - Add support for parsing RANGE datatypes (integer and numerical). - Add support for parsing HSTORE datatypes (see function `pg-hstore-setup` to prepare the database connection for use of the HSTORE datatype). - Add function `pg-cancel` to request cancellation of the command currently being processed by the backend. ### Fixed - Fix bug in handling of DataRow messages when zero columns returned by query. ## [0.18] - 2022-10-16 ### New - Add support for connecting to PostgreSQL over a local Unix socket. - Add support for parsing the `BYTEA` datatype (binary strings). We assume that the PostgreSQL configuration variable `bytea_output` is set to `hex` (the default setting). - Add support for parsing the `JSON` datatype, into the Emacs JSON representation. - Add support for parsing the `JSONB` datatype, into the Emacs JSON representation. - Add support for handling ParameterStatus messages sent by the backend (see variable `pg-parameter-change-functions`). - Add support for handling NOTICE messages sent by the backend (see variable `pg-handle-notice-functions`). - New pg-error and pg-protocol-error error types. All errors raised by the library will be a subclass of pg-error. ### Fixed - Fix bug in parsing of NULL column values in DataRow messages. - Fix handling of encoding of attribute column names. - Fix handling of PostgreSQL error messages (correctly resync with the backend). ## [0.17] - 2022-09-30 ### Updated - Support for encrypted (TLS) connections with PostgreSQL - Native support for PBKDF2 algorithm to allow SCRAM-SHA-256 authentication without the external nettle-pbkdf2 application - Implement multibyte encoding and decoding for pg-exec requests - Send application_name to PostgreSQL backend to improve observability - Fix handling of NotificationResponse messages - Improve test coverage - Include continuous integration tests on Windows and MacOS (GitHub actions) - This version distributed via MELPA ## [0.16] - 2022-09-18 ### Updated - Fix MD5 authentication - Use client-encoding to decode PostgreSQL error messages - Improve GitHub Actions continuous integration workflow ## [0.15] - 2022-09-06 ### Updated - Moved from cl library to cl-lib - pg: prefix for symbol names changed to pg- (Emacs Lisp coding conventions) - Implemented version 3.0 of the PostgreSQL wire protocol - Implemented SCRAM-SHA-256 authentication - Implemented MD5 authentication - Distributed via github repository ## [0.11] - 2001 This version was distributed from http://purl.org/net/emarsden/home/downloads/ and via the EmacsWiki. pg-el-0.54/LICENSE000066400000000000000000001045151500535241500134610ustar00rootroot00000000000000 GNU GENERAL PUBLIC LICENSE Version 3, 29 June 2007 Copyright (C) 2007 Free Software Foundation, Inc. Everyone is permitted to copy and distribute verbatim copies of this license document, but changing it is not allowed. Preamble The GNU General Public License is a free, copyleft license for software and other kinds of works. The licenses for most software and other practical works are designed to take away your freedom to share and change the works. By contrast, the GNU General Public License is intended to guarantee your freedom to share and change all versions of a program--to make sure it remains free software for all its users. We, the Free Software Foundation, use the GNU General Public License for most of our software; it applies also to any other work released this way by its authors. You can apply it to your programs, too. When we speak of free software, we are referring to freedom, not price. Our General Public Licenses are designed to make sure that you have the freedom to distribute copies of free software (and charge for them if you wish), that you receive source code or can get it if you want it, that you can change the software or use pieces of it in new free programs, and that you know you can do these things. To protect your rights, we need to prevent others from denying you these rights or asking you to surrender the rights. Therefore, you have certain responsibilities if you distribute copies of the software, or if you modify it: responsibilities to respect the freedom of others. For example, if you distribute copies of such a program, whether gratis or for a fee, you must pass on to the recipients the same freedoms that you received. You must make sure that they, too, receive or can get the source code. And you must show them these terms so they know their rights. Developers that use the GNU GPL protect your rights with two steps: (1) assert copyright on the software, and (2) offer you this License giving you legal permission to copy, distribute and/or modify it. For the developers' and authors' protection, the GPL clearly explains that there is no warranty for this free software. For both users' and authors' sake, the GPL requires that modified versions be marked as changed, so that their problems will not be attributed erroneously to authors of previous versions. Some devices are designed to deny users access to install or run modified versions of the software inside them, although the manufacturer can do so. This is fundamentally incompatible with the aim of protecting users' freedom to change the software. The systematic pattern of such abuse occurs in the area of products for individuals to use, which is precisely where it is most unacceptable. Therefore, we have designed this version of the GPL to prohibit the practice for those products. If such problems arise substantially in other domains, we stand ready to extend this provision to those domains in future versions of the GPL, as needed to protect the freedom of users. Finally, every program is threatened constantly by software patents. States should not allow patents to restrict development and use of software on general-purpose computers, but in those that do, we wish to avoid the special danger that patents applied to a free program could make it effectively proprietary. To prevent this, the GPL assures that patents cannot be used to render the program non-free. The precise terms and conditions for copying, distribution and modification follow. TERMS AND CONDITIONS 0. Definitions. "This License" refers to version 3 of the GNU General Public License. "Copyright" also means copyright-like laws that apply to other kinds of works, such as semiconductor masks. "The Program" refers to any copyrightable work licensed under this License. Each licensee is addressed as "you". "Licensees" and "recipients" may be individuals or organizations. To "modify" a work means to copy from or adapt all or part of the work in a fashion requiring copyright permission, other than the making of an exact copy. The resulting work is called a "modified version" of the earlier work or a work "based on" the earlier work. A "covered work" means either the unmodified Program or a work based on the Program. To "propagate" a work means to do anything with it that, without permission, would make you directly or secondarily liable for infringement under applicable copyright law, except executing it on a computer or modifying a private copy. Propagation includes copying, distribution (with or without modification), making available to the public, and in some countries other activities as well. To "convey" a work means any kind of propagation that enables other parties to make or receive copies. Mere interaction with a user through a computer network, with no transfer of a copy, is not conveying. An interactive user interface displays "Appropriate Legal Notices" to the extent that it includes a convenient and prominently visible feature that (1) displays an appropriate copyright notice, and (2) tells the user that there is no warranty for the work (except to the extent that warranties are provided), that licensees may convey the work under this License, and how to view a copy of this License. If the interface presents a list of user commands or options, such as a menu, a prominent item in the list meets this criterion. 1. Source Code. The "source code" for a work means the preferred form of the work for making modifications to it. "Object code" means any non-source form of a work. A "Standard Interface" means an interface that either is an official standard defined by a recognized standards body, or, in the case of interfaces specified for a particular programming language, one that is widely used among developers working in that language. The "System Libraries" of an executable work include anything, other than the work as a whole, that (a) is included in the normal form of packaging a Major Component, but which is not part of that Major Component, and (b) serves only to enable use of the work with that Major Component, or to implement a Standard Interface for which an implementation is available to the public in source code form. A "Major Component", in this context, means a major essential component (kernel, window system, and so on) of the specific operating system (if any) on which the executable work runs, or a compiler used to produce the work, or an object code interpreter used to run it. The "Corresponding Source" for a work in object code form means all the source code needed to generate, install, and (for an executable work) run the object code and to modify the work, including scripts to control those activities. However, it does not include the work's System Libraries, or general-purpose tools or generally available free programs which are used unmodified in performing those activities but which are not part of the work. For example, Corresponding Source includes interface definition files associated with source files for the work, and the source code for shared libraries and dynamically linked subprograms that the work is specifically designed to require, such as by intimate data communication or control flow between those subprograms and other parts of the work. The Corresponding Source need not include anything that users can regenerate automatically from other parts of the Corresponding Source. The Corresponding Source for a work in source code form is that same work. 2. Basic Permissions. All rights granted under this License are granted for the term of copyright on the Program, and are irrevocable provided the stated conditions are met. This License explicitly affirms your unlimited permission to run the unmodified Program. The output from running a covered work is covered by this License only if the output, given its content, constitutes a covered work. This License acknowledges your rights of fair use or other equivalent, as provided by copyright law. You may make, run and propagate covered works that you do not convey, without conditions so long as your license otherwise remains in force. You may convey covered works to others for the sole purpose of having them make modifications exclusively for you, or provide you with facilities for running those works, provided that you comply with the terms of this License in conveying all material for which you do not control copyright. Those thus making or running the covered works for you must do so exclusively on your behalf, under your direction and control, on terms that prohibit them from making any copies of your copyrighted material outside their relationship with you. Conveying under any other circumstances is permitted solely under the conditions stated below. Sublicensing is not allowed; section 10 makes it unnecessary. 3. Protecting Users' Legal Rights From Anti-Circumvention Law. No covered work shall be deemed part of an effective technological measure under any applicable law fulfilling obligations under article 11 of the WIPO copyright treaty adopted on 20 December 1996, or similar laws prohibiting or restricting circumvention of such measures. When you convey a covered work, you waive any legal power to forbid circumvention of technological measures to the extent such circumvention is effected by exercising rights under this License with respect to the covered work, and you disclaim any intention to limit operation or modification of the work as a means of enforcing, against the work's users, your or third parties' legal rights to forbid circumvention of technological measures. 4. Conveying Verbatim Copies. You may convey verbatim copies of the Program's source code as you receive it, in any medium, provided that you conspicuously and appropriately publish on each copy an appropriate copyright notice; keep intact all notices stating that this License and any non-permissive terms added in accord with section 7 apply to the code; keep intact all notices of the absence of any warranty; and give all recipients a copy of this License along with the Program. You may charge any price or no price for each copy that you convey, and you may offer support or warranty protection for a fee. 5. Conveying Modified Source Versions. You may convey a work based on the Program, or the modifications to produce it from the Program, in the form of source code under the terms of section 4, provided that you also meet all of these conditions: a) The work must carry prominent notices stating that you modified it, and giving a relevant date. b) The work must carry prominent notices stating that it is released under this License and any conditions added under section 7. This requirement modifies the requirement in section 4 to "keep intact all notices". c) You must license the entire work, as a whole, under this License to anyone who comes into possession of a copy. This License will therefore apply, along with any applicable section 7 additional terms, to the whole of the work, and all its parts, regardless of how they are packaged. This License gives no permission to license the work in any other way, but it does not invalidate such permission if you have separately received it. d) If the work has interactive user interfaces, each must display Appropriate Legal Notices; however, if the Program has interactive interfaces that do not display Appropriate Legal Notices, your work need not make them do so. A compilation of a covered work with other separate and independent works, which are not by their nature extensions of the covered work, and which are not combined with it such as to form a larger program, in or on a volume of a storage or distribution medium, is called an "aggregate" if the compilation and its resulting copyright are not used to limit the access or legal rights of the compilation's users beyond what the individual works permit. Inclusion of a covered work in an aggregate does not cause this License to apply to the other parts of the aggregate. 6. Conveying Non-Source Forms. You may convey a covered work in object code form under the terms of sections 4 and 5, provided that you also convey the machine-readable Corresponding Source under the terms of this License, in one of these ways: a) Convey the object code in, or embodied in, a physical product (including a physical distribution medium), accompanied by the Corresponding Source fixed on a durable physical medium customarily used for software interchange. b) Convey the object code in, or embodied in, a physical product (including a physical distribution medium), accompanied by a written offer, valid for at least three years and valid for as long as you offer spare parts or customer support for that product model, to give anyone who possesses the object code either (1) a copy of the Corresponding Source for all the software in the product that is covered by this License, on a durable physical medium customarily used for software interchange, for a price no more than your reasonable cost of physically performing this conveying of source, or (2) access to copy the Corresponding Source from a network server at no charge. c) Convey individual copies of the object code with a copy of the written offer to provide the Corresponding Source. This alternative is allowed only occasionally and noncommercially, and only if you received the object code with such an offer, in accord with subsection 6b. d) Convey the object code by offering access from a designated place (gratis or for a charge), and offer equivalent access to the Corresponding Source in the same way through the same place at no further charge. You need not require recipients to copy the Corresponding Source along with the object code. If the place to copy the object code is a network server, the Corresponding Source may be on a different server (operated by you or a third party) that supports equivalent copying facilities, provided you maintain clear directions next to the object code saying where to find the Corresponding Source. Regardless of what server hosts the Corresponding Source, you remain obligated to ensure that it is available for as long as needed to satisfy these requirements. e) Convey the object code using peer-to-peer transmission, provided you inform other peers where the object code and Corresponding Source of the work are being offered to the general public at no charge under subsection 6d. A separable portion of the object code, whose source code is excluded from the Corresponding Source as a System Library, need not be included in conveying the object code work. A "User Product" is either (1) a "consumer product", which means any tangible personal property which is normally used for personal, family, or household purposes, or (2) anything designed or sold for incorporation into a dwelling. In determining whether a product is a consumer product, doubtful cases shall be resolved in favor of coverage. For a particular product received by a particular user, "normally used" refers to a typical or common use of that class of product, regardless of the status of the particular user or of the way in which the particular user actually uses, or expects or is expected to use, the product. A product is a consumer product regardless of whether the product has substantial commercial, industrial or non-consumer uses, unless such uses represent the only significant mode of use of the product. "Installation Information" for a User Product means any methods, procedures, authorization keys, or other information required to install and execute modified versions of a covered work in that User Product from a modified version of its Corresponding Source. The information must suffice to ensure that the continued functioning of the modified object code is in no case prevented or interfered with solely because modification has been made. If you convey an object code work under this section in, or with, or specifically for use in, a User Product, and the conveying occurs as part of a transaction in which the right of possession and use of the User Product is transferred to the recipient in perpetuity or for a fixed term (regardless of how the transaction is characterized), the Corresponding Source conveyed under this section must be accompanied by the Installation Information. But this requirement does not apply if neither you nor any third party retains the ability to install modified object code on the User Product (for example, the work has been installed in ROM). The requirement to provide Installation Information does not include a requirement to continue to provide support service, warranty, or updates for a work that has been modified or installed by the recipient, or for the User Product in which it has been modified or installed. Access to a network may be denied when the modification itself materially and adversely affects the operation of the network or violates the rules and protocols for communication across the network. Corresponding Source conveyed, and Installation Information provided, in accord with this section must be in a format that is publicly documented (and with an implementation available to the public in source code form), and must require no special password or key for unpacking, reading or copying. 7. Additional Terms. "Additional permissions" are terms that supplement the terms of this License by making exceptions from one or more of its conditions. Additional permissions that are applicable to the entire Program shall be treated as though they were included in this License, to the extent that they are valid under applicable law. If additional permissions apply only to part of the Program, that part may be used separately under those permissions, but the entire Program remains governed by this License without regard to the additional permissions. When you convey a copy of a covered work, you may at your option remove any additional permissions from that copy, or from any part of it. (Additional permissions may be written to require their own removal in certain cases when you modify the work.) You may place additional permissions on material, added by you to a covered work, for which you have or can give appropriate copyright permission. Notwithstanding any other provision of this License, for material you add to a covered work, you may (if authorized by the copyright holders of that material) supplement the terms of this License with terms: a) Disclaiming warranty or limiting liability differently from the terms of sections 15 and 16 of this License; or b) Requiring preservation of specified reasonable legal notices or author attributions in that material or in the Appropriate Legal Notices displayed by works containing it; or c) Prohibiting misrepresentation of the origin of that material, or requiring that modified versions of such material be marked in reasonable ways as different from the original version; or d) Limiting the use for publicity purposes of names of licensors or authors of the material; or e) Declining to grant rights under trademark law for use of some trade names, trademarks, or service marks; or f) Requiring indemnification of licensors and authors of that material by anyone who conveys the material (or modified versions of it) with contractual assumptions of liability to the recipient, for any liability that these contractual assumptions directly impose on those licensors and authors. All other non-permissive additional terms are considered "further restrictions" within the meaning of section 10. If the Program as you received it, or any part of it, contains a notice stating that it is governed by this License along with a term that is a further restriction, you may remove that term. If a license document contains a further restriction but permits relicensing or conveying under this License, you may add to a covered work material governed by the terms of that license document, provided that the further restriction does not survive such relicensing or conveying. If you add terms to a covered work in accord with this section, you must place, in the relevant source files, a statement of the additional terms that apply to those files, or a notice indicating where to find the applicable terms. Additional terms, permissive or non-permissive, may be stated in the form of a separately written license, or stated as exceptions; the above requirements apply either way. 8. Termination. You may not propagate or modify a covered work except as expressly provided under this License. Any attempt otherwise to propagate or modify it is void, and will automatically terminate your rights under this License (including any patent licenses granted under the third paragraph of section 11). However, if you cease all violation of this License, then your license from a particular copyright holder is reinstated (a) provisionally, unless and until the copyright holder explicitly and finally terminates your license, and (b) permanently, if the copyright holder fails to notify you of the violation by some reasonable means prior to 60 days after the cessation. Moreover, your license from a particular copyright holder is reinstated permanently if the copyright holder notifies you of the violation by some reasonable means, this is the first time you have received notice of violation of this License (for any work) from that copyright holder, and you cure the violation prior to 30 days after your receipt of the notice. Termination of your rights under this section does not terminate the licenses of parties who have received copies or rights from you under this License. If your rights have been terminated and not permanently reinstated, you do not qualify to receive new licenses for the same material under section 10. 9. Acceptance Not Required for Having Copies. You are not required to accept this License in order to receive or run a copy of the Program. Ancillary propagation of a covered work occurring solely as a consequence of using peer-to-peer transmission to receive a copy likewise does not require acceptance. However, nothing other than this License grants you permission to propagate or modify any covered work. These actions infringe copyright if you do not accept this License. Therefore, by modifying or propagating a covered work, you indicate your acceptance of this License to do so. 10. Automatic Licensing of Downstream Recipients. Each time you convey a covered work, the recipient automatically receives a license from the original licensors, to run, modify and propagate that work, subject to this License. You are not responsible for enforcing compliance by third parties with this License. An "entity transaction" is a transaction transferring control of an organization, or substantially all assets of one, or subdividing an organization, or merging organizations. If propagation of a covered work results from an entity transaction, each party to that transaction who receives a copy of the work also receives whatever licenses to the work the party's predecessor in interest had or could give under the previous paragraph, plus a right to possession of the Corresponding Source of the work from the predecessor in interest, if the predecessor has it or can get it with reasonable efforts. You may not impose any further restrictions on the exercise of the rights granted or affirmed under this License. For example, you may not impose a license fee, royalty, or other charge for exercise of rights granted under this License, and you may not initiate litigation (including a cross-claim or counterclaim in a lawsuit) alleging that any patent claim is infringed by making, using, selling, offering for sale, or importing the Program or any portion of it. 11. Patents. A "contributor" is a copyright holder who authorizes use under this License of the Program or a work on which the Program is based. The work thus licensed is called the contributor's "contributor version". A contributor's "essential patent claims" are all patent claims owned or controlled by the contributor, whether already acquired or hereafter acquired, that would be infringed by some manner, permitted by this License, of making, using, or selling its contributor version, but do not include claims that would be infringed only as a consequence of further modification of the contributor version. For purposes of this definition, "control" includes the right to grant patent sublicenses in a manner consistent with the requirements of this License. Each contributor grants you a non-exclusive, worldwide, royalty-free patent license under the contributor's essential patent claims, to make, use, sell, offer for sale, import and otherwise run, modify and propagate the contents of its contributor version. In the following three paragraphs, a "patent license" is any express agreement or commitment, however denominated, not to enforce a patent (such as an express permission to practice a patent or covenant not to sue for patent infringement). To "grant" such a patent license to a party means to make such an agreement or commitment not to enforce a patent against the party. If you convey a covered work, knowingly relying on a patent license, and the Corresponding Source of the work is not available for anyone to copy, free of charge and under the terms of this License, through a publicly available network server or other readily accessible means, then you must either (1) cause the Corresponding Source to be so available, or (2) arrange to deprive yourself of the benefit of the patent license for this particular work, or (3) arrange, in a manner consistent with the requirements of this License, to extend the patent license to downstream recipients. "Knowingly relying" means you have actual knowledge that, but for the patent license, your conveying the covered work in a country, or your recipient's use of the covered work in a country, would infringe one or more identifiable patents in that country that you have reason to believe are valid. If, pursuant to or in connection with a single transaction or arrangement, you convey, or propagate by procuring conveyance of, a covered work, and grant a patent license to some of the parties receiving the covered work authorizing them to use, propagate, modify or convey a specific copy of the covered work, then the patent license you grant is automatically extended to all recipients of the covered work and works based on it. A patent license is "discriminatory" if it does not include within the scope of its coverage, prohibits the exercise of, or is conditioned on the non-exercise of one or more of the rights that are specifically granted under this License. You may not convey a covered work if you are a party to an arrangement with a third party that is in the business of distributing software, under which you make payment to the third party based on the extent of your activity of conveying the work, and under which the third party grants, to any of the parties who would receive the covered work from you, a discriminatory patent license (a) in connection with copies of the covered work conveyed by you (or copies made from those copies), or (b) primarily for and in connection with specific products or compilations that contain the covered work, unless you entered into that arrangement, or that patent license was granted, prior to 28 March 2007. Nothing in this License shall be construed as excluding or limiting any implied license or other defenses to infringement that may otherwise be available to you under applicable patent law. 12. No Surrender of Others' Freedom. If conditions are imposed on you (whether by court order, agreement or otherwise) that contradict the conditions of this License, they do not excuse you from the conditions of this License. If you cannot convey a covered work so as to satisfy simultaneously your obligations under this License and any other pertinent obligations, then as a consequence you may not convey it at all. For example, if you agree to terms that obligate you to collect a royalty for further conveying from those to whom you convey the Program, the only way you could satisfy both those terms and this License would be to refrain entirely from conveying the Program. 13. Use with the GNU Affero General Public License. Notwithstanding any other provision of this License, you have permission to link or combine any covered work with a work licensed under version 3 of the GNU Affero General Public License into a single combined work, and to convey the resulting work. The terms of this License will continue to apply to the part which is the covered work, but the special requirements of the GNU Affero General Public License, section 13, concerning interaction through a network will apply to the combination as such. 14. Revised Versions of this License. The Free Software Foundation may publish revised and/or new versions of the GNU General Public License from time to time. Such new versions will be similar in spirit to the present version, but may differ in detail to address new problems or concerns. Each version is given a distinguishing version number. If the Program specifies that a certain numbered version of the GNU General Public License "or any later version" applies to it, you have the option of following the terms and conditions either of that numbered version or of any later version published by the Free Software Foundation. If the Program does not specify a version number of the GNU General Public License, you may choose any version ever published by the Free Software Foundation. If the Program specifies that a proxy can decide which future versions of the GNU General Public License can be used, that proxy's public statement of acceptance of a version permanently authorizes you to choose that version for the Program. Later license versions may give you additional or different permissions. However, no additional obligations are imposed on any author or copyright holder as a result of your choosing to follow a later version. 15. Disclaimer of Warranty. THERE IS NO WARRANTY FOR THE PROGRAM, TO THE EXTENT PERMITTED BY APPLICABLE LAW. EXCEPT WHEN OTHERWISE STATED IN WRITING THE COPYRIGHT HOLDERS AND/OR OTHER PARTIES PROVIDE THE PROGRAM "AS IS" WITHOUT WARRANTY OF ANY KIND, EITHER EXPRESSED OR IMPLIED, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE. THE ENTIRE RISK AS TO THE QUALITY AND PERFORMANCE OF THE PROGRAM IS WITH YOU. SHOULD THE PROGRAM PROVE DEFECTIVE, YOU ASSUME THE COST OF ALL NECESSARY SERVICING, REPAIR OR CORRECTION. 16. Limitation of Liability. IN NO EVENT UNLESS REQUIRED BY APPLICABLE LAW OR AGREED TO IN WRITING WILL ANY COPYRIGHT HOLDER, OR ANY OTHER PARTY WHO MODIFIES AND/OR CONVEYS THE PROGRAM AS PERMITTED ABOVE, BE LIABLE TO YOU FOR DAMAGES, INCLUDING ANY GENERAL, SPECIAL, INCIDENTAL OR CONSEQUENTIAL DAMAGES ARISING OUT OF THE USE OR INABILITY TO USE THE PROGRAM (INCLUDING BUT NOT LIMITED TO LOSS OF DATA OR DATA BEING RENDERED INACCURATE OR LOSSES SUSTAINED BY YOU OR THIRD PARTIES OR A FAILURE OF THE PROGRAM TO OPERATE WITH ANY OTHER PROGRAMS), EVEN IF SUCH HOLDER OR OTHER PARTY HAS BEEN ADVISED OF THE POSSIBILITY OF SUCH DAMAGES. 17. Interpretation of Sections 15 and 16. If the disclaimer of warranty and limitation of liability provided above cannot be given local legal effect according to their terms, reviewing courts shall apply local law that most closely approximates an absolute waiver of all civil liability in connection with the Program, unless a warranty or assumption of liability accompanies a copy of the Program in return for a fee. END OF TERMS AND CONDITIONS How to Apply These Terms to Your New Programs If you develop a new program, and you want it to be of the greatest possible use to the public, the best way to achieve this is to make it free software which everyone can redistribute and change under these terms. To do so, attach the following notices to the program. It is safest to attach them to the start of each source file to most effectively state the exclusion of warranty; and each file should have at least the "copyright" line and a pointer to where the full notice is found. Copyright (C) This program is free software: you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation, either version 3 of the License, or (at your option) any later version. This program is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. You should have received a copy of the GNU General Public License along with this program. If not, see . Also add information on how to contact you by electronic and paper mail. If the program does terminal interaction, make it output a short notice like this when it starts in an interactive mode: Copyright (C) This program comes with ABSOLUTELY NO WARRANTY; for details type `show w'. This is free software, and you are welcome to redistribute it under certain conditions; type `show c' for details. The hypothetical commands `show w' and `show c' should show the appropriate parts of the General Public License. Of course, your program's commands might be different; for a GUI interface, you would use an "about box". You should also get your employer (if you work as a programmer) or school, if any, to sign a "copyright disclaimer" for the program, if necessary. For more information on this, and how to apply and follow the GNU GPL, see . The GNU General Public License does not permit incorporating your program into proprietary programs. If your program is a subroutine library, you may consider it more useful to permit linking proprietary applications with the library. If this is what you want to do, use the GNU Lesser General Public License instead of this License. But first, please read . pg-el-0.54/README.md000066400000000000000000000334571500535241500137410ustar00rootroot00000000000000# pg.el -- Emacs Lisp socket-level interface to the PostgreSQL RDBMS [![License: GPL v3](https://img.shields.io/badge/License-GPL%20v3-blue.svg)](https://www.gnu.org/licenses/gpl-3.0.html) [![Latest tagged version](https://img.shields.io/github/v/tag/emarsden/pg-el?label=Latest%20tagged%20version)](https://github.com/emarsden/pg-el/) [![MELPA](https://melpa.org/packages/pg-badge.svg)](https://melpa.org/#/pg) [![test-pgv16](https://github.com/emarsden/pg-el/workflows/test-pgv16/badge.svg)](https://github.com/emarsden/pg-el/actions/) [![Documentation build](https://img.shields.io/github/actions/workflow/status/emarsden/pg-el/mdbook.yml?label=Documentation)](https://github.com/emarsden/pg-el/actions/) This library lets you access the PostgreSQL 🐘 database management system from Emacs, using its network-level frontend/backend “wire” protocol. The module is capable of automatic type coercions from a range of SQL types to the equivalent Emacs Lisp type. 📖 You may be interested in the [user manual](https://emarsden.github.io/pg-el/). This is a developer-oriented library, which won’t be useful to end users. If you’re looking for a browsing/editing interface to PostgreSQL in Emacs, you may be interested in [PGmacs](https://github.com/emarsden/pgmacs/). This library has support for: - **SCRAM-SHA-256 authentication** (the default authentication method since PostgreSQL version 14), as well as MD5 and password authentication. There is currently no support for authentication using client-side certificates. - Encrypted (**TLS**) connections with the PostgreSQL database, if your Emacs has been built with GnuTLS support. This includes support for authentication using client certificates. - **Prepared statements** using PostgreSQL’s extended query protocol, to avoid SQL injection attacks. - The PostgreSQL **COPY protocol** to copy preformatted data from an Emacs buffer to PostgreSQL, or to dump a PostgreSQL table or query result to an Emacs buffer in CSV or TSV format. - Asynchronous handling of **LISTEN/NOTIFY** notification messages from PostgreSQL, allowing the implementation of **publish-subscribe architectures** (PostgreSQL as an “event broker” or “message bus” and Emacs as event publisher and consumer). - Parsing various PostgreSQL types including integers, floats, array types, numerical ranges, JSON and JSONB objects into their native Emacs Lisp equivalents. The parsing support is user-extensible. Support for the HSTORE, pgvector, PostGIS, BM25 extensions. - Connections over TCP or (on Unix machines) a local Unix socket. Tested **PostgreSQL versions**: The code has been tested with versions 17.4, 16.4, 15.4, 13.8, 11.17, and 10.22 on Linux. It is also tested via GitHub actions on MacOS and Windows. This library also works, more or less, against other “PostgreSQL-compatible” databases. There are four main points where this compatibility may be problematic: - Compatibility with the PostgreSQL wire protocol. This is the most basic form of compatibility. - Compatibility with the PostgreSQL flavour of SQL, such as row expressions, non-standard functions such as `CHR`, data types such as `BIT`, `VARBIT`, `JSON` and `JSONB`, user-defined ENUMS and so on, functionality such as `LISTEN`. Some databases that claim to be “Postgres compatible” don’t even support foreign keys, views, triggers, sequences, tablespaces and temporary tables (looking at you, Amazon Aurora DSQL). - Implementation of the system tables that are used by certain pg-el functions, to retrieve the list of tables in a database, the list of types, and so on. - Establishing encrypted TLS connections to hosted services. Most PostgreSQL client libraries (in particular the official client library libpq) use OpenSSL for TLS support, whereas Emacs uses GnuTLS, and you may encounter incompatibilities. The following PostgreSQL-compatible databases have been tested: - [Neon](https://neon.tech/) “serverless PostgreSQL” works perfectly. This is a commercially hosted service using a new storage engine for PostgreSQL, that they make available under the Apache licence. Last tested 2025-05. - [ParadeDB](https://www.paradedb.com/) version 0.13.1 works perfectly (it's really a PostgreSQL extension rather than a distinct database implementation). - [IvorySQL](https://www.ivorysql.org/) works perfectly (this Apache licensed fork of PostgreSQL adds some features for compatibility with Oracle). Last tested 2025-04 with version 4.4. - The [Timescale DB](https://www.timescale.com/) extension for time series data, source available but non open source. This works perfectly (last tested 2025-05 with version 2.19.3). - The [CitusDB](https://github.com/citusdata/citus) extension for sharding PostgreSQL over multiple hosts (AGPLv3 licence). Works perfectly (last tested 2025-05 with Citus version 13.0). - The [OrioleDB](https://github.com/orioledb/orioledb) extension, which adds a new storage engine designed for better multithreading and solid state storage, works perfectly. Last tested 2025-04 with version beta10. - The [Microsoft DocumentDB](https://github.com/microsoft/documentdb) extension for MongoDB-like queries (MIT licensed). Works perfectly. Note that this is not the same product as Amazon DocumentDB. Last tested 2025-04 with the FerretDB distribution 2.1.0. - The [Hydra Columnar](https://github.com/hydradatabase/columnar) extension for column-oriented storage and parallel queries (Apache license). Works perfectly (last tested 2025-05 with v1.1.2). - The [PgBouncer](https://www.pgbouncer.org/) connection pooler for PostgreSQL (open source, ISC licensed). Works fine (last tested 2025-05 with version 1.24 in the default session pooling mode). - The [PgDog](https://github.com/pgdogdev/pgdog) sharding connection pooler for PostgreSQL (AGPLv3 licensed). Works mostly fine but disconnects the client when the client-encoding is switched to `LATIN1` (last tested 2025-05). - The [PgCat](https://github.com/postgresml/pgcat) sharding connection pooler for PostgreSQL (MIT license). Works fine (last tested 2025-05 with v0.2.5). - [Google AlloyDB Omni](https://cloud.google.com/alloydb/omni/docs/quickstart) is a proprietary fork of PostgreSQL with Google-developed extensions, including a columnar storage extension, adaptive autovacuum, and an index advisor. It works perfectly with pg-el as of 2025-05 (version that reports itself as "15.7"). - [Xata](https://xata.io/) “serverless PostgreSQL” has many limitations including lack of support for `CREATE DATABASE`, `CREATE COLLATION`, for XML processing, for temporary tables, for cursors, for `EXPLAIN`, for `CREATE EXTENSION`, for `DROP FUNCTION`, for functions such as `pg_notify`. - The [YugabyteDB](https://yugabyte.com/) distributed database (Apache licence). Mostly working though the `pg_sequences` table is not implemented so certain tests fail. YugabyteDB does not have full compatibility with PostgreSQL SQL, and for example `GENERATED ALWAYS AS` columns are not supported, and `LISTEN` and `NOTIFY` are not supported. It does support certain extensions such as pgvector, however. Last tested on 2025-05 against version 2.25. - The [RisingWave](https://github.com/risingwavelabs/risingwave) event streaming database (Apache license) is mostly working. It does not support `GENERATED ALWAYS AS IDENTITY` or `SERIAL` columns, nor `VACUUM ANALYZE`. Last tested 2025-05 with v2.3.1. - The [CrateDB](https://crate.io/) distributed database (Apache licence). CrateDB does not support rows (e.g. `SELECT (1,2)`), does not support the `time`, `varbit`, `bytea`, `jsonb` and `hstore` types, does not handle a query which only contains an SQL comment, does not handle various PostgreSQL functions such as `factorial`, does not return a correct type OID for text columns in rows returned from a prepared statement, doesn't support Unicode identifiers, doesn't support the `COPY` protocol, doesn't support `TRUNCATE TABLE`. It works with these limitations with pg-el (last tested 2025-05 with version 5.10.5). - The [CockroachDB](https://github.com/cockroachdb/cockroach) distributed database (source-available but non-free software licence). Note that this database does not implement the large object functionality, and its interpretation of SQL occasionally differs from that of PostgreSQL. Currently fails with an internal error on the SQL generated by our query for `pg-table-owner`, and fails on the boolean vector syntax b'1001000'. Works with these limitations with pg-el (last tested 2025-04 with CockroachDB CCL v25.1). - The [QuestDB](https://questdb.io/) time series database (Apache licensed) has very limited PostgreSQL support, and does not support the `integer` type for example. Last tested 2025-05 with version 8.3.1. - [Google Spanner](https://cloud.google.com/spanner) proprietary distributed database: tested with the Spanner emulator (that reports itself as `PostgreSQL 14.1`) and the PGAdapter library that enables support for the PostgreSQL wire protocol. Spanner has very limited PostgreSQL compatibility, for example refusing to create tables that do not have a primary key. It does not recognize basic PostgreSQL types such as `INT2`. It also does not for example support the `CHR` and `MD5` functions, row expressions, and `WHERE` clauses without a `FROM` clause. - The [YDB by Yandex](https://ydb.tech/docs/en/postgresql/docker-connect) distributed database (Apache licence). Has very limited PostgreSQL compatibility. For example, an empty query string leads to a hung connection, and the `bit` type is returned as a string with the wrong oid. Last tested 2025-05 with version 23-4. - The [Materialize](https://materialize.com/) operational database (a proprietary differential dataflow database) has many limitations in its PostgreSQL compatibility: no support for primary keys, unique constraints, check constraints, for the 'bit' type for example. It works with these limitations with pg-el (last tested 2025-05 with Materialize v0.142). - [YottaDB Octo](https://gitlab.com/YottaDB/DBMS/YDBOcto), which is built on the YottaDB key-value store (which is historically based on the MUMPS programming language). GNU AGPL v3 licence. There are many limitations in the PostgreSQL compatibility: no user metainformation, no cursors, no server-side prepared statements, no support for various types including arrays, JSON, UUID, vectors, tsvector, numeric ranges, geometric types. It works with these limitations with pg-el (last tested 2025-05 with YottaDB 2.0.2). - The [GreptimeDB](https://github.com/GrepTimeTeam/greptimedb) time series database (Apache license) implements quite a lot of the PostgreSQL wire protocol, but the names it uses for types in the `pg_catalog.pg_types` table are not the same as those used by PostgreSQL (e.g. `Int64` instead of `int8`), so our parsing machinery does not work. This database also has more restrictions on the use of identifiers than PostgreSQL (for example, `id` is not accepted as a column name, nor are identifiers containing Unicode characters). Last tested v0.14.2 in 2025-05. - Hosted PostgreSQL services that have been tested: as of 2024-12 [Railway.app](https://railway.app/) is running a Debian build of PostgreSQL 16.4, and works fine; [Aiven.io](https://aiven.io/) is running a Red Hat build of PostgreSQL 16.4 on Linux/Aarch64 and works fine. - Untested but likely to work: Amazon RDS, Google Cloud SQL, Azure Database for PostgreSQL, Amazon Aurora. You may however encounter difficulties with TLS connections, as noted above. It does not work in a satisfactory manner with the ClickHouse database, whose PostgreSQL support is too limited. As of version 25.4 in 2025-04, there is no implementation of the `pg_types` system table, no support for basic PostgreSQL-flavoured SQL commands such as `SET`, no support for the extended query mechanism. Tested **Emacs versions**: mostly tested with versions 31 pre-release, 30.1 and 29.4. Emacs versions older than 26.1 will not work against a recent PostgreSQL version (whose default configuration requires SCRAM-SHA-256 authentication), because they don’t include the GnuTLS support which we use to calculate HMACs. They may however work against a database set up to allow unauthenticated local connections. Emacs versions older than 28.1 (from April 2022) will not be able to use the extended query protocol (prepared statements), because they don’t have the necessary bindat functionality. It should however be easy to update the installed version of bindat.el for these older versions. > [!TIP] > Emacs 31 (in pre-release) has support for disabling the Nagle algorithm on TCP network > connections (`TCP_NODELAY`). This leads to far better performance for PostgreSQL connections, in > particular on Unix platforms. This performance difference does not apply when you connect to > PostgreSQL over a local Unix socket connection. You may be interested in an alternative library [emacs-libpq](https://github.com/anse1/emacs-libpq) that enables access to PostgreSQL from Emacs by binding to the libpq library. ## Installation Install via the [MELPA package archive](https://melpa.org/partials/getting-started.html) by including the following in your Emacs initialization file (`.emacs.el` or `init.el`): (require 'package) (add-to-list 'package-archives '("melpa" . "https://melpa.org/packages/") t) then saying M-x package-install RET pg Alternatively, you can install the library from the latest GitHub revision using: (unless (package-installed-p 'pg) (package-vc-install "https://github.com/emarsden/pg-el" nil nil 'pg)) You can later update to the latest version with `M-x package-vc-upgrade RET pg RET`. ## Acknowledgements Thanks to Eric Ludlam for discovering a bug in the date parsing routines, to Hartmut Pilch and Yoshio Katayama for adding multibyte support, and to Doug McNaught and Pavel Janik for bug fixes. pg-el-0.54/doc/000077500000000000000000000000001500535241500132135ustar00rootroot00000000000000pg-el-0.54/doc/.gitignore000066400000000000000000000000051500535241500151760ustar00rootroot00000000000000book pg-el-0.54/doc/book.toml000066400000000000000000000005541500535241500150460ustar00rootroot00000000000000[book] title = "Using pg-el" authors = ["Eric Marsden "] description = "User manual for the pg-el Emacs Lisp socket-level interface to PostgreSQL." language = "en" multilingual = false src = "src" [output.html] git-repository-url = "https://github.com/emarsden/pg-el" git-repository-icon = "fa-github" smart-punctuation = true pg-el-0.54/doc/src/000077500000000000000000000000001500535241500140025ustar00rootroot00000000000000pg-el-0.54/doc/src/API.md000066400000000000000000000334171500535241500147450ustar00rootroot00000000000000# The pg-el API The entry points in the pg-el library are documented below. (with-pg-connection con (dbname user [password host port]) &body body) A macro which opens a TCP network connection to database `DBNAME`, executes the `BODY` forms then disconnects. See function `pg-connect` for details of the connection arguments. (with-pg-connection-local con (path dbname user [password]) &body body) A macro which opens a connection to database `DBNAME` over a local Unix socket at `PATH`, executes the `BODY` forms then disconnects. See function `pg-connect-local` for details of the connection arguments. (with-pg-transaction con &body body) A macro which executes the `BODY` forms wrapped in an SQL transaction. `CON` is a connection to the database. If an error occurs during the execution of the forms, a ROLLBACK instruction is executed. (pg-connect dbname user [password host port tls-options]) -> con Connect to the database `DBNAME` on `HOST` (defaults to localhost) at `PORT` (defaults to 5432) via TCP/IP and authenticate as `USER` with `PASSWORD`. This library currently supports SCRAM-SHA-256 authentication (the default method from PostgreSQL version 14 onwards), MD5 authentication and cleartext password authentication. This function also sets the output date type to `ISO` and initializes our type parser tables. If `tls-options` is non-NIL, attempt to establish an encrypted connection to PostgreSQL by passing `tls-options` to Emacs function `gnutls-negotiate`. `tls-options` is a Common-Lisp style argument list of the form ```lisp (list :priority-string "NORMAL:-MD5" :trustfiles (list "/etc/company/RootCA.crt")) ``` To use client certificates to authenticate the TLS connection, use a value of `TLS-OPTIONS` of the form ```lisp `(list :keylist ((,key ,cert))) ``` where `key` is the filename of the client certificate private key and `cert` is the filename of the client certificate. These are passed to GnuTLS. (pg-connect-local path dbname user [password]) -> con Initiate a connection with the PostgreSQL backend over local Unix socket `PATH`. Connect to the database `DBNAME` with the username `USER`, providing `PASSWORD` if necessary. Returns a connection to the database (as an opaque type). `PASSWORD` defaults to an empty string. (pg-exec con &rest sql) -> pgresult Concatenate the SQL strings and send to the PostgreSQL backend over connection `CON`. Retrieve the information returned by the database and return it in an opaque record PGRESULT. The content of the pgresult should be accessed using the `pg-result` function. (pg-exec-prepared con query typed-arguments &key (max-rows 0)) -> pgresult Execute SQL query `QUERY`, which may include numbered parameters such as `$1`, ` $2` and so on, using PostgreSQL's extended query protocol, on database connection `CON`. The `TYPED-ARGUMENTS` are a list of the form '((42 . "int4") ("42" . "text")) This query will return at most `MAX-ROWS` rows (a value of zero indicates no limit). It returns a pgresult structure (see function `pg-result`). This method is useful to reduce the risk of SQL injection attacks. (pg-result pgresult what &rest args) -> info Extract information from the `PGRESULT` returned by `pg-exec`. The `WHAT` keyword can be one of * `:connection`: retrieve the database connection. * `:status`: a string returned by the backend to indicate the status of the command; it is something like "SELECT" for a select command, "DELETE 1" if the deletion affected a single row, etc. * `:attributes`: a list of tuples providing metadata: the first component of each tuple is the attribute's name as a string, the second an integer representing its PostgreSQL type, and the third an integer representing the size of that type. * `:tuples`: all the data retrieved from the database, as a list of lists, each list corresponding to one row of data returned by the backend. * `:tuple` tuple-number: return a specific tuple (numbering starts at 0). * `:incomplete`: determine whether the set of tuples returned in this query set is incomplete, due to a suspended portal. If true, further tuples can be obtained by calling `pg-fetch`. * `:oid`: allows you to retrieve the OID returned by the backend if the command was an insertion. The OID is a unique identifier for that row in the database (this is PostgreSQL-specific; please refer to the documentation for more details). . (pg-fetch con result &key (max-rows 0)) Fetch pending rows from the suspended portal in `RESULT` on database connection `CON`. This query will retrieve at most `MAX-ROWS` rows (default value of zero means no limit). Returns a pgresult structure (see function `pg-result`). When used in multiple fetch situations (with the `:max-rows` parameter to `pg-exec-prepared` which allows you to retrieve large result sets incrementally), the same pgresult structure (initally returned by `pg-exec-prepared`) should be passed to each successive call to `pg-fetch`, because it contains column metainformation that is required to parse the incoming data. Each successive call to `pg-fetch` will return this pgresult structure with new tuples accessible via `pg-result :tuples`. When no more tuples are available, the `:incomplete` slot of the pgresult structure will be nil. (pg-cancel con) -> nil Ask the server to cancel the command currently being processed by the backend. The cancellation request concerns the command requested over database connection `CON`. (pg-disconnect con) -> nil Close the database connection `CON`. (pg-for-each con select-form callback) Calls `CALLBACK` on each tuple returned by `SELECT-FORM`. Declares a cursor for `SELECT-FORM`, then fetches tuples using repeated executions of `FETCH 1`, until no results are left. The cursor is then closed. The work is performed within a transaction. When you have a large amount of data to handle, this usage is more efficient than fetching all the tuples in one go. If you wish to browse the results, each one in a separate buffer, you could have the callback insert each tuple into a buffer created with `(generate-new-buffer "myprefix")`, then use ibuffer's "/ n" to list/visit/delete all buffers whose names match myprefix. (pg-databases con) -> list of strings Return a list of the databases available over PostgreSQL connection `CON`. A database is a set of tables; in a fresh PostgreSQL installation there is a single database named "template1". (pg-schemas con) -> list of strings Return the list of the schemas in the PostgreSQL server to which we are connected with `CON`. Schemas are a form of namespace, which can contain elements such as tables, sequences, indexes and views. The default schema name is `public`. (pg-tables con) -> list of strings Return a list of the tables present in the database to which we are currently connected over `CON`. Only include user tables: system tables are not included in this list. (pg-columns con table) -> list of strings Return a list of the columns (or attributes) in `TABLE`, which must be a table in the database to which we are connected over `CON`. We only include the column names; if you want more detailed information (attribute types, for example), it can be obtained from `pg-result` on a SELECT statement for that table. (pg-table-comment con table) -> opt-string Return the comment on `TABLE`, which must be a table in the database to which we are connected over `CON`. Return nil if no comment is defined for `TABLE`. A setf function allows you to change the table comment, or delete it with an argument of nil: (setf (pg-table-comment con "table") "The comment") (pg-column-comment con table column) -> opt-string Return the comment on `COLUMN` in `TABLE` in a PostgreSQL database. `TABLE` can be a string or a schema-qualified name. Uses database connection `CON`. Returns a string or nil if no comment is defined. A setf function allows you to change the column comment, or delete it with a value of nil: (setf (pg-column-comment con "table" "column") "The comment") (pg-hstore-setup con) Prepare for the use of HSTORE datatypes over database connection `CON`. This function must be called before using the HSTORE extension. It loads the extension if necessary, and sets up the parsing support for HSTORE datatypes. (pg-vector-setup con) Prepare for the use of VECTOR datatypes from the pgvector extension over database connection `CON`. This function must be called before using the pgvector extension. It loads the extension if necessary, and sets up the parsing support for vector datatypes. (pg-lo-create con . args) -> oid Create a new large object (BLOB, or binary large object in other DBMSes parlance) in the database to which we are connected via `CON`. Returns an `OID` (which is represented as an elisp integer) which will allow you to use the large object. Optional `ARGS` are a Unix-style mode string which determines the permissions of the newly created large object, one of "r" for read-only permission, "w" for write-only, "rw" for read+write. Default is "r". Large-object functions MUST be used within a transaction (see the macro `with-pg-transaction`). (pg-lo-open con oid . args) -> fd Open a large object whose unique identifier is `OID` (an elisp integer) in the database to which we are connected via `CON`. Optional `ARGS` is a Unix-style mode string as for `pg-lo-create`; which defaults to "r" read-only permissions. Returns a file descriptor (an elisp integer) which can be used in other large-object functions. (pg-lo-close con fd) Close the file descriptor `FD` which was associated with a large object. Note that this does not delete the large object; use `pg-lo-unlink` for that. (pg-lo-read con fd bytes) -> string Read `BYTES` from the file descriptor `FD` which is associated with a large object. Return an elisp string which should be `BYTES` characters long. (pg-lo-write con fd buf) Write the bytes contained in the elisp string `BUF` to the large object associated with the file descriptor `FD`. (pg-lo-lseek con fd offset whence) Do the equivalent of a `lseek(2)` on the file descriptor `FD` which is associated with a large object; i.e. reposition the read/write file offset for that large object to `OFFSET` (an elisp integer). `WHENCE` has the same significance as in `lseek()`; it should be one of `SEEK_SET` (set the offset to the absolute position), `SEEK_CUR` (set the offset relative to the current offset) or `SEEK_END` (set the offset relative to the end of the file). `WHENCE` should be an elisp integer whose values can be obtained from the header file `` (probably 0, 1 and 2 respectively). (pg-lo-tell con oid) -> integer Do the equivalent of an `ftell(3)` on the file associated with the large object whose unique identifier is `OID`. Returns the current position of the file offset for the object's associated file descriptor, as an elisp integer. (pg-lo-unlink con oid) Remove the large object whose unique identifier is `OID` from the system. In the current implementation of large objects in PostgreSQL, each large object is associated with an object in the filesystem. (pg-lo-import con filename) -> oid Create a new large object and initialize it to the data contained in the file whose name is `FILENAME`. Returns an `OID` (as an elisp integer). Note that this operation is only syntactic sugar around the basic large-object operations listed above. (pg-lo-export con oid filename) Create a new file named `FILENAME` and fill it with the contents of the large object whose unique identifier is `OID`. This operation is also syntactic sugar. Variable `pg-parameter-change-functions` is a list of handlers to be called when the backend informs us of a parameter change, for example a change to the session time zone. Each handler is called with three arguments: the connection to the backend, the parameter name and the parameter value. It is initially set to a function that looks out for `client_encoding` messages and updates the value recorded in the connection. Variable `pg-handle-notice-functions` is a list of handlers to be called when the backend sends us a `NOTICE` message. Each handler is called with one argument, the notice, as a pgerror struct. Boolean variable `pg-disable-type-coercion` can be set to non-nil (before initiating a connection) to disable the library's type coercion facility. Default is `t`. ~~~admonish warning title="Security note" Setting up PostgreSQL to accept TCP/IP connections has security implications; please consult the documentation for details. It is possible to use the port forwarding capabilities of ssh to establish a connection to the backend over TCP/IP, which provides both a secure authentication mechanism and encryption (and optionally compression) of data passing through the tunnel. Here's how to do it (thanks to Gene Selkov, Jr. for the description): 1. Establish a tunnel to the backend machine, like this: ssh -L 3333:backend.dom:5432 postgres@backend.dom The first number in the -L argument, 3333, is the port number of your end of the tunnel. The second number, 5432, is the remote end of the tunnel -- the port number your backend is using. The name or the address in between the port numbers belongs to the server machine, as does the last argument to ssh that also includes the optional user name. Without the user name, ssh will try the name you are currently logged on as on the client machine. You can use any user name the server machine will accept, not necessarily those related to postgres. 2. Now that you have a running ssh session, you can point pg.el to the local host at the port number which you specified in step 1. For example, (pg-connect "dbname" "user" "password" "localhost" 3333) You can omit the port argument if you chose 5432 as the local end of the tunnel, since pg.el defaults to this value. ~~~ pg-el-0.54/doc/src/SUMMARY.md000066400000000000000000000010501500535241500154550ustar00rootroot00000000000000# Summary - [About](./about.md) - [Installation](./installation.md) - [Quickstart](./quickstart.md) - [Using pg-el](./usage.md) - [Using prepared statements](./prepared-statements.md) - [JSON and JSONB support](./json.md) - [HSTORE support](./hstore.md) - [PostGIS support](./postgis.md) - [Collation support](./collation.md) - [The COPY protocol](./copy-protocol.md) - [Using schema-qualified names](./schemas.md) - [Error handling](./error-handling.md) - [Special pg-el features](./special-features.md) - [API](./API.md) - [Feedback](./feedback.md) pg-el-0.54/doc/src/about.md000066400000000000000000000252731500535241500154470ustar00rootroot00000000000000# pg-el [![License: GPL v3](https://img.shields.io/badge/License-GPL%20v3-blue.svg)](https://www.gnu.org/licenses/gpl-3.0.html) [![Latest tagged version](https://img.shields.io/github/v/tag/emarsden/pg-el?label=Latest%20tagged%20version)](https://github.com/emarsden/pg-el/) [![MELPA](https://melpa.org/packages/pg-badge.svg)](https://melpa.org/#/pg) [![test-pgv16](https://github.com/emarsden/pg-el/workflows/test-pgv16/badge.svg)](https://github.com/emarsden/pg-el/workflows/test-pgv16/badge.svg) This Emacs Lisp library lets you access the [PostgreSQL](https://www.postgresql.org/) 🐘 database from Emacs, using its network-level frontend/backend protocol. The library is capable of automatic type coercions from a range of SQL types to and from the equivalent Emacs Lisp type. This libary will be useful for developers, rather than end users. If you’re looking for an Emacs-based browser/editor for PostgreSQL, you may be interested in [PGmacs](https://github.com/emarsden/pgmacs/), which uses this library to communicate with PostgreSQL or a compatible database. ~~~admonish note title="Supported features" - SCRAM-SHA-256 authentication (the default method since PostgreSQL version 14) as well as MD5 and password authentication. - Encrypted (TLS) connections between Emacs and the PostgreSQL backend. This includes support for client certificates. - **Prepared statements** using PostgreSQL's extended query message flow, that allows for parameterized queries to protect from SQL injection issues. - The PostgreSQL **COPY protocol** to copy preformatted data to PostgreSQL from an Emacs buffer. - Asynchronous handling of LISTEN/NOTIFY notification messages from PostgreSQL, allowing the implementation of publish-subscribe type architectures (PostgreSQL as an “event broker” or “message bus” and Emacs as event publisher and consumer). - Parsing various PostgreSQL types including integers, floats, array types, numerical ranges, JSON and JSONB objects into their native Emacs Lisp equivalents. The parsing support is user-extensible. Support for the HSTORE, pgvector and PostGIS extensions. - Connections over TCP or (on Unix machines) a local Unix socket. ~~~ The code has been tested with **PostgreSQL versions** 17.4, 16.3, 15.4, 13.8, 11.17, and 10.22 on Linux. It is also tested via GitHub actions on MacOS and Microsoft Windows. This library also works, to a variable extent, against other databases that implement the PostgreSQL wire protocol: - [Neon](https://neon.tech/) “serverless PostgreSQL” works perfectly. - [ParadeDB](https://www.paradedb.com/) version 0.9.1 works perfectly (it's really a PostgreSQL extension rather than a distinct database implementation). - [IvorySQL](https://www.ivorysql.org/) version 3.4 works perfectly (this fork of PostgreSQL adds some features for compatibility with Oracle). - The [CitusDB](https://github.com/citusdata/citus) extension for sharding PostgreSQL over multiple hosts works perfectly (last tested with Citus version 12.1.5, which is based on PostgreSQL 16.6). - The [Microsoft DocumentDB](https://github.com/microsoft/documentdb) extension for MongoDB-like queries works perfectly (last tested 2025-02 with version 16.6). Note that this is not the same product as Amazon DocumentDB. - The [Hydra Columnar](https://github.com/hydradatabase/columnar) extension for column-oriented storage and parallel queries works perfectly (last tested 2025-02). - The [Timescale DB](https://www.timescale.com/) extension for time series data works perfectly (tested with version 2.16.1). - The [PgBouncer](https://www.pgbouncer.org/) connection pooler for PostgreSQL works fine (tested with version 1.23 in the default session pooling mode). - [Google AlloyDB Omni](https://cloud.google.com/alloydb/omni/docs/quickstart) is a proprietary fork of PostgreSQL with Google-developed extensions, including a columnar storage extension, adaptive autovacuum, and an index advisor. It works perfectly with pg-el as of 2025-01. - [ParadeDB](https://www.paradedb.com/): This ElasticSearch alternative is very PostgreSQL-compatible (more of an extension than a reimplementation). Tested with the Dockerhub instance which is based on PostgreSQL 16.3. All tests pass. - [Xata](https://xata.io/) “serverless PostgreSQL” has many limitations including lack of support for `CREATE DATABASE`, `CREATE COLLATION`, for XML processing, for temporary tables, for cursors, for `EXPLAIN`, for `CREATE EXTENSION`, for functions such as `pg_notify`. - [YugabyteDB](https://yugabyte.com/): tested against version 2.23. This database uses a lot of code from PostgreSQL 11 and is quite compatible, including with the HSTORE and pgvector extensions. However, some system tables differ from PostgreSQL, such as the `pg_sequences` table. It does not support the XML type. It does not support `LISTEN`/`NOTIFY`. - The [RisingWave](https://github.com/risingwavelabs/risingwave) event streaming database is mostly working. It does not support `GENERATED ALWAYS AS IDENTITY` columns. Last tested 2025-02 with v2.1.2. - [CrateDB](https://crate.io/): last tested 2025-02 with version 5.9.9. There are limitations in this database's emulation of the PostgreSQL system tables: for example, it's not possible to query the owner of a table (function `pg-table-owner`). It doesn't accept SQL statements that only include an SQL comment. It doesn't support setting comments on SQL tables. As [documented](https://cratedb.com/docs/crate/reference/en/latest/interfaces/postgres.html), CrateDB does not support the `TIME` type without a time zone. It doesn't support casting integers to bits. It doesn't support the `VARBIT` type. It has no support for the COPY protocol. - [CockroachDB](https://github.com/cockroachdb/cockroach): tested with CockroachDB CCL v24.3. Note that this database does not implement the large object functionality, and its interpretation of SQL occasionally differs from that of PostgreSQL. It is currently [reporting an internal error](https://github.com/cockroachdb/cockroach/issues/104009) when we call `pg-table-comment`. - [QuestDB](https://questdb.io/): tested against version 6.5.4. This is not very PostgreSQL-compatible: it fails on the SQL query `SELECT 1::integer` because it doesn't recognize integer as a type. It doesn't support `DELETE` statements. - [Google Spanner](https://cloud.google.com/spanner): tested with the Spanner emulator (that reports itself as `PostgreSQL 14.1`) and the PGAdapter library that enables support for the PostgreSQL wire protocol. Spanner has very limited PostgreSQL compatibility, for example refusing to create tables that do not have a primary key. It does not recognize basic PostgreSQL types such as `INT2`. It also does not for example support the `CHR` and `MD5` functions, row expressions, and WHERE clauses without a FROM clause. - [YDB by Yandex](https://ydb.tech/docs/en/postgresql/docker-connect) last tested with version 23-4. Has very limited PostgreSQL compatibility. For example, an empty query string leads to a hung connection, and the `bit` type is returned as a string with the wrong oid. - The [Materialize](https://materialize.com/) operational database (a proprietary differential dataflow database) has many limitations in its PostgreSQL compatibility: no support for primary keys, unique constraints, check constraints, for the `bit` type for example. It works with these limitations with pg-el (last tested 2025-02 with Materialize v0.133). - [ClickHouse](https://clickhouse.com/) doesn't work with pg-el. Their version 24.5 has a very basic implementation of the PostgreSQL wire protocol. It doesn’t support the `pg_type` system table which provides information on the OIDs associated with different PostgreSQL types. All values are returned in textual format using the pseudo-OID of 0, which means the client must parse the value. The database immediately closes the connection on any SQL error. It doesn't support configuration statements such as `SET datestyle`. It doesn't specify a `server_name` in the startup sequence, which might allow us to detect this special case and restrict functionality to the most basic aspects. - [GreptimeDB](https://github.com/GrepTimeTeam/greptimedb) version 0.9.5 implements quite a lot of the PostgreSQL wire protocol, but the names it uses for types in the `pg_catalog.pg_types` table are not the same as those used by PostgreSQL (e.g. `Int64` instead of `int8`), so our parsing machinery does not work. - Untested but likely to work: Amazon RDS, Google Cloud SQL, Azure Database for PostgreSQL, Amazon Auroa. You may however encounter difficulties with TLS connections, as noted above. The generic function `pg-do-variant-specific-setup` allows you to specify setup operations to run for a particular semi-compatible PostgreSQL variant. You can specialize it on the symbol name of the variant, currently one of `postgresql`, `alloydb`, `cratedb`, `cockroachdb`, `yugabyte`, `questdb`, `greptimedb`, `risingwave`, `immudb`, `timescaledb`, `ydb`, `orioledb`, `xata`, `spanner`, `ivorydb`. As an example, the following specializer is already defined to run for AlloyDB variants: ```lisp ;; Register the OIDs associated with these OmniDB-specific types, so that their types appear in ;; column metadata listings. (cl-defmethod pg-do-variant-specific-setup ((con pgcon) (_variant (eql 'alloydb))) (message "pg-el: running variant-specific setup for AlloyDB Omni") ;; These type names are in the google_ml schema (pg-register-parser "model_family_type" #'pg-text-parser) (pg-register-parser "model_family_info" #'pg-text-parser) (pg-register-parser "model_provider" #'pg-text-parser) (pg-register-parser "model_type" #'pg-text-parser) (pg-register-parser "auth_type" #'pg-text-parser) (pg-register-parser "auth_info" #'pg-text-parser) (pg-register-parser "models" #'pg-text-parser) (pg-initialize-parsers con)) ``` Tested with **Emacs versions** 30-pre-release, 29.4, 28.2, 27.2 and 26.3. Emacs versions older than 26.1 will not work against a recent PostgreSQL version (whose default configuration requires SCRAM-SHA-256 authentication), because they don’t include the GnuTLS support which we use to calculate HMACs. They may however work against a database set up to allow unauthenticated local connections. Emacs versions before 28.1 will not support the extended query protocol, because the `bindat` package is required. We mostly test with Emacs on Linux, but the library also works fine on Microsoft Windows and MacOS. You may be interested in an alternative library [emacs-libpq](https://github.com/anse1/emacs-libpq) that enables access to PostgreSQL from Emacs by binding to the libpq library. ## Licence pg-el is free software distributed under the terms of the GNU GPL v3 or later. pg-el-0.54/doc/src/collation.md000066400000000000000000000021221500535241500163050ustar00rootroot00000000000000# Collation Case support in PostgreSQL (`lower()` and `upper()` functions) depend on the current [collation rules](https://www.postgresql.org/docs/current/collation.html). A table has a default collation which is specified at creation (with a default). To remove the dependency on the table's collation, you can specify the desired collation explicitly. Note that PostgreSQL can be compiled with or without support for libicu, as a complement to the collation support in your libc. ~~~admonish example title="Using different collation rules" ```lisp ELISP> (let ((res (pg-exec *pg* "SELECT lower('FÔÖÉ' COLLATE \"fr_FR\")"))) (car (pg-result res :tuple 0))) "fôöé" ELISP> (let ((res (pg-exec *pg* "SELECT lower('FÔ🐘💥bz' COLLATE \"fr_FR\")"))) (car (pg-result res :tuple 0))) "fô🐘💥bz" ELISP> (pg-result (pg-exec *pg* "CREATE COLLATION IF NOT EXISTS \"french\" (provider = icu, locale = 'fr_FR')") :status) "CREATE COLLATION" ELISP> (let ((res (pg-exec *pg* "SELECT lower('FÔÖÉ' COLLATE \"french\")"))) (car (pg-result res :tuple 0))) "fôöé" ``` ~~~ pg-el-0.54/doc/src/copy-protocol.md000066400000000000000000000106711500535241500171420ustar00rootroot00000000000000# The COPY protocol The [COPY protocol](https://www.postgresql.org/docs/current/sql-copy.html) can be used to send and receive large amounts of data to/from PostgreSQL. It can be used with CSV or TSV data. ## From Emacs to PostgreSQL The pg-el library allows you to COPY from an Emacs buffer into PostgreSQL using function `pg-copy-from-buffer`, as illustrated below. ~~~admonish example title="Inserting tab-separated data" ```lisp ELISP> (defun ascii (n) (+ ?A (mod n 26))) ascii ELISP> (defun random-word () (apply #'string (cl-loop for count to 10 collect (+ ?a (random 26))))) random-word ELISP> (pg-result (pg-exec *pg* "CREATE TABLE copy_tsv(a INTEGER, b CHAR, c TEXT)") :status) "CREATE TABLE" ELISP> (let ((buf (get-buffer-create " *pg-copy-temp-tsv*"))) (with-current-buffer buf (dotimes (i 42) (insert (format "%d\t%c\t%s\n" i (ascii i) (random-word))))) (pg-result (pg-copy-from-buffer *pg* "COPY copy_tsv(a,b,c) FROM STDIN" buf) :status)) "COPY 84" ELISP> (pg-result (pg-exec *pg* "SELECT COUNT(*) FROM copy_tsv") :tuple 0) (84) ELISP> (pg-result (pg-exec *pg* "SELECT * FROM copy_tsv LIMIT 5") :tuples) ((0 "A" "ufyhdnkoyfi") (1 "B" "jpnlxbftdpm") (2 "C" "lqvazrhesdg") (3 "D" "epxkjdsfdpg") (4 "E" "yjhgdwjzbvt")) ``` ~~~ ~~~admonish example title="Inserting comma-separated data (CSV)" The use of CSV formatted data is very similar; you simply need to specify `WITH (FORMAT CSV)` in the [`COPY` statement](https://www.postgresql.org/docs/current/sql-copy.html). ```lisp ELISP> (pg-result (pg-exec *pg* "CREATE TABLE copy_csv (a INT2, b INTEGER, c CHAR, d TEXT)") :status) "CREATE TABLE" ELISP> (let ((buf (get-buffer-create " *pg-copy-temp-csv*"))) (with-current-buffer buf (dotimes (i 1000) (insert (format "%d,%d,%c,%s\n" i (* i i) (ascii i) (random-word))))) (pg-result (pg-copy-from-buffer *pg* "COPY copy_csv(a,b,c,d) FROM STDIN WITH (FORMAT CSV)" buf) :status)) "COPY 1000" ELISP> (pg-result (pg-exec *pg* "SELECT * FROM copy_csv LIMIT 3") :tuples) ((0 0 "A" "ajoskqunbrx") (1 1 "B" "pzmoyefgywu") (2 4 "C" "blylbnhnrdb")) ``` ~~~ ## From PostgreSQL to Emacs You can copy from PostgreSQL into an Emacs buffer using the function `pg-copy-to-buffer`, as illustrated below. ~~~admonish example title="Dumping a PostgreSQL table into an Emacs buffer as CSV" ```lisp ELISP> (let ((res (pg-copy-to-buffer *pg* "COPY copy_csv TO STDOUT WITH (FORMAT CSV, HEADER TRUE)" (get-buffer-create "*pg-csv*")))) (pg-result res :status)) "COPY 1000" ``` ~~~ The following more verbose example illustrates fetching CSV data from an online source, importing it into PostgreSQL, removing some unneeded columns and querying the data. ~~~admonish example title="Fetching and querying online CSV datasets" ```lisp ELISP> (with-temp-buffer (url-insert-file-contents "https://www.data.gouv.fr/fr/datasets/r/51606633-fb13-4820-b795-9a2a575a72f1") (pg-exec *pg* "CREATE TABLE cities( insee_code TEXT NOT NULL, city_code TEXT, zip_code NUMERIC, label TEXT NOT NULL, latitude FLOAT, longitude FLOAT, department_name TEXT, department_number VARCHAR(3), region_name TEXT, region_geojson_name TEXT)") (pg-result (pg-copy-from-buffer *pg* "COPY cities FROM STDIN WITH (FORMAT CSV, DELIMITER ',', HEADER TRUE)" (current-buffer)) :status)) "COPY 39145" ELISP> (pg-result (pg-exec *pg* "ALTER TABLE cities DROP COLUMN region_name") :status) "ALTER TABLE" ELISP> (pg-result (pg-exec *pg* "ALTER TABLE cities DROP COLUMN region_geojson_name") :status) "ALTER TABLE" ELISP> (pg-result (pg-exec *pg* "ALTER TABLE cities DROP COLUMN label") :status) "ALTER TABLE" ELISP> (pg-result (pg-exec *pg* "SELECT * FROM cities WHERE city_code LIKE 'toulouse%'") :tuples) (("39533" "toulouse le chateau" 39230 46.821901729 5.583200112 "jura" "39") ("31555" "toulouse" 31100 43.596037953 1.432094901 "haute-garonne" "31") ("31555" "toulouse" 31300 43.596037953 1.432094901 "haute-garonne" "31") ("31555" "toulouse" 31400 43.596037953 1.432094901 "haute-garonne" "31") ("31555" "toulouse" 31500 43.596037953 1.432094901 "haute-garonne" "31") ("31555" "toulouse" 31000 43.596037953 1.432094901 "haute-garonne" "31") ("31555" "toulouse" 31200 43.596037953 1.432094901 "haute-garonne" "31")) ``` ~~~ pg-el-0.54/doc/src/error-handling.md000066400000000000000000000126141500535241500172430ustar00rootroot00000000000000# Error handling Errors signaled by PostgreSQL will be converted into an Emacs Lisp error that subclasses `pg-error`. You can handle these errors as usual in Emacs Lisp, as shown in the example below. ~~~admonish example title="Basic error handling" ```lisp ELISP> (ignore-errors (pg-exec *pg* "SELECT ###")) nil ELISP> (condition-case nil (pg-exec *pg* "SELECT ###") (pg-error 42)) 42 (#o52, #x2a, ?*) ``` ~~~ Some errors are converted into specific subclasses of `pg-error`, as listed below. We can discriminate the error category thanks to [PostgreSQL's SQLSTATE support](See https://www.postgresql.org/docs/17/errcodes-appendix.html). | Error class | Meaning | |-----------------------------------|---------------------------------------------------------------------------------| | pg-connection-error | Connection failure | | pg-invalid-password | Invalid password or authentication data | | pg-feature-not-supported | PostgreSQL feature not supported | | pg-syntax-error | Syntax error | | pg-undefined-table | Undefined table | | pg-undefined-column | Undefined column | | pg-undefined-function | Undefined function | | pg-copy-failed | PostgreSQL COPY failed | | pg-connect-timeout | PostgreSQL connection attempt timed out | | pg-type-error | When serializing, an argument was of an unexpected type | | pg-numeric-value-out-of-range | Numeric value out of range | | pg-division-by-zero | Division by zero | | pg-floating-point-exception | Floating point exception | | pg-array-subscript-error | Array subscript error | | pg-datetime-field-overflow | Overflow in a datetime field | | pg-invalid-text-representation | Invalid text representation | | pg-invalid-binary-representation | Invalid binary representation | | pg-character-not-in-repertoire | Character not in repertoire | | pg-datatype-mismatch | Datatype mismatch | | pg-json-error | JSON-related error | | pg-integrity-constraint-violation | Violation of an integrity constraint | | pg-restrict-violation | Restrict violation | | pg-not-null-violation | Violation of a not NULL constraint | | pg-foreign-key-violation | Violation of a FOREIGN KEY constraint | | pg-unique-violation | Violation of a UNIQUE constraint | | pg-check-violation | Violation of a CHECK constraint | | pg-exclusion-violation | Violation of an exclusion constraint | | pg-plpgsql-error | PL/pgSQL error | | pg-transaction-timeout | Transaction timeout | | pg-insufficient-resources | Insufficient resources on the backend server (eg. memory full) | | pg-disk-full | Disk full on the backend server | | pg-too-many-connections | Too many connections to the backend | | pg-internal-error | Internal error in the backend | You can undertake error handling for specific error categories as shown in the example below: ~~~admonish example title="Differentiated error handling" ```lisp ELISP> (condition-case nil (pg-exec *pg* "SELECT 2147483649::int4") (pg-numeric-value-out-of-range (message "Numeric overflow")) (pg-syntax-error (message "Syntax error")) (pg-error (message "Generic error"))) "Numeric overflow" ``` ~~~ Please note that some semi-compatible PostgreSQL variants do not implement fine-grained SQLSTATE error reporting, simply returning most errors as an “internal error” (this is the case of CrateDB in 2025-02, for example). pg-el-0.54/doc/src/feedback.md000066400000000000000000000002321500535241500160450ustar00rootroot00000000000000# Your feedback Bug reports should be filed as issues on [our GitHub project page](https://github.com/emarsden/pg-el). Pull requests are also welcome! pg-el-0.54/doc/src/hstore.md000066400000000000000000000026311500535241500156320ustar00rootroot00000000000000# The HSTORE key-value type There is support for the PostgreSQL [HSTORE extension](https://www.postgresql.org/docs/current/hstore.html), which can store key/value pairs in a single PostgreSQL column. It's necessary to call `pg-hstore-setup` before using this functionality, to load the extension if necessary and to set up our parser support for the HSTORE type. ~~~admonish example title="Using HSTORE values" ```lisp ELISP> (pg-hstore-setup *pg*) ELISP> (defvar *hs* (car (pg-result (pg-exec *pg* "SELECT 'foo=>bar'::hstore") :tuple 0))) *hs* ELISP> (gethash "foo" *hs*) "bar" ELISP> (hash-table-count *hs*) 1 (#o1, #x1, ?\C-a) ;; There is no guarantee as to the value stored for the 'a' key (duplicate) ELISP> (setq *hs* (car (pg-result (pg-exec *pg* "SELECT 'a=>1,foobles=>2,a=>66'::hstore") :tuple 0))) # ELISP> (hash-table-count *hs*) 2 (#o2, #x2, ?\C-b) ELISP> (pg-result (pg-exec *pg* "SELECT akeys('biz=>NULL,baz=>42,boz=>66'::hstore)") :tuple 0) (["baz" "biz" "boz"]) ``` ~~~ ~~~admonish example title="Serialization support for HSTORE values" ```lisp ELISP> (pg-hstore-setup *pg*) ELISP> (let ((ht (make-hash-table :test #'equal))) (puthash "biz" "baz" ht) (puthash "foo" "bar" ht) (puthash "more" "than" ht) (let* ((res (pg-exec-prepared con "SELECT $1 ? 'foo'" `((,ht . "hstore")))) (pg-result res :tuple 0)))) (t) ``` ~~~ pg-el-0.54/doc/src/installation.md000066400000000000000000000020531500535241500170250ustar00rootroot00000000000000# Installation You can install via the MELPA package archive, or with `package-vc-install`, or with `use-package`. ## Installing via MELPA Install via the [MELPA package archive](https://melpa.org/partials/getting-started.html) by including the following in your Emacs initialization file (`.emacs.el` or `init.el`): ```lisp (require 'package) (add-to-list 'package-archives '("melpa" . "https://melpa.org/packages/") t) ``` then saying M-x package-install RET pg ## Installing with package-vc-install With Emacs 29, you can install the library from the latest Github revision (this requires git to be installed) using: (unless (package-installed-p 'pg) (package-vc-install "https://github.com/emarsden/pg-el" nil nil 'pg)) You can later update to the latest version with `M-x package-vc-upgrade RET pg RET`. ## Installing with `use-package` If you prefer to use the `use-package` macro, which is built in to Emacs 29, you can use (requires git to be installed): (use-package pg :vc (:url "https://github.com/emarsden/pg-el")) pg-el-0.54/doc/src/json.md000066400000000000000000000061701500535241500153010ustar00rootroot00000000000000# JSON and JSONB values PostgreSQL has quite a lot of [support for storing, saving and processing JSON and JSONB data](https://www.postgresql.org/docs/current/functions-json.html). pg-el is able to deserialize JSON and JSONB values into Emacs Lisp structures such as hashtables (for dicts), arrays, numbers, strings and so on. This library will parse and represent JSON/JSONB data either using the JSON support built into Emacs with libjansson (see function `json-available-p`, from version 28.1), or using the `json.el` library. There are some differences in the ways these methods handle dictionaries and specific values such as NULL, false, [] and {}. Our examples below use the builtin JSON support in Emacs. ~~~admonish example title="Retrieving and manipulating JSON data" ```lisp ELISP> (defun scalar (sql) (car (pg-result (pg-exec *pg* sql) :tuple 0))) scalar ELISP> (let ((json (scalar "SELECT '[5,7]'::json"))) (aref json 0)) 5 (#o5, #x5, ?\C-e) ELISP> (let ((json (scalar "SELECT '[42.0,77.7]'::jsonb"))) (aref json 1)) 77.7 ELISP> (scalar "SELECT '[]'::json") [] ELISP> (scalar "SELECT '{}'::json") # ELISP> (let ((json (scalar "SELECT '{\"a\": 42, \"b\": \"foo\"}'::json"))) (gethash "b" json)) "foo" ELISP> (let ((json (scalar "SELECT '{\"a\": [0,1,2,null]}'::json"))) (gethash "a" json)) [0 1 2 :null] ``` ~~~ pg-el can also serialize Emacs Lisp structures into the PostgreSQL JSON format, for use in prepared statements. ~~~admonish example title="Serializing objects to JSON / JSONB" ```lisp ELISP> (let ((ht (make-hash-table))) (puthash "biz" 45 ht) (puthash "boz" -5.5 ht) (puthash "comment" "good stuff" ht) (pg-result (pg-exec-prepared *pg* "SELECT $1->'boz'" `((,ht . "json"))) :tuple 0)) (-5.5) ELISP> (let ((ht (make-hash-table))) (puthash "biz" 45 ht) (puthash "boz" -5.5 ht) (puthash "comment" "good stuff" ht) ;; the '-' jsonb operator deletes a matching key/value mapping (let* ((res (pg-exec-prepared *pg* "SELECT $1 - 'boz'" `((,ht . "jsonb")))) (row (pg-result res :tuple 0))) (gethash "comment" (cl-first row) ))) "good stuff" ``` ~~~ ## Support for the JSON path language (jsonpath type) pg-el serializes and deserializes [JSONPATH expressions](https://www.postgresql.org/docs/current/functions-json.html#FUNCTIONS-SQLJSON-PATH) as strings, as illustrated below. You can use them as arguments to prepared statements. ~~~admonish example title="Serializing and deserializing JSON path expressions" ```lisp ELISP> (pg-result (pg-exec *pg* "SELECT 'true'::jsonpath") :tuple 0) (list "true") ELISP> (pg-result (pg-exec *pg* "SELECT '$[*] ? (@ < 1 || @ > 5)'::jsonpath") :tuple 0) (list "$[*]?(@ < 1 || @ > 5)") ELISP> (let* ((sql "SELECT jsonb_path_query($1, $2)") (dict (make-hash-table :test #'equal)) (_ (puthash "h" 5.6 dict)) (params `((,dict . "jsonb") ("$.h.floor()" . "jsonpath"))) (res (pg-exec-prepared con sql params)) (row (pg-result res :tuple 0))) (cl-first row)) 5 ``` ~~~ pg-el-0.54/doc/src/postgis.md000066400000000000000000000035701500535241500160210ustar00rootroot00000000000000# Data types used by the PostGIS extension There is deserialization support (and trivial serialization) support for the data types used by the [PostGIS extension](http://www.postgis.net/). It's necessary to require the `pg-gis` library and to call `pg-setup-postgis` before using this functionality, to load the extension if necessary and to set up our deserialization support for the types used by PostGIS (in particular, the `geometry` and `geography` types). ```lisp (require 'pg-gis) (pg-setup-postgis *pg*) ``` PostGIS sends values over the wire in HEXEWKB format ([Extended Well-Known Binary](https://en.wikipedia.org/wiki/Well-known_text_representation_of_geometry#Well-known_binary) encoded in hexademical), such as `01010000200400000000000000000000000000000000000000` which represents the well-known text (WKT) `POINT (0 0)`. If the variable `pg-gis-use-geosop` is non-nil, we parse this format using the `geosop` commandline utility function from GEOS (often available in packages named `geos-bin` or similar). Otherwise, we leave it as a string (it can be parsed using PostGIS functions such as `ST_AsText`). ```shell sudo apt install geos-bin ``` ~~~admonish example title="Using PostGIS datatypes" ```lisp ELISP> (require 'pg-gis) ELISP> (pg-setup-postgis *pg*) ELISP> (pg-result (pg-exec *pg* "SELECT 'POINT(4 5)'::geometry") :tuple 0) ("POINT (4 5)") ELISP> (pg-result (pg-exec *pg* "SELECT Box2D(ST_GeomFromText('LINESTRING(1 2, 3 4, 5 6)'))") :tuple 0) ("BOX(1 2,5 6)") ELISP> (pg-result (pg-exec *pg* "SELECT 'MULTILINESTRING((-118.584 38.374 20,-118.583 38.5 30),(-71.05957 42.3589 75, -71.061 43 90))'::geometry") :tuple 0) ("MULTILINESTRING Z ((-118.584 38.374 20, -118.583 38.5 30), (-71.05957 42.3589 75, -71.061 43 90))") ELISP> (pg-result (pg-exec *pg* "SELECT 'SPHEROID[\"GRS_1980\",6378137,298.2572]'::spheroid") :tuple 0) ("SPHEROID(\"GRS_1980\",6378137,298.2572)") ``` ~~~ pg-el-0.54/doc/src/prepared-statements.md000066400000000000000000000065061500535241500203220ustar00rootroot00000000000000# Using prepared statements pg-el has support for PostgreSQL's **extended query protocol** (prepared statements), which you should use to prevent SQL injection attacks. ~~~admonish example title="Prepared statements and the extended query protocol" ```lisp ELISP> (pg-result (pg-exec *pg* "CREATE TABLE count_test(key INTEGER, val INTEGER)") :status) "CREATE TABLE" ELISP> (dotimes (i 100) (pg-exec-prepared *pg* "INSERT INTO count_test VALUES($1, $2)" `((,i . "int4") (,(* i i) . "int4")))) nil ELISP> (let ((res (pg-exec *pg* "SELECT count(*) FROM count_test"))) (car (pg-result res :tuple 0))) 100 ELISP> (defvar *multires* (pg-exec-prepared *pg* "SELECT key FROM count_test" nil :max-rows 10)) *multires* ELISP> (pg-result *multires* :tuples) ((0) (1) (2) (3) (4) (5) (6) (7) (8) (9)) ELISP> (pg-result *multires* :incomplete) t ELISP> (setq *multires* (pg-fetch *pg* *multires* :max-rows 5)) ;; *multires* ELISP> (pg-result *multires* :tuples) ((10) (11) (12) (13) (14)) ELISP> (pg-result *multires* :incomplete) t ELISP> (setq *multires* (pg-fetch *pg* *multires* :max-rows 100)) ;; *multires* ELISP> (length (pg-result *multires* :tuples)) 85 ELISP> (pg-result *multires* :incomplete) nil ``` ~~~ If your application will use the same prepared statement multiple times, you can ask PostgreSQL to parse/analyze the SQL query and bind parameters once, then use the prepared statement with different variable values multiple times. This will improve performance by avoiding the overhead of reparsing and reoptimizing a query plan multiple times. ~~~admonish example title="Fetching from a previously prepared statement" The example function below (which comes from the [PGmacs](https://github.com/emarsden/pgmacs) browsing/editing interface for PostgreSQL) illustrates the use of the utility function `pg-ensure-prepared-statement`, which either retrieves the cached prepared statement if the function has already been called (pg-el maintains a per-connection cache of prepared statements), or prepares the statement given the SQL and the argument types if the function has not yet been called in this PostgreSQL connection. The prepared statement is executed using `pg-fetch-prepared`, which functions in a similar way to function `pg-fetch`. ```lisp (defun pgmacs--table-primary-keys (con table) "Return the columns active as PRIMARY KEY in TABLE. Uses PostgreSQL connection CON." (let* ((schema (if (pg-qualified-name-p table) (pg-qualified-name-schema table) "public")) (tname (if (pg-qualified-name-p table) (pg-qualified-name-name table) table)) (sql "SELECT a.attname FROM pg_catalog.pg_index idx JOIN pg_catalog.pg_class c ON c.oid = idx.indrelid JOIN pg_catalog.pg_attribute a ON a.attrelid = c.oid AND a.attnum = ANY(idx.indkey) JOIN pg_catalog.pg_namespace n ON n.oid = c.relnamespace WHERE relname = $1 AND nspname = $2 AND indisprimary") (argument-types (list "text" "text")) (params `((,tname . "text") (,schema . "text"))) (ps-name (pg-ensure-prepared-statement con "QRY-tbl-primary-keys" sql argument-types)) (res (pg-fetch-prepared con ps-name params))) (mapcar #'cl-first (pg-result res :tuples)))) ``` ~~~ pg-el-0.54/doc/src/quickstart.md000066400000000000000000000075301500535241500165230ustar00rootroot00000000000000# Quickstart to using pg-el These illustrative examples assume you have a PostgreSQL user `pgeltestuser` with password `pgeltest` who owns a database `pgeltestdb`. To set that up with a local PostgreSQL database, use commands similar to the following: ~~~admonish example title="Create a test user and database with a local PostgreSQL" ```shell sudo -u postgres createuser --createdb pgeltestuser sudo -u postgres createdb --owner=pgeltestuser pgeltestdb sudo -u postgres psql postgres=# alter user pgeltestuser with encrypted password 'pgeltest'; ``` If you want to enable and test the support for the HSTORE and pgvector extensions, you will need to load them into the test database as PostgreSQL superuser (the normal user `pgeltestuser` we created above is not allowed to load extensions). The pgvector extension generally needs to be installed separately from PostgreSQL (for example by installing the `postgresql-17-pgvector` package on Debian). ```shell sudo -u postgres psql postgres=# CREATE EXTENSION hstore; CREATE EXTENSION postgres=# CREATE EXTENSION vector; CREATE EXTENSION ``` The same applies to the PostGIS extension. ~~~ Now, from your preferred Emacs Lisp shell (here `M-x ielm`), check that you are able to connect to and authenticate with the database from Emacs: ~~~admonish example title="Connect to PostgreSQL from Emacs" ```lisp ELISP> (require 'pg) pg ELISP> (defvar *pg* (pg-connect "pgeltestdb" "pgeltestuser" "pgeltest" "localhost" 5432)) *pg* ``` ~~~ If you don’t already have PostgreSQL installed locally, it may be convenient for you to use [PostgreSQL Docker Community images](https://hub.docker.com/_/postgres/), using [Docker](https://www.docker.com/) or [Podman](https://podman.io/). I recommend installing Podman because it’s fully free software, whereas Docker is partly commercial. Podman is also able to run containers “rootless”, without special privileges, which is good for security, and doesn’t require a background daemon. Podman has a docker-compatible commandline interface. ~~~admonish example title="Start up PostgreSQL inside a Podman container" ```shell podman run -d --name pgsql \ -v /dev/log:/dev/log \ -v /var/run/postgresql:/var/run/postgresql \ --publish 5432:5432 \ -e POSTGRES_DB=pgeltestdb \ -e POSTGRES_USER=pgeltestuser \ -e POSTGRES_PASSWORD=pgeltest \ docker.io/library/postgres:latest ``` ~~~ then connect from Emacs with ELISP> (pg-connect "pgeltestdb" "pgeltestuser" "pgeltest" "localhost" 5432) or connect over a local Unix socket ELISP> (pg-connect-local "/var/run/postgresql/.s.PGSQL.5432" "pgeltestdb" "pgeltestuser "pgeltest") Now some simple interactions with the database: ```lisp ELISP> (pg-backend-version *pg*) "PostgreSQL 16.1 (Debian 16.1-1) on x86_64-pc-linux-gnu, compiled by gcc (Debian 13.2.0-6) 13.2.0, 64-bit" ELISP> (let ((res (pg-exec *pg* "SELECT 42, 1.23"))) (pg-result res :tuple 0)) (42 1.23) ``` Note that the first query has returned an Emacs Lisp string, and the second query has returned a tuple (represented as a list) where the first value is an Emacs Lisp integer, and the second and Emacs Lisp float. The pg-el library has ensured **automatic type coercion** from the SQL types to the most appropriate Emacs Lisp type. The following example shows the output from a query that returns multiple rows. It returns a list of tuples, each tuple containing a single integer. ~~~admonish example title="A query that returns multiple rows" ```lisp ELISP> (let ((res (pg-exec *pg* "SELECT * FROM generate_series(50,55)"))) (pg-result res :tuples)) ((50) (51) (52) (53) (54) (55)) ``` ~~~ An SQL query that returns no results will return the empty list. ```lisp ELISP> (let ((res (pg-exec *pg* "SELECT 3 where 1=0"))) (pg-result res :tuples)) nil ``` For more, see the [usage information](usage.html) and the [API documentation](API.html). pg-el-0.54/doc/src/schemas.md000066400000000000000000000053751500535241500157610ustar00rootroot00000000000000# Schema-qualified names ## Introduction to PostgreSQL schemas A [schema in PostgreSQL](https://www.postgresql.org/docs/current/ddl-schemas.html) (and in the ANSI SQL standard) is a collection of tables, views, functions, constraints, indexes and sequences. PostgreSQL allows you to define multiple schemas in the same database, and different schemas can include datastructres (such as tables) with the same name. You can think of them as namespaces for tables. Here is the hierarchy of names: - each PostgreSQL instance can have multiple databases; - each database can contain multiple schemas; - each schema can contain multiple tables (and views, functions and so on). In SQL syntax you will use **qualified names** including a schema, such as `myschema.mytable` anywhere were you use a “normal” unqualified name `mytable`. Default objects created by the user are in the schema named `public` (this schema is not normally printed in query results because the current [`search_path`](https://www.postgresql.org/docs/current/ddl-schemas.html#DDL-SCHEMAS-PATH) includes `public`). Objects used internally by PostgreSQL are in system-defined schemas such as `pg_catalog`, `pg_toast` and `information_schema`. The pg-el library represents schema-qualified names using `pg-qualified-name` objects, which are `cl-defstruct` objects. This means you can create them as follows: ```lisp (make-pg-qualified-name :schema "myschema" :name "mytable") ``` You can then use these objects anywhere you would use a normal table name, escaping special characters using `pg-print-qualified-name`. The `pg-tables` function will return normal string names for tables in the `public` namespace, and `pg-qualified-name` objects for tables in other namespaces. ~~~admonish example title="Using schema-qualified names" ```lisp ELISP> (let ((res (pg-exec *pg* "SHOW search_path"))) (pg-result res :tuple 0)) ("\"$user\", public") ELISP> (let ((res (pg-exec *pg* "CREATE SCHEMA custom"))) (pg-result res :status)) "CREATE SCHEMA" ELISP> (let* ((qn (make-pg-qualified-name :schema "custom" :name "mytable")) (sql (format "CREATE TABLE IF NOT EXISTS %s(id INTEGER)" (pg-print-qualified-name qn))) (res (pg-exec *pg* sql))) (pg-result res :status)) "CREATE TABLE" ELISP> (pg-tables *pg*) ("purchases" "customers" #s(pg-qualified-name :schema "custom" :name "mytable")) ;; We can use schema-qualified names as parameters for a prepared query. ELISP> (let* ((qn (make-pg-qualified-name :schema "custom" :name "mytable")) (pqn (pg-print-qualified-name qn)) (sql "SELECT pg_total_relation_size($1)") (res (pg-exec-prepared *pg* sql `((,pqn . "text"))))) (pg-result res :tuple 0)) (0) ``` ~~~ pg-el-0.54/doc/src/special-features.md000066400000000000000000000103341500535241500175610ustar00rootroot00000000000000# Special pg-el features ## Handling parameter changes The PostgreSQL backend informs connected clients when certain server parameters change, by sending them a special `ParameterStatus` message. These notifications are sent for `GUC_REPORT` parameters, which include the `client_encoding`, the `DateStyle`, `TimeZone`, `server_encoding`, `in_hot_standby` and `is_superuser`. You can register your interest in these messages by adding a handler function to `pg-parameter-change-functions`. Each of these handler functions will be called when such a message is received, with three arguments: the connection to PostgreSQL, the parameter name and the parameter value. These messages are sent asynchronously. ~~~admonish example title="Handling changes to session timezone" ```lisp ELISP> (defun handle-tz-change (_con name value) (when (string= name "TimeZone") (message "New timezone in PostgreSQL is %s" value))) handle-tz-change ELISP> (cl-pushnew #'handle-tz-change pg-parameter-change-functions) (handle-tz-change pg-handle-parameter-client-encoding) ELISP> (pg-result (pg-exec *pg* "SET SESSION TIME ZONE 'Europe/Paris'") :status) "SET" ELISP> (pg-result (pg-exec *pg* "SET SESSION TIME ZONE 'America/Chicago'") :status) "SET" ``` You should see either one or two messages announcing a parameter change (the first statement won't generate a ParameterStatus message if the time zone was already set to Europe/Paris). ~~~ ## Handling asynchronous notifications PostgreSQL has an asynchronous notification functionality based on the [LISTEN and NOTIFY commands](https://www.postgresql.org/docs/current/libpq-notify.html). A client can register its interest in a particular notification channel with the `LISTEN` command, and later stop listening with the `UNLISTEN` command. All clients listening on a particular channel will be notified asynchronously when a `NOTIFY` command with that channel name is executed by any client. A “payload” string can be passed to communicate additional data to the listeners. In pg-el you can register functions to be called when an asynchronous notification is received by adding them to the `pg-handle-notice-functions`. Each handler function is called with a single argument, the notice, in the form of a `pgerror` struct. ~~~admonish example title="Looking out for DROP TABLE commands" PostgreSQL will signal an asynchronous notification for a `DROP TABLE IF EXISTS` command that attempts to remove a table that doesn't exist, as a form of warning message. We can register our interest in this message by locally binding the `pg-handle-notice-functions` variable. ```lisp ELISP> (defun deity-p (notif) ;; the notification message will be localized, but should contain the table name (when (cl-search "deity" (pgerror-message notif)) (message "Indeed"))) ELISP> (let ((pg-handle-notice-functions (list #'deity-p))) (pg-result (pg-exec *pg* "DROP TABLE IF EXISTS deity") :status)) "DROP TABLE" ``` You should see the message in the minibuffer. ~~~ ~~~admonish example title="Using NOTIFY / LISTEN" This example illustrates the use of NOTIFY and LISTEN. It's obviously not very useful with a single client; real applications would involve multiple event consumers and possibly also multiple event producers. This functionality can be used to implement simple publish-subscribe communication patterns, with PostgreSQL serving as an event broker. ```lisp (cl-flet ((notification-handler (channel payload) (message "Async notification on %s: %s" channel payload))) (pg-add-notification-handler *pg* #'notification-handler) (pg-exec *pg* "LISTEN yourheart") (pg-exec *pg* "NOTIFY yourheart, 'foobles'") (pg-exec *pg* "SELECT 'ignored'") (pg-exec *pg* "NOTIFY yourheart, 'bazzles'") (sleep-for 10) (pg-exec *pg* "SELECT 'ignored'") (pg-exec *pg* "NOTIFY yourheart") (pg-exec *pg* "SELECT 'ignored'") ;; The function pg_notify is an alternative to the LISTEN statement, and more flexible if your ;; channel name is determined by a variable. (pg-exec *pg* "SELECT pg_notify('yourheart', 'leaving')") (pg-exec *pg* "SELECT 'ignored'") (pg-exec *pg* "UNLISTEN yourheart") (pg-exec *pg* "NOTIFY yourheart, 'Et redit in nihilum quod fuit ante nihil.'"))) ``` ~~~ pg-el-0.54/doc/src/usage.md000066400000000000000000000214751500535241500154410ustar00rootroot00000000000000# Using pg-el The examples below illustrate various features of pg-el in conjunction with PostgreSQL. A more complete set of examples can be found in our [test suite](https://github.com/emarsden/pg-el/tree/main/test). The examples all assume that you are using ielm as an Emacs Lisp shell (start with `M-x ielm`) and that you have a connection to PostgreSQL: ~~~admonish example title="Connect to PostgreSQL from Emacs" ```lisp ELISP> (require 'cl-lib) cl-lib ELISP> (require 'pg) pg ELISP> (defvar *pg* (pg-connect "pgeltestdb" "pgeltestuser" "pgeltest" "localhost" 5432)) *pg* ``` ~~~ The library should in principle convert from any obscure Emacs encoding to the UTF-8 supported by PostgreSQL. ~~~admonish example title="Unicode support" ```lisp ELISP> (let ((res (pg-exec *pg* "SELECT 'était ' || 'là'"))) (pg-result res :tuple 0)) ("était là") ELISP> (let ((res (pg-exec *pg* "select length('(╯°□°)╯︵ ┻━┻')"))) (pg-result res :tuple 0)) (12) ELISP> (let ((res (pg-exec *pg* "SELECT '😎'"))) (pg-result res :tuple 0)) ("😎") ``` ~~~ You can create and delete tables, and query the database metainformation using `pg-tables` and `pg-columns`. ~~~admonish example title="Working with tables and DDL" ```lisp ELISP> (pg-result (pg-exec *pg* "CREATE TABLE messages(id BIGSERIAL PRIMARY KEY, msg TEXT)") :status) "CREATE TABLE" ELISP> (member "messages" (pg-tables *pg*)) ("messages") ELISP> (member "msg" (pg-columns *pg* "messages")) ("msg") ELISP> (pg-result (pg-exec *pg* "DROP TABLE messages") :status) "DROP TABLE" ELISP> (member "messages" (pg-tables *pg*)) nil ``` ~~~ The library has support for PostgreSQL's **extended query protocol** (prepared statements), which you should use to prevent SQL injection attacks. ~~~admonish example title="Prepared statements and the extended query protocol" ```lisp ELISP> (pg-result (pg-exec *pg* "CREATE TABLE count_test(key INTEGER, val INTEGER)") :status) "CREATE TABLE" ELISP> (dotimes (i 100) (pg-exec-prepared *pg* "INSERT INTO count_test VALUES($1, $2)" `((,i . "int4") (,(* i i) . "int4")))) nil ELISP> (let ((res (pg-exec *pg* "SELECT count(*) FROM count_test"))) (car (pg-result res :tuple 0))) 100 ELISP> (defvar *multires* (pg-exec-prepared *pg* "SELECT key FROM count_test" nil :max-rows 10)) *multires* ELISP> (pg-result *multires* :tuples) ((0) (1) (2) (3) (4) (5) (6) (7) (8) (9)) ELISP> (pg-result *multires* :incomplete) t ELISP> (setq *multires* (pg-fetch *pg* *multires* :max-rows 5)) ;; *multires* ELISP> (pg-result *multires* :tuples) ((10) (11) (12) (13) (14)) ELISP> (pg-result *multires* :incomplete) t ELISP> (setq *multires* (pg-fetch *pg* *multires* :max-rows 100)) ;; *multires* ELISP> (length (pg-result *multires* :tuples)) 85 ELISP> (pg-result *multires* :incomplete) nil ``` ~~~ ~~~admonish example title="Casting SQL values to a specific type" ```lisp ELISP> (let ((res (pg-exec *pg* "SELECT pi()::int4"))) (car (pg-result res :tuple 0))) 3 ELISP> (let ((res (pg-exec *pg* "SELECT 42::text"))) (car (pg-result res :tuple 0))) "42" ELISP> (let ((res (pg-exec *pg* "SELECT '42'::smallint"))) (car (pg-result res :tuple 0))) 42 (#o52, #x2a, ?*) ELISP> (let ((res (pg-exec *pg* "SELECT 'PT3H4M42S'::interval"))) (car (pg-result res :tuple 0))) "03:04:42" ``` ~~~ ~~~admonish example title="Working with boolean vectors" Boolean vectors are only supported in Emacs from version 27 onwards (you can check whether the function `make-bool-vector` is fboundp). ```lisp ELISP> (let ((res (pg-exec *pg* "SELECT '1010'::bit(4)"))) (equal (car (pg-result res :tuple 0)) (coerce (vector t nil t nil) 'bool-vector))) t ELISP> (let ((res (pg-exec *pg* "SELECT b'1001000'"))) (equal (car (pg-result res :tuple 0)) (coerce (vector t nil nil t nil nil nil) 'bool-vector))) t ELISP> (let ((res (pg-exec *pg* "SELECT '101111'::varbit(6)"))) (equal (car (pg-result res :tuple 0)) (coerce (vector t nil t t t t) 'bool-vector))) t ``` ~~~ Emacs has support for bignums from version 27.2 onwards. ~~~admonish example title="Using bignums" ```lisp ELISP> (fboundp 'bignump) t ELISP> (let ((res (pg-exec *pg* "SELECT factorial(25)"))) (car (pg-result res :tuple 0))) 15511210043330985984000000 (#o6324500606375411017360000000, #xcd4a0619fb0907bc00000) ``` ~~~ ~~~admonish example title="Special floating point syntax" ```lisp ELISP> (let ((res (pg-exec *pg* "SELECT 'Infinity'::float4"))) (car (pg-result res :tuple 0))) 1.0e+INF ELISP> (let ((res (pg-exec *pg* "SELECT '-Infinity'::float8"))) (car (pg-result res :tuple 0))) -1.0e+INF ELISP> (let ((res (pg-exec *pg* "SELECT 'NaN'::float8"))) (car (pg-result res :tuple 0))) 0.0e+NaN ``` ~~~ ~~~admonish title="Numerical ranges" ```lisp ELISP> (let ((res (pg-exec *pg* "SELECT int4range(10, 20)"))) (car (pg-result res :tuple 0))) (:range 91 10 41 20) ;; note that 91 is the character ?\[ and 41 is the character ?\) ELISP> (let ((res (pg-exec *pg* "SELECT int4range(10, 20)"))) (equal (car (pg-result res :tuple 0)) (list :range ?\[ 10 ?\) 20))) t ELISP> (let ((res (pg-exec *pg* "SELECT int4range(5,15) + int4range(10,20)"))) (equal (car (pg-result res :tuple 0)) (list :range ?\[ 5 ?\) 20))) t ELISP> (let ((res (pg-exec *pg* "SELECT int8range(5,15) * int8range(10,20)"))) (equal (car (pg-result res :tuple 0)) (list :range ?\[ 10 ?\) 15))) t ELISP> (let ((res (pg-exec *pg* "SELECT '(3,7)'::int4range"))) (equal (car (pg-result res :tuple 0)) (list :range ?\[ 4 ?\) 7))) t ELISP> (let ((res (pg-exec *pg* "SELECT int8range(1, 14, '(]')"))) (equal (car (pg-result res :tuple 0)) (list :range ?\[ 2 ?\) 15))) t ELISP> (let ((res (pg-exec *pg* "SELECT '[4,4)'::int4range"))) (equal (car (pg-result res :tuple 0)) (list :range))) t ELISP> (let ((res (pg-exec *pg* "SELECT numrange(33.33, 66.66)"))) (car (pg-result res :tuple 0))) (:range 91 33.33 41 66.66) ELISP> (let ((res (pg-exec *pg* "SELECT upper(numrange(-50.0, -40.0))"))) (car (pg-result res :tuple 0))) -40.0 ELISP> (let ((res (pg-exec *pg* "SELECT numrange(NULL, 2.2)"))) (car (pg-result res :tuple 0))) (:range 40 nil 41 2.2) ELISP> (let ((res (pg-exec *pg* "SELECT numrange(NULL, NULL)"))) (car (pg-result res :tuple 0))) (:range 40 nil 41 nil) ``` ~~~ ## Working with binary data The [BYTEA type](https://www.postgresql.org/docs/current/datatype-binary.html) allows the storage of binary strings, i.e. sequences of octets. They can contain NUL octets (the value zero). ~~~admonish example title="Using the BYTEA type" ```lisp ELISP> (let ((res (pg-exec *pg* "SELECT '\\xDEADBEEF'::bytea"))) (equal (car (pg-result res :tuple 0)) (decode-hex-string "DEADBEEF"))) t ELISP> (let ((res (pg-exec *pg* "SELECT '\\001\\003\\005'::bytea"))) (equal (car (pg-result res :tuple 0)) (string 1 3 5))) t ELISP> (let ((res (pg-exec *pg* "SELECT '\\x123456'::bytea || '\\x789a00bcde'::bytea"))) (equal (car (pg-result res :tuple 0)) (decode-hex-string "123456789a00bcde"))) t ELISP> (let ((res (pg-exec *pg* "SELECT 'warning\\000'::bytea"))) (equal (length (car (pg-result res :tuple 0))) 8)) t ``` ~~~ When sending binary data to PostgreSQL, either encode all potentially problematic octets, as we did for NUL above, or send base64-encoded content and decode it in PostgreSQL. There are various other useful functions for working with binary data on PostgreSQL, such as hash functions. ~~~admonish example title="Encoding and decoding binary data" ```lisp ELISP> (pg-result (pg-exec *pg* "CREATE TABLE bt(blob BYTEA, tag int)") :status) "CREATE TABLE" ELISP> (let* ((size 512) (random-octets (make-string size 0))) (dotimes (i size) (setf (aref random-octets i) (random 256))) (setf (aref random-octets 0) 0) (pg-exec-prepared *pg* "INSERT INTO bt VALUES (decode($1, 'base64'), 42)" `((,(base64-encode-string random-octets) . "text"))) (equal random-octets (car (pg-result (pg-exec *pg* "SELECT blob FROM bt WHERE tag=42") :tuple 0)))) t ELISP> (let* ((res (pg-exec *pg* "SELECT sha256('foobles'::bytea)")) (hx (encode-hex-string (car (pg-result res :tuple 0))))) (equal hx (secure-hash 'sha256 "foobles"))) t ELISP> (let* ((res (pg-exec *pg* "SELECT md5('foobles')")) (r (car (pg-result res :tuple 0)))) (equal r (md5 "foobles"))) t ELISP> (let* ((res (pg-exec *pg* "SELECT encode('foobles', 'base64')")) (r (car (pg-result res :tuple 0)))) (equal r (base64-encode-string "foobles"))) t ``` ~~~ ## PostgreSQL arrays (To be documented) pg-el-0.54/doc/theme/000077500000000000000000000000001500535241500143155ustar00rootroot00000000000000pg-el-0.54/doc/theme/highlight.js000066400000000000000000001012601500535241500166220ustar00rootroot00000000000000/*! Highlight.js v11.9.0 (git: f47103d4f1) (c) 2006-2023 undefined and other contributors License: BSD-3-Clause */ var hljs=function(){"use strict";function e(t){ return t instanceof Map?t.clear=t.delete=t.set=()=>{ throw Error("map is read-only")}:t instanceof Set&&(t.add=t.clear=t.delete=()=>{ throw Error("set is read-only") }),Object.freeze(t),Object.getOwnPropertyNames(t).forEach((n=>{ const i=t[n],s=typeof i;"object"!==s&&"function"!==s||Object.isFrozen(i)||e(i) })),t}class t{constructor(e){ void 0===e.data&&(e.data={}),this.data=e.data,this.isMatchIgnored=!1} ignoreMatch(){this.isMatchIgnored=!0}}function n(e){ return e.replace(/&/g,"&").replace(//g,">").replace(/"/g,""").replace(/'/g,"'") }function i(e,...t){const n=Object.create(null);for(const t in e)n[t]=e[t] ;return t.forEach((e=>{for(const t in e)n[t]=e[t]})),n}const s=e=>!!e.scope ;class o{constructor(e,t){ this.buffer="",this.classPrefix=t.classPrefix,e.walk(this)}addText(e){ this.buffer+=n(e)}openNode(e){if(!s(e))return;const t=((e,{prefix:t})=>{ if(e.startsWith("language:"))return e.replace("language:","language-") ;if(e.includes(".")){const n=e.split(".") ;return[`${t}${n.shift()}`,...n.map(((e,t)=>`${e}${"_".repeat(t+1)}`))].join(" ") }return`${t}${e}`})(e.scope,{prefix:this.classPrefix});this.span(t)} closeNode(e){s(e)&&(this.buffer+="")}value(){return this.buffer}span(e){ this.buffer+=``}}const r=(e={})=>{const t={children:[]} ;return Object.assign(t,e),t};class a{constructor(){ this.rootNode=r(),this.stack=[this.rootNode]}get top(){ return this.stack[this.stack.length-1]}get root(){return this.rootNode}add(e){ this.top.children.push(e)}openNode(e){const t=r({scope:e}) ;this.add(t),this.stack.push(t)}closeNode(){ if(this.stack.length>1)return this.stack.pop()}closeAllNodes(){ for(;this.closeNode(););}toJSON(){return JSON.stringify(this.rootNode,null,4)} walk(e){return this.constructor._walk(e,this.rootNode)}static _walk(e,t){ return"string"==typeof t?e.addText(t):t.children&&(e.openNode(t), t.children.forEach((t=>this._walk(e,t))),e.closeNode(t)),e}static _collapse(e){ "string"!=typeof e&&e.children&&(e.children.every((e=>"string"==typeof e))?e.children=[e.children.join("")]:e.children.forEach((e=>{ a._collapse(e)})))}}class c extends a{constructor(e){super(),this.options=e} addText(e){""!==e&&this.add(e)}startScope(e){this.openNode(e)}endScope(){ this.closeNode()}__addSublanguage(e,t){const n=e.root ;t&&(n.scope="language:"+t),this.add(n)}toHTML(){ return new o(this,this.options).value()}finalize(){ return this.closeAllNodes(),!0}}function l(e){ return e?"string"==typeof e?e:e.source:null}function g(e){return h("(?=",e,")")} function u(e){return h("(?:",e,")*")}function d(e){return h("(?:",e,")?")} function h(...e){return e.map((e=>l(e))).join("")}function f(...e){const t=(e=>{ const t=e[e.length-1] ;return"object"==typeof t&&t.constructor===Object?(e.splice(e.length-1,1),t):{} })(e);return"("+(t.capture?"":"?:")+e.map((e=>l(e))).join("|")+")"} function p(e){return RegExp(e.toString()+"|").exec("").length-1} const b=/\[(?:[^\\\]]|\\.)*\]|\(\??|\\([1-9][0-9]*)|\\./ ;function m(e,{joinWith:t}){let n=0;return e.map((e=>{n+=1;const t=n ;let i=l(e),s="";for(;i.length>0;){const e=b.exec(i);if(!e){s+=i;break} s+=i.substring(0,e.index), i=i.substring(e.index+e[0].length),"\\"===e[0][0]&&e[1]?s+="\\"+(Number(e[1])+t):(s+=e[0], "("===e[0]&&n++)}return s})).map((e=>`(${e})`)).join(t)} const E="[a-zA-Z]\\w*",x="[a-zA-Z_]\\w*",w="\\b\\d+(\\.\\d+)?",y="(-?)(\\b0[xX][a-fA-F0-9]+|(\\b\\d+(\\.\\d*)?|\\.\\d+)([eE][-+]?\\d+)?)",_="\\b(0b[01]+)",O={ begin:"\\\\[\\s\\S]",relevance:0},v={scope:"string",begin:"'",end:"'", illegal:"\\n",contains:[O]},k={scope:"string",begin:'"',end:'"',illegal:"\\n", contains:[O]},N=(e,t,n={})=>{const s=i({scope:"comment",begin:e,end:t, contains:[]},n);s.contains.push({scope:"doctag", begin:"[ ]*(?=(TODO|FIXME|NOTE|BUG|OPTIMIZE|HACK|XXX):)", end:/(TODO|FIXME|NOTE|BUG|OPTIMIZE|HACK|XXX):/,excludeBegin:!0,relevance:0}) ;const o=f("I","a","is","so","us","to","at","if","in","it","on",/[A-Za-z]+['](d|ve|re|ll|t|s|n)/,/[A-Za-z]+[-][a-z]+/,/[A-Za-z][a-z]{2,}/) ;return s.contains.push({begin:h(/[ ]+/,"(",o,/[.]?[:]?([.][ ]|[ ])/,"){3}")}),s },S=N("//","$"),M=N("/\\*","\\*/"),R=N("#","$");var j=Object.freeze({ __proto__:null,APOS_STRING_MODE:v,BACKSLASH_ESCAPE:O,BINARY_NUMBER_MODE:{ scope:"number",begin:_,relevance:0},BINARY_NUMBER_RE:_,COMMENT:N, C_BLOCK_COMMENT_MODE:M,C_LINE_COMMENT_MODE:S,C_NUMBER_MODE:{scope:"number", begin:y,relevance:0},C_NUMBER_RE:y,END_SAME_AS_BEGIN:e=>Object.assign(e,{ "on:begin":(e,t)=>{t.data._beginMatch=e[1]},"on:end":(e,t)=>{ t.data._beginMatch!==e[1]&&t.ignoreMatch()}}),HASH_COMMENT_MODE:R,IDENT_RE:E, MATCH_NOTHING_RE:/\b\B/,METHOD_GUARD:{begin:"\\.\\s*"+x,relevance:0}, NUMBER_MODE:{scope:"number",begin:w,relevance:0},NUMBER_RE:w, PHRASAL_WORDS_MODE:{ begin:/\b(a|an|the|are|I'm|isn't|don't|doesn't|won't|but|just|should|pretty|simply|enough|gonna|going|wtf|so|such|will|you|your|they|like|more)\b/ },QUOTE_STRING_MODE:k,REGEXP_MODE:{scope:"regexp",begin:/\/(?=[^/\n]*\/)/, end:/\/[gimuy]*/,contains:[O,{begin:/\[/,end:/\]/,relevance:0,contains:[O]}]}, RE_STARTERS_RE:"!|!=|!==|%|%=|&|&&|&=|\\*|\\*=|\\+|\\+=|,|-|-=|/=|/|:|;|<<|<<=|<=|<|===|==|=|>>>=|>>=|>=|>>>|>>|>|\\?|\\[|\\{|\\(|\\^|\\^=|\\||\\|=|\\|\\||~", SHEBANG:(e={})=>{const t=/^#![ ]*\// ;return e.binary&&(e.begin=h(t,/.*\b/,e.binary,/\b.*/)),i({scope:"meta",begin:t, end:/$/,relevance:0,"on:begin":(e,t)=>{0!==e.index&&t.ignoreMatch()}},e)}, TITLE_MODE:{scope:"title",begin:E,relevance:0},UNDERSCORE_IDENT_RE:x, UNDERSCORE_TITLE_MODE:{scope:"title",begin:x,relevance:0}});function A(e,t){ "."===e.input[e.index-1]&&t.ignoreMatch()}function I(e,t){ void 0!==e.className&&(e.scope=e.className,delete e.className)}function T(e,t){ t&&e.beginKeywords&&(e.begin="\\b("+e.beginKeywords.split(" ").join("|")+")(?!\\.)(?=\\b|\\s)", e.__beforeBegin=A,e.keywords=e.keywords||e.beginKeywords,delete e.beginKeywords, void 0===e.relevance&&(e.relevance=0))}function L(e,t){ Array.isArray(e.illegal)&&(e.illegal=f(...e.illegal))}function B(e,t){ if(e.match){ if(e.begin||e.end)throw Error("begin & end are not supported with match") ;e.begin=e.match,delete e.match}}function P(e,t){ void 0===e.relevance&&(e.relevance=1)}const D=(e,t)=>{if(!e.beforeMatch)return ;if(e.starts)throw Error("beforeMatch cannot be used with starts") ;const n=Object.assign({},e);Object.keys(e).forEach((t=>{delete e[t] })),e.keywords=n.keywords,e.begin=h(n.beforeMatch,g(n.begin)),e.starts={ relevance:0,contains:[Object.assign(n,{endsParent:!0})] },e.relevance=0,delete n.beforeMatch },H=["of","and","for","in","not","or","if","then","parent","list","value"],C="keyword" ;function $(e,t,n=C){const i=Object.create(null) ;return"string"==typeof e?s(n,e.split(" ")):Array.isArray(e)?s(n,e):Object.keys(e).forEach((n=>{ Object.assign(i,$(e[n],t,n))})),i;function s(e,n){ t&&(n=n.map((e=>e.toLowerCase()))),n.forEach((t=>{const n=t.split("|") ;i[n[0]]=[e,U(n[0],n[1])]}))}}function U(e,t){ return t?Number(t):(e=>H.includes(e.toLowerCase()))(e)?0:1}const z={},W=e=>{ console.error(e)},X=(e,...t)=>{console.log("WARN: "+e,...t)},G=(e,t)=>{ z[`${e}/${t}`]||(console.log(`Deprecated as of ${e}. ${t}`),z[`${e}/${t}`]=!0) },K=Error();function F(e,t,{key:n}){let i=0;const s=e[n],o={},r={} ;for(let e=1;e<=t.length;e++)r[e+i]=s[e],o[e+i]=!0,i+=p(t[e-1]) ;e[n]=r,e[n]._emit=o,e[n]._multi=!0}function Z(e){(e=>{ e.scope&&"object"==typeof e.scope&&null!==e.scope&&(e.beginScope=e.scope, delete e.scope)})(e),"string"==typeof e.beginScope&&(e.beginScope={ _wrap:e.beginScope}),"string"==typeof e.endScope&&(e.endScope={_wrap:e.endScope }),(e=>{if(Array.isArray(e.begin)){ if(e.skip||e.excludeBegin||e.returnBegin)throw W("skip, excludeBegin, returnBegin not compatible with beginScope: {}"), K ;if("object"!=typeof e.beginScope||null===e.beginScope)throw W("beginScope must be object"), K;F(e,e.begin,{key:"beginScope"}),e.begin=m(e.begin,{joinWith:""})}})(e),(e=>{ if(Array.isArray(e.end)){ if(e.skip||e.excludeEnd||e.returnEnd)throw W("skip, excludeEnd, returnEnd not compatible with endScope: {}"), K ;if("object"!=typeof e.endScope||null===e.endScope)throw W("endScope must be object"), K;F(e,e.end,{key:"endScope"}),e.end=m(e.end,{joinWith:""})}})(e)}function V(e){ function t(t,n){ return RegExp(l(t),"m"+(e.case_insensitive?"i":"")+(e.unicodeRegex?"u":"")+(n?"g":"")) }class n{constructor(){ this.matchIndexes={},this.regexes=[],this.matchAt=1,this.position=0} addRule(e,t){ t.position=this.position++,this.matchIndexes[this.matchAt]=t,this.regexes.push([t,e]), this.matchAt+=p(e)+1}compile(){0===this.regexes.length&&(this.exec=()=>null) ;const e=this.regexes.map((e=>e[1]));this.matcherRe=t(m(e,{joinWith:"|" }),!0),this.lastIndex=0}exec(e){this.matcherRe.lastIndex=this.lastIndex ;const t=this.matcherRe.exec(e);if(!t)return null ;const n=t.findIndex(((e,t)=>t>0&&void 0!==e)),i=this.matchIndexes[n] ;return t.splice(0,n),Object.assign(t,i)}}class s{constructor(){ this.rules=[],this.multiRegexes=[], this.count=0,this.lastIndex=0,this.regexIndex=0}getMatcher(e){ if(this.multiRegexes[e])return this.multiRegexes[e];const t=new n ;return this.rules.slice(e).forEach((([e,n])=>t.addRule(e,n))), t.compile(),this.multiRegexes[e]=t,t}resumingScanAtSamePosition(){ return 0!==this.regexIndex}considerAll(){this.regexIndex=0}addRule(e,t){ this.rules.push([e,t]),"begin"===t.type&&this.count++}exec(e){ const t=this.getMatcher(this.regexIndex);t.lastIndex=this.lastIndex ;let n=t.exec(e) ;if(this.resumingScanAtSamePosition())if(n&&n.index===this.lastIndex);else{ const t=this.getMatcher(0);t.lastIndex=this.lastIndex+1,n=t.exec(e)} return n&&(this.regexIndex+=n.position+1, this.regexIndex===this.count&&this.considerAll()),n}} if(e.compilerExtensions||(e.compilerExtensions=[]), e.contains&&e.contains.includes("self"))throw Error("ERR: contains `self` is not supported at the top-level of a language. See documentation.") ;return e.classNameAliases=i(e.classNameAliases||{}),function n(o,r){const a=o ;if(o.isCompiled)return a ;[I,B,Z,D].forEach((e=>e(o,r))),e.compilerExtensions.forEach((e=>e(o,r))), o.__beforeBegin=null,[T,L,P].forEach((e=>e(o,r))),o.isCompiled=!0;let c=null ;return"object"==typeof o.keywords&&o.keywords.$pattern&&(o.keywords=Object.assign({},o.keywords), c=o.keywords.$pattern, delete o.keywords.$pattern),c=c||/\w+/,o.keywords&&(o.keywords=$(o.keywords,e.case_insensitive)), a.keywordPatternRe=t(c,!0), r&&(o.begin||(o.begin=/\B|\b/),a.beginRe=t(a.begin),o.end||o.endsWithParent||(o.end=/\B|\b/), o.end&&(a.endRe=t(a.end)), a.terminatorEnd=l(a.end)||"",o.endsWithParent&&r.terminatorEnd&&(a.terminatorEnd+=(o.end?"|":"")+r.terminatorEnd)), o.illegal&&(a.illegalRe=t(o.illegal)), o.contains||(o.contains=[]),o.contains=[].concat(...o.contains.map((e=>(e=>(e.variants&&!e.cachedVariants&&(e.cachedVariants=e.variants.map((t=>i(e,{ variants:null},t)))),e.cachedVariants?e.cachedVariants:q(e)?i(e,{ starts:e.starts?i(e.starts):null }):Object.isFrozen(e)?i(e):e))("self"===e?o:e)))),o.contains.forEach((e=>{n(e,a) })),o.starts&&n(o.starts,r),a.matcher=(e=>{const t=new s ;return e.contains.forEach((e=>t.addRule(e.begin,{rule:e,type:"begin" }))),e.terminatorEnd&&t.addRule(e.terminatorEnd,{type:"end" }),e.illegal&&t.addRule(e.illegal,{type:"illegal"}),t})(a),a}(e)}function q(e){ return!!e&&(e.endsWithParent||q(e.starts))}class J extends Error{ constructor(e,t){super(e),this.name="HTMLInjectionError",this.html=t}} const Y=n,Q=i,ee=Symbol("nomatch"),te=n=>{ const i=Object.create(null),s=Object.create(null),o=[];let r=!0 ;const a="Could not find the language '{}', did you forget to load/include a language module?",l={ disableAutodetect:!0,name:"Plain text",contains:[]};let p={ ignoreUnescapedHTML:!1,throwUnescapedHTML:!1,noHighlightRe:/^(no-?highlight)$/i, languageDetectRe:/\blang(?:uage)?-([\w-]+)\b/i,classPrefix:"hljs-", cssSelector:"pre code",languages:null,__emitter:c};function b(e){ return p.noHighlightRe.test(e)}function m(e,t,n){let i="",s="" ;"object"==typeof t?(i=e, n=t.ignoreIllegals,s=t.language):(G("10.7.0","highlight(lang, code, ...args) has been deprecated."), G("10.7.0","Please use highlight(code, options) instead.\nhttps://github.com/highlightjs/highlight.js/issues/2277"), s=e,i=t),void 0===n&&(n=!0);const o={code:i,language:s};N("before:highlight",o) ;const r=o.result?o.result:E(o.language,o.code,n) ;return r.code=o.code,N("after:highlight",r),r}function E(e,n,s,o){ const c=Object.create(null);function l(){if(!N.keywords)return void M.addText(R) ;let e=0;N.keywordPatternRe.lastIndex=0;let t=N.keywordPatternRe.exec(R),n="" ;for(;t;){n+=R.substring(e,t.index) ;const s=_.case_insensitive?t[0].toLowerCase():t[0],o=(i=s,N.keywords[i]);if(o){ const[e,i]=o ;if(M.addText(n),n="",c[s]=(c[s]||0)+1,c[s]<=7&&(j+=i),e.startsWith("_"))n+=t[0];else{ const n=_.classNameAliases[e]||e;u(t[0],n)}}else n+=t[0] ;e=N.keywordPatternRe.lastIndex,t=N.keywordPatternRe.exec(R)}var i ;n+=R.substring(e),M.addText(n)}function g(){null!=N.subLanguage?(()=>{ if(""===R)return;let e=null;if("string"==typeof N.subLanguage){ if(!i[N.subLanguage])return void M.addText(R) ;e=E(N.subLanguage,R,!0,S[N.subLanguage]),S[N.subLanguage]=e._top }else e=x(R,N.subLanguage.length?N.subLanguage:null) ;N.relevance>0&&(j+=e.relevance),M.__addSublanguage(e._emitter,e.language) })():l(),R=""}function u(e,t){ ""!==e&&(M.startScope(t),M.addText(e),M.endScope())}function d(e,t){let n=1 ;const i=t.length-1;for(;n<=i;){if(!e._emit[n]){n++;continue} const i=_.classNameAliases[e[n]]||e[n],s=t[n];i?u(s,i):(R=s,l(),R=""),n++}} function h(e,t){ return e.scope&&"string"==typeof e.scope&&M.openNode(_.classNameAliases[e.scope]||e.scope), e.beginScope&&(e.beginScope._wrap?(u(R,_.classNameAliases[e.beginScope._wrap]||e.beginScope._wrap), R=""):e.beginScope._multi&&(d(e.beginScope,t),R="")),N=Object.create(e,{parent:{ value:N}}),N}function f(e,n,i){let s=((e,t)=>{const n=e&&e.exec(t) ;return n&&0===n.index})(e.endRe,i);if(s){if(e["on:end"]){const i=new t(e) ;e["on:end"](n,i),i.isMatchIgnored&&(s=!1)}if(s){ for(;e.endsParent&&e.parent;)e=e.parent;return e}} if(e.endsWithParent)return f(e.parent,n,i)}function b(e){ return 0===N.matcher.regexIndex?(R+=e[0],1):(T=!0,0)}function m(e){ const t=e[0],i=n.substring(e.index),s=f(N,e,i);if(!s)return ee;const o=N ;N.endScope&&N.endScope._wrap?(g(), u(t,N.endScope._wrap)):N.endScope&&N.endScope._multi?(g(), d(N.endScope,e)):o.skip?R+=t:(o.returnEnd||o.excludeEnd||(R+=t), g(),o.excludeEnd&&(R=t));do{ N.scope&&M.closeNode(),N.skip||N.subLanguage||(j+=N.relevance),N=N.parent }while(N!==s.parent);return s.starts&&h(s.starts,e),o.returnEnd?0:t.length} let w={};function y(i,o){const a=o&&o[0];if(R+=i,null==a)return g(),0 ;if("begin"===w.type&&"end"===o.type&&w.index===o.index&&""===a){ if(R+=n.slice(o.index,o.index+1),!r){const t=Error(`0 width match regex (${e})`) ;throw t.languageName=e,t.badRule=w.rule,t}return 1} if(w=o,"begin"===o.type)return(e=>{ const n=e[0],i=e.rule,s=new t(i),o=[i.__beforeBegin,i["on:begin"]] ;for(const t of o)if(t&&(t(e,s),s.isMatchIgnored))return b(n) ;return i.skip?R+=n:(i.excludeBegin&&(R+=n), g(),i.returnBegin||i.excludeBegin||(R=n)),h(i,e),i.returnBegin?0:n.length})(o) ;if("illegal"===o.type&&!s){ const e=Error('Illegal lexeme "'+a+'" for mode "'+(N.scope||"")+'"') ;throw e.mode=N,e}if("end"===o.type){const e=m(o);if(e!==ee)return e} if("illegal"===o.type&&""===a)return 1 ;if(I>1e5&&I>3*o.index)throw Error("potential infinite loop, way more iterations than matches") ;return R+=a,a.length}const _=O(e) ;if(!_)throw W(a.replace("{}",e)),Error('Unknown language: "'+e+'"') ;const v=V(_);let k="",N=o||v;const S={},M=new p.__emitter(p);(()=>{const e=[] ;for(let t=N;t!==_;t=t.parent)t.scope&&e.unshift(t.scope) ;e.forEach((e=>M.openNode(e)))})();let R="",j=0,A=0,I=0,T=!1;try{ if(_.__emitTokens)_.__emitTokens(n,M);else{for(N.matcher.considerAll();;){ I++,T?T=!1:N.matcher.considerAll(),N.matcher.lastIndex=A ;const e=N.matcher.exec(n);if(!e)break;const t=y(n.substring(A,e.index),e) ;A=e.index+t}y(n.substring(A))}return M.finalize(),k=M.toHTML(),{language:e, value:k,relevance:j,illegal:!1,_emitter:M,_top:N}}catch(t){ if(t.message&&t.message.includes("Illegal"))return{language:e,value:Y(n), illegal:!0,relevance:0,_illegalBy:{message:t.message,index:A, context:n.slice(A-100,A+100),mode:t.mode,resultSoFar:k},_emitter:M};if(r)return{ language:e,value:Y(n),illegal:!1,relevance:0,errorRaised:t,_emitter:M,_top:N} ;throw t}}function x(e,t){t=t||p.languages||Object.keys(i);const n=(e=>{ const t={value:Y(e),illegal:!1,relevance:0,_top:l,_emitter:new p.__emitter(p)} ;return t._emitter.addText(e),t})(e),s=t.filter(O).filter(k).map((t=>E(t,e,!1))) ;s.unshift(n);const o=s.sort(((e,t)=>{ if(e.relevance!==t.relevance)return t.relevance-e.relevance ;if(e.language&&t.language){if(O(e.language).supersetOf===t.language)return 1 ;if(O(t.language).supersetOf===e.language)return-1}return 0})),[r,a]=o,c=r ;return c.secondBest=a,c}function w(e){let t=null;const n=(e=>{ let t=e.className+" ";t+=e.parentNode?e.parentNode.className:"" ;const n=p.languageDetectRe.exec(t);if(n){const t=O(n[1]) ;return t||(X(a.replace("{}",n[1])), X("Falling back to no-highlight mode for this block.",e)),t?n[1]:"no-highlight"} return t.split(/\s+/).find((e=>b(e)||O(e)))})(e);if(b(n))return ;if(N("before:highlightElement",{el:e,language:n }),e.dataset.highlighted)return void console.log("Element previously highlighted. To highlight again, first unset `dataset.highlighted`.",e) ;if(e.children.length>0&&(p.ignoreUnescapedHTML||(console.warn("One of your code blocks includes unescaped HTML. This is a potentially serious security risk."), console.warn("https://github.com/highlightjs/highlight.js/wiki/security"), console.warn("The element with unescaped HTML:"), console.warn(e)),p.throwUnescapedHTML))throw new J("One of your code blocks includes unescaped HTML.",e.innerHTML) ;t=e;const i=t.textContent,o=n?m(i,{language:n,ignoreIllegals:!0}):x(i) ;e.innerHTML=o.value,e.dataset.highlighted="yes",((e,t,n)=>{const i=t&&s[t]||n ;e.classList.add("hljs"),e.classList.add("language-"+i) })(e,n,o.language),e.result={language:o.language,re:o.relevance, relevance:o.relevance},o.secondBest&&(e.secondBest={ language:o.secondBest.language,relevance:o.secondBest.relevance }),N("after:highlightElement",{el:e,result:o,text:i})}let y=!1;function _(){ "loading"!==document.readyState?document.querySelectorAll(p.cssSelector).forEach(w):y=!0 }function O(e){return e=(e||"").toLowerCase(),i[e]||i[s[e]]} function v(e,{languageName:t}){"string"==typeof e&&(e=[e]),e.forEach((e=>{ s[e.toLowerCase()]=t}))}function k(e){const t=O(e) ;return t&&!t.disableAutodetect}function N(e,t){const n=e;o.forEach((e=>{ e[n]&&e[n](t)}))} "undefined"!=typeof window&&window.addEventListener&&window.addEventListener("DOMContentLoaded",(()=>{ y&&_()}),!1),Object.assign(n,{highlight:m,highlightAuto:x,highlightAll:_, highlightElement:w, highlightBlock:e=>(G("10.7.0","highlightBlock will be removed entirely in v12.0"), G("10.7.0","Please use highlightElement now."),w(e)),configure:e=>{p=Q(p,e)}, initHighlighting:()=>{ _(),G("10.6.0","initHighlighting() deprecated. Use highlightAll() now.")}, initHighlightingOnLoad:()=>{ _(),G("10.6.0","initHighlightingOnLoad() deprecated. Use highlightAll() now.") },registerLanguage:(e,t)=>{let s=null;try{s=t(n)}catch(t){ if(W("Language definition for '{}' could not be registered.".replace("{}",e)), !r)throw t;W(t),s=l} s.name||(s.name=e),i[e]=s,s.rawDefinition=t.bind(null,n),s.aliases&&v(s.aliases,{ languageName:e})},unregisterLanguage:e=>{delete i[e] ;for(const t of Object.keys(s))s[t]===e&&delete s[t]}, listLanguages:()=>Object.keys(i),getLanguage:O,registerAliases:v, autoDetection:k,inherit:Q,addPlugin:e=>{(e=>{ e["before:highlightBlock"]&&!e["before:highlightElement"]&&(e["before:highlightElement"]=t=>{ e["before:highlightBlock"](Object.assign({block:t.el},t)) }),e["after:highlightBlock"]&&!e["after:highlightElement"]&&(e["after:highlightElement"]=t=>{ e["after:highlightBlock"](Object.assign({block:t.el},t))})})(e),o.push(e)}, removePlugin:e=>{const t=o.indexOf(e);-1!==t&&o.splice(t,1)}}),n.debugMode=()=>{ r=!1},n.safeMode=()=>{r=!0},n.versionString="11.9.0",n.regex={concat:h, lookahead:g,either:f,optional:d,anyNumberOfTimes:u} ;for(const t in j)"object"==typeof j[t]&&e(j[t]);return Object.assign(n,j),n },ne=te({});return ne.newInstance=()=>te({}),ne}() ;"object"==typeof exports&&"undefined"!=typeof module&&(module.exports=hljs);/*! `bash` grammar compiled for Highlight.js 11.9.0 */ (()=>{var e=(()=>{"use strict";return e=>{const s=e.regex,t={},n={begin:/\$\{/, end:/\}/,contains:["self",{begin:/:-/,contains:[t]}]};Object.assign(t,{ className:"variable",variants:[{ begin:s.concat(/\$[\w\d#@][\w\d_]*/,"(?![\\w\\d])(?![$])")},n]});const a={ className:"subst",begin:/\$\(/,end:/\)/,contains:[e.BACKSLASH_ESCAPE]},i={ begin:/<<-?\s*(?=\w+)/,starts:{contains:[e.END_SAME_AS_BEGIN({begin:/(\w+)/, end:/(\w+)/,className:"string"})]}},c={className:"string",begin:/"/,end:/"/, contains:[e.BACKSLASH_ESCAPE,t,a]};a.contains.push(c);const o={begin:/\$?\(\(/, end:/\)\)/,contains:[{begin:/\d+#[0-9a-f]+/,className:"number"},e.NUMBER_MODE,t] },r=e.SHEBANG({binary:"(fish|bash|zsh|sh|csh|ksh|tcsh|dash|scsh)",relevance:10 }),l={className:"function",begin:/\w[\w\d_]*\s*\(\s*\)\s*\{/,returnBegin:!0, contains:[e.inherit(e.TITLE_MODE,{begin:/\w[\w\d_]*/})],relevance:0};return{ name:"Bash",aliases:["sh"],keywords:{$pattern:/\b[a-z][a-z0-9._-]+\b/, keyword:["if","then","else","elif","fi","for","while","until","in","do","done","case","esac","function","select"], literal:["true","false"], built_in:["break","cd","continue","eval","exec","exit","export","getopts","hash","pwd","readonly","return","shift","test","times","trap","umask","unset","alias","bind","builtin","caller","command","declare","echo","enable","help","let","local","logout","mapfile","printf","read","readarray","source","type","typeset","ulimit","unalias","set","shopt","autoload","bg","bindkey","bye","cap","chdir","clone","comparguments","compcall","compctl","compdescribe","compfiles","compgroups","compquote","comptags","comptry","compvalues","dirs","disable","disown","echotc","echoti","emulate","fc","fg","float","functions","getcap","getln","history","integer","jobs","kill","limit","log","noglob","popd","print","pushd","pushln","rehash","sched","setcap","setopt","stat","suspend","ttyctl","unfunction","unhash","unlimit","unsetopt","vared","wait","whence","where","which","zcompile","zformat","zftp","zle","zmodload","zparseopts","zprof","zpty","zregexparse","zsocket","zstyle","ztcp","chcon","chgrp","chown","chmod","cp","dd","df","dir","dircolors","ln","ls","mkdir","mkfifo","mknod","mktemp","mv","realpath","rm","rmdir","shred","sync","touch","truncate","vdir","b2sum","base32","base64","cat","cksum","comm","csplit","cut","expand","fmt","fold","head","join","md5sum","nl","numfmt","od","paste","ptx","pr","sha1sum","sha224sum","sha256sum","sha384sum","sha512sum","shuf","sort","split","sum","tac","tail","tr","tsort","unexpand","uniq","wc","arch","basename","chroot","date","dirname","du","echo","env","expr","factor","groups","hostid","id","link","logname","nice","nohup","nproc","pathchk","pinky","printenv","printf","pwd","readlink","runcon","seq","sleep","stat","stdbuf","stty","tee","test","timeout","tty","uname","unlink","uptime","users","who","whoami","yes"] },contains:[r,e.SHEBANG(),l,o,e.HASH_COMMENT_MODE,i,{match:/(\/[a-z._-]+)+/},c,{ match:/\\"/},{className:"string",begin:/'/,end:/'/},{match:/\\'/},t]}}})() ;hljs.registerLanguage("bash",e)})();/*! `lisp` grammar compiled for Highlight.js 11.9.0 */ (()=>{var e=(()=>{"use strict";return e=>{ const n="[a-zA-Z_\\-+\\*\\/<=>&#][a-zA-Z0-9_\\-+*\\/<=>&#!]*",a="\\|[^]*?\\|",i="(-|\\+)?\\d+(\\.\\d+|\\/\\d+)?((d|e|f|l|s|D|E|F|L|S)(\\+|-)?\\d+)?",s={ className:"literal",begin:"\\b(t{1}|nil)\\b"},l={className:"number",variants:[{ begin:i,relevance:0},{begin:"#(b|B)[0-1]+(/[0-1]+)?"},{ begin:"#(o|O)[0-7]+(/[0-7]+)?"},{begin:"#(x|X)[0-9a-fA-F]+(/[0-9a-fA-F]+)?"},{ begin:"#(c|C)\\("+i+" +"+i,end:"\\)"}]},b=e.inherit(e.QUOTE_STRING_MODE,{ illegal:null}),g=e.COMMENT(";","$",{relevance:0}),r={begin:"\\*",end:"\\*"},t={ className:"symbol",begin:"[:&]"+n},c={begin:n,relevance:0},d={begin:a},o={ contains:[l,b,r,t,{begin:"\\(",end:"\\)",contains:["self",s,b,l,c]},c], variants:[{begin:"['`]\\(",end:"\\)"},{begin:"\\(quote ",end:"\\)",keywords:{ name:"quote"}},{begin:"'"+a}]},v={variants:[{begin:"'"+n},{ begin:"#'"+n+"(::"+n+")*"}]},m={begin:"\\(\\s*",end:"\\)"},u={endsWithParent:!0, relevance:0};return m.contains=[{className:"name",variants:[{begin:n,relevance:0 },{begin:a}]},u],u.contains=[o,v,m,s,l,b,g,r,t,d,c],{name:"Lisp",illegal:/\S/, contains:[l,e.SHEBANG(),s,b,g,o,v,m,c]}}})();hljs.registerLanguage("lisp",e) })();/*! `sql` grammar compiled for Highlight.js 11.9.0 */ (()=>{var e=(()=>{"use strict";return e=>{ const r=e.regex,t=e.COMMENT("--","$"),n=["true","false","unknown"],a=["bigint","binary","blob","boolean","char","character","clob","date","dec","decfloat","decimal","float","int","integer","interval","nchar","nclob","national","numeric","real","row","smallint","time","timestamp","varchar","varying","varbinary"],i=["abs","acos","array_agg","asin","atan","avg","cast","ceil","ceiling","coalesce","corr","cos","cosh","count","covar_pop","covar_samp","cume_dist","dense_rank","deref","element","exp","extract","first_value","floor","json_array","json_arrayagg","json_exists","json_object","json_objectagg","json_query","json_table","json_table_primitive","json_value","lag","last_value","lead","listagg","ln","log","log10","lower","max","min","mod","nth_value","ntile","nullif","percent_rank","percentile_cont","percentile_disc","position","position_regex","power","rank","regr_avgx","regr_avgy","regr_count","regr_intercept","regr_r2","regr_slope","regr_sxx","regr_sxy","regr_syy","row_number","sin","sinh","sqrt","stddev_pop","stddev_samp","substring","substring_regex","sum","tan","tanh","translate","translate_regex","treat","trim","trim_array","unnest","upper","value_of","var_pop","var_samp","width_bucket"],s=["create table","insert into","primary key","foreign key","not null","alter table","add constraint","grouping sets","on overflow","character set","respect nulls","ignore nulls","nulls first","nulls last","depth first","breadth first"],o=i,c=["abs","acos","all","allocate","alter","and","any","are","array","array_agg","array_max_cardinality","as","asensitive","asin","asymmetric","at","atan","atomic","authorization","avg","begin","begin_frame","begin_partition","between","bigint","binary","blob","boolean","both","by","call","called","cardinality","cascaded","case","cast","ceil","ceiling","char","char_length","character","character_length","check","classifier","clob","close","coalesce","collate","collect","column","commit","condition","connect","constraint","contains","convert","copy","corr","corresponding","cos","cosh","count","covar_pop","covar_samp","create","cross","cube","cume_dist","current","current_catalog","current_date","current_default_transform_group","current_path","current_role","current_row","current_schema","current_time","current_timestamp","current_path","current_role","current_transform_group_for_type","current_user","cursor","cycle","date","day","deallocate","dec","decimal","decfloat","declare","default","define","delete","dense_rank","deref","describe","deterministic","disconnect","distinct","double","drop","dynamic","each","element","else","empty","end","end_frame","end_partition","end-exec","equals","escape","every","except","exec","execute","exists","exp","external","extract","false","fetch","filter","first_value","float","floor","for","foreign","frame_row","free","from","full","function","fusion","get","global","grant","group","grouping","groups","having","hold","hour","identity","in","indicator","initial","inner","inout","insensitive","insert","int","integer","intersect","intersection","interval","into","is","join","json_array","json_arrayagg","json_exists","json_object","json_objectagg","json_query","json_table","json_table_primitive","json_value","lag","language","large","last_value","lateral","lead","leading","left","like","like_regex","listagg","ln","local","localtime","localtimestamp","log","log10","lower","match","match_number","match_recognize","matches","max","member","merge","method","min","minute","mod","modifies","module","month","multiset","national","natural","nchar","nclob","new","no","none","normalize","not","nth_value","ntile","null","nullif","numeric","octet_length","occurrences_regex","of","offset","old","omit","on","one","only","open","or","order","out","outer","over","overlaps","overlay","parameter","partition","pattern","per","percent","percent_rank","percentile_cont","percentile_disc","period","portion","position","position_regex","power","precedes","precision","prepare","primary","procedure","ptf","range","rank","reads","real","recursive","ref","references","referencing","regr_avgx","regr_avgy","regr_count","regr_intercept","regr_r2","regr_slope","regr_sxx","regr_sxy","regr_syy","release","result","return","returns","revoke","right","rollback","rollup","row","row_number","rows","running","savepoint","scope","scroll","search","second","seek","select","sensitive","session_user","set","show","similar","sin","sinh","skip","smallint","some","specific","specifictype","sql","sqlexception","sqlstate","sqlwarning","sqrt","start","static","stddev_pop","stddev_samp","submultiset","subset","substring","substring_regex","succeeds","sum","symmetric","system","system_time","system_user","table","tablesample","tan","tanh","then","time","timestamp","timezone_hour","timezone_minute","to","trailing","translate","translate_regex","translation","treat","trigger","trim","trim_array","true","truncate","uescape","union","unique","unknown","unnest","update","upper","user","using","value","values","value_of","var_pop","var_samp","varbinary","varchar","varying","versioning","when","whenever","where","width_bucket","window","with","within","without","year","add","asc","collation","desc","final","first","last","view"].filter((e=>!i.includes(e))),l={ begin:r.concat(/\b/,r.either(...o),/\s*\(/),relevance:0,keywords:{built_in:o}} ;return{name:"SQL",case_insensitive:!0,illegal:/[{}]|<\//,keywords:{ $pattern:/\b[\w\.]+/,keyword:((e,{exceptions:r,when:t}={})=>{const n=t ;return r=r||[],e.map((e=>e.match(/\|\d+$/)||r.includes(e)?e:n(e)?e+"|0":e)) })(c,{when:e=>e.length<3}),literal:n,type:a, built_in:["current_catalog","current_date","current_default_transform_group","current_path","current_role","current_schema","current_transform_group_for_type","current_user","session_user","system_time","system_user","current_time","localtime","current_timestamp","localtimestamp"] },contains:[{begin:r.either(...s),relevance:0,keywords:{$pattern:/[\w\.]+/, keyword:c.concat(s),literal:n,type:a}},{className:"type", begin:r.either("double precision","large object","with timezone","without timezone") },l,{className:"variable",begin:/@[a-z0-9][a-z0-9_]*/},{className:"string", variants:[{begin:/'/,end:/'/,contains:[{begin:/''/}]}]},{begin:/"/,end:/"/, contains:[{begin:/""/}]},e.C_NUMBER_MODE,e.C_BLOCK_COMMENT_MODE,t,{ className:"operator",begin:/[-+*/=%^~]|&&?|\|\|?|!=?|<(?:=>?|<|>)?|>[>=]?/, relevance:0}]}}})();hljs.registerLanguage("sql",e)})();/*! `xml` grammar compiled for Highlight.js 11.9.0 */ (()=>{var e=(()=>{"use strict";return e=>{ const a=e.regex,n=a.concat(/[\p{L}_]/u,a.optional(/[\p{L}0-9_.-]*:/u),/[\p{L}0-9_.-]*/u),s={ className:"symbol",begin:/&[a-z]+;|&#[0-9]+;|&#x[a-f0-9]+;/},t={begin:/\s/, contains:[{className:"keyword",begin:/#?[a-z_][a-z1-9_-]+/,illegal:/\n/}] },i=e.inherit(t,{begin:/\(/,end:/\)/}),c=e.inherit(e.APOS_STRING_MODE,{ className:"string"}),l=e.inherit(e.QUOTE_STRING_MODE,{className:"string"}),r={ endsWithParent:!0,illegal:/`]+/}]}]}]};return{ name:"HTML, XML", aliases:["html","xhtml","rss","atom","xjb","xsd","xsl","plist","wsf","svg"], case_insensitive:!0,unicodeRegex:!0,contains:[{className:"meta",begin://,relevance:10,contains:[t,l,c,i,{begin:/\[/,end:/\]/,contains:[{ className:"meta",begin://,contains:[t,i,l,c]}]}] },e.COMMENT(//,{relevance:10}),{begin://, relevance:10},s,{className:"meta",end:/\?>/,variants:[{begin:/<\?xml/, relevance:10,contains:[l]},{begin:/<\?[a-z][a-z0-9]+/}]},{className:"tag", begin:/)/,end:/>/,keywords:{name:"style"},contains:[r],starts:{ end:/<\/style>/,returnEnd:!0,subLanguage:["css","xml"]}},{className:"tag", begin:/)/,end:/>/,keywords:{name:"script"},contains:[r],starts:{ end:/<\/script>/,returnEnd:!0,subLanguage:["javascript","handlebars","xml"]}},{ className:"tag",begin:/<>|<\/>/},{className:"tag", begin:a.concat(//,/>/,/\s/)))), end:/\/?>/,contains:[{className:"name",begin:n,relevance:0,starts:r}]},{ className:"tag",begin:a.concat(/<\//,a.lookahead(a.concat(n,/>/))),contains:[{ className:"name",begin:n,relevance:0},{begin:/>/,relevance:0,endsParent:!0}]}]}} })();hljs.registerLanguage("xml",e)})();pg-el-0.54/pg-bm25.el000066400000000000000000000050221500535241500141400ustar00rootroot00000000000000;;; pg-bm25.el --- Support for the Vectorchord BM25 extension -*- lexical-binding: t -*- ;; ;; Copyright: (C) 2025 Eric Marsden ;; Author: Eric Marsden ;; SPDX-License-Identifier: GPL-3.0-or-later ;;; Commentary: ;; ;; VectorChord-BM25 is a PostgreSQL extension that implements the bm25 (Best Match 25) ranking ;; algorithm, used for information retrieval and search engines. It determines a document’s ;; relevance to a given query and ranks documents based on their relevance scores. ;; ;; https://github.com/tensorchord/VectorChord-bm25/ ;; ;; This file provides parsing and serialization support for the `bm25vector' and `bm25query' types ;; that are implemented by the vchord_bm25 extension. ;;; Code: (require 'cl-lib) (declare-function pg-register-parser "pg" (type-name parser)) (declare-function pg-register-textual-serializer "pg" (type-name serializer)) (declare-function pg-exec "pg" (con &rest args)) (declare-function pg-exec-prepared "pg" (con query typed-arguments &rest args)) (declare-function pg-result "pg" (result what &rest arg)) (declare-function pg-initialize-parsers "pg" (con)) (declare-function pg-text-parser "pg" (str encoding)) (declare-function pg--serialize-text "pg" (object encoding)) (defun pg--bm25-register-serializers () "Register the (de)serialization functions for Vectorchord BM25 types." (pg-register-textual-serializer "bm25vector" #'pg--serialize-text) (pg-register-parser "bm25vector" #'pg-text-parser) (pg-register-textual-serializer "bm25query" #'pg--serialize-text) (pg-register-parser "bm25query" #'pg-text-parser)) (cl-eval-when (load) (pg--bm25-register-serializers)) (defun pg-setup-bm25 (con) "Prepare for use of Vectorchord BM25 on PostgreSQL connection CON. Loads the extension, updates the `search_path' to include `bm25_catalog' and sets up the parsing support for the relevant datatypes. Return nil if the extension could not be loaded." (pg--bm25-register-serializers) (condition-case nil (progn ;; This is a non-privileged extension (pg-exec con "CREATE EXTENSION IF NOT EXISTS vchord_bm25 CASCADE") (pg-initialize-parsers con) (let* ((sql "SELECT current_setting('search_path')") (row (pg-result (pg-exec con sql) :tuple 0)) (new-path (concat (cl-first row) ", bm25_catalog"))) (pg-exec-prepared con "SELECT set_config('search_path', $1, false)" `((,new-path . "text"))))) (pg-error nil))) (provide 'pg-bm25) ;;; pg-bm25.el ends here pg-el-0.54/pg-geometry.el000066400000000000000000000213111500535241500152250ustar00rootroot00000000000000;;; pg-geometry.el --- Support for PostgreSQL geometric types -*- lexical-binding: t -*- ;; ;; Copyright: (C) 2024 Eric Marsden ;; Author: Eric Marsden ;; SPDX-License-Identifier: GPL-3.0-or-later ;;; Commentary: ;; Geometric data types, per https://www.postgresql.org/docs/current/datatype-geometric.html ;;; Code: (require 'cl-lib) (require 'peg) (declare-function pg-register-parser "pg" (type-name parser)) (declare-function pg-register-textual-serializer "pg" (type-name serializer)) (declare-function pg-initialize-parsers "pg" (con)) (declare-function pg-signal-type-error "pg" (fmt &rest arguments)) (defun pg--point-parser (str _encoding) (with-temp-buffer (insert str) (goto-char (point-min)) (with-peg-rules ((point (or with-parens without-parens)) (with-parens (* [space]) (* "(") x-comma-y (* ")") (* [space]) (eol)) (without-parens x-comma-y (* [space]) (eol)) (x-comma-y (* [space]) float (* [space]) "," (* [space]) float (* [space]) (* ")") `(x y -- (cons x y))) (float (substring sign (+ [digit]) (* "." (+ [digit])) (* "e" sign (+ [digit]))) `(str -- (string-to-number str))) (sign (or "+" "-" ""))) (car (peg-run (peg point)))))) (defun pg--serialize-point (point _encoding) (unless (consp point) (pg-signal-type-error "Expecting a cons, got %s" point)) (unless (numberp (car point)) (pg-signal-type-error "Expecting a cons of numbers, got %s" point)) (unless (numberp (cdr point)) (pg-signal-type-error "Expecting a cons of numbers, got %s" point)) (format "(%s,%s)" (car point) (cdr point))) ;; A line is represented in Emacs Lisp by a 3-element vector. (defun pg--line-parser (str _encoding) (with-temp-buffer (insert str) (goto-char (point-min)) (with-peg-rules ((line (* [space]) "{" float "," (* [space]) float "," (* [space]) float "}" (* [space]) (eol) `(a b c -- (vector a b c))) (float (substring sign (+ [digit]) (* "." (+ [digit])) (* "e" sign (+ [digit]))) `(str -- (string-to-number str))) (sign (or "+" "-" ""))) (car (peg-run (peg line)))))) (defun pg--serialize-line (line _encoding) (unless (vectorp line) (pg-signal-type-error "Expecting a vector, got %s" line)) (unless (numberp (aref line 0)) (pg-signal-type-error "Expecting a vector of numbers, got %s" line)) (unless (numberp (aref line 1)) (pg-signal-type-error "Expecting a vector of numbers, got %s" line)) (unless (numberp (aref line 2)) (pg-signal-type-error "Expecting a vector of numbers, got %s" line)) (format "{%f,%f,%f}" (aref line 0) (aref line 1) (aref line 2))) ;; An lseg is represented in Emacs Lisp by a two-element vector of points. (defun pg--lseg-parser (str _encoding) (with-temp-buffer (insert str) (goto-char (point-min)) (with-peg-rules ((lseg (* [space]) "[" point "," (* [space]) point (* [space]) "]" (* [space]) (eol) `(p1 p2 -- (vector p1 p2))) (point "(" x-comma-y ")") (x-comma-y (* [space]) float (* [space]) "," (* [space]) float (* [space]) `(x y -- (cons x y))) (float (substring sign (+ [digit]) (* "." (+ [digit])) (* "e" sign (+ [digit]))) `(str -- (string-to-number str))) (sign (or "+" "-" ""))) (car (peg-run (peg lseg)))))) ;; [(x1,y1),(x2,y2)] (defun pg--serialize-lseg (lseg _encoding) (unless (vectorp lseg) (pg-signal-type-error "Expecting a vector, got %s" lseg)) (unless (eql 2 (length lseg)) (pg-signal-type-error "Expecting a vector of length 2, got %s" lseg)) (format "[(%f,%f),(%f,%f)]" (car (aref lseg 0)) (cdr (aref lseg 0)) (car (aref lseg 1)) (cdr (aref lseg 1)))) ;; ( x1 , y1 ) , ( x2 , y2 ) (defun pg--box-parser (str _encoding) (with-temp-buffer (insert str) (goto-char (point-min)) (with-peg-rules ((box (* [space]) point "," (* [space]) point (* [space]) (eol) `(p1 p2 -- (vector p1 p2))) (point "(" x-comma-y ")") (x-comma-y (* [space]) float (* [space]) "," (* [space]) float (* [space]) `(x y -- (cons x y))) (float (substring sign (+ [digit]) (* "." (+ [digit])) (* "e" sign (+ [digit]))) `(str -- (string-to-number str))) (sign (or "+" "-" ""))) (car (peg-run (peg box)))))) (defun pg--serialize-box (box _encoding) (format "(%f,%f),(%f,%f)" (car (aref box 0)) (cdr (aref box 0)) (car (aref box 1)) (cdr (aref box 1)))) ;; type is one of :open, :closed (cl-defstruct pg-geometry-path type points) (defun pg--path-parser (str _encoding) (with-temp-buffer (insert str) (goto-char (point-min)) (with-peg-rules ((path (* [space]) (or open-path closed-path) (* [space]) (eol)) (open-path "[" (* [space]) (list point-list) (* [space]) "]" `(points -- (make-pg-geometry-path :type :open :points points))) (closed-path "(" (* [space]) (list point-list) (* [space]) ")" `(points -- (make-pg-geometry-path :type :closed :points points))) (point-list point (* "," (* [space]) point-list)) (point "(" x-comma-y ")") (x-comma-y (* [space]) float (* [space]) "," (* [space]) float (* [space]) `(x y -- (cons x y))) (float (substring sign (+ [digit]) (* "." (+ [digit])) (* "e" sign (+ [digit]))) `(str -- (string-to-number str))) (sign (or "+" "-" ""))) (car (peg-run (peg path)))))) (defun pg--serialize-path (path encoding) (unless (pg-geometry-path-p path) (pg-signal-type-error "Expecting a pg-geometry-path object, got %s" path)) (let ((type (pg-geometry-path-type path)) (points (pg-geometry-path-points path))) (format "%s%s%s" (if (eq :open type) "[" "(") (string-join (mapcar (lambda (p) (pg--serialize-point p encoding)) points) ",") (if (eq :open type) "]" ")")))) (cl-defstruct pg-geometry-polygon points) ;; ( ( x1 , y1 ) , ... , ( xn , yn ) ) (defun pg--polygon-parser (str _encoding) (with-temp-buffer (insert str) (goto-char (point-min)) (with-peg-rules ((polygon (* [space]) "(" (* [space]) (list point-list) (* [space]) ")" (* [space]) (eol) `(points -- (make-pg-geometry-polygon :points points))) (point-list point (* "," (* [space]) point-list)) (point "(" x-comma-y ")") (x-comma-y (* [space]) float (* [space]) "," (* [space]) float (* [space]) `(x y -- (cons x y))) (float (substring sign (+ [digit]) (* "." (+ [digit])) (* "e" sign (+ [digit]))) `(str -- (string-to-number str))) (sign (or "+" "-" ""))) (car (peg-run (peg polygon)))))) (defun pg--serialize-polygon (polygon encoding) (unless (pg-geometry-polygon-p polygon) (pg-signal-type-error "Expecting a pg-geometry-polygon object, got %s" polygon)) (let* ((points (pg-geometry-polygon-points polygon)) (spoints (mapcar (lambda (p) (pg--serialize-point p encoding)) points))) (format "(%s)" (string-join spoints ",")))) (defun pg--geometry-register-serializers () "Register the serializers and deserializers for geometric types." (pg-register-parser "point" #'pg--point-parser) (pg-register-textual-serializer "point" #'pg--serialize-point) (pg-register-parser "line" #'pg--line-parser) (pg-register-textual-serializer "line" #'pg--serialize-line) (pg-register-parser "lseg" #'pg--lseg-parser) (pg-register-textual-serializer "lseg" #'pg--serialize-lseg) (pg-register-parser "box" #'pg--box-parser) (pg-register-textual-serializer "box" #'pg--serialize-box) (pg-register-parser "path" #'pg--path-parser) (pg-register-textual-serializer "path" #'pg--serialize-path) (pg-register-parser "polygon" #'pg--polygon-parser) (pg-register-textual-serializer "polygon" #'pg--serialize-polygon)) (cl-eval-when (load) (pg--geometry-register-serializers)) ;; We call pg-initialize-parsers to look up the OID corresponding to these newly defined types and ;; to hook them into the parsing machinery. (defun pg-geometry-setup (con) "Initialize (de)serialization support for geometric types. This function must be called if you loaded the pg-geometry library after a PostgreSQL connection has been established. It sets up the deserialization and serialization functionality to recognize the newly defined types point, line, lseg and so on. The function need not be called if the pg-geometry library was loaded prior to establishing your PostgreSQL connection CON." (pg--geometry-register-serializers) (pg-initialize-parsers con)) (provide 'pg-geometry) ;;; pg-geometry.el ends here pg-el-0.54/pg-gis.el000066400000000000000000000074311500535241500141630ustar00rootroot00000000000000;;; pg-gis.el --- Support for PostGIS types -*- lexical-binding: t -*- ;; ;; Copyright: (C) 2024 Eric Marsden ;; Author: Eric Marsden ;; SPDX-License-Identifier: GPL-3.0-or-later ;;; Commentary: ;; PostGIS ;; https://postgis.net/docs/manual-3.4/using_postgis_dbmanagement.html ;;; Code: (require 'cl-lib) (declare-function pg-register-parser "pg" (type-name parser)) (declare-function pg-register-textual-serializer "pg" (type-name serializer)) (declare-function pg-exec "pg" (con &rest args)) (declare-function pg-initialize-parsers "pg" (con)) (declare-function pg--serialize-text "pg" (object encoding)) (defvar pg-gis-use-geosop t "If non-nil, parse PostGIS EWKB to text using the geosop utility.") ;; PostGIS sends values over the wire in HEXEWKB format (Extended Well-Known Binary encoded in ;; hexademical), such as "01010000200400000000000000000000000000000000000000". ;; ;; https://en.wikipedia.org/wiki/Well-known_text_representation_of_geometry#Well-known_binary ;; ;; if the variable `pg-gis-use-geosop' is non-nil, we parse this format using the geosop commandline ;; utility function from GEOS (often available in packages named geos-bin or similar). Otherwise, we ;; leave it as a string (it can be parsed using PostGIS functions such as ST_AsText). ;; ;; Some alternative parsing code that we could adapt to elisp: ;; https://github.com/filonenko-mikhail/cl-ewkb/blob/master/cl-ewkb/ewkb.lisp ;; ;; % echo 01010000200400000000000000000000000000000000000000 | geosop -a stdin.wkb -f txt ;; POINT (0 0) (defun pg-gis--parse-ewkb-geosop (string _encoding) "Parse STRING in EWKB or HEXEWKB to text using the geosop application." (with-temp-buffer (call-process-region string nil "geosop" nil t nil "-a" "stdin.wkb" "-f" "txt") (string-trim (buffer-string)))) (defun pg-gis--parse-ewkb (string encoding) "Parse STRING in EWKB or HEXEWKB following the value of pg-gis-use-geosop." (if pg-gis-use-geosop (pg-gis--parse-ewkb-geosop string encoding) string)) (defun pg-gis--parse-spheroid (string _encoding) string) (defun pg-gis--parse-box2d (string _encoding) string) (defun pg-gis--parse-box3d (string _encoding) string) ;; PostGIS data types that we receive over the wire: ;; ;; geometry ;; geography ;; box2d ;; box3d ;; spheroid ;; Types that don't seem to be sent over the wire: ;; box2df -- box2d with floating point precision ;; gidx -- box3d with floating point precision ;; geometry_dump ;; valid_detail ;; geography_columns (defun pg--gis-register-serializers () "Register the (de)serialization functions for PostGIS types." (pg-register-parser "geometry" #'pg-gis--parse-ewkb) (pg-register-textual-serializer "geometry" #'pg--serialize-text) (pg-register-parser "geography" #'pg-gis--parse-ewkb) (pg-register-textual-serializer "geography" #'pg--serialize-text) (pg-register-parser "spheroid" #'pg-gis--parse-spheroid) (pg-register-textual-serializer "spheroid" #'pg--serialize-text) (pg-register-parser "box2d" #'pg-gis--parse-box2d) (pg-register-textual-serializer "box2d" #'pg--serialize-text) (pg-register-parser "box3d" #'pg-gis--parse-box3d) (pg-register-textual-serializer "box3d" #'pg--serialize-text)) (cl-eval-when (load) (pg--gis-register-serializers)) ;; This function must be called before using the PostGIS extension. It loads the extension if ;; necessary, and sets up the parsing support for the relevant datatypes. (defun pg-setup-postgis (con) "Prepare for use of PostGIS types on PostgreSQL connection CON. Return nil if the extension could not be loaded." (pg--gis-register-serializers) (condition-case nil (progn (pg-exec con "CREATE EXTENSION IF NOT EXISTS postgis") (pg-initialize-parsers con)) (pg-error nil))) (provide 'pg-gis) ;;; pg-gis.el ends here pg-el-0.54/pg-lo.el000066400000000000000000000175451500535241500140220ustar00rootroot00000000000000;;; pg-lo.el --- Support for PostgreSQL large objects -*- lexical-binding: t -*- ;; ;; Copyright: (C) 2024 Eric Marsden ;; Author: Eric Marsden ;; SPDX-License-Identifier: GPL-3.0-or-later ;;; Commentary: ;; Humphrey: Who is Large and to what does he object? ;; ;; Large objects are the PostgreSQL way of doing what most databases ;; call BLOBs (binary large objects). In addition to being able to ;; stream data to and from large objects, PostgreSQL's ;; object-relational capabilities allow the user to provide functions ;; which act on the objects. ;; ;; For example, the user can define a new type called "circle", and ;; define a C or Tcl function called `circumference' which will act on ;; circles. There is also an inheritance mechanism in PostgreSQL. ;;; Code: (require 'cl-lib) (declare-function pg-read-string "pg" (con maxbytes)) (declare-function pg-read-char "pg" (con)) (declare-function pg-read-chars "pg" (con count)) (declare-function pg-read-net-int "pg" (con bytes)) (declare-function pg-handle-error-response "pg" (con &optional context)) (declare-function pg-flush "pg" (con)) (declare-function pg-send "pg" (con str &optional bytes)) (declare-function pg-send-uint "pg" (con num bytes)) (declare-function pg-send-char "pg" (con char)) (declare-function pg-connection-set-busy "pg" (con busy)) (declare-function pg-result "pg" (result what &rest arg)) (declare-function pg-exec "pg" (con &rest args)) (defconst pg--INV_ARCHIVE 65536) ; fe-lobj.c (defconst pg--INV_WRITE 131072) (defconst pg--INV_READ 262144) (defconst pg--LO_BUFIZE 1024) (defconst pg--MAX_MESSAGE_LEN 8192) ; libpq-fe.h (defvar pg-lo-initialized nil) (defvar pg-lo-functions '()) (defun pg-lo-init (con) (let* ((res (pg-exec con "SELECT proname, oid from pg_proc WHERE " "proname = 'lo_open' OR " "proname = 'lo_close' OR " "proname = 'lo_creat' OR " "proname = 'lo_unlink' OR " "proname = 'lo_lseek' OR " "proname = 'lo_tell' OR " "proname = 'loread' OR " "proname = 'lowrite'"))) (setq pg-lo-functions '()) (mapc (lambda (tuple) (push (cons (car tuple) (cadr tuple)) pg-lo-functions)) (pg-result res :tuples)) (setq pg-lo-initialized t))) ;; fn is either an integer, in which case it is the OID of an element ;; in the pg_proc table, and otherwise it is a string which we look up ;; in the alist `pg-lo-functions' to find the corresponding OID. (defun pg-fn (con fn integer-result &rest args) (pg-connection-set-busy con t) (unless pg-lo-initialized (pg-lo-init con)) (let ((fnid (cond ((integerp fn) fn) ((not (stringp fn)) (let ((msg (format "Expecting a string or an integer: %s" fn))) (signal 'pg-protocol-error (list msg)))) ((assoc fn pg-lo-functions) ; blech (cdr (assoc fn pg-lo-functions))) (t (error "Unknown builtin function %s" fn))))) (pg-send-char con ?F) (pg-send-char con 0) (pg-send-uint con fnid 4) (pg-send-uint con (length args) 4) (mapc (lambda (arg) (cond ((integerp arg) (pg-send-uint con 4 4) (pg-send-uint con arg 4)) ((stringp arg) (pg-send-uint con (length arg) 4) (pg-send con arg)) (t (error "Unknown fastpath type %s" arg)))) args) (pg-flush con) (cl-loop with result = (list) for c = (pg-read-char con) do (cl-case c ;; ErrorResponse (?E (pg-handle-error-response con "in pg-fn")) ;; FunctionResultResponse (?V (setq result t)) ;; Nonempty response (?G (let* ((len (pg-read-net-int con 4)) (res (if integer-result (pg-read-net-int con len) (pg-read-chars con len)))) (setq result res))) ;; NoticeResponse (?N (let ((notice (pg-read-string con pg--MAX_MESSAGE_LEN))) (message "NOTICE: %s" notice)) (when (fboundp 'unix-sync) (unix-sync))) ;; ReadyForQuery message (?Z (let ((_msglen (pg-read-net-int con 4)) (status (pg-read-char con))) (when (eql ?E status) (message "PostgreSQL ReadyForQuery message with error status")) (pg-connection-set-busy con nil) (cl-return-from pg-fn result))) ;; end of FunctionResult (?0 nil) (t (error "Unexpected character in pg-fn: %s" c)))))) ;; returns an OID (defun pg-lo-create (connection &optional args) (let* ((modestr (or args "r")) (mode (cond ((integerp modestr) modestr) ((string= "r" modestr) pg--INV_READ) ((string= "w" modestr) pg--INV_WRITE) ((string= "rw" modestr) (logior pg--INV_READ pg--INV_WRITE)) (t (error "pg-lo-create: bad mode %s" modestr)))) (oid (pg-fn connection "lo_creat" t mode))) (cond ((not (integerp oid)) (error "Returned value not an OID: %s" oid)) ((zerop oid) (error "Can't create large object")) (t oid)))) ;; args = modestring (default "r", or "w" or "rw") ;; returns a file descriptor for use in later pg-lo-* procedures (defun pg-lo-open (connection oid &optional args) (let* ((modestr (or args "r")) (mode (cond ((integerp modestr) modestr) ((string= "r" modestr) pg--INV_READ) ((string= "w" modestr) pg--INV_WRITE) ((string= "rw" modestr) (logior pg--INV_READ pg--INV_WRITE)) (t (error "pg-lo-open: bad mode %s" modestr)))) (fd (pg-fn connection "lo_open" t oid mode))) (unless (integerp fd) (error "Couldn't open large object")) fd)) (defsubst pg-lo-close (connection fd) (pg-fn connection "lo_close" t fd)) (defsubst pg-lo-read (connection fd bytes) (pg-fn connection "loread" nil fd bytes)) (defsubst pg-lo-write (connection fd buf) (pg-fn connection "lowrite" t fd buf)) (defsubst pg-lo-lseek (connection fd offset whence) (pg-fn connection "lo_lseek" t fd offset whence)) (defsubst pg-lo-tell (connection oid) (pg-fn connection "lo_tell" t oid)) (defsubst pg-lo-unlink (connection oid) (pg-fn connection "lo_unlink" t oid)) ;; returns an OID ;; FIXME should use unwind-protect here (defun pg-lo-import (connection filename) (let* ((buf (get-buffer-create (format " *pg-%s" filename))) (oid (pg-lo-create connection "rw")) (fdout (pg-lo-open connection oid "w")) (pos (point-min))) (with-current-buffer buf (insert-file-contents-literally filename) (while (< pos (point-max)) (pg-lo-write connection fdout (buffer-substring-no-properties pos (min (point-max) (cl-incf pos 1024))))) (pg-lo-close connection fdout)) (kill-buffer buf) oid)) (defun pg-lo-export (connection oid filename) (let* ((buf (get-buffer-create (format " *pg-%d" oid))) (fdin (pg-lo-open connection oid "r"))) (with-current-buffer buf (cl-do ((str (pg-lo-read connection fdin 1024) (pg-lo-read connection fdin 1024))) ((or (not str) (zerop (length str)))) (insert str)) (pg-lo-close connection fdin) (write-file filename)) (kill-buffer buf))) (provide 'pg-lo) ;;; pg-lo.el ends here pg-el-0.54/pg.el000066400000000000000000005304341500535241500134070ustar00rootroot00000000000000;;; pg.el --- Socket-level interface to the PostgreSQL database -*- lexical-binding: t -*- ;; Copyright: (C) 1999-2002, 2022-2025 Eric Marsden ;; Author: Eric Marsden ;; Version: 0.53 ;; Keywords: data comm database postgresql ;; URL: https://github.com/emarsden/pg-el ;; Package-Requires: ((emacs "28.1") (peg "1.0.1")) ;; SPDX-License-Identifier: GPL-3.0-or-later ;; ;; This file is free software: you can redistribute it and/or modify ;; it under the terms of the GNU General Public License as published ;; by the Free Software Foundation, either version 3 of the License, ;; or (at your option) any later version. ;; ;; This file is distributed in the hope that it will be useful, ;; but WITHOUT ANY WARRANTY; without even the implied warranty of ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the ;; GNU General Public License for more details. ;; ;; You should have received a copy of the GNU General Public License ;; along with this file. If not, see . ;;; Commentary: ;; Overview ;; -------- ;; ;; This module lets you access the PostgreSQL database from Emacs, using its socket-level ;; frontend/backend protocol (the PostgreSQL wire protocol). The module is capable of automatic type ;; coercions from a range of SQL types to the equivalent Emacs Lisp type. ;; ;; Supported features: ;; ;; - SCRAM-SHA-256 authentication (the default method since PostgreSQL version 14) and MD5 ;; - authentication. ;; ;; - Encrypted (TLS) connections between Emacs and the PostgreSQL backend. ;; ;; - Parameterized queries using PostgreSQL's extended query syntax, to protect from SQL ;; injection issues. ;; ;; - The PostgreSQL COPY protocol to copy preformatted data to PostgreSQL from an Emacs ;; buffer. ;; ;; - Asynchronous handling of LISTEN/NOTIFY notification messages from PostgreSQL, allowing the ;; implementation of publish-subscribe type architectures (PostgreSQL as an "event broker" or ;; "message bus" and Emacs as event publisher and consumer). ;; ;; ;; This is a low level API, and won't be useful to end users. If you're looking for an ;; Emacs-based browsing/editing interface to PostgreSQL, see the PGmacs library at ;; https://github.com/emarsden/pgmacs/. ;; ;; ;; Entry points ;; ------------ ;; ;; See the online documentation at . ;; Thanks to Eric Ludlam for discovering a bug in the date parsing routines, to ;; Hartmut Pilch and Yoshio Katayama for adding multibyte support, and to Doug ;; McNaught and Pavel Janik for bug fixes. ;;; TODO ;; ;; * Implement the SASLPREP algorithm for usernames and passwords that contain ;; unprintable characters (used for SCRAM-SHA-256 authentication). ;;; Code: (require 'cl-lib) (require 'eieio) (require 'hex-util) (require 'bindat) (require 'url) (require 'peg) (require 'rx) (require 'parse-time) ;; https://www.postgresql.org/docs/current/libpq-envars.html (defvar pg-application-name (or (getenv "PGAPPNAME") "pg.el") "The application_name sent to the PostgreSQL backend. This information appears in queries to the `pg_stat_activity' table and (depending on server configuration) in the connection log.") (defvar pg-connect-timeout (cl-case system-type (windows-nt 0) (ms-dos 0) (t 30)) "Timeout in seconds for establishing the network connection to PostgreSQL. If set to zero (the default on Microsoft Windows platforms), do not create a timer to signal a connection timeout.") (defvar pg-read-timeout 10 "Timeout in seconds when reading data from PostgreSQL.") (defvar pg-disable-type-coercion nil "*Non-nil disables the type coercion mechanism. The default is nil, which means that data recovered from the database is coerced to the corresponding Emacs Lisp type before being returned; for example numeric data is transformed to Emacs Lisp numbers, and booleans to booleans. The coercion mechanism requires an initialization query to the database, in order to build a table mapping type names to OIDs. This option is provided mainly in case you wish to avoid the overhead of this initial query. The overhead is only incurred once per Emacs session (not per connection to the backend).") (defvar pg-parameter-change-functions (list 'pg-handle-parameter-client-encoding) "List of handlers called when the backend informs us of a parameter change. Each handler is called with three arguments: the connection to the backend, the parameter name and the parameter value.") (defvar pg-handle-notice-functions (list 'pg-log-notice) "List of handlers called when the backend sends us a NOTICE message. Each handler is called with one argument, the notice, as a pgerror struct.") (defvar pg-new-connection-hook (list #'pg-detect-server-variant) "A list of functions called when a new PostgreSQL connection is established. Each function is called with the new connection as a single argument. The default value of this hook includes a function that detects various semi-compatible PostgreSQL variants, which sometimes requires additional SQL queries. To avoid this overhead on establishing a connection, remove `pg-detect-server-variant' from this list.") ;; See https://www.postgresql.org/docs/17/errcodes-appendix.html (define-error 'pg-error "PostgreSQL error" 'error) (define-error 'pg-user-error "pg-el user error" 'pg-error) (define-error 'pg-protocol-error "PostgreSQL protocol error" 'pg-error) (define-error 'pg-database-error "PostgreSQL database error" 'pg-error) (define-error 'pg-operational-error "PostgreSQL operational error" 'pg-error) (define-error 'pg-programming-error "PostgreSQL programming error" 'pg-error) (define-error 'pg-data-error "PostgreSQL data error" 'pg-error) (define-error 'pg-integrity-error "PostgreSQL integrity error" 'pg-error) (define-error 'pg-internal-error "PostgreSQL internal error" 'pg-error) (define-error 'pg-encoding-error "Client-level error encoding PostgreSQL query" 'pg-operational-error) (define-error 'pg-connection-error "PostgreSQL connection failure" 'pg-operational-error) (define-error 'pg-invalid-password "PostgreSQL invalid password" 'pg-operational-error) (define-error 'pg-invalid-catalog-name "PostgreSQL invalid catalog name" 'pg-operational-error) (define-error 'pg-feature-not-supported "PostgreSQL feature not supported" 'pg-error) (define-error 'pg-syntax-error "PostgreSQL syntax error" 'pg-programming-error) (define-error 'pg-undefined-table "PostgreSQL undefined table" 'pg-programming-error) (define-error 'pg-undefined-column "PostgreSQL undefined column" 'pg-programming-error) (define-error 'pg-undefined-function "PostgreSQL undefined function" 'pg-programming-error) (define-error 'pg-reserved-name "PostgreSQL reserved name" 'pg-programming-error) (define-error 'pg-copy-failed "PostgreSQL COPY failed" 'pg-operational-error) (define-error 'pg-connect-timeout "PostgreSQL connection attempt timed out" 'pg-operational-error) (define-error 'pg-timeout "PostgreSQL data transfer timed out" 'pg-operational-error) (define-error 'pg-type-error "Incorrect type in binding PostgreSQL prepared statement" 'pg-user-error) (define-error 'pg-numeric-value-out-of-range "PostgreSQL numeric value out of range" 'pg-data-error) (define-error 'pg-division-by-zero "PostgreSQL division by zero" 'pg-data-error) (define-error 'pg-floating-point-exception "PostgreSQL floating point exception" 'pg-data-error) (define-error 'pg-array-subscript-error "PostgreSQL array subscript error" 'pg-data-error) (define-error 'pg-datetime-field-overflow "PostgreSQL datetime field overflow" 'pg-data-error) (define-error 'pg-character-not-in-repertoire "PostgreSQL character not in repertoire" 'pg-data-error) (define-error 'pg-invalid-text-representation "Invalid text representation" 'pg-data-error) (define-error 'pg-invalid-binary-representation "Invalid binary representation" 'pg-data-error) (define-error 'pg-datatype-mismatch "PostgreSQL datatype mismatch" 'pg-data-error) (define-error 'pg-json-error "PostgreSQL JSON-related error" 'pg-data-error) (define-error 'pg-xml-error "PostgreSQL XML-related error" 'pg-data-error) (define-error 'pg-integrity-constraint-violation "PostgreSQL integrity constraint violation" 'pg-integrity-error) (define-error 'pg-restrict-violation "PostgreSQL restrict violation" 'pg-integrity-error) (define-error 'pg-not-null-violation "PostgreSQL not NULL violation" 'pg-integrity-error) (define-error 'pg-foreign-key-violation "PostgreSQL FOREIGN KEY violation" 'pg-integrity-error) (define-error 'pg-unique-violation "PostgreSQL UNIQUE violation" 'pg-integrity-error) (define-error 'pg-check-violation "PostgreSQL CHECK violation" 'pg-integrity-error) (define-error 'pg-exclusion-violation "PostgreSQL exclusion violation" 'pg-integrity-error) (define-error 'pg-transaction-missing "PostgreSQL no transaction in progress" 'pg-programming-error) (define-error 'pg-transaction-timeout "PostgreSQL transaction timeout" 'pg-operational-error) (define-error 'pg-insufficient-privilege "PostgreSQL insufficient privilege" 'pg-operational-error) (define-error 'pg-insufficient-resources "PostgreSQL insufficient resources" 'pg-operational-error) (define-error 'pg-disk-full "PostgreSQL disk full error" 'pg-operational-error) (define-error 'pg-too-many-connections "PostgreSQL too many connections" 'pg-operational-error) (define-error 'pg-plpgsql-error "PostgreSQL PL/pgSQL error" 'pg-programming-error) (defun pg-signal-type-error (fmt &rest arguments) (let ((msg (apply #'format fmt arguments))) (signal 'pg-type-error (list msg)))) ;; Maps from type-name to a function that converts from text representation to wire-level binary ;; representation. (defvar pg--serializers (make-hash-table :test #'equal)) ;; Contains an entry for types that serialize to a text format, rather than a binary format (e.g. ;; HSTORE). The serialization function itself is stored in pg--serializers. (defvar pg--textual-serializers (make-hash-table :test #'equal)) ;; Maps from type-name to a parsing function (from string to Emacs native type). This is built ;; dynamically at initialization of the connection with the database (once generated, the ;; information is shared between connections). (defvar pg--parser-by-typname (make-hash-table :test #'equal)) (defclass pgcon () ((dbname :type string :initarg :dbname :accessor pgcon-dbname) (process :initarg :process :accessor pgcon-process) (pid :type integer :accessor pgcon-pid ) (server-version-major :accessor pgcon-server-version-major) ;; Holds something like 'postgresql, 'ydb, 'cratedb (server-variant :type symbol :initform 'postgresql :accessor pgcon-server-variant) (secret :accessor pgcon-secret) (client-encoding :type symbol :initform 'utf-8 :accessor pgcon-client-encoding) ;; Maps from oid (an integer) to a parsing function. (parser-by-oid :type hash-table :initform (make-hash-table :test #'eql) :accessor pgcon-parser-by-oid) ;; Maps from type-name to PostgreSQL oid, for PostgreSQL builtin types. (oid-by-typname :type hash-table :initform (make-hash-table :test #'equal) :accessor pgcon-oid-by-typname) ;; Maps from oid to type-name. (typname-by-oid :type hash-table :initform (make-hash-table :test #'eql) :accessor pgcon-typname-by-oid) (timeout ;; This bizarre (progn ...) syntax is required by EIEIO for historical reasons. :initform (progn pg-read-timeout) :accessor pgcon-timeout) (connect-timer :initform nil :accessor pgcon-connect-timer) (query-log :initform nil :accessor pgcon-query-log) (prepared-statement-cache :type hash-table :initform (make-hash-table :test #'equal) :accessor pgcon-prepared-statement-cache) (connect-info :initform nil :accessor pgcon-connect-info))) (defun make-pgcon (&rest args) (apply #'make-instance (cons 'pgcon args))) (cl-defmethod cl-print-object ((this pgcon) stream) "Printer for pgcon PostgreSQL connection objects." (let ((dbname (when (slot-boundp this 'dbname) (pgcon-dbname this))) (pid (when (slot-boundp this 'pid) (pgcon-pid this)))) (princ (format "#" (or dbname "") (or pid "")) stream))) ;; Used to save the connection-specific position in our input buffer. (defvar-local pgcon--position 1) ;; Used to check whether the connection is currently "busy", so that we can determine whether a ;; message was received asynchronously or synchronously. (defvar-local pgcon--busy t) (defvar-local pgcon--notification-handlers (list)) (defun pg-connection-set-busy (con busy) (with-current-buffer (process-buffer (pgcon-process con)) (setq-local pgcon--busy busy))) (defun pg-connection-busy-p (con) (with-current-buffer (process-buffer (pgcon-process con)) pgcon--busy)) (defun pg-enable-query-log (con) "Enable logging of PostgreSQL queries on connection CON. Queries are logged to a buffer identified by `pgcon-query-log'." (unless (pgcon-query-log con) (message "pg-el: enabling query log on %s" (cl-prin1-to-string con)) (setf (pgcon-query-log con) (generate-new-buffer " *PostgreSQL query log*")))) ;; The qualified name is represented in SQL queries as schema.name. The schema is often either the ;; username or "public". (cl-defstruct pg-qualified-name "The identifier for a table or view which optionally includes a schema." (schema nil) name) ;; Print as "\"schema\".\"name\"", for example "\"public\".\"mytable\"". (defun pg-print-qualified-name (qn) (let ((schema (pg-escape-identifier (pg-qualified-name-schema qn))) (name (pg-escape-identifier (pg-qualified-name-name qn)))) (if schema (format "%s.%s" schema name) name))) (cl-defstruct pgresult connection status attributes tuples portal (incomplete nil)) (defsubst pg-flush (con) (accept-process-output (pgcon-process con) 0.1)) ;; this is ugly because lambda lists don't do destructuring (defmacro with-pg-connection (con connect-args &rest body) "Execute BODY forms in a scope with connection CON created by CONNECT-ARGS. The database connection is bound to the variable CON. If the connection is unsuccessful, the forms are not evaluated. Otherwise, the BODY forms are executed, and upon termination, normal or otherwise, the database connection is closed." `(let ((,con (pg-connect ,@connect-args))) (unwind-protect (progn ,@body) (when ,con (pg-disconnect ,con))))) (put 'with-pg-connection 'lisp-indent-function 'defun) (defmacro with-pg-connection-local (con connect-args &rest body) "Execute BODY forms in a scope with local Unix connection CON created by CONNECT-ARGS. The database connection is bound to the variable CON. If the connection is unsuccessful, the forms are not evaluated. Otherwise, the BODY forms are executed, and upon termination, normal or otherwise, the database connection is closed." `(let ((,con (pg-connect-local ,@connect-args))) (unwind-protect (progn ,@body) (when ,con (pg-disconnect ,con))))) (put 'with-pg-connection 'lisp-indent-function 'defun) (defmacro with-pg-transaction (con &rest body) "Execute BODY forms in a BEGIN..END block with pre-established connection CON. If a PostgreSQL error occurs during execution of the forms, execute a ROLLBACK command. Large-object manipulations _must_ occur within a transaction, since the large object descriptors are only valid within the context of a transaction." (let ((exc-sym (gensym))) `(progn (pg-exec ,con "BEGIN") (condition-case ,exc-sym (prog1 (progn ,@body) (pg-exec ,con "COMMIT")) (error (message "PostgreSQL error %s" ,exc-sym) (pg-exec ,con "ROLLBACK")))))) (put 'with-pg-transaction 'lisp-indent-function 'defun) (defun pg-for-each (con select-form callback) "Create a cursor for SELECT-FORM and call CALLBACK for each result. Uses the PostgreSQL database connection CON. SELECT-FORM must be an SQL SELECT statement. The cursor is created using an SQL DECLARE CURSOR command, then results are fetched successively until no results are left. The cursor is then closed. The work is performed within a transaction. The work can be interrupted before all tuples have been handled by THROWing to a tag called pg-finished." (let ((cursor (symbol-name (gensym "pgelcursor")))) (catch 'pg-finished (with-pg-transaction con (pg-exec con "DECLARE " cursor " CURSOR FOR " select-form) (unwind-protect (cl-loop for res = (pg-result (pg-exec con "FETCH 1 FROM " cursor) :tuples) until (zerop (length res)) do (funcall callback res)) (pg-exec con "CLOSE " cursor)))))) ;; This is installed as an Emacs Lisp process filter for the PostgreSQL connection. We return nil if ;; the PostgreSQL connection is currently "busy" (meaning that we are currently processing a ;; synchronous request), or if the data received doesn't look like a complete NotificationResponse ;; message (starting with ?A, total length compatible with the length specified in the PostgreSQL ;; message format). Otherwise, we return the length of the message length that we handled. ;; ;; When we return non-nil, the original process filter is called (see `add-function' advice below), ;; which places the data in the process buffer for normal (synchronous) handling. (defun pg-process-filter (process data) (with-current-buffer (process-buffer process) (unless pgcon--busy (when (and (eql ?A (aref data 0)) (eql 0 (aref data 1))) (let ((msglen 0)) ;; read a net int in 4 octets representing the message length (setq msglen (+ (* 256 msglen) (aref data 1))) (setq msglen (+ (* 256 msglen) (aref data 2))) (setq msglen (+ (* 256 msglen) (aref data 3))) (setq msglen (+ (* 256 msglen) (aref data 4))) ;; We parse the channel and payload if we received a full NotificationResponse. msglen is one ;; less than the size of data due to the ?A message tag. (when (eql (1+ msglen) (length data)) ;; ignore a net int in 4 octets representing notifying backend PID (let* ((channel-end-pos (cl-position 0 data :start 9 :end (length data))) (payload-end-pos (cl-position 0 data :start (1+ channel-end-pos) :end (length data))) (channel (cl-subseq data 9 channel-end-pos)) (payload (cl-subseq data (1+ channel-end-pos) payload-end-pos))) (dolist (handler pgcon--notification-handlers) (funcall handler channel payload)))) (1- msglen)))))) ;; With the :before-until advice type, the original process filter (which places the incoming ;; content in the process buffer) will be called only if our process filter returns nil. Our process ;; filter returns non-nil when it has detected, parsed and handled an asynchronous notification and ;; nil otherwise. This allows us to avoid duplicate processing of asynchronous notifications, once ;; by #'pg-process-filter and once by the notification handling code in pg-exec. (defun pg-enable-async-notification-handlers (con) (add-function :before-until (process-filter (pgcon-process con)) #'pg-process-filter)) (defun pg-disable-async-notification-handlers (con) (remove-function (process-filter (pgcon-process con)) #'pg-process-filter)) (defconst pg--AUTH_REQ_OK 0) (defconst pg--AUTH_REQ_KRB4 1) (defconst pg--AUTH_REQ_KRB5 2) (defconst pg--AUTH_REQ_PASSWORD 3) ; AuthenticationCleartextPassword (defconst pg--AUTH_REQ_CRYPT 4) (defconst pg--STARTUP_MSG 7) (defconst pg--STARTUP_KRB4_MSG 10) (defconst pg--STARTUP_KRB5_MSG 11) (defconst pg--STARTUP_PASSWORD_MSG 14) (cl-defgeneric pg-do-variant-specific-setup (con variant) "Run any setup actions on connnection establishment specific to VARIANT. Uses PostgreSQL connection CON.") ;; QuestDB only supports text-encoded values in the extended query statement protocol, so for this ;; PostgreSQL variant we ignore any binary serializers that were registered using ;; pg--register-serializer. (cl-defmethod pg-do-variant-specific-setup ((_con pgcon) (_variant (eql 'questdb))) (message "pg-el: running variant-specific setup for QuestDB") (setq pg--serializers (make-hash-table :test #'equal))) ;; Register the OIDs associated with these OmniDB-specific types, so that their types appear in ;; column metadata listings. (cl-defmethod pg-do-variant-specific-setup ((con pgcon) (_variant (eql 'alloydb))) (message "pg-el: running variant-specific setup for AlloyDB Omni") ;; These type names are in the google_ml schema (pg-register-parser "model_family_type" #'pg-text-parser) (pg-register-parser "model_family_info" #'pg-text-parser) (pg-register-parser "model_provider" #'pg-text-parser) (pg-register-parser "model_type" #'pg-text-parser) (pg-register-parser "auth_type" #'pg-text-parser) (pg-register-parser "auth_info" #'pg-text-parser) (pg-register-parser "models" #'pg-text-parser) (pg-initialize-parsers con)) ;; OctoDB defaults to starting up using the SQL_ASCII client encoding. (cl-defmethod pg-do-variant-specific-setup ((con pgcon) (_variant (eql 'octodb))) (message "pg-el: running variant-specific setup for YottaDB Octo") (pg-set-client-encoding con "UTF8")) (cl-defmethod pg-do-variant-specific-setup ((con pgcon) (variant t)) ;; This statement fails on ClickHouse (and the database immediately closes the connection!). (unless (eq variant 'clickhouse) (pg-exec con "SET datestyle = 'ISO'"))) (defun pg-detect-server-variant (con) "Detect the flavour of PostgreSQL that we are connected to. Uses connection CON. The variant can be accessed by `pgcon-server-variant'." (pcase (pgcon-server-variant con) ;; This is the default value, meaning we haven't yet identified a variant based on its backend ;; parameter values. ('postgresql (let ((version (pg-backend-version con))) (cond ((cl-search "CrateDB" version) (setf (pgcon-server-variant con) 'cratedb)) ((cl-search "CockroachDB" version) (setf (pgcon-server-variant con) 'cockroachdb)) ((cl-search "-YB-" version) (setf (pgcon-server-variant con) 'yugabyte)) ((cl-search "QuestDB" version) (setf (pgcon-server-variant con) 'questdb)) ((cl-search "GreptimeDB" version) (setf (pgcon-server-variant con) 'greptimedb)) ((cl-search "RisingWave" version) (setf (pgcon-server-variant con) 'risingwave)) ((cl-search "implemented by immudb" version) (setf (pgcon-server-variant con) 'immudb)) ((cl-search "Greenplum" version) (setf (pgcon-server-variant con) 'greenplum)) ((cl-search "(Materialize " version) (setf (pgcon-server-variant con) 'materialize)) ;; A more expensive test is needed for Google AlloyDB. If this parameter is defined, ;; the query will return "on" or "off" as a string, and if the parameter is not defined ;; the query (second argument meaning no-error) will return '((nil)). ((let ((res (pg-exec con "SELECT current_setting('omni_disk_cache_enabled', true)"))) (stringp (cl-first (pg-result res :tuple 0)))) (setf (pgcon-server-variant con) 'alloydb)) ;; TODO: we could also detect CitusDB in the same way by checking for citus.cluster_name ;; setting for example, but in practice it is very PostgreSQL compatible so identifying ;; it as a variant doesn't seem mandatory. ((let* ((sql "SELECT 1 FROM information_schema.schemata WHERE schema_name=$1") (res (pg-exec-prepared con sql '(("_timescaledb_catalog" . "text"))))) (pg-result res :tuples)) (setf (pgcon-server-variant con) 'timescaledb))))) ('ydb (pg-exec con "SET search_path = 'public'"))) (pg-do-variant-specific-setup con (pgcon-server-variant con))) (defun pg-handle-error-response (con &optional context) "Handle an ErrorMessage from the backend we are connected to over CON. Additional information CONTEXT can be optionally included in the error message presented to the user." (let ((e (pg-read-error-response con)) (extra (list))) (when (pgerror-detail e) (push (format "detail: %s" (pgerror-detail e)) extra)) (when (pgerror-hint e) (push (format "hint: %s" (pgerror-hint e)) extra)) (when (pgerror-table e) (push (format "table: %s" (pgerror-table e)) extra)) (when (pgerror-column e) (push (format "column: %s" (pgerror-column e)) extra)) (when (pgerror-file e) (push (format "file: %s" (pgerror-file e)) extra)) (when (pgerror-line e) (push (format "line: %s" (pgerror-line e)) extra)) (when (pgerror-routine e) (push (format "routine: %s" (pgerror-routine e)) extra)) (when (pgerror-dtype e) (push (format "dtype: %s" (pgerror-dtype e)) extra)) (when (pgerror-where e) (push (format "where: %s" (pgerror-where e)) extra)) (when (pgerror-constraint e) (push (format "constraint name: %s" (pgerror-constraint e)) extra)) ;; Now read the ReadyForQuery message. We don't always receive this immediately; for example if ;; an incorrect username is sent during startup, PostgreSQL sends an ErrorMessage then an ;; AuthenticationSASL message. In that case, unread the message type octet so that it can ;; potentially be handled after the error is signaled. Some databases like Clickhouse ;; immediately close their connection on error, so we ignore any errors here. (ignore-errors (let ((c (pg-read-char con))) (unless (eql c ?Z) (message "Unexpected message type after ErrorMsg: %s" c) (pg-unread-char con))) ;; Read message length then status, which we discard. (pg-read-net-int con 4) (pg-read-char con)) (let ((msg (format "%s%s: %s (%s)" (pgerror-severity e) (if context (concat " " context) "") (pgerror-message e) (string-join extra ", "))) ;; https://www.postgresql.org/docs/17/errcodes-appendix.html (error-type (pcase (pgerror-sqlstate e) ("0A000" 'pg-feature-not-supported) ((pred (lambda (v) (string-prefix-p "08" v))) 'pg-connection-error) ("28P01" 'pg-invalid-password) ("28000" 'pg-invalid-password) ("22003" 'pg-numeric-value-out-of-range) ("2202E" 'pg-array-subscript-error) ("22008" 'pg-datetime-field-overflow) ("22012" 'pg-division-by-zero) ("22P01" 'pg-floating-point-exception) ("2201E" 'pg-floating-point-exception) ("2201F" 'pg-floating-point-exception) ("22021" 'pg-character-not-in-repertoire) ((pred (lambda (v) (string-prefix-p "2203" v))) 'pg-json-error) ("2200L" 'pg-xml-error) ("2200M" 'pg-xml-error) ("2200N" 'pg-xml-error) ("2200S" 'pg-xml-error) ("2200T" 'pg-xml-error) ("22P02" 'pg-invalid-text-representation) ("22P03" 'pg-invalid-binary-representation) ((pred (lambda (v) (string-prefix-p "22" v))) 'pg-data-error) ("23000" 'pg-integrity-constraint-violation) ("23001" 'pg-restrict-violation) ("23502" 'pg-not-null-violation) ("23503" 'pg-foreign-key-violation) ("23505" 'pg-unique-violation) ("23514" 'pg-check-violation) ("23P01" 'pg-exclusion-violation) ((pred (lambda (v) (string-prefix-p "23" v))) 'pg-integrity-error) ("25P01" 'pg-transaction-missing) ("25P04" 'pg-transaction-timeout) ((pred (lambda (v) (string-prefix-p "2F" v))) 'pg-programming-error) ((pred (lambda (v) (string-prefix-p "38" v))) 'pg-programming-error) ((pred (lambda (v) (string-prefix-p "39" v))) 'pg-programming-error) ((pred (lambda (v) (string-prefix-p "40" v))) 'pg-operational-error) ("3D000" 'pg-invalid-catalog-name) ("42000" 'pg-syntax-error) ("42601" 'pg-syntax-error) ("42P01" 'pg-undefined-table) ("42703" 'pg-undefined-column) ("42804" 'pg-datatype-mismatch) ("42883" 'pg-undefined-function) ("42501" 'pg-insufficient-privilege) ("42939" 'pg-reserved-name) ((pred (lambda (v) (string-prefix-p "42" v))) 'pg-programming-error) ("53000" 'pg-insufficient-resources) ("53100" 'pg-disk-full) ("53300" 'pg-too-many-connections) ((pred (lambda (v) (string-prefix-p "53" v))) 'pg-operational-error) ((pred (lambda (v) (string-prefix-p "54" v))) 'pg-operational-error) ((pred (lambda (v) (string-prefix-p "57" v))) 'pg-operational-error) ("P0000" 'pg-plpgsql-error) ((pred (lambda (v) (string-prefix-p "P0" v))) 'pg-programming-error) ((pred (lambda (v) (string-prefix-p "XX" v))) 'pg-internal-error) (_ 'pg-error)))) (signal error-type (list msg))))) ;; Run the startup interaction with the PostgreSQL database. Authenticate and read the connection ;; parameters. This function allows us to share code common to TCP and Unix socket connections to ;; the backend. (cl-defun pg-do-startup (con dbname user password) "Handle the startup sequence to authenticate with PostgreSQL over CON. Uses database DBNAME, user USER and password PASSWORD." ;; send the StartupMessage, as per https://www.postgresql.org/docs/current/protocol-message-formats.html (pg-connection-set-busy con t) (let ((packet-octets (+ 4 2 2 (1+ (length "user")) (1+ (length user)) (1+ (length "database")) (1+ (length dbname)) (1+ (length "application_name")) (1+ (length pg-application-name)) 1))) (pg-send-uint con packet-octets 4) (pg-send-uint con 3 2) ; Protocol major version = 3 (pg-send-uint con 0 2) ; Protocol minor version = 0 (pg-send-string con "user") (pg-send-string con user) (pg-send-string con "database") (pg-send-string con dbname) (pg-send-string con "application_name") (pg-send-string con pg-application-name) ;; A zero byte is required as a terminator after the last name/value pair. (pg-send-uint con 0 1) (pg-flush con)) (when (pgcon-connect-timer con) (cancel-timer (pgcon-connect-timer con))) (cl-loop for c = (pg-read-char con) do (cl-case c ;; an ErrorResponse message (?E (pg-handle-error-response con "after StartupMessage")) ;; NegotiateProtocolVersion (?v (let ((_msglen (pg-read-net-int con 4)) (protocol-supported (pg-read-net-int con 4)) (unrec-options (pg-read-net-int con 4)) (unrec (list))) ;; read the list of protocol options not supported by the server (dotimes (_i unrec-options) (push (pg-read-string con 4096) unrec)) (let ((msg (format "Server only supports protocol minor version <= %s" protocol-supported))) (signal 'pg-protocol-error (list msg))))) ;; BackendKeyData (?K (let ((_msglen (pg-read-net-int con 4))) (setf (pgcon-pid con) (pg-read-net-int con 4)) (setf (pgcon-secret con) (pg-read-net-int con 4)))) ;; NoticeResponse (?N ;; a Notice response has the same structure and fields as an ErrorResponse (let ((notice (pg-read-error-response con))) (dolist (handler pg-handle-notice-functions) (funcall handler notice)))) ;; ReadyForQuery message (?Z (let ((_msglen (pg-read-net-int con 4)) (status (pg-read-char con))) ;; status is 'I' or 'T' or 'E', Idle or InTransaction or Error (when (eql ?E status) (message "PostgreSQL ReadyForQuery message with error status")) (and (not pg-disable-type-coercion) (zerop (hash-table-count (pgcon-parser-by-oid con))) (pg-initialize-parsers con)) (dolist (f pg-new-connection-hook) (funcall f con)) (pg-enable-async-notification-handlers con) (pg-connection-set-busy con nil) (cl-return-from pg-do-startup con))) ;; an authentication request (?R (let ((_msglen (pg-read-net-int con 4)) (areq (pg-read-net-int con 4))) (cond ;; AuthenticationOK message ((= areq pg--AUTH_REQ_OK) ;; Continue processing server messages and wait for the ReadyForQuery ;; message nil) ((= areq pg--AUTH_REQ_PASSWORD) ;; send a PasswordMessage (pg-send-char con ?p) (pg-send-uint con (+ 5 (length password)) 4) (pg-send-string con password) (pg-flush con)) ;; AuthenticationSASL request ((= areq 10) (pg-do-sasl-authentication con user password)) ((= areq 5) (pg-do-md5-authentication con user password)) ((= areq pg--AUTH_REQ_CRYPT) (signal 'pg-protocol-error '("Crypt authentication not supported"))) ((= areq pg--AUTH_REQ_KRB4) (signal 'pg-protocol-error '("Kerberos4 authentication not supported"))) ((= areq pg--AUTH_REQ_KRB5) (signal 'pg-protocol-error '("Kerberos5 authentication not supported"))) (t (let ((msg (format "Can't do that type of authentication: %s" areq))) (signal 'pg-protocol-error (list msg))))))) ;; ParameterStatus (?S (let* ((msglen (pg-read-net-int con 4)) (msg (pg-read-chars con (- msglen 4))) (items (split-string msg (string 0))) (key (cl-first items)) (val (cl-second items))) ;; ParameterStatus items sent by the backend include application_name, ;; DateStyle, in_hot_standby, integer_datetimes (when (> (length key) 0) (when (string= "server_version" key) ;; We need to accept a version string of the form "17beta1" as well as "16.1" (let* ((major (cl-first (split-string val "\\."))) (major-numeric (apply #'string (cl-loop for c across major while (<= ?0 c ?9) collect c)))) (setf (pgcon-server-version-major con) (cl-parse-integer major-numeric))) (when (cl-search "ydb stable" val) (setf (pgcon-server-variant con) 'ydb)) (when (cl-search "-greptimedb-" val) (setf (pgcon-server-variant con) 'greptimedb)) (when (cl-search "OrioleDB" val) (setf (pgcon-server-variant con) 'orioledb)) (when (cl-search "(ReadySet)" val) (setf (pgcon-server-variant con) 'readyset))) ;; Now some somewhat ugly code to detect semi-compatible PostgreSQL variants, to allow us ;; to work around some of their behaviour that is incompatible with real PostgreSQL. (when (string= "session_authorization" key) ;; We could also look for the existence of the "xata" schema in pg-schemas (when (string-prefix-p "xata" val) (setf (pgcon-server-variant con) 'xata)) (when (string= "PGAdapter" val) (setf (pgcon-server-variant con) 'spanner))) (when (string-prefix-p "ivorysql." key) (setf (pgcon-server-variant con) 'ivorydb)) (dolist (handler pg-parameter-change-functions) (funcall handler con key val))))) (t (let ((msg (format "Problem connecting: expected an authentication response, got %s" c))) (signal 'pg-protocol-error (list msg))))))) ;; Avoid warning from the bytecode compiler (declare-function gnutls-negotiate "gnutls.el") (declare-function network-stream-certificate "network-stream.el") (cl-defun pg-connect (dbname user &optional (password "") (host "localhost") (port 5432) (tls-options nil) (server-variant nil)) "Initiate a connection with the PostgreSQL backend over TCP. Connect to the database DBNAME with the username USER, on PORT of HOST, providing PASSWORD if necessary. Return a connection to the database (as an opaque type). PORT defaults to 5432, HOST to \"localhost\", and PASSWORD to an empty string. If TLS-OPTIONS is non-NIL, attempt to establish an encrypted connection to PostgreSQL passing TLS-OPTIONS to `gnutls-negotiate'. To use client certificates to authenticate the TLS connection, use a value of TLS-OPTIONS of the form `(:keylist ((,key ,cert)))', where `key' is the filename of the client certificate private key and `cert' is the filename of the client certificate. These are passed to GnuTLS. Variable SERVER-VARIANT can be used to specify that we are connecting to a specific semi-compatible PostgreSQL variant. This may be useful if the variant cannot be autodetected by pg-el but you would like to run specific code in `pg-do-variant-specific-setup'" (let* ((buf (generate-new-buffer " *PostgreSQL*")) (process (open-network-stream "postgres" buf host port :coding nil ;; :nowait t :nogreeting t)) (con (make-pgcon :dbname dbname :process process))) (when server-variant (setf (pgcon-server-variant con) server-variant)) ;; Emacs supports disabling the Nagle algorithm, i.e. enabling TCP_NODELAY on this connection as ;; of version 31.x. We do that if possible as it leads to a huge performance improvement for TCP ;; connections (increasing throughput by a factor of 12 in our test suite, for example). (when (featurep 'make-network-process :nodelay) (set-network-process-option process :nodelay t)) (unless (zerop pg-connect-timeout) (setf (pgcon-connect-timer con) (run-at-time pg-connect-timeout nil (lambda () (unless (memq (process-status process) '(open listen)) (delete-process process) (kill-buffer buf) (signal 'pg-connect-timeout (list "PostgreSQL connection timed out"))))))) (with-current-buffer buf (set-process-coding-system process 'binary 'binary) (set-buffer-multibyte nil) (setq-local pgcon--position 1 pgcon--busy t pgcon--notification-handlers (list))) ;; Save connection info in the pgcon object, for possible later use by pg-cancel (setf (pgcon-connect-info con) (list :tcp host port dbname user password)) ;; TLS connections to PostgreSQL are based on a custom STARTTLS-like connection upgrade ;; handshake. The frontend establishes an unencrypted network connection to the backend over the ;; standard port (normally 5432). It then sends an SSLRequest message, indicating the desire to ;; establish an encrypted connection. The backend responds with ?S to indicate that it is able ;; to support an encrypted connection. The frontend then runs TLS negociation to upgrade the ;; connection to an encrypted one. (when tls-options (require 'gnutls) (require 'network-stream) (unless (gnutls-available-p) (signal 'pg-error '("Connecting over TLS requires GnuTLS support in Emacs"))) ;; send the SSLRequest message (pg-send-uint con 8 4) (pg-send-uint con 80877103 4) (pg-flush con) (let ((ch (pg-read-char con))) (unless (eql ?S ch) (let ((msg (format "Couldn't establish TLS connection to PostgreSQL: read char %s" ch))) (signal 'pg-protocol-error (list msg))))) ;; FIXME could use tls-options as third arg to network-stream-certificate (let* ((cert (network-stream-certificate host port nil)) (opts (append (list :process process) (list :hostname host) (when cert (list :keylist cert)) (when (listp tls-options) tls-options)))) (condition-case err ;; now do STARTTLS-like connection upgrade (apply #'gnutls-negotiate opts) (gnutls-error (let ((msg (format "TLS error connecting to PostgreSQL: %s" (error-message-string err)))) (signal 'pg-protocol-error (list msg))))))) ;; the remainder of the startup sequence is common to TCP and Unix socket connections (pg-do-startup con dbname user password))) (cl-defun pg-connect-local (path dbname user &optional (password "")) "Initiate a connection with the PostgreSQL backend over local Unix socket PATH. Connect to the database DBNAME with the username USER, providing PASSWORD if necessary. Return a connection to the database (as an opaque type). PASSWORD defaults to an empty string." (let* ((buf (generate-new-buffer " *PostgreSQL*")) (process (make-network-process :name "postgres" :buffer buf :family 'local :service path :coding nil)) (connection (make-pgcon :dbname dbname :process process))) ;; Save connection info in the pgcon object, for possible later use by pg-cancel (setf (pgcon-connect-info connection) (list :local path nil dbname user password)) (with-current-buffer buf (set-process-coding-system process 'binary 'binary) (set-buffer-multibyte nil) (setq-local pgcon--position 1 pgcon--busy t pgcon--notification-handlers (list))) (pg-do-startup connection dbname user password))) ;; e.g. "host=localhost port=5432 dbname=mydb connect_timeout=10" ;; see https://www.postgresql.org/docs/current/libpq-connect.html#LIBPQ-PARAMKEYWORDS (defun pg-connect/string (connection-string) "Connect to PostgreSQL with parameters specified by CONNECTION-STRING. A connection string is of the form `host=localhost port=5432 dbname=mydb'. We do not support all the parameter keywords supported by libpq, such as those which specify particular aspects of the TCP connection to PostgreSQL (e.g. keepalives_interval). The supported keywords are host, hostaddr, port, dbname, user, password, sslmode (partial support), connect_timeout, client_encoding and application_name." (let* ((components (split-string connection-string "[ \t]" t)) (params (cl-loop for c in components for param-val = (split-string c "=" t "\s") unless (eql 2 (length param-val)) do (error "Invalid connection string component %s" c) collect (cons (cl-first param-val) (cl-second param-val)))) (host (or (cdr (assoc "host" params)) (cdr (assoc "hostaddr" params)) (getenv "PGHOST") (getenv "PGHOSTADDR") "localhost")) (port (or (cdr (assoc "port" params)) (getenv "PGPORT") 5432)) (dbname (or (cdr (assoc "dbname" params)) (getenv "PGDATABASE") (error "Database name not specified in connection string or PGDATABASE environment variable"))) (user (or (cdr (assoc "user" params)) (getenv "PGUSER") (error "User not specified in connection string or PGUSER environment variable"))) (password (or (cdr (assoc "password" params)) (getenv "PGPASSWORD"))) (sslmode (or (cdr (assoc "sslmode" params)) (getenv "PGSSLMODE"))) (tls (cond ((string= sslmode "disable") nil) ((string= sslmode "allow") t) ((string= sslmode "prefer") t) ((string= sslmode "require") t) ((string= sslmode "verify-ca") (error "verify-ca sslmode not implemented")) ((string= sslmode "verify-full") (error "verify-full sslmode not implemented")) ((cdr (assoc "requiressl" params)) t) (t nil))) (connect-timeout-str (cadr (assoc "connect_timeout" params))) (connect-timeout (and connect-timeout-str (cl-parse-integer connect-timeout-str))) (pg-connect-timeout (or connect-timeout pg-connect-timeout)) ;; This "read_timeout" is a non-standard extension that we implement (read-timeout-str (cadr (assoc "read_timeout" params))) (read-timeout (and read-timeout-str (cl-parse-integer read-timeout-str))) (pg-read-timeout (or read-timeout pg-read-timeout)) (pg-application-name (or (cdr (assoc "application_name" params)) pg-application-name)) (client-encoding-str (cadr (assoc "client_encoding" params))) (client-encoding (and client-encoding-str (pg-normalize-encoding-name client-encoding-str)))) ;; TODO: should handle sslcert, sslkey variables ;; ;; Some of the parameters are taken from our local variable bindings, but for other parameters we ;; need to set them explicitly in the pgcon object. (let ((con (pg-connect dbname user password host port tls))) (when client-encoding (setf (pgcon-client-encoding con) client-encoding)) con))) (defun pg-parse-url (url) "Adaptation of function `url-generic-parse-url' that does not downcase the host component of the URL." (if (null url) (url-parse-make-urlobj) (with-temp-buffer ;; Don't let those temp-buffer modifications accidentally ;; deactivate the mark of the current-buffer. (let ((deactivate-mark nil)) (set-syntax-table url-parse-syntax-table) (erase-buffer) (insert url) (goto-char (point-min)) (let ((save-pos (point)) scheme user pass host port file fragment full (inhibit-read-only t)) ;; 3.1. Scheme ;; This is nil for a URI that is not fully specified. (when (looking-at "\\([a-zA-Z][-a-zA-Z0-9+.]*\\):") (goto-char (match-end 0)) (setq save-pos (point)) (setq scheme (downcase (match-string 1)))) ;; 3.2. Authority (when (looking-at "//") (setq full t) (forward-char 2) (setq save-pos (point)) (skip-chars-forward "^/?#") (setq host (buffer-substring save-pos (point))) ;; 3.2.1 User Information (if (string-match "^\\([^@]+\\)@" host) (setq user (match-string 1 host) host (substring host (match-end 0)))) (if (and user (string-match "\\`\\([^:]*\\):\\(.*\\)" user)) (setq pass (match-string 2 user) user (match-string 1 user))) (cond ;; IPv6 literal address. ((string-match "^\\(\\[[^]]+\\]\\)\\(?::\\([0-9]*\\)\\)?$" host) (setq port (match-string 2 host) host (match-string 1 host))) ;; Registered name or IPv4 address. ((string-match ":\\([0-9]*\\)$" host) (setq port (match-string 1 host) host (substring host 0 (match-beginning 0))))) (cond ((equal port "") (setq port nil)) (port (setq port (cl-parse-integer port))))) ;; Now point is on the / ? or # which terminates the ;; authority, or at the end of the URI, or (if there is no ;; authority) at the beginning of the absolute path. (setq save-pos (point)) (if (string= "data" scheme) ;; For the "data" URI scheme, all the rest is the FILE. (setq file (buffer-substring save-pos (point-max))) ;; For hysterical raisins, our data structure returns the ;; path and query components together in one slot. ;; 3.3. Path (skip-chars-forward "^?#") ;; 3.4. Query (when (looking-at "\\?") (skip-chars-forward "^#")) (setq file (buffer-substring save-pos (point))) ;; 3.5 Fragment (when (looking-at "#") (let ((opoint (point))) (forward-char 1) (setq fragment (buffer-substring (point) (point-max))) (delete-region opoint (point-max))))) (if (and host (string-match "%[0-9][0-9]" host)) (setq host (url-unhex-string host))) (url-parse-make-urlobj scheme user pass host port file fragment nil full)))))) ;; postgresql://[userspec@][hostspec][/dbname][?paramspec] ;; Examples: ;; - postgresql://other@localhost/otherdb?connect_timeout=10&application_name=myapp&ssl=true ;; - postgresql://%2Fvar%2Flib%2Fpostgresql/dbname ;; ;; https://www.postgresql.org/docs/current/libpq-connect.html (defun pg-connect/uri (uri) "Connect to PostgreSQL with parameters specified by URI. A connection URI is of the form `postgresql://[userspec@][hostspec][/dbname][?paramspec]'. `userspec' is of the form username:password. If hostspec is a string representing a local path (e.g. `%2Fvar%2Flib%2Fpostgresql' with percent-encoding) then it is interpreted as a Unix pathname used for a local Unix domain connection. We do not support all the paramspec keywords supported by libpq, such as those which specify particular aspects of the TCP connection to PostgreSQL (e.g. keepalives_interval). The supported paramspec keywords are sslmode (partial support) and application_name." (let* ((parsed (pg-parse-url uri)) (scheme (url-type parsed))) (unless (or (string= "postgres" scheme) (string= "postgresql" scheme)) (let ((msg (format "Invalid protocol %s in connection URI" scheme))) (signal 'pg-programming-error (list msg)))) ;; FIXME unfortunately the url-host is being downcased by url-generic-parse-url, which is ;; incorrect when the hostname is specifying a local path. (let* ((host (url-unhex-string (url-host parsed))) (parsed-user (url-user parsed)) (parsed-password (url-password parsed)) (user (or (when parsed-user (url-unhex-string parsed-user)) (getenv "PGUSER"))) (password (or (when parsed-password (url-unhex-string parsed-password)) (getenv "PGPASSWORD"))) (port (or (url-portspec parsed) (getenv "PGPORT") 5432)) (path-query (url-path-and-query parsed)) (dbname (or (and (car path-query) ;; ignore the "/" prefix (substring (car path-query) 1)) (getenv "PGDATABASE") (signal 'pg-programming-error '("Missing database name in connection URI")))) (params (cdr path-query)) ;; this is returning a list of lists, not an alist (params (and params (url-parse-query-string params))) (sslmode (or (cadr (assoc "sslmode" params)) (getenv "PGSSLMODE"))) (tls (cond ((string= sslmode "disable") nil) ((string= sslmode "allow") t) ((string= sslmode "prefer") t) ((string= sslmode "require") t) ((string= sslmode "verify-ca") (signal 'pg-error '("verify-ca sslmode not implemented"))) ((string= sslmode "verify-full") (signal 'pg-error '("verify-full sslmode not implemented"))) ((cdr (assoc "requiressl" params)) t) (t nil))) ;; Should be a decimal integer designating a number of seconds (connect-timeout-str (cadr (assoc "connect_timeout" params))) (connect-timeout (and connect-timeout-str (cl-parse-integer connect-timeout-str))) (pg-connect-timeout (or connect-timeout pg-connect-timeout)) ;; This "read_timeout" is a non-standard extension that we implement (read-timeout-str (cadr (assoc "read_timeout" params))) (read-timeout (and read-timeout-str (cl-parse-integer read-timeout-str))) (pg-read-timeout (or read-timeout pg-read-timeout)) (pg-application-name (or (cadr (assoc "application_name" params)) pg-application-name)) (client-encoding-str (cadr (assoc "client_encoding" params))) (client-encoding (and client-encoding-str (pg-normalize-encoding-name client-encoding-str)))) ;; If the host is empty or looks like an absolute pathname, connect over Unix-domain socket. (let ((con (if (or (zerop (length host)) (eq ?/ (aref host 0))) (pg-connect-local host dbname user password) (pg-connect dbname user password host port tls)))) (when client-encoding (setf (pgcon-client-encoding con) client-encoding)) con)))) ;; Called from pg-parameter-change-functions when we receive a ParameterStatus ;; message of type name=value from the backend. If the status message concerns ;; the client encoding, update the value recorded in the connection. (defun pg-handle-parameter-client-encoding (con name value) (when (string= "client_encoding" name) (let ((ce (pg-normalize-encoding-name value))) (if ce (setf (pgcon-client-encoding con) ce) (let ((msg (format "Don't know the Emacs equivalent for client encoding %s" value))) (signal 'pg-error (list msg))))))) (defun pg-add-notification-handler (con handler) "Register HANDLER for NotificationResponse messages on CON. A handler takes two arguments: the channel and the payload. These correspond to SQL-level NOTIFY channel, \\='payload\\='." (with-current-buffer (process-buffer (pgcon-process con)) (push handler pgcon--notification-handlers))) (cl-defun pg-exec (con &rest args) "Execute the SQL command given by concatenating ARGS on database CON. Return a result structure which can be decoded using `pg-result'." (pg-connection-set-busy con t) (let* ((sql (apply #'concat args)) (tuples (list)) (attributes (list)) (result (make-pgresult :connection con)) (ce (pgcon-client-encoding con)) (encoded (if ce (encode-coding-string sql ce t) sql))) ;; Ensure that the SQL string is encodable with the current client-encoding system. The function ;; `encode-coding-string' does not trigger an error, but rather silently replaces characters ;; that can't be encoded with '?' or ' '; we don't want to send this corrupted SQL string to ;; PostgreSQL. Unfortunately there does not seem to be any more efficient solution than ;; searching through the list returned by `find-coding-systems-string'. Also note that this ;; check only works if we are using the canonical name for an encoding system, and doesn't work ;; for coding system aliases (eg. 'latin-1 for 'iso-latin-1). We ensure that we are not using ;; aliases in the values contained in pg--encoding-names. (when ce (let ((codings (find-coding-systems-string sql))) (unless (or (eq 'undecided (car codings)) (memq ce codings)) (let ((msg (format "Can't encode `%s' with current client encoding %s" sql ce))) (signal 'pg-encoding-error (list msg)))))) ;; (message "pg-exec: %s" sql) (when (pgcon-query-log con) (with-current-buffer (pgcon-query-log con) (insert sql "\n"))) (let ((len (length encoded))) (when (> len (- (expt 2 32) 5)) (signal 'pg-user-error (list "Query is too large"))) (pg-send-char con ?Q) (pg-send-uint con (+ 4 len 1) 4) (pg-send-string con encoded)) (cl-loop for c = (pg-read-char con) do ;; (message "pg-exec message-type = %c" c) (cl-case c ;; NoData (?n (pg-read-net-int con 4)) ;; NotificationResponse (?A (let* ((_msglen (pg-read-net-int con 4)) ;; PID of the notifying backend (_pid (pg-read-int con 4)) (channel (pg-read-string con)) (payload (pg-read-string con)) (buf (process-buffer (pgcon-process con))) (handlers (with-current-buffer buf pgcon--notification-handlers))) (dolist (handler handlers) (funcall handler channel payload)))) ;; Bind -- should not receive this here (?B (unless attributes (signal 'pg-protocol-error (list "Tuple received before metadata"))) (let ((_msglen (pg-read-net-int con 4))) (push (pg-read-tuple con attributes) tuples))) ;; CommandComplete -- one SQL command has completed (?C (let* ((msglen (pg-read-net-int con 4)) (msg (pg-read-chars con (- msglen 5))) (_null (pg-read-char con))) (setf (pgresult-status result) msg))) ;; now wait for the ReadyForQuery message ;; DataRow (?D (let ((_msglen (pg-read-net-int con 4))) (push (pg-read-tuple con attributes) tuples))) ;; ErrorResponse (?E (pg-handle-error-response con "in pg-exec")) ;; EmptyQueryResponse -- response to an empty query string (?I (pg-read-net-int con 4) (setf (pgresult-status result) "EMPTY")) ;; BackendKeyData (?K (let ((_msglen (pg-read-net-int con 4))) (setf (pgcon-pid con) (pg-read-net-int con 4)) (setf (pgcon-secret con) (pg-read-net-int con 4)))) ;; NoticeResponse (?N ;; a Notice response has the same structure and fields as an ErrorResponse (let ((notice (pg-read-error-response con))) ;; This is rather ugly, but seems to be the only way of detecting YottaDB Octo on startup. (when (string= "INFO" (pgerror-severity notice)) (when (string-prefix-p "Generating M file [" (pgerror-message notice)) (setf (pgcon-server-variant con) 'octodb))) (dolist (handler pg-handle-notice-functions) (funcall handler notice)))) ;; CursorResponse (?P (let ((portal (pg-read-string con))) (setf (pgresult-portal result) portal))) ;; ParameterStatus sent in response to a user update over the connection (?S (let* ((msglen (pg-read-net-int con 4)) (msg (pg-read-chars con (- msglen 4))) (items (split-string msg (string 0)))) ;; ParameterStatus items sent by the backend include application_name, ;; DateStyle, TimeZone, in_hot_standby, integer_datetimes (when (> (length (cl-first items)) 0) (dolist (handler pg-parameter-change-functions) (funcall handler con (cl-first items) (cl-second items)))))) ;; RowDescription (?T (when attributes (signal 'pg-protocol-error (list "Cannot handle multiple result group"))) (setq attributes (pg-read-attributes con))) ;; CopyFail (?f (let* ((msglen (pg-read-net-int con 4)) (msg (pg-read-chars con (- msglen 4)))) (message "Unexpected CopyFail message %s" msg))) ;; ParseComplete -- not expecting this using the simple query protocol (?1 (pg-read-net-int con 4)) ;; BindComplete -- not expecting this using the simple query protocol (?2 (pg-read-net-int con 4)) ;; CloseComplete -- not expecting this using the simple query protocol (?3 (pg-read-net-int con 4)) ;; PortalSuspended -- this message is not expected using the simple query protocol (?s (message "Unexpected PortalSuspended message in pg-exec (sql was %s)" sql) (pg-read-net-int con 4) (setf (pgresult-incomplete result) t) (setf (pgresult-tuples result) (nreverse tuples)) (setf (pgresult-status result) "SUSPENDED") (pg-connection-set-busy con nil) (cl-return-from pg-exec result)) ;; ReadyForQuery (?Z (let ((_msglen (pg-read-net-int con 4)) (status (pg-read-char con))) ;; status is 'I' or 'T' or 'E', Idle or InTransaction or Error (when (eql ?E status) (message "PostgreSQL ReadyForQuery message with error status")) (setf (pgresult-tuples result) (nreverse tuples)) (setf (pgresult-attributes result) attributes) (pg-connection-set-busy con nil) (cl-return-from pg-exec result))) (t (let ((msg (format "Unknown response type from backend in pg-exec: %s" c))) (signal 'pg-protocol-error (list msg)))))))) (defun pg-result (result what &rest arg) "Extract WHAT component of RESULT. RESULT should be a structure obtained from a call to `pg-exec', and the keyword WHAT should be one of :connection -> return the connection object :status -> return the status string provided by the database :attributes -> return the metadata, as a list of lists :incomplete -> are more rows pending in the portal :tuples -> return the data, as a list of lists :tuple n -> return the nth component of the data :oid -> return the OID (a unique identifier generated by PostgreSQL for each row resulting from an insertion)" (cl-case what (:connection (pgresult-connection result)) (:status (pgresult-status result)) (:attributes (pgresult-attributes result)) (:incomplete (pgresult-incomplete result)) (:tuples (pgresult-tuples result)) (:tuple (let ((which (if (integerp (car arg)) (car arg) (let ((msg (format "%s is not an integer" arg))) (signal 'pg-programming-error (list msg))))) (tuples (pgresult-tuples result))) (nth which tuples))) (:oid (let ((status (pgresult-status result))) (if (string= "INSERT" (substring status 0 6)) (cl-parse-integer (substring status 7 (cl-position ? status :start 7))) (let ((msg (format "Only INSERT commands generate an oid: %s" status))) (signal 'pg-programming-error (list msg)))))) (t (let ((msg (format "Unknown result request %s" what))) (signal 'pg-programming-error (list msg)))))) (defun pg--escape-identifier-simple (str) (with-temp-buffer (insert ?\") (cl-loop for c across str do (when (eql c ?\") (insert ?\")) (insert c)) (insert ?\") (buffer-string))) ;; Similar to libpq function PQescapeIdentifier. ;; See https://www.postgresql.org/docs/current/libpq-exec.html#LIBPQ-EXEC-ESCAPE-STRING ;; ;; This function can help to prevent SQL injection attacks ("Little Bobby Tables", ;; https://xkcd.com/327/) in situations where you can't use a prepared statement (a parameterized ;; query, using the prepare/bind/execute extended query message flow in PostgreSQL). You might need ;; this for example when specifying the name of a column in a SELECT statement. See function ;; `pg-exec-prepared' which should be used when possible instead of relying on this function. (defun pg-escape-identifier (identifier) "Escape and quote an SQL identifier, such as a table, column, or function name. IDENTIFIER can be a string or a pg-qualified-name (including a schema specifier). Similar to libpq function PQescapeIdentifier. You should use prepared statements (`pg-exec-prepared') instead of this function whenever possible." (cond ((pg-qualified-name-p identifier) (let ((schema (pg-qualified-name-schema identifier)) (name (pg-qualified-name-name identifier))) (if schema (format "%s.%s" (pg--escape-identifier-simple schema) (pg--escape-identifier-simple name)) (pg--escape-identifier-simple name)))) (t (pg--escape-identifier-simple identifier)))) (defun pg-escape-literal (string) "Escape STRING for use within an SQL command. Similar to libpq function PQescapeLiteral. You should use prepared statements (`pg-exec-prepared') instead of this function whenever possible." (with-temp-buffer (insert ?E) (insert ?\') (cl-loop for c across string do (when (eql c ?\') (insert ?\')) (when (eql c ?\\) (insert ?\\)) (insert c)) (insert ?\') (buffer-string))) ;; We look up the type-name in our OID cache. If it's not found, we force a refresh of our OID ;; cache, because a new type might have been defined using CREATE TYPE, either in this session since ;; connection establishment when we populated the cache, or in a parallel connection to PostgreSQL. (defun pg--lookup-oid (con type-name) "Return the PostgreSQL OID associated with TYPE-NAME. This may force a refresh of the OID-typename cache if TYPE-NAME is not known. Uses PostgreSQL connection CON." (let ((oid-by-typname (pgcon-oid-by-typname con))) (or (gethash type-name oid-by-typname) (progn (pg-initialize-parsers con) (gethash type-name oid-by-typname))))) ;; This version that errors on unknown OID is deprecated. (defun pg--lookup-type-name (con oid) "Return the PostgreSQL type name associated with OID. Uses PostgreSQL connection CON." (let ((typname-by-oid (pgcon-typname-by-oid con))) (or (gethash oid typname-by-oid) (progn (pg-initialize-parsers con) (or (gethash oid typname-by-oid) (let ((msg (format "Unknown PostgreSQL oid %d" oid))) (signal 'pg-error (list msg)))))))) (defun pg-lookup-type-name (con oid) "Return the PostgreSQL type name associated with OID. Uses PostgreSQL connection CON." (let ((typname-by-oid (pgcon-typname-by-oid con))) (or (gethash oid typname-by-oid) (let* ((sql "SELECT typname FROM pg_catalog.pg_type WHERE oid=$1") (res (pg-exec-prepared con sql `((,oid . "int4")))) (maybe-name (cl-first (pg-result res :tuple 0)))) (when maybe-name (setf (gethash oid typname-by-oid) maybe-name)) maybe-name)))) (cl-defun pg-prepare (con query argument-types &key (name "")) "Prepare statement QUERY with ARGUMENT-TYPES on connection CON. The prepared statement may be given optional NAME (defaults to an unnamed prepared statement). ARGUMENT-TYPES is a list of PostgreSQL type names of the form (\"int4\" \"text\" \"bool\"). Returns the prepared statement name (a string)." (cl-flet ((oid-for (type-name) ;; If we have defined a serializer for type-name and we know the corresponding OID, we ;; will be sending this type in binary form: return that OID. Otherwise, return the ;; pseudo-OID value of 0 to tell PostgreSQL that we are sending this type in text ;; format. (if (gethash type-name pg--serializers) (or (pg--lookup-oid con type-name) (let ((msg (format "Don't know the OID for PostgreSQL type %s" type-name))) (signal 'pg-error (list msg)))) 0))) (let* ((ce (pgcon-client-encoding con)) (query/enc (if ce (encode-coding-string query ce t) query)) (oids (mapcar #'oid-for argument-types)) (len (+ 4 (1+ (length name)) (1+ (length query/enc)) 2 (* 4 (length oids))))) ;; send a Parse message (pg-connection-set-busy con t) (pg-send-char con ?P) (pg-send-uint con len 4) (pg-send-string con name) (pg-send-string con query/enc) (pg-send-uint con (length oids) 2) (dolist (oid oids) (pg-send-uint con oid 4))) name)) (cl-defun pg-bind (con statement-name typed-arguments &key (portal "")) "Bind the SQL prepared statement STATEMENT-NAME to TYPED-ARGUMENTS. The STATEMENT-NAME should have been returned by function `pg-prepare'. TYPE-ARGUMENTS is a list of the form ((42 . \"int4\") (\"foo\" . \"text\")). Uses PostgreSQL connection CON." (let* ((ce (pgcon-client-encoding con)) (argument-values (mapcar #'car typed-arguments)) (argument-types (mapcar #'cdr typed-arguments)) (serialized-values (cl-loop for typ in argument-types for v in argument-values for serializer = (gethash typ pg--serializers) collect (cond ((gethash typ pg--textual-serializers) ;; this argument will be sent as text (cons (funcall serializer v ce) 0)) (serializer ;; this argument will be sent in binary format (cons (funcall serializer v ce) 1)) (t ;; this argument will be sent in text format, raw (let* ((raw (if (stringp v) v (format "%s" v))) (encoded (if ce (encode-coding-string raw ce t) raw))) (cons encoded 0)))))) (len (+ 4 (1+ (length portal)) (1+ (length statement-name)) 2 (* 2 (length argument-types)) 2 (cl-loop for v in (mapcar #'car serialized-values) sum (+ 4 (length v))) 2))) (when (> len (expt 2 32)) (signal 'pg-user-error (list "Field is too large"))) ;; send a Bind message (pg-send-char con ?B) (pg-send-uint con len 4) ;; the destination portal (pg-send-string con portal) (pg-send-string con statement-name) (pg-send-uint con (length argument-types) 2) (cl-loop for (_ . binary-p) in serialized-values do (pg-send-uint con binary-p 2)) (pg-send-uint con (length argument-values) 2) (cl-loop for (v . _) in serialized-values do (if (null v) ;; for a null value, send -1 followed by zero octets for the value (pg-send-uint con -1 4) (let ((len (length v))) (when (> len (expt 2 32)) (signal 'pg-user-error (list "Field is too large"))) (pg-send-uint con len 4) (pg-send-octets con v)))) ;; the number of result-column format codes: we use zero to indicate that result columns can use ;; text format (pg-send-uint con 0 2) portal)) (defun pg-describe-portal (con portal) (let ((len (+ 4 1 (1+ (length portal))))) ;; send a Describe message for this portal (pg-send-char con ?D) (pg-send-uint con len 4) (pg-send-char con ?P) (pg-send-string con portal))) (cl-defun pg-execute (con portal &key (max-rows 0)) (let* ((ce (pgcon-client-encoding con)) (pn/encoded (if ce (encode-coding-string portal ce t) portal)) (len (+ 4 (1+ (length pn/encoded)) 4))) ;; send an Execute message (pg-send-char con ?E) (pg-send-uint con len 4) ;; the destination portal (pg-send-string con pn/encoded) ;; Maximum number of rows to return; zero means "no limit" (pg-send-uint con max-rows 4))) (cl-defun pg-fetch (con result &key (max-rows 0)) "Fetch pending rows from portal in RESULT on database connection CON. Retrieve at most MAX-ROWS rows (default value of zero means no limit). Returns a pgresult structure (see function `pg-result')." (let* ((tuples (list)) (attributes (pgresult-attributes result))) (setf (pgresult-status result) nil) ;; We are counting on the Describe message having been sent prior to calling pg-fetch. (pg-execute con (pgresult-portal result) :max-rows max-rows) ;; If we are requesting a subset of available rows, we send a Flush message instead of a Sync ;; message, otherwise our unnamed portal will be closed by the Sync message and we won't be able ;; to retrieve more rows on the next call to pg-fetch. (cond ((zerop max-rows) ;; send a Sync message (pg-send-char con ?S) (pg-send-uint con 4 4)) (t ;; send a Flush message (pg-send-char con ?H) (pg-send-uint con 4 4))) ;; In the extended query protocol, the Execute phase is always terminated by the appearance of ;; exactly one of these messages: CommandComplete, EmptyQueryResponse (if the portal was created ;; from an empty query string), ErrorResponse, or PortalSuspended. (cl-loop for c = (pg-read-char con) do ;; (message "pg-fetch got %c" c) (cl-case c ;; ParseComplete (?1 (pg-read-net-int con 4)) ;; BindComplete (?2 (pg-read-net-int con 4)) ;; NotificationResponse (?A (let* ((_msglen (pg-read-net-int con 4)) ;; PID of the notifying backend (_pid (pg-read-int con 4)) (channel (pg-read-string con)) (payload (pg-read-string con)) (buf (process-buffer (pgcon-process con))) (handlers (with-current-buffer buf pgcon--notification-handlers))) (dolist (handler handlers) (funcall handler channel payload)))) ;; ParameterStatus (?S (let* ((msglen (pg-read-net-int con 4)) (msg (pg-read-chars con (- msglen 4))) (items (split-string msg (string 0))) (key (cl-first items)) (val (cl-second items))) ;; ParameterStatus items sent by the backend include application_name, ;; DateStyle, in_hot_standby, integer_datetimes (when (> (length key) 0) (dolist (handler pg-parameter-change-functions) (funcall handler con key val))))) ;; RowDescription (?T (when attributes (signal 'pg-protocol-error (list "Cannot handle multiple result group"))) (setq attributes (pg-read-attributes con)) (setf (pgresult-attributes result) attributes)) ;; DataRow message (?D (let ((_msglen (pg-read-net-int con 4))) (push (pg-read-tuple con attributes) tuples))) ;; PortalSuspended -- the row-count limit for the Execute message was reached; more data is ;; available with another Execute message. (?s (unless (> max-rows 0) (message "Unexpected PortalSuspended message in pg-exec-prepared")) (pg-read-net-int con 4) (setf (pgresult-incomplete result) t) (setf (pgresult-tuples result) (nreverse tuples)) (setf (pgresult-status result) "SUSPENDED") (pg-connection-set-busy con nil) (cl-return-from pg-fetch result)) ;; CommandComplete -- one SQL command has completed (portal's execution is completed) (?C (let* ((msglen (pg-read-net-int con 4)) (msg (pg-read-chars con (- msglen 5))) (_null (pg-read-char con))) (setf (pgresult-status result) msg)) (setf (pgresult-incomplete result) nil) (when (> max-rows 0) ;; send a Sync message to close the portal and request the ReadyForQuery (pg-send-char con ?S) (pg-send-uint con 4 4) (pg-flush con))) ;; EmptyQueryResponse -- the response to an empty query string (?I (pg-read-net-int con 4) (setf (pgresult-status result) "EMPTY") (setf (pgresult-incomplete result) nil)) ;; NoData message (?n (pg-read-net-int con 4)) ;; ErrorResponse (?E (pg-handle-error-response con)) ;; NoticeResponse (?N (let ((notice (pg-read-error-response con))) (dolist (handler pg-handle-notice-functions) (funcall handler notice)))) ;; CursorResponse (?P (let ((portal (pg-read-string con))) (setf (pgresult-portal result) portal))) ;; ReadyForQuery (?Z (let ((_msglen (pg-read-net-int con 4)) (status (pg-read-char con))) ;; status is 'I' or 'T' or 'E', Idle or InTransaction or Error (when (eql ?E status) (message "PostgreSQL ReadyForQuery message with error status")) (setf (pgresult-tuples result) (nreverse tuples)) (pg-connection-set-busy con nil) (cl-return-from pg-fetch result))) (t (message "Received unexpected message type %s in pg-fetch" c)))))) ;; Do a PARSE/BIND/EXECUTE sequence, using the Extended Query message flow. ;; ;; We are careful here to only send a single Describe message even in the case of a multifetch ;; request (retrieving rows progressively with multiple calls to pg-fetch). The attribute ;; information from the initial Describe message is maintained in the pgresult struct that serves as ;; a handle for the pg-fetch requests. ;; ;; We default to using an empty prepared-statement name and empty portal name because PostgreSQL has ;; a fast path for these queries. ;; ;; The user can also use the extended query protocol at a lower level by calling pg-prepare, pg-bind ;; and pg-fetch explicitly (for example, binding a prepared statement to different values in a ;; loop). (cl-defun pg-exec-prepared (con query typed-arguments &key (max-rows 0) (portal "")) "Execute SQL QUERY using TYPED-ARGUMENTS on database connection CON. Query can contain numbered parameters ($1, $2 etc.) that are bound to the values in TYPED-ARGUMENTS, which is a list of the form \\='((42 . \"int4\") (\"42\" . \"text\")). This uses PostgreSQL's parse/bind/execute extended query protocol for prepared statements, which allows parameterized queries to avoid SQL injection attacks. Returns a pgresult structure that can be decoded with function `pg-result'. It returns at most MAX-ROWS rows (a value of zero indicates no limit). If more rows are available, they can later be retrieved with `pg-fetch'." ;; (message "pg-exec-prepared: %s with %s" query typed-arguments) (when (pgcon-query-log con) (with-current-buffer (pgcon-query-log con) (insert query "\n") (insert (format " %s\n" typed-arguments)))) (let* ((argument-types (mapcar #'cdr typed-arguments)) (ps-name (pg-prepare con query argument-types)) (portal-name (pg-bind con ps-name typed-arguments :portal portal)) (result (make-pgresult :connection con :portal portal-name))) (pg-describe-portal con portal-name) (pg-fetch con result :max-rows max-rows))) (defun pg-ensure-prepared-statement (con ps-name sql argument-types) "Return a prepared-statement named PS-NAME for query SQL and ARGUMENT-TYPES. Either returns the previously prepared statement saved in the prepared statement cache of our connection CON, or prepares the statement using pg-prepare and saves it in the cache." (let* ((ps-cache (pgcon-prepared-statement-cache con)) (maybe-statement (gethash ps-name ps-cache))) (or maybe-statement (let ((ps (pg-prepare con sql argument-types :name ps-name))) (puthash ps-name ps ps-cache) ps)))) (defun pg-fetch-prepared (con ps-name typed-arguments) "Bind arguments to a prepared-statement and fetch results. PS-NAME is a previously prepared statement name from `pg-prepare' or `pg-ensure-prepared-statement'. Calls `pg-bind' to bind the TYPED-ARGUMENTS then fetches query results from PostgreSQL connection CON. Preparing a statement once then reusing it multiple times with different argument values allows you avoid the overhead of sending and parsing the SQL query and calculating the query plan." (let* ((portal-name (pg-bind con ps-name typed-arguments :portal "pgmacs")) (result (make-pgresult :connection con :portal portal-name))) (pg-describe-portal con portal-name) (prog1 (pg-fetch con result) (pg-close-portal con portal-name)))) (cl-defun pg-close-portal (con portal) "Close the portal named PORTAL that was opened by `pg-exec-prepared'. Uses PostgreSQL connection CON." (let ((len (+ 4 1 (1+ (length portal))))) ;; send a Close message (pg-send-char con ?C) (pg-send-uint con len 4) (pg-send-char con ?P) (pg-send-string con portal) ;; send a Sync message (pg-send-char con ?S) (pg-send-uint con 4 4) (pg-flush con) (cl-loop for c = (pg-read-char con) do (cl-case c ;; ParseComplete (?1 (pg-read-net-int con 4)) ;; CloseComplete (?3 (pg-read-net-int con 4)) ;; PortalSuspended: sent by some old PostgreSQL versions here? (?s (pg-read-net-int con 4)) ;; ErrorResponse (?E (pg-handle-error-response con)) ;; NoticeResponse (?N (let ((notice (pg-read-error-response con))) (dolist (handler pg-handle-notice-functions) (funcall handler notice)))) ;; ReadyForQuery (?Z (let ((_msglen (pg-read-net-int con 4)) (status (pg-read-char con))) ;; status is 'I' or 'T' or 'E' (when (eql ?E status) (message "PostgreSQL ReadyForQuery message with error status")) (cl-return-from pg-close-portal nil))) (t (message "Received unexpected message type %s in pg-close-portal" c)))))) (cl-defun pg-copy-from-buffer (con query buf) "Execute COPY FROM STDIN on the contents of BUF, according to QUERY. Uses PostgreSQL connection CON. Returns a result structure which can be decoded using `pg-result'." (unless (string-equal "COPY" (upcase (cl-subseq query 0 4))) (signal 'pg-programming-error (list "Invalid COPY query"))) (unless (cl-search "FROM STDIN" query) (signal 'pg-programming-error (list "COPY command must contain 'FROM STDIN'"))) (pg-connection-set-busy con t) (let ((result (make-pgresult :connection con)) (ce (pgcon-client-encoding con)) (len (length query))) (when (> len (expt 2 32)) (signal 'pg-user-error (list "Query is too large"))) (pg-send-char con ?Q) (pg-send-uint con (+ 4 len 1) 4) (pg-send-string con query) (pg-flush con) (let ((more-pending t)) (while more-pending (let ((c (pg-read-char con))) (cl-case c (?G ;; CopyInResponse (let ((_msglen (pg-read-net-int con 4)) (status (pg-read-net-int con 1)) (cols (pg-read-net-int con 2)) (format-codes (list))) ;; status=0, which will be returned by recent backend versions: the backend is ;; expecting data in textual format (rows separated by newlines, columns separated by ;; separator characters, etc.). ;; ;; status=1: the backend is expecting binary format (which is similar to DataRow ;; format, and which we don't implement here). (dotimes (_c cols) (push (pg-read-net-int con 2) format-codes)) (unless (zerop status) (signal 'pg-error (list "BINARY format for COPY is not implemented"))) (setq more-pending nil))) ;; NotificationResponse (?A (let* ((_msglen (pg-read-net-int con 4)) ;; PID of the notifying backend (_pid (pg-read-int con 4)) (channel (pg-read-string con)) (payload (pg-read-string con)) (buf (process-buffer (pgcon-process con))) (handlers (with-current-buffer buf pgcon--notification-handlers))) (dolist (handler handlers) (funcall handler channel payload)))) ;; ErrorResponse (?E (pg-handle-error-response con)) ;; ParameterStatus sent in response to a user update over the connection (?S (let* ((msglen (pg-read-net-int con 4)) (msg (pg-read-chars con (- msglen 4))) (items (split-string msg (string 0)))) (when (> (length (cl-first items)) 0) (dolist (handler pg-parameter-change-functions) (funcall handler con (cl-first items) (cl-second items)))))) (t (let ((msg (format "Unknown response type from backend in copy-from-buffer: %s" c))) (signal 'pg-protocol-error (list msg)))))))) ;; Send the input buffer in chunks 1000 lines long. (save-excursion (with-current-buffer buf (goto-char (point-min)) (while (not (eobp)) (let* ((chunk-start (point)) (chunk-end (progn (dotimes (_ 1000) (end-of-line) (unless (eobp) (forward-char))) (point))) (data (buffer-substring-no-properties chunk-start chunk-end)) (encoded (if ce (encode-coding-string data ce t) data))) ;; a CopyData message with the encoded data (pg-send-char con ?d) (pg-send-uint con (+ 4 (length encoded)) 4) (pg-send-octets con encoded))))) ;; send a CopyDone message (pg-send-char con ?c) (pg-send-uint con 4 4) (pg-flush con) ;; Backend sends us either CopyDone or CopyFail, followed by CommandComplete + ReadyForQuery (cl-loop for c = (pg-read-char con) do (cl-case c (?c ;; CopyDone (let ((_msglen (pg-read-net-int con 4))) nil)) ;; CopyFail (?f (let* ((msglen (pg-read-net-int con 4)) (msg (pg-read-chars con (- msglen 4))) (emsg (format "COPY failed: %s" msg))) (signal 'pg-copy-failed (list emsg)))) ;; CommandComplete -- SQL command has completed. After this we expect a ReadyForQuery message. (?C (let* ((msglen (pg-read-net-int con 4)) (msg (pg-read-chars con (- msglen 5))) (_null (pg-read-char con))) (setf (pgresult-status result) msg))) ;; NotificationResponse (?A (let* ((_msglen (pg-read-net-int con 4)) ;; PID of the notifying backend (_pid (pg-read-int con 4)) (channel (pg-read-string con)) (payload (pg-read-string con)) (buf (process-buffer (pgcon-process con))) (handlers (with-current-buffer buf pgcon--notification-handlers))) (dolist (handler handlers) (funcall handler channel payload)))) ;; ErrorResponse (?E (pg-handle-error-response con)) ;; ReadyForQuery message (?Z (let ((_msglen (pg-read-net-int con 4)) (status (pg-read-char con))) (when (eql ?E status) (message "PostgreSQL ReadyForQuery message with error status")) (pg-connection-set-busy con nil) (cl-return-from pg-copy-from-buffer result))) (t (let ((msg (format "Unknown response type from backend in copy-from-buffer/2: %s" c))) (signal 'pg-protocol-error (list msg)))))))) ;; https://www.postgresql.org/docs/current/sql-copy.html ;; and https://www.postgresql.org/docs/current/protocol-flow.html#PROTOCOL-COPY (cl-defun pg-copy-to-buffer (con query buf) "Execute COPY TO STDOUT on QUERY into the buffer BUF. Uses PostgreSQL connection CON. Returns a result structure which can be decoded using `pg-result'." (unless (string-equal "COPY" (upcase (cl-subseq query 0 4))) (signal 'pg-programming-error (list "Invalid COPY query"))) (unless (cl-search "TO STDOUT" query) (signal 'pg-programming-error (list "COPY command must contain 'TO STDOUT'"))) (pg-connection-set-busy con t) (let ((result (make-pgresult :connection con))) (pg-send-char con ?Q) (pg-send-uint con (+ 4 (length query) 1) 4) (pg-send-string con query) (pg-flush con) (let ((more-pending t)) (while more-pending (let ((c (pg-read-char con))) (cl-case c ;; CopyOutResponse (?H (let ((_msglen (pg-read-net-int con 4)) (status (pg-read-net-int con 1)) (cols (pg-read-net-int con 2)) (format-codes (list))) ;; status=0 indicates the overall COPY format is textual (rows separated by ;; newlines, columns separated by separator characters, etc.). 1 indicates the ;; overall copy format is binary (which we don't implement here). (dotimes (_c cols) (push (pg-read-net-int con 2) format-codes)) (unless (zerop status) (signal 'pg-error (list "BINARY format for COPY is not implemented"))) (setq more-pending nil))) ;; NotificationResponse (?A (let* ((_msglen (pg-read-net-int con 4)) ;; PID of the notifying backend (_pid (pg-read-int con 4)) (channel (pg-read-string con)) (payload (pg-read-string con)) (buf (process-buffer (pgcon-process con))) (handlers (with-current-buffer buf pgcon--notification-handlers))) (dolist (handler handlers) (funcall handler channel payload)))) ;; ErrorResponse (?E (pg-handle-error-response con)) ;; ParameterStatus sent in response to a user update over the connection (?S (let* ((msglen (pg-read-net-int con 4)) (msg (pg-read-chars con (- msglen 4))) (items (split-string msg (string 0)))) (when (> (length (cl-first items)) 0) (dolist (handler pg-parameter-change-functions) (funcall handler con (cl-first items) (cl-second items)))))) (t (let ((msg (format "Unknown response type from backend in copy-to-buffer: %s" c))) (signal 'pg-protocol-error (list msg)))))))) ;; Backend sends us CopyData, CopyDone or CopyFail, followed by CommandComplete + ReadyForQuery (with-current-buffer buf ;; TODO: set the buffer to CSV mode? (cl-loop for c = (pg-read-char con) do (cl-case c ;; CopyData (?d (let* ((msglen (pg-read-net-int con 4)) (payload (pg-read-chars-old con (- msglen 4))) (ce (pgcon-client-encoding con)) (decoded (if ce (decode-coding-string payload ce t) payload))) (insert decoded))) ;; CopyDone (?c (let ((_msglen (pg-read-net-int con 4))) nil)) ;; CopyFail (?f (let* ((msglen (pg-read-net-int con 4)) (msg (pg-read-chars con (- msglen 4))) (emsg (format "COPY failed: %s" msg))) (signal 'pg-copy-failed (list emsg)))) ;; CommandComplete -- SQL command has completed. After this we expect a ReadyForQuery message. (?C (let* ((msglen (pg-read-net-int con 4)) (msg (pg-read-chars con (- msglen 5))) (_null (pg-read-char con))) (setf (pgresult-status result) msg))) ;; NotificationResponse (?A (let* ((_msglen (pg-read-net-int con 4)) ;; PID of the notifying backend (_pid (pg-read-int con 4)) (channel (pg-read-string con)) (payload (pg-read-string con)) (buf (process-buffer (pgcon-process con))) (handlers (with-current-buffer buf pgcon--notification-handlers))) (dolist (handler handlers) (funcall handler channel payload)))) ;; ErrorResponse (?E (pg-handle-error-response con)) ;; ReadyForQuery message (?Z (let ((_msglen (pg-read-net-int con 4)) (status (pg-read-char con))) (when (eql ?E status) (message "PostgreSQL ReadyForQuery message with error status")) (pg-connection-set-busy con nil) (cl-return-from pg-copy-to-buffer result))) (t (let ((msg (format "Unknown response type from backend in copy-to-buffer/2: %s" c))) (signal 'pg-protocol-error (list msg))))))))) (defun pg-sync (con) (pg-connection-set-busy con t) ;; discard any content in our process buffer (with-current-buffer (process-buffer (pgcon-process con)) (setq-local pgcon--position (point-max))) (pg-send-char con ?S) (pg-send-uint con 4 4) (pg-flush con) (when (fboundp 'thread-yield) (thread-yield)) ;; Read the ReadyForQuery message (ignore-errors (let ((c (pg-read-char con))) (unless (eql c ?Z) (message "Unexpected message type after Sync: %s" c) (pg-unread-char con))) ;; Read message length then status, which we discard. (pg-read-net-int con 4) (pg-read-char con)) (pg-connection-set-busy con nil)) (defun pg-cancel (con) "Cancel the command currently being processed by the backend. The cancellation request concerns the command requested over connection CON." ;; Send a CancelRequest message. We open a new connection to the server and ;; send the CancelRequest message, rather than the StartupMessage message that ;; would ordinarily be sent across a new connection. The server will process ;; this request and then close the connection. (let* ((ci (pgcon-connect-info con)) (ccon (cl-case (car ci) ;; :tcp host port dbname user password (:tcp (let* ((buf (generate-new-buffer " *PostgreSQL-cancellation*")) (host (nth 1 ci)) (port (nth 2 ci)) (process (open-network-stream "postgres-cancel" buf host port :coding nil)) (connection (make-pgcon :process process))) (with-current-buffer buf (set-process-coding-system process 'binary 'binary) (set-buffer-multibyte nil) (setq-local pgcon--position 1) (setq-local pgcon--busy t) (setq-local pgcon--notification-handlers (list))) connection)) ;; :local path dbname user password (:local (let* ((buf (generate-new-buffer " *PostgreSQL-cancellation*")) (path (nth 1 ci)) (process (make-network-process :name "postgres" :buffer buf :family 'local :service path :coding nil)) (connection (make-pgcon :process process))) (with-current-buffer buf (set-process-coding-system process 'binary 'binary) (set-buffer-multibyte nil) (setq-local pgcon--position 1) (setq-local pgcon--busy t) (setq-local pgcon--notification-handlers (list))) connection))))) (pg-send-uint ccon 16 4) (pg-send-uint ccon 80877102 4) (pg-send-uint ccon (pgcon-pid con) 4) (pg-send-uint ccon (pgcon-secret con) 4) (pg-disconnect ccon))) (defun pg-disconnect (con) "Close the PostgreSQL connection CON. This command should be used when you have finished with the database. It will release memory used to buffer the data transfered between PostgreSQL and Emacs. CON should no longer be used." ;; send a Terminate message (pg-connection-set-busy con t) (pg-send-char con ?X) (pg-send-uint con 4 4) (pg-flush con) (delete-process (pgcon-process con)) (kill-buffer (process-buffer (pgcon-process con))) (when (pgcon-query-log con) (kill-buffer (pgcon-query-log con))) (clrhash (pgcon-parser-by-oid con)) (clrhash (pgcon-typname-by-oid con)) (clrhash (pgcon-oid-by-typname con))) ;; type coercion support ============================================== ;; ;; When returning data from a SELECT statement, PostgreSQL starts by ;; sending some metadata describing the attributes. This information ;; is read by `pg-read-attributes', and consists of each attribute's ;; name (as a string), its size (in bytes), and its type (as an oid ;; which identifies a row in the PostgreSQL system table pg_type). Each ;; row in pg_type includes the type's name (as a string). ;; ;; We are able to parse a certain number of the PostgreSQL types (for ;; example, numeric data is converted to a numeric Emacs Lisp type, ;; dates are converted to the Emacs date representation, booleans to ;; Emacs Lisp booleans). However, there isn't a fixed mapping from a ;; type to its OID which is guaranteed to be stable across database ;; installations, so we need to build a table mapping OIDs to parser ;; functions. ;; ;; This is done by the procedure `pg-initialize-parsers', which is run ;; the first time a connection is initiated with the database from ;; this invocation of Emacs, and which issues a SELECT statement to ;; extract the required information from pg_type. This initialization ;; imposes a slight overhead on the first request, which you can avoid ;; by setting `pg-disable-type-coercion' to non-nil if it bothers you. ;; ;; see `man pgbuiltin' for details on PostgreSQL builtin types. Also see ;; https://www.npgsql.org/dev/types.html for useful information on the wire format for various ;; types. ;; This function is generally called upon establishing a connection to PostgreSQL. It may also be ;; called later when we encounter an OID that is not present in the cache, indicating that some ;; other activity has led to the creation of new PostgreSQL types (e.g. "CREATE TYPE ..."), and that ;; we need to repopulate our caches. ;; ;; Some databases such as Clickhouse that implement the PostgreSQL wire protocol do not implement the ;; pg_type table. They send all data in textual format with an OID of zero. For this reason, we ;; tolerate an error in the query on pg_type and leave all our oid-related caches empty. ;; ;; Note: the psycopg libary makes the following query to also retrieve datatype delimiters and array ;; types: ;; ;; SELECT typname AS name, oid, typarray AS array_oid, oid::regtype::text AS regtype, typdelim AS delimiter ;; FROM pg_type t ;; WHERE t.oid = to_regtype($1) ;; ORDER BY t.oid (cl-defun pg-initialize-parsers (con) "Initialize the datatype parsers on PostgreSQL connection CON." (when (eq 'clickhouse (pgcon-server-variant con)) (cl-return-from pg-initialize-parsers nil)) (let ((type-names (list)) (parser-by-oid (pgcon-parser-by-oid con)) (oid-by-typname (pgcon-oid-by-typname con)) (typname-by-oid (pgcon-typname-by-oid con))) (clrhash parser-by-oid) (clrhash typname-by-oid) (clrhash oid-by-typname) (maphash (lambda (k _v) (push k type-names)) pg--serializers) (maphash (lambda (k _v) (push k type-names)) pg--textual-serializers) (maphash (lambda (k _v) (push k type-names)) pg--parser-by-typname) (let* ((qnames (mapcar (lambda (tn) (format "'%s'" tn)) type-names)) (sql (format "SELECT typname,oid FROM pg_catalog.pg_type WHERE typname IN (%s)" (string-join qnames ","))) (res (ignore-errors (pg-exec con sql))) (pgtypes (and res (pg-result res :tuples))) ;; We only use the pg_type information if it looks plausible, and otherwise populate our ;; oid<->typname mappings with some predefined data (though strictly speaking there is no ;; guarantee that this internal information will remain the same in future PostgreSQL ;; releases, it is unlikely to change). This is a workaround for databases like ;; GreptimeDB that populate pg_types with invalid information like ("UInt8" "7"). (rows (if (cl-position '("oid" "26") pgtypes :test #'equal) pgtypes '(("bool" "16") ("bytea" "17") ("char" "18") ("name" "19") ("int8" "20") ("int2" "21") ("int4" "23") ("text" "25") ("oid" "26") ("json" "114") ("xml" "142") ("float4" "700") ("float8" "701") ("varchar" "1043") ("date" "1082") ("time" "1083") ("timestamp" "1114") ("timestamptz" "1184") ("numeric" "1700") ("uuid" "2950") ("jsonb" "3802") ("_bool" "1000") ("_int8" "1016") ("_int2" "1005") ("_int4" "1007") ("_float4" "1021") ("_float8" "1022") ("_numeric" "1231"))))) (dolist (row rows) (let* ((typname (cl-first row)) (oid (cl-parse-integer (cl-second row))) (parser (gethash typname pg--parser-by-typname))) (puthash typname oid oid-by-typname) (puthash oid typname typname-by-oid) (when parser (puthash oid parser parser-by-oid))))))) (defun pg-parse (con str oid) "Deserialize textual representation STR to an Emacs Lisp object. Uses the client-encoding specified in the connection to PostgreSQL CON." (if pg-disable-type-coercion str (let ((parser (gethash oid (pgcon-parser-by-oid con))) (ce (pgcon-client-encoding con))) (if parser (funcall parser str ce) str)))) (defun pg-serialize (object type-name encoding) (let ((serializer (gethash type-name pg--serializers))) (if serializer (funcall serializer object encoding) object))) ;; Map between PostgreSQL names for encodings and their Emacs name. See the list at ;; https://www.postgresql.org/docs/current/multibyte.html ;; ;; For Emacs, see coding-system-alist. (defconst pg--encoding-names `(("UTF8" . utf-8) ("UNICODE" . utf-8) ("LATIN1" . ,(coding-system-base 'latin-1)) ("LATIN2" . ,(coding-system-base 'latin-2)) ("LATIN3" . ,(coding-system-base 'latin-3)) ("LATIN4" . ,(coding-system-base 'latin-4)) ("LATIN5" . ,(coding-system-base 'latin-5)) ("LATIN6" . ,(coding-system-base 'latin-6)) ("LATIN7" . ,(coding-system-base 'latin-7)) ("LATIN8" . ,(coding-system-base 'latin-8)) ("LATIN9" . ,(coding-system-base 'latin-9)) ("LATIN10" . ,(coding-system-base 'latin-10)) ("WIN1250" . windows-1250) ("WIN1251" . windows-1251) ("WIN1252" . windows-1252) ("WIN1253" . windows-1253) ("WIN1254" . windows-1254) ("WIN1255" . windows-1255) ("WIN1256" . windows-1256) ("WIN1257" . windows-1257) ("WIN1258" . windows-1258) ("SHIFT_JIS_2004" . ,(coding-system-base 'shift_jis-2004)) ("SJIS" . ,(coding-system-base 'shift_jis-2004)) ("GB18030" . ,(coding-system-base 'gb18030)) ("EUC_TW" . ,(coding-system-base 'euc-taiwan)) ("EUC_KR" . ,(coding-system-base 'euc-korea)) ("EUC_JP" . ,(coding-system-base 'euc-japan)) ("EUC_CN" . ,(coding-system-base 'euc-china)) ("BIG5" . ,(coding-system-base 'big5)) ("SQL_ASCII" . ,(coding-system-base 'ascii)))) (defun pg-normalize-encoding-name (name) "Convert PostgreSQL encoding NAME to an Emacs encoding name." (if (fboundp 'string-equal-ignore-case) (cdr (assoc name pg--encoding-names #'string-equal-ignore-case)) (cdr (assoc name pg--encoding-names #'string-equal)))) ;; Note: this set_config() function call does not work on all variants; for example it fails on QuestDB. (defun pg-set-client-encoding (con encoding) "Change the encoding used by the client to ENCODING. ENCODING should be a string of the form \"UTF8\" or \"LATIN1\" (see `pg--encoding-names' for all values supported by PostgreSQL). Sends the SQL command to change the value of the client_encoding runtime configuration parameter and also modifies the pgcon-client-encoding for the PostgreSQL connection CON." (let ((emacs-encoding-name (pg-normalize-encoding-name encoding))) (unless emacs-encoding-name (signal 'pg-encoding-error (list (format "Unknown encoding %s" encoding)))) (pcase (pgcon-server-variant con) ('octodb (let* ((res (pg-exec con (format "SET client_encoding TO '%s'" encoding))) (status (pg-result res :status))) (unless (string= "SET" status) (signal 'pg-error (format "Couldn't set client_encoding to %s" encoding))))) (_ (let* ((res (pg-exec-prepared con "SELECT set_config('client_encoding', $1, false)" `((,encoding . "text")))) (status (pg-result res :status))) (unless (string= "SELECT 1" status) (signal 'pg-error (format "Couldn't set client_encoding to %s" encoding)))))) (setf (pgcon-client-encoding con) emacs-encoding-name))) ;; Note that if you register a parser for a new type-name after a PostgreSQL connection has been ;; established, you must call (pg-initialize-parsers *connection*) to hook the parser into the ;; deserialization machinery (this will look up the OID for the new type). (defun pg-register-parser (type-name parser) (puthash type-name parser pg--parser-by-typname)) (put 'pg-register-parser 'lisp-indent-function 'defun) (defun pg-lookup-parser (type-name) (gethash type-name pg--parser-by-typname)) (defun pg-bool-parser (str _encoding) (cond ((string= "t" str) t) ((string= "f" str) nil) (t (let ((msg (format "Badly formed boolean from backend: %s" str))) (signal 'pg-protocol-error (list msg)))))) (pg-register-parser "bool" #'pg-bool-parser) (defun pg-bit-parser (str _encoding) "Parse STR as a PostgreSQL bit to an Emacs bool-vector." (declare (speed 3)) (let* ((len (length str)) (bv (make-bool-vector len t))) (dotimes (i len) (setf (aref bv i) (eql ?1 (aref str i)))) bv)) (pg-register-parser "bit" #'pg-bit-parser) (pg-register-parser "varbit" #'pg-bit-parser) (defun pg-text-parser (str encoding) "Parse PostgreSQL value STR as text using ENCODING." (if encoding (decode-coding-string str encoding) str)) (defun pg-char-parser (str encoding) (if encoding (aref (pg-text-parser str encoding) 0) (aref str 0))) (pg-register-parser "char" #'pg-char-parser) (pg-register-parser "bpchar" #'pg-char-parser) (pg-register-parser "char2" #'pg-text-parser) (pg-register-parser "char4" #'pg-text-parser) (pg-register-parser "char8" #'pg-text-parser) (pg-register-parser "char16" #'pg-text-parser) (pg-register-parser "name" #'pg-text-parser) (pg-register-parser "text" #'pg-text-parser) (pg-register-parser "varchar" #'pg-text-parser) (pg-register-parser "xml" #'pg-text-parser) (pg-register-parser "uuid" #'pg-text-parser) (pg-register-parser "bytea" ;; BYTEA binary strings (sequence of octets), that use hex escapes. Note ;; PostgreSQL setting variable bytea_output which selects between hex escape ;; format (the default in recent version) and traditional escape format. We ;; assume that hex format is selected. ;; ;; https://www.postgresql.org/docs/current/datatype-binary.html (lambda (str _encoding) "Parse PostgreSQL value STR as a binary string using hex escapes." (unless (and (eql 92 (aref str 0)) ; \ character (eql ?x (aref str 1))) (signal 'pg-protocol-error (list "Unexpected format for BYTEA binary string"))) (decode-hex-string (substring str 2)))) (declare-function json-read-from-string "json.el") ;; We use either the native libjansson support compiled into Emacs, or fall back to the routines ;; from the JSON library. Note however that these do not parse JSON in exactly the same way (in ;; particular, NULL, false and the empty array are handled differently). (defun pg-json-parser (str _encoding) "Parse PostgreSQL value STR as JSON." (if (and (fboundp 'json-parse-string) (fboundp 'json-available-p) (json-available-p)) ;; Use the JSON support natively compiled into Emacs (json-parse-string str) ;; Use the parsing routines from the json library (require 'json) (json-read-from-string str))) (pg-register-parser "json" #'pg-json-parser) (pg-register-parser "jsonb" #'pg-json-parser) (pg-register-parser "jsonpath" #'pg-text-parser) ;; This function must be called before using the HSTORE extension. It loads the extension if ;; necessary, and sets up the parsing support for HSTORE datatypes. This is necessary because ;; the hstore type is not defined on startup in the pg_type table. ;; ;; https://www.postgresql.org/docs/current/hstore.html (defun pg-hstore-setup (con) "Prepare for use of HSTORE datatypes on PostgreSQL connection CON. Return nil if the extension could not be loaded." (when (condition-case nil (pg-exec con "CREATE EXTENSION IF NOT EXISTS hstore") (pg-error nil)) (let* ((res (pg-exec con "SELECT oid FROM pg_catalog.pg_type WHERE typname='hstore'")) (oid (car (pg-result res :tuple 0))) (parser (pg-lookup-parser "hstore")) (parser-by-oid (pgcon-parser-by-oid con)) (oid-by-typname (pgcon-oid-by-typname con))) (when parser (puthash oid parser parser-by-oid)) (puthash "hstore" oid oid-by-typname)) (pg-register-textual-serializer "hstore" (lambda (ht encoding) (unless (hash-table-p ht) (pg-signal-type-error "Expecting a hash-table, got %s" ht)) (let ((kv (list))) ;; FIXME should escape \" characters in k and v (maphash (lambda (k v) (push (format "\"%s\"=>\"%s\"" (pg--serialize-text k encoding) (pg--serialize-text v encoding)) kv)) ht) (string-join kv ",")))))) ;; Note however that the hstore type is generally not present in the pg_type table ;; upon startup, so we need to call `pg-hstore-setup' before using HSTORE datatypes. (pg-register-parser "hstore" ;; We receive something like "\"a\"=>\"1\", \"b\"=>\"2\"" (lambda (str encoding) "Parse PostgreSQL value STR as HSTORE content." (cl-flet ((parse (v) (if (string= "NULL" v) nil (unless (and (eql ?\" (aref v 0)) (eql ?\" (aref v (1- (length v))))) (signal 'pg-protocol-error '("Unexpected format for HSTORE content"))) (pg-text-parser (substring v 1 (1- (length v))) encoding)))) (let ((hstore (make-hash-table :test #'equal))) (dolist (segment (split-string str "," t "\s+")) (let* ((kv (split-string segment "=>" t "\s+"))) (puthash (parse (car kv)) (parse (cadr kv)) hstore))) hstore)))) (defun pg-number-parser (str _encoding) "Parse PostgreSQL value STR as a number." (cl-parse-integer str)) (pg-register-parser "count" #'pg-number-parser) (pg-register-parser "smallint" #'pg-number-parser) (pg-register-parser "integer" #'pg-number-parser) (pg-register-parser "bigint" #'pg-number-parser) (pg-register-parser "int2" #'pg-number-parser) (pg-register-parser "int4" #'pg-number-parser) (pg-register-parser "int8" #'pg-number-parser) (pg-register-parser "oid" #'pg-number-parser) ;; We need to handle +Inf, -Inf, NaN specially because the Emacs Lisp reader uses a specific format ;; for them. (defun pg-float-parser (str _encoding) "Parse PostgreSQL value STR as a floating-point value." (cond ((string= str "Infinity") 1.0e+INF) ((string= str "-Infinity") -1.0e+INF) ((string= str "NaN") 0.0e+NaN) (t (string-to-number str)))) (pg-register-parser "numeric" #'pg-float-parser) (pg-register-parser "float" #'pg-float-parser) (pg-register-parser "float4" #'pg-float-parser) (pg-register-parser "float8" #'pg-float-parser) ;; FIXME we are not currently handling multidimensional arrays correctly. They are serialized by ;; PostgreSQL using the same typid as a unidimensional array, with only the presence of additional ;; levels of {} marking the extra dimensions. ;; See https://www.postgresql.org/docs/current/arrays.html (defun pg-intarray-parser (str _encoding) "Parse PostgreSQL value STR as an array of integers." (let ((len (length str))) (unless (and (eql (aref str 0) ?{) (eql (aref str (1- len)) ?})) (signal 'pg-protocol-error (list "Unexpected format for int array"))) (let ((maybe-items (cl-subseq str 1 (- len 1)))) (if (zerop (length maybe-items)) (vector) (let ((items (split-string maybe-items ","))) (apply #'vector (mapcar #'cl-parse-integer items))))))) (pg-register-parser "_int2" #'pg-intarray-parser) (pg-register-parser "_int2vector" #'pg-intarray-parser) (pg-register-parser "_int4" #'pg-intarray-parser) (pg-register-parser "_int8" #'pg-intarray-parser) (defun pg-floatarray-parser (str _encoding) "Parse PostgreSQL value STR as an array of floats." (let ((len (length str))) (unless (and (eql (aref str 0) ?{) (eql (aref str (1- len)) ?})) (signal 'pg-protocol-error (list "Unexpected format for float array"))) (let ((maybe-items (cl-subseq str 1 (- len 1)))) (if (zerop (length maybe-items)) (vector) (let ((items (split-string maybe-items ","))) (apply #'vector (mapcar (lambda (x) (pg-float-parser x nil)) items))))))) (pg-register-parser "_float4" #'pg-floatarray-parser) (pg-register-parser "_float8" #'pg-floatarray-parser) (pg-register-parser "_numeric" #'pg-floatarray-parser) (defun pg-boolarray-parser (str _encoding) "Parse PostgreSQL value STR as an array of boolean values." (let ((len (length str))) (unless (and (eql (aref str 0) ?{) (eql (aref str (1- len)) ?})) (signal 'pg-protocol-error (list "Unexpected format for bool array"))) (let ((maybe-items (cl-subseq str 1 (- len 1)))) (if (zerop (length maybe-items)) (vector) (let ((items (split-string maybe-items ","))) (apply #'vector (mapcar (lambda (x) (pg-bool-parser x nil)) items))))))) (pg-register-parser "_bool" #'pg-boolarray-parser) (defun pg-chararray-parser (str encoding) "Parse PostgreSQL value STR as an array of characters using ENCODING." (let ((len (length str))) (unless (and (eql (aref str 0) ?{) (eql (aref str (1- len)) ?})) (signal 'pg-protocol-error (list "Unexpected format for char array"))) (let ((maybe-items (cl-subseq str 1 (- len 1)))) (if (zerop (length maybe-items)) (vector) (let ((items (split-string maybe-items ","))) (apply #'vector (mapcar (lambda (x) (pg-char-parser x encoding)) items))))))) (pg-register-parser "_char" #'pg-chararray-parser) (pg-register-parser "_bpchar" #'pg-chararray-parser) (defun pg-textarray-parser (str encoding) "Parse PostgreSQL value STR as an array of TEXT values. Uses text encoding ENCODING." (let ((len (length str))) (unless (and (eql (aref str 0) ?{) (eql (aref str (1- len)) ?})) (signal 'pg-protocol-error (list "Unexpected format for text array"))) (let ((maybe-items (cl-subseq str 1 (- len 1)))) (if (zerop (length maybe-items)) (vector) (let ((items (split-string maybe-items ","))) (apply #'vector (mapcar (lambda (x) (pg-text-parser x encoding)) items))))))) (pg-register-parser "_text" #'pg-textarray-parser) ;; Anonymouse records in PostgreSQL (oid = 2249) are little used in practice, and difficult to parse ;; because we receive no information concerning the types of the different record "columns". ;; ;; SELECT (1,2) --> "(1,2)" ;; SELECT (null,1,2) --> "(,1,2)" ;; SELECT ('foo,ble',null) --> "(\"foo,ble\",)" ;; SELECT (1, (2, 3)) --> "(1,\"(2,3)\")" -- nested records are allowed ;; SELECT (1, '(2,3)') --> "(1,\"(2,3)\")" -- note the ambiguity! ;; ;; We simply return these as an unparsed string. (pg-register-parser "record" #'pg-text-parser) ;; Something like "[10.4,20)". TODO: handle multirange types (from PostgreSQL v14) (defun pg-numrange-parser (str _encoding) "Parse PostgreSQL value STR as a numerical range." (if (string= "empty" str) (list :range) (let* ((len (length str)) (lower-type (aref str 0)) (upper-type (aref str (1- len)))) (unless (and (cl-find lower-type "[(") (cl-find upper-type ")]")) (signal 'pg-protocol-error '("Unexpected format for numerical range"))) (let* ((segments (split-string (cl-subseq str 1 (1- len)) ",")) (lower-str (nth 0 segments)) (upper-str (nth 1 segments)) ;; if the number is empty, that's a NULL lower or upper bound (lower (if (zerop (length lower-str)) nil (string-to-number lower-str))) (upper (if (zerop (length upper-str)) nil (string-to-number upper-str)))) (unless (eql 2 (length segments)) (signal 'pg-protocol-error '("Unexpected number of elements in numerical range"))) (list :range lower-type lower upper-type upper))))) (pg-register-parser "int4range" #'pg-numrange-parser) (pg-register-parser "int8range" #'pg-numrange-parser) (pg-register-parser "numrange" #'pg-numrange-parser) (pg-register-parser "money" #'pg-text-parser) ;; format for ISO dates is "1999-10-24" (defun pg-date-parser (str _encoding) "Parse PostgreSQL value STR as a date." (let ((year (string-to-number (substring str 0 4))) (month (string-to-number (substring str 5 7))) (day (string-to-number (substring str 8 10)))) (encode-time 0 0 0 day month year))) (pg-register-parser "date" #'pg-date-parser) (defconst pg--ISODATE_REGEX (concat "^\\([0-9]+\\)-\\([0-9][0-9]\\)-\\([0-9][0-9]\\)" ; Y-M-D "\\([ T]\\)" ; delim "\\([0-9][0-9]\\):\\([0-9][0-9]\\):\\([.0-9]+\\)" ; H:M:S.S "\\(?:\\(?:[zZ]\\)\\|\\(?:[-+][0-9]\\{2\\}:?\\(?:[0-9]\\{2\\}\\)?\\)\\)?$")) ; TZ ;; format for abstime/timestamp etc with ISO output syntax is ;;; "1999-01-02 14:32:53.789+01" ;; which we convert to the internal Emacs date/time representation ;; (there may be a fractional seconds quantity as well, which the regex ;; handles) (defun pg-isodate-with-timezone-parser (str _encoding) "Parse PostgreSQL value STR as an ISO-formatted date." (if (string-match pg--ISODATE_REGEX str) (let ((iso (replace-match "T" nil nil str 4))) ;; Use of parse-iso8601-time-string with a second argument is only supported from Emacs 29.1 ;; onwards. In earlier versions we call the function with a single argument, which loses ;; sub-second precision (and will fail our test suite for this reason). (if (>= emacs-major-version 29) (parse-iso8601-time-string iso t) (parse-iso8601-time-string iso))) (let ((msg (format "Badly formed ISO timestamp from backend: %s" str))) (signal 'pg-protocol-error (list msg))))) (defun pg-isodate-without-timezone-parser (str _encoding) "Parse PostgreSQL value STR as an ISO-formatted date." (if (string-match pg--ISODATE_REGEX str) (let ((year (string-to-number (match-string 1 str))) (month (string-to-number (match-string 2 str))) (day (string-to-number (match-string 3 str))) (hours (string-to-number (match-string 5 str))) (minutes (string-to-number (match-string 6 str))) (seconds (string-to-number (match-string 7 str))) (tz nil)) ;; a tz of nil means that we are parsing into Emacs' local time, which is dependent on the ;; setting of the TZ environment variable. (encode-time (list seconds minutes hours day month year nil -1 tz))) (let ((msg (format "Badly formed ISO timestamp from backend: %s" str))) (signal 'pg-protocol-error (list msg))))) (pg-register-parser "timestamp" #'pg-isodate-without-timezone-parser) (pg-register-parser "timestamptz" #'pg-isodate-with-timezone-parser) (pg-register-parser "datetime" #'pg-isodate-with-timezone-parser) (pg-register-parser "time" #'pg-text-parser) ; preparsed "15:32:45" (pg-register-parser "timetz" #'pg-text-parser) (pg-register-parser "reltime" #'pg-text-parser) ; don't know how to parse these (pg-register-parser "timespan" #'pg-text-parser) (pg-register-parser "tinterval" #'pg-text-parser) ;; A tsvector is a type used by PostgreSQL to support full-text search in documents. ;; ;; Possible input formats: ;; "'a' 'and' 'ate' 'cat' 'fat' 'mat' 'on' 'rat' 'sat'" ;; "' ' 'contains' 'lexeme' 'spaces' 'the'" ;; "'Joe''s' 'a' 'contains' 'lexeme' 'quote' 'the'" ;; "'a':1,6,10 'and':8 'ate':9 'cat':3" ;; "'a':1A 'cat':5 'fat':2B,4C" ;; ;; Parse this to a list of pg-ts. (cl-defstruct pg-ts "A component of a PostgreSQL tsvector, comprising lexeme and its weighted-positions." lexeme weighted-positions) ;; https://elpa.gnu.org/packages/peg.html (defun pg-tsvector-parser (str _encoding) (with-temp-buffer (insert str) (goto-char (point-min)) (with-peg-rules ((tsvector tslist (eol)) (tslist ts (* (and (+ [space]) ts))) (ts lexeme positions `(lx wpos -- (make-pg-ts :lexeme lx :weighted-positions wpos))) ;; We want 'Joe''s' to be parsed as the lexeme "Joe's" (lexeme "'" (substring (or (+ (or [alpha] "''")) (+ [space]))) "'" `(lx -- (string-replace "''" "'" lx))) (positions (or (and ":" (list (* (and position ",")) position)) `(-- nil))) (position (and (substring (+ [digit])) opt-weight) `(pos w -- (cons (string-to-number pos) w))) ;; The default weight is :D. It's omitted in the default PostgreSQL string format for a ;; tsvector, but it seems better to make it explicit. (opt-weight (or weight `(-- (intern ":D")))) (weight (substring (or [A-D] [a-d])) `(w -- (intern (concat ":" (upcase w)))))) (peg-run (peg tsvector))))) ;; (pg-tsvector-parser "'foo'" nil) ;; (pg-tsvector-parser "'foo' 'bar'" nil) ;; (pg-tsvector-parser "' ' 'contains' 'lexeme' 'spaces' 'the'" nil) ;; (pg-tsvector-parser "'fooé' 'bar':44 'bizzles':1" nil) ;; (pg-tsvector-parser "'foo' 'bar':4 'bizlles':1,2,10" nil) ;; (pg-tsvector-parser "'a':1A 'cat':5 'fat':2B,4C" nil) ;; (pg-tsvector-parser "'Joe''s' 'a' 'contains' 'lexeme' 'quote' 'the'" nil) (pg-register-parser "tsvector" #'pg-tsvector-parser) ;; TODO: also define a parser for the tsquery type ;;; Support for the pgvector extension (vector similarity search). ;; This function must be called before using the pgvector extension. It loads the extension if ;; necessary, and sets up the parsing support for vector datatypes. (defun pg-vector-setup (con) "Prepare for use of VECTOR datatypes on PostgreSQL connection CON. Return nil if the extension could not be set up." (when (condition-case nil (pg-exec con "CREATE EXTENSION IF NOT EXISTS vector") (pg-error nil)) (let* ((res (pg-exec con "SELECT oid FROM pg_catalog.pg_type WHERE typname='vector'")) (oid (car (pg-result res :tuple 0))) (parser (pg-lookup-parser "vector"))) (when parser (puthash oid parser (pgcon-parser-by-oid con)))))) ;; pgvector embeddings are sent by the database as strings, in the form "[1,2,3]" or ["0.015220831, ;; 0.039211094, 0.02235647]" (pg-register-parser "vector" (lambda (s _e) (let ((len (length s))) (unless (and (eql (aref s 0) ?\[) (eql (aref s (1- len)) ?\])) (signal 'pg-protocol-error (list "Unexpected format for VECTOR embedding"))) (let ((segments (split-string (cl-subseq s 1 (1- len)) ","))) (apply #'vector (mapcar #'string-to-number segments)))))) (defun pg-register-serializer (type-name serializer) (puthash type-name serializer pg--serializers)) (defun pg-register-textual-serializer (type-name serializer) (puthash type-name serializer pg--serializers) (puthash type-name t pg--textual-serializers)) (put 'pg-register-serializer 'lisp-indent-function 'defun) (put 'pg-register-textual-serializer 'lisp-indent-function 'defun) (defun pg--serialize-text (object encoding) (if encoding (encode-coding-string object encoding t) object)) (defun pg--serialize-binary (object _encoding) object) (pg-register-serializer "text" #'pg--serialize-text) (pg-register-serializer "varchar" #'pg--serialize-text) (pg-register-serializer "xml" #'pg--serialize-text) (pg-register-serializer "bytea" #'pg--serialize-binary) (pg-register-serializer "jsonb" #'pg--serialize-binary) (pg-register-textual-serializer "jsonpath" #'pg--serialize-text) ;; Expected format: e313723b-7d52-4c87-bf0f-b7d73d6284fd (defun pg--serialize-uuid (uuid _encoding) (let ((uuid-rx (rx string-start (group (repeat 8 xdigit)) ?- (group (repeat 4 xdigit)) ?- (group (repeat 4 xdigit)) ?- (group (repeat 4 xdigit)) ?- (group (repeat 12 xdigit)) string-end))) (unless (string-match uuid-rx uuid) (pg-signal-type-error "Expecting a UUID, got %s" uuid))) (let* ((hx (concat (match-string 1 uuid) (match-string 2 uuid) (match-string 3 uuid) (match-string 4 uuid) (match-string 5 uuid)))) (decode-hex-string hx))) (pg-register-serializer "uuid" #'pg--serialize-uuid) (pg-register-serializer "bool" (lambda (v _encoding) (if v (string 1) (string 0)))) (defun pg--serialize-boolvec (bv _encoding) (unless (bool-vector-p bv) (pg-signal-type-error "Expecting a bool-vector, got %s" bv)) (let* ((len (length bv)) (out (make-string len ?0))) (dotimes (i len) (setf (aref out i) (if (aref bv i) ?1 ?0))) out)) (pg-register-textual-serializer "bit" #'pg--serialize-boolvec) (pg-register-textual-serializer "varbit" #'pg--serialize-boolvec) (pg-register-serializer "char" (lambda (v _encoding) (unless (<= 0 v 255) (pg-signal-type-error "Value %s out of range for CHAR type" v)) (string v))) (pg-register-serializer "bpchar" (lambda (v encoding) (unless (<= 0 v 255) (pg-signal-type-error "Value %s out of range for BPCHAR type" v)) (pg--serialize-text (string v) encoding))) ;; see https://www.postgresql.org/docs/current/datatype-numeric.html (pg-register-serializer "int2" (lambda (v _encoding) (unless (integerp v) (pg-signal-type-error "Expecting an integer, got %s" v)) (unless (<= (- (expt 2 15)) v (expt 2 15)) (pg-signal-type-error "Value %s out of range for INT2 type" v)) ;; This use of bindat-type makes us depend on Emacs 28.1, released in April 2022. (bindat-pack (bindat-type sint 16 nil) v))) (pg-register-serializer "smallint" (lambda (v _encoding) (unless (integerp v) (pg-signal-type-error "Expecting an integer, got %s" v)) (unless (<= (- (expt 2 15)) v (expt 2 15)) (pg-signal-type-error "Value %s out of range for SMALLINT type" v)) (bindat-pack (bindat-type sint 16 nil) v))) (pg-register-serializer "int4" (lambda (v _encoding) (unless (integerp v) (pg-signal-type-error "Expecting an integer, got %s" v)) (bindat-pack (bindat-type sint 32 nil) v))) (pg-register-serializer "integer" (lambda (v _encoding) (unless (integerp v) (pg-signal-type-error "Expecting an integer, got %s" v)) (bindat-pack (bindat-type sint 32 nil) v))) ;; see https://www.postgresql.org/docs/current/datatype-oid.html (pg-register-serializer "oid" (lambda (v _encoding) (unless (integerp v) (pg-signal-type-error "Expecting an integer, got %s" v)) (bindat-pack (bindat-type uint 32 nil) v))) (pg-register-serializer "int8" (lambda (v _encoding) (unless (integerp v) (pg-signal-type-error "Expecting an integer, got %s" v)) (bindat-pack (bindat-type sint 64 nil) v))) (pg-register-serializer "bigint" (lambda (v _encoding) (unless (integerp v) (pg-signal-type-error "Expecting an integer, got %s" v)) (bindat-pack (bindat-type sint 64 nil) v))) (pg-register-serializer "smallserial" (lambda (v _encoding) (unless (integerp v) (pg-signal-type-error "Expecting an integer, got %s" v)) (bindat-pack (bindat-type uint 16 nil) v))) (pg-register-serializer "serial" (lambda (v _encoding) (unless (integerp v) (pg-signal-type-error "Expecting an integer, got %s" v)) (bindat-pack (bindat-type uint 32 nil) v))) (pg-register-serializer "bigserial" (lambda (v _encoding) (unless (integerp v) (pg-signal-type-error "Expecting an integer, got %s" v)) (bindat-pack (bindat-type uint 64 nil) v))) ;; We send floats in text format, because we don't know how to access the binary representation from ;; Emacs Lisp. Here a possible conversion routine and reader, but there is probably no performance ;; benefit to using it. ;; ;; https://lists.gnu.org/archive/html/help-gnu-emacs/2002-10/msg00724.html ;; https://www.emacswiki.org/emacs/read-float.el (defun pg--serialize-float (number _encoding) "Serialize floating point NUMBER to PostgreSQL wire-level text format for floats. Respects floating-point infinities and NaN." (unless (numberp number) (pg-signal-type-error "Expecting a number, got %s" number)) (let ((fl (float number))) (cond ((= fl 1.0e+INF) "Infinity") ((= fl -1.0e+INF) "-Infinity") ((isnan fl) "NaN") (t (number-to-string fl))))) (pg-register-textual-serializer "float4" #'pg--serialize-float) (pg-register-textual-serializer "float8" #'pg--serialize-float) ;; FIXME probably we should be encoding this. (defun pg--serialize-json (json _encoding) (if (fboundp 'json-serialize) (json-serialize json) (require 'json) (json-encode json))) (pg-register-textual-serializer "json" #'pg--serialize-json) (pg-register-textual-serializer "jsonb" #'pg--serialize-json) (defun pg--serialize-encoded-time-date (encoded-time _encoding) (unless (and (listp encoded-time) (integerp (car encoded-time)) (integerp (cadr encoded-time))) (pg-signal-type-error "Expecting an encoded time-date (a . b), got %s" encoded-time)) (format-time-string "%Y-%m-%d" encoded-time)) (pg-register-textual-serializer "date" #'pg--serialize-encoded-time-date) ;; We parse these into an Emacs Lisp "encoded-time", which is represented as a list of two integers. ;; Serialize them back to an ISO timestamp. (defun pg--serialize-encoded-time (encoded-time _encoding) (unless (and (listp encoded-time) (integerp (car encoded-time)) (or (listp (cdr encoded-time))(integerp (cdr encoded-time)))) (pg-signal-type-error "Expecting an encoded time-date (a . b), got %s" encoded-time)) (format-time-string "%Y-%m-%dT%T.%N%z" encoded-time "UTC")) (pg-register-textual-serializer "timestamp" #'pg--serialize-encoded-time) (pg-register-textual-serializer "timestamptz" #'pg--serialize-encoded-time) (pg-register-textual-serializer "datetime" #'pg--serialize-encoded-time) ;; Serialize an elisp vector of numbers (integers or floats) to a string of the form "[44,55,66]" (pg-register-textual-serializer "vector" (lambda (v _encoding) (unless (and (vectorp v) (cl-every #'numberp v)) (pg-signal-type-error "Expecting a vector of numbers, got %s" v)) (concat "[" (string-join (mapcar #'prin1-to-string v) ",") "]"))) ;; pwdhash = md5(password + username).hexdigest() ;; hash = ′md5′ + md5(pwdhash + salt).hexdigest() (defun pg-do-md5-authentication (con user password) "Attempt MD5 authentication with PostgreSQL database over connection CON. Authenticate as USER with PASSWORD." (let* ((salt (pg-read-chars con 4)) (pwdhash (md5 (concat password user))) (hash (concat "md5" (md5 (concat pwdhash salt))))) (pg-send-char con ?p) (pg-send-uint con (+ 5 (length hash)) 4) (pg-send-string con hash))) ;; TODO: implement stringprep for user names and passwords, as per RFC4013. (defun pg-sasl-prep (string) string) (defun pg-logxor-string (s1 s2) "Elementwise XOR of each character of strings S1 and S2." (declare (speed 3)) (let ((len (length s1))) (cl-assert (eql len (length s2))) (let ((out (make-string len 0))) (dotimes (i len) (setf (aref out i) (logxor (aref s1 i) (aref s2 i)))) out))) ;; PBKDF2 is a key derivation function used to reduce vulnerability to brute-force password guessing ;; attempts . (defun pg-pbkdf2-hash-sha256 (password salt iterations) "Return the PBKDF2 hash of PASSWORD using SALT and ITERATIONS." (declare (speed 3)) (let* ((hash (gnutls-hash-mac 'SHA256 (cl-copy-seq password) (concat salt (string 0 0 0 1)))) (result hash)) (dotimes (_i (1- iterations)) (setf hash (gnutls-hash-mac 'SHA256 (cl-copy-seq password) hash)) (setf result (pg-logxor-string result hash))) result)) ;; Implement PBKDF2 by calling out to the nettle-pbkdf2 application (typically available in the ;; "nettle-bin" package) as a subprocess. (defun pg-pbkdf2-hash-sha256-nettle (password salt iterations) "Return the PBKDF2 hash of PASSWORD using SALT and ITERATIONS, with nettle." ;; ITERATIONS is a integer ;; the hash function in nettle-pbkdf2 is hard coded to HMAC-SHA256 (require 'hex-util) (with-temp-buffer (insert (pg-sasl-prep password)) (call-process-region (point-min) (point-max) "nettle-pbkdf2" t t "--raw" "-i" (format "%d" iterations) "-l" "32" salt) ;; delete trailing newline character (goto-char (point-max)) (backward-char 1) (when (eql ?\n (char-after)) (delete-char 1)) ;; out is in the format 55234f50f7f54f13 9e7f13d4becff1d6 aee3ab80a08cc034 c75e8ba21e43e01b (let ((out (delete ?\s (buffer-string)))) (decode-hex-string out)))) ;; use NIL to generate a new client nonce on each authentication attempt (normal practice) ;; or specify a string here to force a particular value for test purposes (compare test vectors) ;; Example value: "rOprNGfwEbeRWgbNEkqO" (defvar pg--*force-client-nonce* nil) ;; SCRAM authentication methods use a password as a shared secret, which can then be used for mutual ;; authentication in a way that doesn't expose the secret directly to an attacker who might be ;; sniffing the communication. ;; ;; https://www.postgresql.org/docs/15/sasl-authentication.html ;; https://www.rfc-editor.org/rfc/rfc7677 (defun pg-do-scram-sha256-authentication (con user password) "Attempt SCRAM-SHA-256 authentication with PostgreSQL over connection CON. Authenticate as USER with PASSWORD." (let* ((mechanism "SCRAM-SHA-256") (client-nonce (or pg--*force-client-nonce* (apply #'string (cl-loop for i below 32 collect (+ ?A (random 25)))))) (client-first (format "n,,n=%s,r=%s" user client-nonce)) (len-cf (length client-first)) ;; packet length doesn't include the initial ?p message type indicator (len-packet (+ 4 (1+ (length mechanism)) 4 len-cf))) ;; send the SASLInitialResponse message (pg-send-char con ?p) (pg-send-uint con len-packet 4) (pg-send-string con mechanism) (pg-send-uint con len-cf 4) (pg-send-octets con client-first) (let ((c (pg-read-char con))) (cl-case c (?E ;; an ErrorResponse message (pg-handle-error-response con "during SASL auth")) ;; AuthenticationSASLContinue message, what we are hoping for (?R (let* ((len (pg-read-net-int con 4)) (type (pg-read-net-int con 4)) (server-first-msg (pg-read-chars con (- len 8)))) (unless (eql type 11) (let ((msg (format "Unexpected AuthenticationSASLContinue type %d" type))) (signal 'pg-protocol-error (list msg)))) (let* ((components (split-string server-first-msg ",")) (r= (cl-find "r=" components :key (lambda (s) (substring s 0 2)) :test #'string=)) (r (substring r= 2)) (s= (cl-find "s=" components :key (lambda (s) (substring s 0 2)) :test #'string=)) (s (substring s= 2)) (salt (base64-decode-string s)) (i= (cl-find "i=" components :key (lambda (s) (substring s 0 2)) :test #'string=)) (iterations (cl-parse-integer (substring i= 2))) (salted-password (pg-pbkdf2-hash-sha256 password salt iterations)) ;; beware: gnutls-hash-mac will zero out its first argument (the "secret")! (client-key (gnutls-hash-mac 'SHA256 (cl-copy-seq salted-password) "Client Key")) (server-key (gnutls-hash-mac 'SHA256 (cl-copy-seq salted-password) "Server Key")) (stored-key (secure-hash 'sha256 client-key nil nil t)) (client-first-bare (concat "n=" (pg-sasl-prep user) ",r=" client-nonce)) (client-final-bare (concat "c=biws,r=" r)) (auth-message (concat client-first-bare "," server-first-msg "," client-final-bare)) (client-sig (gnutls-hash-mac 'SHA256 stored-key auth-message)) (client-proof (pg-logxor-string client-key client-sig)) (server-sig (gnutls-hash-mac 'SHA256 server-key auth-message)) (client-final-msg (concat client-final-bare ",p=" (base64-encode-string client-proof t)))) (when (zerop iterations) (let ((msg (format "SCRAM-SHA-256: server supplied invalid iteration count %s" i=))) (signal 'pg-protocol-error (list msg)))) (unless (string= client-nonce (substring r 0 (length client-nonce))) (signal 'pg-protocol-error (list "SASL response doesn't include correct client nonce"))) ;; we send a SASLResponse message with SCRAM client-final-message as content (pg-send-char con ?p) (pg-send-uint con (+ 4 (length client-final-msg)) 4) (pg-send-octets con client-final-msg) (let ((c (pg-read-char con))) (cl-case c (?E ;; an ErrorResponse message (pg-handle-error-response con "after SASLResponse")) (?R ;; an AuthenticationSASLFinal message (let* ((len (pg-read-net-int con 4)) (type (pg-read-net-int con 4)) (server-final-msg (pg-read-chars con (- len 8)))) (unless (eql type 12) (let ((msg (format "Expecting AuthenticationSASLFinal, got type %d" type))) (signal 'pg-protocol-error (list msg)))) (when (string= "e=" (substring server-final-msg 0 2)) (let ((msg (format "PostgreSQL server error during SASL authentication: %s" (substring server-final-msg 2)))) (signal 'pg-protocol-error (list msg)))) (unless (string= "v=" (substring server-final-msg 0 2)) (signal 'pg-protocol-error '("Unable to verify PostgreSQL server during SASL auth"))) (unless (string= (substring server-final-msg 2) (base64-encode-string server-sig t)) (let ((msg (format "SASL server validation failure: v=%s / %s" (substring server-final-msg 2) (base64-encode-string server-sig t)))) (signal 'pg-protocol-error (list msg)))) ;; should be followed immediately by an AuthenticationOK message ))))))) (t (let ((msg (format "Unexpected response to SASLInitialResponse message: %s" c))) (signal 'pg-protocol-error (list msg)))))))) (defun pg-do-sasl-authentication (con user password) "Attempt SASL authentication with PostgreSQL over connection CON. Authenticate as USER with PASSWORD." (let ((mechanisms (list))) ;; read server's list of preferered authentication mechanisms (cl-loop for mech = (pg-read-string con 4096) while (not (zerop (length mech))) do (push mech mechanisms)) (if (member "SCRAM-SHA-256" mechanisms) (pg-do-scram-sha256-authentication con user password) (let ((msg (format "Can't handle any of SASL mechanisms %s" mechanisms))) (signal 'pg-protocol-error (list msg)))))) (defun pg-table-owner (con table) "Return the owner of TABLE in a PostgreSQL database. TABLE can be a string or a schema-qualified name. Uses database connection CON." (pcase (pgcon-server-variant con) ;; QuestDB have a notion of the current user and RBAC, but does not seem to have any information ;; on the owner of a particular table. ('questdb nil) ;; CrateDB does not have information on table owners, but rather on privileges granted on objects to users. ('cratedb (let* ((sql "SELECT name FROM sys.users WHERE superuser='t'") (res (pg-exec con sql)) (row (pg-result res :tuple 0))) (cl-first row))) (_ (let* ((schema (when (pg-qualified-name-p table) (pg-qualified-name-schema table))) (table-name (if (pg-qualified-name-p table) (pg-qualified-name-name table) table)) (schema-sql (if schema " AND schemaname=$2" "")) (sql (concat "SELECT tableowner FROM pg_catalog.pg_tables WHERE tablename=$1" schema-sql)) (args (if schema `((,table-name . "text") (,schema . "text")) `((,table-name . "text")))) (res (pg-exec-prepared con sql args))) (cl-first (pg-result res :tuple 0)))))) (defun pg--table-classoid (con table) "Return the OID of the class for PostgreSQL TABLE. Uses database connection CON." (let* ((table-name (if (pg-qualified-name-p table) (pg-qualified-name-name table) table)) (schema-name (when (pg-qualified-name-p table) (pg-qualified-name-schema table))) (relnamespace (when schema-name (let ((res (pg-exec-prepared con "SELECT oid FROM pg_catalog.pg_namespace WHERE nspname=$1" `((,schema-name . "text"))))) (cl-first (pg-result res :tuple 0))))) (sql/noschema "SELECT oid FROM pg_catalog.pg_class WHERE relkind='r' AND relname=$1") (sql/wschema "SELECT oid FROM pg_catalog.pg_class WHERE relkind='r' AND relname=$1 AND relnamespace=$2") (res (if schema-name (pg-exec-prepared con sql/wschema `((,table-name . "text") (,relnamespace . "int4"))) (pg-exec-prepared con sql/noschema `((,table-name . "text"))))) (row (pg-result res :tuple 0))) (when (null row) (let ((msg (format "Can't find classoid for table %s" table))) (signal 'pg-user-error (list msg)))) (cl-first row))) ;; As per https://www.postgresql.org/docs/current/sql-comment.html. But many PostgreSQL variants do ;; not implement this functionality, or annoyingly use different SQL syntax for it. (defun pg-table-comment (con table) "Return the comment on TABLE in a PostgreSQL database. TABLE can be a string or a schema-qualified name. Uses database connection CON." (pcase (pgcon-server-variant con) ('cratedb nil) ('questdb nil) ('spanner nil) ('ydb nil) ;; Our query below using PostgreSQL system tables triggers an internal exception in CockroachDB, ;; so we use their non-standard "SHOW TABLES" query. The SHOW TABLES command does not accept a ;; WHERE clause. ('cockroachdb (let* ((table-name (if (pg-qualified-name-p table) (pg-qualified-name-name table) table)) (schema-name (when (pg-qualified-name-p table) (pg-qualified-name-schema table))) (res (pg-exec con "SHOW TABLES WITH COMMENT")) (tuples (pg-result res :tuples)) (column-names (mapcar #'cl-first (pg-result res :attributes))) (table-name-pos (or (cl-position "table_name" column-names :test #'string=) (error "Expecting table_name in SHOW TABLES output"))) (table-schema-pos (or (cl-position "schema_name" column-names :test #'string=) (error "Expecting schema_name in SHOW TABLES output"))) (comment-pos (or (cl-position "comment" column-names :test #'string=) (error "Expecting comment in SHOW TABLES output")))) (cl-loop for tuple in tuples when (and (string= table-name (nth table-name-pos tuple)) (or (not schema-name) (string= schema-name (nth table-schema-pos tuple)))) return (nth comment-pos tuple)))) ('risingwave ;; RisingWave implements the obj_description() function, but annoyingly returns empty values ;; even when comments are defined. Comment data is available in the rw_description table. (let* ((classoid (pg--table-classoid con table)) (sql "SELECT description FROM rw_catalog.rw_description WHERE objoid=$1 AND objsubid IS NULL") (res (pg-exec-prepared con sql `((,classoid . "int4")))) (row (pg-result res :tuple 0))) (cl-first row))) ;; TODO: possibly some other PostgreSQL variants use the syntax "COMMENT ON TABLE tname" to ;; query the comment. (_ (let* ((t-id (pg-escape-identifier table)) ;; TODO: use an SQL query that avoids escaping the table identifier. (sql "SELECT obj_description($1::regclass::oid, 'pg_class')") (res (pg-exec-prepared con sql `((,t-id . "text")))) (tuples (pg-result res :tuples))) (when tuples (caar tuples)))))) ;; Support for (setf (pg-table-comment con table) "comment") (gv-define-setter pg-table-comment (comment con table) `(pcase (pgcon-server-variant ,con) ('cratedb nil) ('questdb nil) ('spanner nil) ('ydb nil) (_ (let* ((cmt (if ,comment (pcase (pgcon-server-variant ,con) ;; RisingWave does not support the escaped literal format E'foo' that is ;; used by pg-escape-identifier. ('risingwave (concat "'" ,comment "'")) (_ (pg-escape-literal ,comment))) "NULL")) (sql (format "COMMENT ON TABLE %s IS %s" (pg-escape-identifier ,table) cmt))) ;; We can't use a prepared statement in this situation. (pg-exec ,con sql) ,comment)))) (defun pg-function-p (con name) "Returns non-null when a function with NAME is defined in PostgreSQL. Uses database connection CON." (pcase (pgcon-server-variant con) ;; The pg_proc table exists, but is empty. ('risingwave (signal 'pg-user-error (list "pg-function-p not implemented for Risingwave"))) ;; QuestDB does not implement the pg_proc table. ('questdb (let* ((sql "SELECT name FROM functions() WHERE name=$1") (res (pg-exec-prepared con sql `((,name . "text")))) (rows (pg-result res :tuples))) (not (null rows)))) ;; (cl-position name rows :key #'cl-first :test #'string=))) (_ (let* ((sql "SELECT * FROM pg_catalog.pg_proc WHERE proname = $1") (res (pg-exec-prepared con sql `((,name . "text"))))) (pg-result res :tuples))))) ;; DBMS metainformation ================================================ ;; ;; Metainformation such as the list of databases present in the database management system, list of ;; tables, attributes per table. This information is not available directly, but can be obtained by ;; querying the system tables. ;; ;; Based on the queries issued by psql in response to user commands `\d' and `\d tablename'; see ;; file /usr/local/src/pgsql/src/bin/psql/psql.c ;; ===================================================================== (defun pg-databases (con) "List of the databases in the PostgreSQL server we are connected to via CON." (let ((res (pg-exec con "SELECT datname FROM pg_catalog.pg_database"))) (apply #'append (pg-result res :tuples)))) (defun pg-current-schema (con) "Return the current schema in the PostgreSQL server we are connected to via CON." (pcase (pgcon-server-variant con) ('clickhouse (let* ((res (pg-exec con "SELECT currentDatabase()")) (row (pg-result res :tuple 0))) (cl-first row))) (_ (let* ((res (pg-exec con "SELECT current_schema()")) (row (pg-result res :tuple 0))) (cl-first row))))) ;; Possible alternative query: ;; SELECT nspname FROM pg_namespace (defun pg-schemas (con) "List of the schemas in the PostgreSQL database we are connected to via CON." (pcase (pgcon-server-variant con) ;; QuestDB doesn't really support schemas. ('questdb (list "sys" "public")) ((or 'risingwave 'octodb) (let ((res (pg-exec con "SELECT DISTINCT table_schema FROM information_schema.tables"))) (apply #'append (pg-result res :tuples)))) (_ (let ((res (pg-exec con "SELECT schema_name FROM information_schema.schemata"))) (apply #'append (pg-result res :tuples)))))) (defun pg--tables-information-schema (con) "List of the tables present in the database we are connected to via CON. Queries the information schema." (let* ((default-schema (if (eq (pgcon-server-variant con) 'cratedb) "postgres" "public")) (res (pg-exec con "SELECT table_schema,table_name FROM information_schema.tables WHERE table_schema NOT IN ('pg_catalog', 'information_schema') AND table_type='BASE TABLE'"))) (cl-loop for tuple in (pg-result res :tuples) collect (let ((schema (cl-first tuple)) (name (cl-second tuple))) (if (string= schema default-schema) name (make-pg-qualified-name :schema schema :name name)))))) ;; This method is better supported on very old PostgreSQL versions, or some semi-compatible ;; PostgreSQL databases that don't fully implement the information schema. (defun pg--tables-legacy (con) "List of the tables present in the database we are connected to via CON. Queries legacy internal PostgreSQL tables." (let ((res (pg-exec con "SELECT relname FROM pg_catalog.pg_class c WHERE " "c.relkind = 'r' AND " "c.relname !~ '^pg_' AND " "c.relname !~ '^sql_' ORDER BY relname"))) (apply #'append (pg-result res :tuples)))) ;; Exclude Materialize-internal tables (which are in Materialize-specific schemata) from the list of ;; tables returned by pg-tables. (defun pg--tables-materialize (con) (let ((res (pg-exec con "SELECT table_schema,table_name FROM information_schema.tables WHERE table_schema NOT IN ('information_schema', 'mz_catalog', 'mz_internal', 'mz_introspection') AND table_type='BASE TABLE'"))) (cl-loop for tuple in (pg-result res :tuples) collect (let ((schema (cl-first tuple)) (name (cl-second tuple))) (if (string= schema "public") name (make-pg-qualified-name :schema schema :name name)))))) ;; Exclude TimescaleDB-internal tables (which are in TimescaleDB-specific schemata) from the list of ;; tables returned by pg-tables. (defun pg--tables-timescaledb (con) (cl-labels ((timescale-name-p (tbl) (when (pg-qualified-name-p tbl) (let ((s (pg-qualified-name-schema tbl))) (cl-find s '("_timescaledb_cache" "_timescaledb_catalog" "_timescaledb_internal" "_timescaledb_config") :test #'string=))))) (cl-delete-if #'timescale-name-p (pg--tables-information-schema con)))) ;; Exclude CrateDB-internal tables (which are in the "sys" schemata) from the list of ;; tables returned by pg-tables. (defun pg--tables-cratedb (con) (cl-labels ((cratedb-name-p (tbl) (when (pg-qualified-name-p tbl) (string= "sys" (pg-qualified-name-schema tbl))))) (cl-delete-if #'cratedb-name-p (pg--tables-information-schema con)))) ;; Exclude Clickhouse-internal tables from the list of tables returned by pg-tables. ;; ;; We could also use the query ;; SELECT name FROM system.tables WHERE database == currentDatabase() (defun pg--tables-clickhouse (con) (cl-labels ((clickhouse-name-p (tbl) (when (pg-qualified-name-p tbl) (string= "system" (pg-qualified-name-schema tbl))))) (cl-delete-if #'clickhouse-name-p (pg--tables-information-schema con)))) (defun pg--tables-ydb (con) (let* ((sql "SELECT schemaname,tablename FROM pg_catalog.pg_tables WHERE hasindexes=true") (res (pg-exec con sql)) (rows (pg-result res :tuples))) (cl-loop for row in rows collect (make-pg-qualified-name :schema (cl-first row) :name (cl-second row))))) (defun pg-tables (con) "List of the tables present in the database we are connected to via CON. Only tables to which the current user has access are listed." (cond ((eq (pgcon-server-variant con) 'ydb) (pg--tables-ydb con)) ((eq (pgcon-server-variant con) 'timescaledb) (pg--tables-timescaledb con)) ((eq (pgcon-server-variant con) 'cratedb) (pg--tables-cratedb con)) ((eq (pgcon-server-variant con) 'materialize) (pg--tables-materialize con)) ((eq (pgcon-server-variant con) 'clickhouse) (pg--tables-clickhouse con)) ((eq (pgcon-server-variant con) 'octodb) (pg--tables-legacy con)) ((> (pgcon-server-version-major con) 11) (pg--tables-information-schema con)) (t (pg--tables-legacy con)))) (defun pg--columns-information-schema (con table) (let* ((default-schema (if (eq (pgcon-server-variant con) 'cratedb) "postgres" "public")) (schema (if (pg-qualified-name-p table) (pg-qualified-name-schema table) default-schema)) (tname (if (pg-qualified-name-p table) (pg-qualified-name-name table) table)) (sql "SELECT column_name FROM information_schema.columns WHERE table_schema=$1 AND table_name = $2") (res (pg-exec-prepared con sql `((,schema . "text") (,tname . "text"))))) (apply #'append (pg-result res :tuples)))) (defun pg--columns-legacy (con table) (let* ((sql (format "SELECT * FROM %s WHERE 0 = 1" table)) (res (pg-exec con sql))) (mapcar #'car (pg-result res :attributes)))) (defun pg-columns (con table) "List of the columns present in TABLE over PostgreSQL connection CON." (cond ((eq (pgcon-server-variant con) 'ydb) (pg--columns-legacy con table)) ((> (pgcon-server-version-major con) 7) (pg--columns-information-schema con table)) (t (pg--columns-legacy con table)))) (defun pg-column-default/full (con table column) "Return the default value for COLUMN in PostgreSQL TABLE. Using connection to PostgreSQL CON." (let* ((schema (if (pg-qualified-name-p table) (pg-qualified-name-schema table) "public")) (tname (if (pg-qualified-name-p table) (pg-qualified-name-name table) table)) (sql "SELECT column_default FROM information_schema.columns WHERE (table_schema, table_name, column_name) = ($1, $2, $3)") (argument-types (list "text" "text" "text")) (params `((,schema . "text") (,tname . "text") (,column . "text"))) (ps-name (pg-ensure-prepared-statement con "QRY-column-default" sql argument-types)) (res (pg-fetch-prepared con ps-name params))) (caar (pg-result res :tuples)))) (defun pg-column-default (con table column) "Return the default value for COLUMN in PostgreSQL TABLE. Using connection to PostgreSQL CON." (pcase (pgcon-server-variant con) ('cratedb nil) ('questdb nil) ('ydb nil) ;; TODO: Materialize is incorrectly returning "DEFAULT NULL" for the query used in ;; pg-column-default/full; we would try to add a workaround. (_ (pg-column-default/full con table column)))) (defun pg-column-comment (con table column) "Return the comment on COLUMN in TABLE in a PostgreSQL database. TABLE can be a string or a schema-qualified name. Uses database connection CON." (pcase (pgcon-server-variant con) ('cratedb nil) ('spanner nil) ('questdb nil) ;; RisingWave implements the col_description() function, but annoyingly returns empty values ;; even when comments are defined. Comment data is available in the rw_description table. ('risingwave (let* ((classoid (pg--table-classoid con table)) (t-id (pg-escape-identifier table)) (res (pg-exec con (format "SELECT * FROM %s LIMIT 0" t-id))) (column-number (or (cl-position column (pg-result res :attributes) :key #'cl-first :test #'string=) (signal 'pg-user-error (list (format "Column %s not found in table %s" column table))))) (sql "SELECT description FROM rw_catalog.rw_description WHERE objoid=$1 AND objsubid=$2") (res (pg-exec-prepared con sql `((,classoid . "int4") (,(1+ column-number) . "int4")))) (row (pg-result res :tuple 0))) (cl-first row))) (_ (let* ((t-id (pg-escape-identifier table)) (res (pg-exec con (format "SELECT * FROM %s LIMIT 0" t-id))) (column-number (or (cl-position column (pg-result res :attributes) :key #'cl-first :test #'string=) (signal 'pg-user-error (list (format "Column %s not found in table %s" column table))))) (sql "SELECT pg_catalog.col_description($1::regclass::oid, $2)") (res (pg-exec-prepared con sql `((,t-id . "text") (,(1+ column-number) . "int4")))) (tuples (pg-result res :tuples))) (when tuples (caar tuples)))))) (gv-define-setter pg-column-comment (comment con table column) `(pcase (pgcon-server-variant ,con) ('cratedb nil) ('questdb nil) ('spanner nil) (_ (let* ((cmt (if ,comment (pcase (pgcon-server-variant ,con) ;; RisingWave does not support the escaped literal format E'foo' that is ;; used by pg-escape-identifier. ('risingwave (concat "'" ,comment "'")) (_ (pg-escape-literal ,comment))) "NULL")) (sql (format "COMMENT ON COLUMN %s.%s IS %s" (pg-escape-identifier ,table) (pg-escape-identifier ,column) cmt))) ;; We can't use a prepared statement in this situation. (pg-exec ,con sql) ,comment)))) ;; This returns non-nil for columns for which you can insert a row without specifying a value for ;; the column. That includes columns: ;; ;; - with a specified DEFAULT (including SERIAL columns) ;; - specified as "BIGINT GENERATED ALWAYS AS IDENTITY" ;; - specified as "GENERATED ALWAYS AS expr STORED" (calculated from other columns) (defun pg-column-autogenerated-p/full (con table column) "Return non-nil if COLUMN has an SQL default value or is autogenerated. COLUMN is in TABLE. Uses connection to PostgreSQL CON." (let* ((schema (if (pg-qualified-name-p table) (pg-qualified-name-schema table) "public")) (tname (if (pg-qualified-name-p table) (pg-qualified-name-name table) table)) (sql "SELECT true FROM information_schema.columns WHERE (table_schema, table_name, column_name) = ($1, $2, $3) AND (column_default IS NOT NULL OR is_generated='ALWAYS' OR is_identity='YES')") (argument-types (list "text" "text" "text")) (params `((,schema . "text") (,tname . "text") (,column . "text"))) (ps-name (pg-ensure-prepared-statement con "QRY-column-autogenerated" sql argument-types)) (res (pg-fetch-prepared con ps-name params))) (caar (pg-result res :tuples)))) ;; CrateDB does not support the is_generated and is_identity columns in the ;; information_schema.columns table. ;; ;; Materialize is buggy on this query: it has column_default='NULL' as a text value, rather than (defun pg-column-autogenerated-p/simple (con table column) "Return non-nil if COLUMN has an SQL default value or is autogenerated. COLUMN is in TABLE. Uses connection to PostgreSQL CON." (let* ((schema (if (pg-qualified-name-p table) (pg-qualified-name-schema table) "public")) (tname (if (pg-qualified-name-p table) (pg-qualified-name-name table) table)) ;; CrateDB does not support tuple comparison WHERE (col1, col2) = (1, 2) (sql "SELECT true FROM information_schema.columns WHERE table_schema=$1 AND table_name=$2 AND column_name=$3 AND column_default IS NOT NULL") (argument-types (list "text" "text" "text")) (params `((,schema . "text") (,tname . "text") (,column . "text"))) (ps-name (pg-ensure-prepared-statement con "QRY-column-autogenerated" sql argument-types)) (res (pg-fetch-prepared con ps-name params))) (caar (pg-result res :tuples)))) (defun pg-column-autogenerated-p (con table column) "Return non-nil if COLUMN has an SQL default value or is autogenerated. COLUMN is in TABLE. Uses connection to PostgreSQL CON." (pcase (pgcon-server-variant con) ((or 'cratedb 'materialize 'questdb) (pg-column-autogenerated-p/simple con table column)) (_ (pg-column-autogenerated-p/full con table column)))) (defun pg-backend-version (con) "Version and operating environment of PostgreSQL backend. Concerns the backend that we are connected to over connection CON. PostgreSQL returns the version as a string. CrateDB returns it as an integer." (let ((res (pg-exec con "SELECT version()"))) (cl-first (pg-result res :tuple 0)))) ;; support routines ============================================================ ;; Called to handle a RowDescription message (defun pg-read-attributes (con) (let* ((_msglen (pg-read-net-int con 4)) (attribute-count (pg-read-net-int con 2)) (attributes (list)) (ce (pgcon-client-encoding con))) (cl-do ((i attribute-count (- i 1))) ((zerop i) (nreverse attributes)) (let ((type-name (pg-read-string con)) (_table-oid (pg-read-net-int con 4)) (_col (pg-read-net-int con 2)) (type-oid (pg-read-net-int con 4)) (type-len (pg-read-net-int con 2)) (_type-mod (pg-read-net-int con 4)) (_format-code (pg-read-net-int con 2))) (push (list (pg-text-parser type-name ce) type-oid type-len) attributes))))) ;; Read data following a DataRow message (defun pg-read-tuple (con attributes) (let* ((num-attributes (length attributes)) (col-count (pg-read-net-int con 2)) (tuples (list))) (unless (eql col-count num-attributes) (signal 'pg-protocol-error '("Unexpected value for attribute count sent by backend"))) (cl-do ((i 0 (+ i 1)) (type-ids (mapcar #'cl-second attributes) (cdr type-ids))) ((= i num-attributes) (nreverse tuples)) (let ((col-octets (pg-read-net-int con 4))) (cl-case col-octets (4294967295 ;; this is "-1" (pg-read-net-int doesn't handle integer overflow), which indicates a ;; NULL column (push nil tuples)) (0 (push "" tuples)) (t (let* ((col-value (pg-read-chars con col-octets)) (parsed (pg-parse con col-value (car type-ids)))) (push parsed tuples)))))))) (defun pg-read-char (con) (declare (speed 3)) (let ((process (pgcon-process con))) ;; (accept-process-output process 0.1) (with-current-buffer (process-buffer process) (when (null (char-after pgcon--position)) (dotimes (_i (pgcon-timeout con)) (when (null (char-after pgcon--position)) ;; (sleep-for 0.1) (accept-process-output process 1.0)))) (when (null (char-after pgcon--position)) (let ((msg (format "Timeout in pg-read-char reading from %s" con))) (signal 'pg-timeout (list msg)))) (prog1 (char-after pgcon--position) (setq-local pgcon--position (1+ pgcon--position)))))) (defun pg-unread-char (con) (let ((process (pgcon-process con))) (with-current-buffer (process-buffer process) (setq-local pgcon--position (1- pgcon--position))))) ;; FIXME should be more careful here; the integer could overflow. (defun pg-read-net-int (con bytes) (declare (speed 3)) (cl-do ((i bytes (- i 1)) (accum 0)) ((zerop i) accum) (setq accum (+ (* 256 accum) (pg-read-char con))))) (defun pg-read-int (con bytes) (declare (speed 3)) (cl-do ((i bytes (- i 1)) (multiplier 1 (* multiplier 256)) (accum 0)) ((zerop i) accum) (cl-incf accum (* multiplier (pg-read-char con))))) (defun pg-read-chars-old (con howmany) (cl-do ((i 0 (+ i 1)) (chars (make-string howmany ?.))) ((= i howmany) chars) (aset chars i (pg-read-char con)))) (defun pg-read-chars (con count) (declare (speed 3)) (let ((process (pgcon-process con))) (with-current-buffer (process-buffer process) (let* ((start pgcon--position) (end (+ start count))) ;; (accept-process-output process 0.1) (when (> end (point-max)) (dotimes (_i (pgcon-timeout con)) (when (> end (point-max)) ;; (sleep-for 0.1) (accept-process-output process 1.0)))) (when (> end (point-max)) (let ((msg (format "Timeout in pg-read-chars reading from %s" con))) (signal 'pg-timeout (list msg)))) (prog1 (buffer-substring start end) (setq-local pgcon--position end)))))) (cl-defun pg-read-string (con &optional (max-bytes 1048576)) "Read a null-terminated string from PostgreSQL connection CON. If MAX-BYTES is specified, it designates the maximal number of octets that will be read." (declare (speed 3)) (cl-loop for i below max-bytes for ch = (pg-read-char con) until (eql ch ?\0) concat (byte-to-string ch))) (cl-defstruct pgerror severity sqlstate message detail hint table column dtype file line routine where constraint) (defun pg-read-error-response (con) (let* ((response-len (pg-read-net-int con 4)) (msglen (- response-len 4)) (msg (pg-read-chars con msglen)) (msgpos 0) (err (make-pgerror)) (ce (pgcon-client-encoding con))) (cl-loop while (< msgpos (1- msglen)) for field = (aref msg msgpos) for val = (let* ((start (cl-incf msgpos)) (end (cl-position #x0 msg :start start :end msglen))) (prog1 (substring msg start end) (setf msgpos (1+ end)))) ;; these field types: https://www.postgresql.org/docs/current/protocol-error-fields.html do (cl-case field (?S (setf (pgerror-severity err) val)) ;; This is the unlocalized severity name (only sent for PostgreSQL > 9.6). It's ;; probably more useful to the user so we keep that. (?V (setf (pgerror-severity err) val)) (?C (setf (pgerror-sqlstate err) val)) (?M (setf (pgerror-message err) (decode-coding-string val ce))) (?D (setf (pgerror-detail err) (decode-coding-string val ce))) (?H (setf (pgerror-hint err) (decode-coding-string val ce))) (?F (setf (pgerror-file err) (decode-coding-string val ce))) (?L (setf (pgerror-line err) (decode-coding-string val ce))) (?R (setf (pgerror-routine err) (decode-coding-string val ce))) (?W (setf (pgerror-where err) (decode-coding-string val ce))) (?t (setf (pgerror-table err) val)) (?c (setf (pgerror-column err) val)) (?d (setf (pgerror-dtype err) val)) (?n (setf (pgerror-constraint err) val)))) err)) (defun pg-log-notice (notice) "Log a NOTICE to the *Messages* buffer." (let ((extra (list))) (when (pgerror-detail notice) (push ", " extra) (push (pgerror-detail notice) extra)) (when (pgerror-hint notice) (push ", " extra) (push (format "hint: %s" (pgerror-hint notice)) extra)) (when (pgerror-table notice) (push ", " extra) (push (format "table: %s" (pgerror-table notice)) extra)) (when (pgerror-column notice) (push ", " extra) (push (format "column: %s" (pgerror-column notice)) extra)) (setf extra (nreverse extra)) (pop extra) (setf extra (butlast extra)) (when extra (setf extra (append (list " (") extra (list ")")))) (message "PostgreSQL %s %s %s" (pgerror-severity notice) (pgerror-message notice) (apply #'concat extra)))) ;; higher order bits first / little endian (defun pg-send-uint (con num bytes) (declare (speed 3)) (let ((process (pgcon-process con)) (str (make-string bytes 0)) (i (- bytes 1))) (while (>= i 0) (aset str i (% num 256)) (setq num (floor num 256)) (cl-decf i)) (process-send-string process str))) ;; big endian (defun pg-send-net-uint (con num bytes) (declare (speed 3)) (let ((process (pgcon-process con)) (str (make-string bytes 0))) (dotimes (i bytes) (aset str i (% num 256)) (setq num (floor num 256))) (process-send-string process str))) (defun pg-send-char (con char) (let ((process (pgcon-process con))) (process-send-string process (char-to-string char)))) (defun pg-send-string (con string) (let ((process (pgcon-process con))) (process-send-string process string) ;; the null-terminator octet (process-send-string process (string 0)))) (defun pg-send-octets (con octets) (let ((process (pgcon-process con))) (process-send-string process octets))) (defun pg-send (con str &optional bytes) (declare (speed 3)) (let ((process (pgcon-process con)) (padding (if (and (numberp bytes) (> bytes (length str))) (make-string (- bytes (length str)) 0) (make-string 0 0)))) (process-send-string process (concat str padding)))) ;; Mostly for debugging use. Doesn't kill lo buffers. (defun pg-kill-all-buffers () "Kill all buffers used for network connections with PostgreSQL." (interactive) (cl-loop for buffer in (buffer-list) for name = (buffer-name buffer) when (and (> (length name) 12) (string= " *PostgreSQL*" (substring (buffer-name buffer) 0 13))) do (let ((p (get-buffer-process buffer))) (when p (kill-process p))) (kill-buffer buffer))) (provide 'pg) ;; Local Variables: ;; indent-tabs-mode: nil ;; End: ;;; pg.el ends here pg-el-0.54/test/000077500000000000000000000000001500535241500134255ustar00rootroot00000000000000pg-el-0.54/test/Makefile000066400000000000000000001134551500535241500150760ustar00rootroot00000000000000EMACS ?= emacs DOCKER ?= podman WORKDIR := $(shell mktemp -d) # export DEPS_DIR = $(shell realpath .deps) export DEPS_DIR := $(shell mktemp -d --tmpdir emacsdepsXXXX) default: test # Note: we have to include test/ in test/install-deps.el because when we load ../pg.el we change the # current directory to the parent of test. .PHONY: install-deps install-deps: ${EMACS} -Q --batch ../pg.el -l test/install-deps.el test: test-pg.el install-deps ${EMACS} -Q --batch -L .. -L . -l load-deps.el ../pg.el \ -l pg.el -l pg-geometry.el -l pg-gis.el -l test-pg.el -f pg-test test-interactive: test-pg.el install-deps ${EMACS} -Q -L .. -L . -l load-deps.el ../pg.el \ -l pg.el -l pg-geometry.el -l pg-gis.el -l test-pg.el -f pg-test supabase: install-deps ${EMACS} -Q --batch -L .. -L . -l load-deps.el -l ../pg.el -l supabase.el -f test-supabase hang: install-deps ${EMACS} -Q -L .. -L . -l load-deps.el -l ../pg.el -l hang.el # Run tests over an encrypted connection to PostgreSQL. Encryption is not available for all versions # and installations (the PostgreSQL backend needs to be set up with TLS certificates), so this is a # separate test target. test-tls: test-pg.el install-deps ${EMACS} -Q --batch -L .. -L . -l load-deps.el -l ../pg.el -l test-pg.el -f pg-test-tls test-tls-direct: test-pg.el install-deps ${EMACS} -Q --batch -L .. -L . -l load-deps.el -l ../pg.el -l test-pg.el -f pg-test-tls-direct # Run tests over a local Unix socket connection to PostgreSQL. test-local: test-pg.el install-deps ${EMACS} -Q --batch -L .. -L . -l load-deps.el -l ../pg.el -l test-pg.el -f pg-test-local test-ebiacuk: test-pg.el install-deps ${EMACS} -Q --batch -L .. -L . -l load-deps.el -l ../pg.el -l test-pg.el -f pg-test-ebiacuk test-connections: test-pg.el install-deps ${EMACS} -Q --batch -L .. -L . -l load-deps.el -l ../pg.el -l test-pg.el -f pg-connection-tests test-multithreaded: test-pg.el install-deps ${EMACS} -Q --batch -L .. -L . -l load-deps.el -l ../pg.el -l test-multithreaded.el -f pgtest-multithreaded test-pgvector: test-pgvector.el install-deps ${EMACS} -Q --batch -L .. -L . -l load-deps.el -l ../pg.el -l test-pgvector.el -f pg-test # Using Docker images for Emacs from https://hub.docker.com/r/silex/emacs/ and the locally installed # PostgreSQL. test-emacs-dev: test-pg.el cp install-deps.el load-deps.el ../pg.el ../pg-geometry.el ../pg-gis.el ../pg-bm25.el test-pg.el ${WORKDIR} ${DOCKER} run --rm -it \ -v ${WORKDIR}:/tmp \ -e DEPS_DIR=/tmp/deps \ -e PGEL_HOSTNAME=10.0.2.2 \ --network slirp4netns:allow_host_loopback=true \ docker.io/silex/emacs:master-alpine-ci \ ${EMACS} -Q --batch /tmp/pg.el -l /tmp/install-deps.el -l /tmp/load-deps.el -l /tmp/pg.el -l ../tmp/pg-geometry.el -l /tmp/pg-gis.el -l /tmp/pg-bm25.el -l /tmp/test-pg.el -f pg-test test-emacs28: test-pg.el cp install-deps.el load-deps.el ../pg.el ../pg-geometry.el ../pg-gis.el ../pg-bm25.el test-pg.el ${WORKDIR} ${DOCKER} run --rm -it \ -v ${WORKDIR}:/tmp \ -e DEPS_DIR=/tmp/deps \ -e PGEL_HOSTNAME=10.0.2.2 \ --network slirp4netns:allow_host_loopback=true \ docker.io/silex/emacs:28.1 \ ${EMACS} -Q --batch /tmp/pg.el -l /tmp/install-deps.el -l /tmp/load-deps.el -l /tmp/pg.el -l /tmp/pg-geometry.el -l /tmp/pg-gis.el -l /tmp/pg-bm25.el -l /tmp/test-pg.el -f pg-test # The peg.el library doesn't actually compile with Emacs 27 (void-function byte-run--set-speed), so # this doesn't work. test-emacs27: test-pg.el cp install-deps.el load-deps.el ../pg.el test-pg.el ${WORKDIR} ${DOCKER} run --rm -it \ -v ${WORKDIR}:/tmp \ -e DEPS_DIR=/tmp/deps \ -e PGEL_HOSTNAME=10.0.2.2 \ --network slirp4netns:allow_host_loopback=true \ docker.io/silex/emacs:27.2 \ ${EMACS} -Q --batch /tmp/pg.el -l /tmp/install-deps.el -l /tmp/load-deps.el -l /tmp/pg.el -l /tmp/test-pg.el -f pg-test # The extended query support will not work in Emacs versions before 28.1, because functionality # provided by the bindat libary is needed. However, other functionality based on the simple query # protocol (the pg-exec function) should work fine. test-emacs26: test-pg.el cp install-deps.el load-deps.el ../pg.el test-pg.el ${WORKDIR} ${DOCKER} run --rm -it \ -v ${WORKDIR}:/tmp \ -e DEPS_DIR=/tmp/deps \ -e PGEL_HOSTNAME=10.0.2.2 \ --network slirp4netns:allow_host_loopback=true \ docker.io/silex/emacs:26.3-alpine-ci \ ${EMACS} -Q --batch /tmp/pg.el -l /tmp/install-deps.el -l /tmp/load-deps.el -l /tmp/pg.el -l /tmp/test-pg.el -f pg-test # Emacs versions older than 26.1 will not work against a recent PostgreSQL version (that is set up # to require SCRAM-SHA-256 authentication), because they don't include the GnuTLS support which we # use to calculate HMACs. They may however work against a database set up to not require # authentication for local connections. test-emacs25: test-pg.el cp ../pg.el test-pg.el ${WORKDIR} ${DOCKER} run --rm -it \ -v ${WORKDIR}:/tmp \ -e DEPS_DIR=/tmp/deps \ -e PGEL_HOSTNAME=10.0.2.2 \ --network slirp4netns:allow_host_loopback=true \ docker.io/silex/emacs:25.3 \ ${EMACS} -Q --batch /tmp/pg.el -l /tmp/install-deps.el -l /tmp/load-deps.el -l /tmp/pg.el -l /tmp/test-pg.el -f pg-test test-postgresql17: test-pg.el ${DOCKER} run --rm --name pgsql \ --publish 5426:5426 \ -e POSTGRES_DB=pgeltestdb \ -e POSTGRES_USER=pgeltestuser \ -e POSTGRES_PASSWORD=pgeltest \ -e PGPORT=5426 \ -e TZ=Asia/Tokyo \ -d docker.io/library/postgres:17-alpine sleep 5 PGEL_PORT=5426 $(MAKE) test ${DOCKER} stop pgsql # A special test for short usernames, database names, passwords and so on (we used to have some # builtin assumptions that a username was a least 4 chars in length). test-shortnames: test-pg.el ${DOCKER} run --rm --name pgsql \ --publish 5926:5926 \ -e POSTGRES_DB=d \ -e POSTGRES_USER=u \ -e POSTGRES_PASSWORD=~ \ -e PGPORT=5926 \ -d docker.io/library/postgres:14 sleep 5 PGEL_PORT=5926 PGEL_DATABASE=d PGEL_USER=u PGEL_PASSWORD="~" $(MAKE) test ${DOCKER} stop pgsql test-postgresql16: test-pg.el ${DOCKER} run --rm --name pgsql \ --publish 5416:5416 \ -e POSTGRES_DB=pgeltestdb \ -e POSTGRES_USER=pgeltestuser \ -e POSTGRES_PASSWORD=pgeltest \ -e PGPORT=5416 \ -e TZ=Asia/Tokyo \ -d docker.io/library/postgres:16-alpine sleep 5 TZ=Asia/Tokyo PGEL_PORT=5416 $(MAKE) test ${DOCKER} stop pgsql test-postgresql15: test-pg.el ${DOCKER} run --rm --name pgsql \ --publish 5116:5116 \ -e POSTGRES_DB=pgeltestdb \ -e POSTGRES_USER=pgeltestuser \ -e POSTGRES_PASSWORD=pgeltest \ -e PGPORT=5116 \ -d docker.io/library/postgres:15 sleep 5 PGEL_PORT=5116 $(MAKE) test ${DOCKER} stop pgsql test-postgresql14: test-pg.el ${DOCKER} run --rm --name pgsql \ --publish 5439:5439 \ -e POSTGRES_DB=pgeltestdb \ -e POSTGRES_USER=pgeltestuser \ -e POSTGRES_PASSWORD=pgeltest \ -e PGPORT=5439 \ -d docker.io/library/postgres:14 sleep 5 PGEL_PORT=5439 $(MAKE) test ${DOCKER} stop pgsql test-postgresql13: test-pg.el ${DOCKER} run --rm --name pgsql \ --publish 5439:5439 \ -e POSTGRES_DB=pgeltestdb \ -e POSTGRES_USER=pgeltestuser \ -e POSTGRES_PASSWORD=pgeltest \ -e PGPORT=5439 \ -d docker.io/library/postgres:13-alpine sleep 5 PGEL_PORT=5439 $(MAKE) test ${DOCKER} stop pgsql test-postgresql12: test-pg.el ${DOCKER} run --rm --name pgsql \ --publish 5439:5439 \ -e POSTGRES_DB=pgeltestdb \ -e POSTGRES_USER=pgeltestuser \ -e POSTGRES_PASSWORD=pgeltest \ -e PGPORT=5439 \ -d docker.io/library/postgres:12-alpine sleep 5 PGEL_PORT=5439 $(MAKE) test ${DOCKER} stop pgsql test-postgresql11: test-pg.el ${DOCKER} run --rm --name pgsql \ --publish 5437:5437 \ -e POSTGRES_DB=pgeltestdb \ -e POSTGRES_USER=pgeltestuser \ -e POSTGRES_PASSWORD=pgeltest \ -e PGPORT=5437 \ -d docker.io/library/postgres:11-alpine sleep 5 PGEL_PORT=5437 $(MAKE) test ${DOCKER} stop pgsql # EDB with a Red Hat Universal Base Image. This defaults to an SQL_ASCII client-encoding unless we # set LC_CTYPE. # # https://github.com/EnterpriseDB/docker-postgresql test-enterprisedb: test-pg.el ${DOCKER} run --rm --name edb \ --publish 5366:5366 \ -e TZ=UTC-7:00 \ -e LANG=en_US.UTF8 \ -e LC_CTYPE=en_US.UTF8 \ -e POSTGRES_DB=pgeltestdb \ -e POSTGRES_USER=pgeltestuser \ -e POSTGRES_PASSWORD=pgeltest \ -e PGPORT=5366 \ -d ghcr.io/enterprisedb/postgresql:17 TZ=UTC-7:00 PGEL_PORT=5366 $(MAKE) test ${DOCKER} stop edb # Tests with a PostgreSQL server configured to only accept clients that present a CA-signed certificate. # # https://www.postgresql.org/docs/current/ssl-tcp.html # # We use openssl to generate a new Root certificate authority and key. Use the root CA to create a # server certificate and key and a client certificate and key. Start PostgreSQL with the server # certificate and the root CA certificate, configured to require clients to present a client # certificate signed by our root CA. Connect presenting the client certificate (this uses the GnuTLS # support for client certificates in Emacs). # # Note: mounting the pgcerts volume with the :U modifier maps the file owner for all volume files to # that selected by the container ("postgres"), which is required for PostgreSQL to accept that the # server certificate key is not readable by other users. # # https://github.com/bitnami/containers/blob/main/bitnami/postgresql/README.md # # The Bitnami configuration for pg_hba.conf deletes all lines with authentication methods # local, or md5, or trust (our value for POSTGRESQL_PHHBA_REMOVE_FILTERS), and adds a line # # hostssl all all 0.0.0.0/0 cert # # This means the equivalent of clientcert=verify-full, meaning that the server will verify that the # client certificate is signed by its root CA (configured as /certs/root.crt below) and will also # verify that the username specified in the CN field of the certificate corresponds to the # PostgreSQL username we are connecting as. test-certificates: test-pg.el install-deps openssl req -new -nodes -text -out ${WORKDIR}/root.csr -keyout ${WORKDIR}/root.key \ -subj "/CN=localhost" chmod og-rwx ${WORKDIR}/root.key openssl x509 -req -in ${WORKDIR}/root.csr -text -days 42 \ -extfile /etc/ssl/openssl.cnf -extensions v3_ca \ -signkey ${WORKDIR}/root.key -out ${WORKDIR}/root.crt openssl req -new -nodes -text -out ${WORKDIR}/server.csr -keyout ${WORKDIR}/server.key \ -subj "/CN=localhost" chmod og-rwx ${WORKDIR}/server.key openssl x509 -req -in ${WORKDIR}/server.csr -text -days 42 \ -CA ${WORKDIR}/root.crt -CAkey ${WORKDIR}/root.key \ -CAcreateserial -out ${WORKDIR}/server.crt openssl req -new -nodes -out ${WORKDIR}/client.csr -keyout ${WORKDIR}/client.key \ -subj "/CN=pgeltestuser" openssl x509 -req -days 42 -in ${WORKDIR}/client.csr \ -CA ${WORKDIR}/root.crt \ -CAkey ${WORKDIR}/root.key \ -CAcreateserial -out ${WORKDIR}/client.crt chmod 600 ${WORKDIR}/server.key ls -l ${WORKDIR} ${DOCKER} volume create pgcerts tar cf ${WORKDIR}/certs.tar --directory=${WORKDIR} server.crt server.key root.crt ${DOCKER} volume import pgcerts ${WORKDIR}/certs.tar ${DOCKER} run --rm --name pgsqltls \ -v pgcerts:/certs:U \ --publish 5488:5488 \ -e POSTGRESQL_PORT_NUMBER=5488 \ -e POSTGRESQL_DATABASE=pgeltestdb \ -e POSTGRESQL_USERNAME=pgeltestuser \ -e POSTGRESQL_PASSWORD=pgeltest \ -e POSTGRESQL_ENABLE_TLS=yes \ -e POSTGRESQL_TLS_CERT_FILE=/certs/server.crt \ -e POSTGRESQL_TLS_KEY_FILE=/certs/server.key \ -e POSTGRESQL_TLS_CA_FILE=/certs/root.crt \ -e POSTGRESQL_PGHBA_REMOVE_FILTERS=local,md5,trust \ -d docker.io/bitnami/postgresql:latest sleep 5 PGEL_CLIENT_CERT=${WORKDIR}/client.crt PGEL_CLIENT_CERT_KEY=${WORKDIR}/client.key PGEL_PORT=5488 ${EMACS} -Q --batch -L .. -L . -l load-deps.el -l ../pg.el -l test-pg.el -f pg-test-client-cert ${DOCKER} stop pgsqltls sleep 2 ${DOCKER} volume rm pgcerts # Supabase (https://supabase.com) provide hosted PostgreSQL instances with convenient web # dashboards, management APIs and integrations with authentication libraries. They have a free tier. # As of 2023-08, they are running PostgreSQL 15.1 on Aarch64. As of 2024-09, their TLS setup is not # compatible with the GnuTLS settings used by the Emacs TLS support, and Emacs is not able to # connect. test-supabase: test-pg.el $(MAKE) test-tls # Neon (https://neon.tech/) provide hosted "serverless" PostgreSQL instances, which allow convenient # automated scalability according to load. They have a free tier. As of 2024-09, they are running # PostgreSQL "15.8" on AMD64. test-neon: test-pg.el PGURI="postgresql://user:password@foo.eu-central-1.aws.neon.tech/main?sslmode=require" $(MAKE) test-tls # app.xata.io are running PostgreSQL 15.5 on aarch64/Linux as of 2025-01 test-xata: test-pg.el PGURI="postgresql://user:password@eu-central-1.sql.xata.sh/pgeltestdb:main?sslmode=force" $(MAKE) test-tls # https://docs.timescale.com/self-hosted/latest/install/installation-docker/ # # Note that Timescaledb has a bunch of internal tables (owned by the currently connected user) in # schemas named _timescaledb_cache, _timescaledb_catalog, timescaledb_internal and so on. We have # code in pg-el to remove these from the list of tables returned by pg-tables. test-timescale: test-pg.el ${DOCKER} run --rm --name timescale \ --publish 5981:5981 \ -e POSTGRES_DB=pgeltestdb \ -e POSTGRES_USER=pgeltestuser \ -e POSTGRES_PASSWORD=pgeltest \ -e PGPORT=5981 \ -d docker.io/timescale/timescaledb:latest-pg17 sleep 5 PGEL_PORT=5981 $(MAKE) test ${DOCKER} stop timescale # https://hub.docker.com/r/citusdata/citus # # An extension for sharding PostgreSQL. We could recognize it by checking for the system tables # s(pg-qualified-name columnar_internal options) #s(pg-qualified-name columnar_internal stripe) # #s(pg-qualified-name columnar_internal chunk_group) #s(pg-qualified-name columnar_internal chunk), # or by the presence of "citus_internal" in the pg-schemas list, but since we don't see any # behavioural difference from standard PostgreSQL, we don't report this as a variant. test-citus: test-pg.el ${DOCKER} run --rm --name citus \ --publish 5409:5409 \ -e POSTGRES_DB=pgeltestdb \ -e POSTGRES_USER=pgeltestuser \ -e POSTGRES_PASSWORD=pgeltest \ -e PGPORT=5409 \ -d docker.io/citusdata/citus:latest sleep 5 PGEL_PORT=5409 $(MAKE) test ${DOCKER} stop citus # A PostgreSQL extension that adds a new storage engine designed for better multithreading and solid # state storage. # # https://github.com/orioledb/orioledb # https://hub.docker.com/r/orioledb/orioledb test-orioledb: test-pg.el ${DOCKER} run --rm --name orioledb \ --publish 5317:5317 \ -e POSTGRES_DB=pgeltestdb \ -e POSTGRES_USER=pgeltestuser \ -e POSTGRES_PASSWORD=pgeltest \ -e PGPORT=5317 \ -d docker.io/orioledb/orioledb:latest-pg17 sleep 5 PGEL_PORT=5317 $(MAKE) test ${DOCKER} stop orioledb # An Oracle-compatible flavour of PostgreSQL. # # https://docs.ivorysql.org/en/ivorysql-doc/v3.4/v3.4/6#Docker-installation # https://registry.hub.docker.com/r/ivorysql/ivorysql/tags test-ivorysql: test-pg.el ${DOCKER} run --rm --name ivorydb \ --publish 5437:5432 \ -e LANG=C.UTF8 \ -e LC_CTYPE=C.UTF8 \ -e IVORYSQL_DB=pgeltestdb \ -e IVORYSQL_USER=pgeltestuser \ -e IVORYSQL_PASSWORD=pgeltest \ -d docker.io/ivorysql/ivorysql:4.4-ubi8 sleep 5 PGEL_PORT=5437 $(MAKE) test ${DOCKER} stop ivorydb # An ElasticSearch alternative, built as a PostgreSQL extension. Works fine with pg.el. # https://docs.paradedb.com/introduction#get-started # # As of 2025-05, the paradedb docker image is built on a Debian PostgreSQL 17.4. It has some TIGER # data preloaded. test-paradedb: test-pg.el ${DOCKER} run --rm --name paradedb \ --publish 5441:5441 \ -e POSTGRES_DB=pgeltestdb \ -e POSTGRESQL_PORT_NUMBER=5441 \ -e PGPORT=5441 \ -e POSTGRESQL_MASTER_PORT_NUMBER=5441 \ -e POSTGRES_USER=pgeltestuser \ -e POSTGRES_PASSWORD=pgeltest \ -e POSTGRESQL_POSTGRES_PASSWORD=pgeltest \ -d docker.io/paradedb/paradedb:latest sleep 5 PGEL_PORT=5441 $(MAKE) test ${DOCKER} stop paradedb # Another ElasticSearch alternative, built as a PostgreSQL extension, implementing the BM25 algorithm. # # https://github.com/tensorchord/VectorChord-bm25/ test-vectorchord: test-pg.el ${DOCKER} run --rm --name vectorchord \ --pull=newer \ --publish 5778:5432 \ -e POSTGRES_DB=pgeltestdb \ -e POSTGRES_USER=pgeltestuser \ -e POSTGRES_PASSWORD=pgeltest \ -d ghcr.io/tensorchord/vchord_bm25-postgres:pg17-v0.2.1 sleep 5 PGURI=postgresql://pgeltestuser:pgeltest@localhost:5778/pgeltestdb $(MAKE) test ${DOCKER} stop vectorchord # Hydra Columnar database # https://github.com/hydradatabase/columnar?tab=readme-ov-file test-hydra: test-pg.el ${DOCKER} run --rm --name hydra \ --pull=newer \ --publish 5167:5167 \ -e POSTGRES_DB=pgeltestdb \ -e POSTGRESQL_PORT_NUMBER=5167 \ -e PGPORT=5167 \ -e POSTGRESQL_MASTER_PORT_NUMBER=5167 \ -e POSTGRES_USER=pgeltestuser \ -e POSTGRES_PASSWORD=pgeltest \ -e POSTGRESQL_POSTGRES_PASSWORD=pgeltest \ -d ghcr.io/hydradatabase/hydra:15-5a258d26896de0f47b08658dc8fa914ad453eeab sleep 5 PGURI=postgresql://pgeltestuser:pgeltest@localhost:5167/pgeltestdb $(MAKE) test ${DOCKER} stop hydra # Microsoft DocumentDB (PostgreSQL-based). This is not the same product as Amazon DocumentDB. # # https://github.com/microsoft/documentdb # # Here using the prebuilt Docker image provided by FerretDB # https://docs.ferretdb.io/installation/ferretdb/docker/ # # -e POSTGRES_INITDB_ARGS="-c cron.database_name=pgeltestdb" \ # Note: we can't change the database name with POSTGRES_DATABASE as that messes with the # initialization of the pg_cron extension. Likewise for the POSTGRES_USER because that changes the # default database name. test-documentdb: test-pg.el ${DOCKER} run --rm --name documentdb \ --pull=newer \ --publish 5488:5488 \ -e POSTGRES_PASSWORD=pgeltest \ -e PGPORT=5488 \ -d ghcr.io/ferretdb/postgres-documentdb:latest sleep 5 PGURI=postgresql://postgres:pgeltest@127.0.0.1:5488/postgres $(MAKE) test ${DOCKER} stop documentdb # Test pgbouncer proxying to our local PostgreSQL (in session pooling mode, so that functionality # such as LISTEN works). # # https://github.com/edoburu/docker-pgbouncer test-pgbouncer: test-pg.el ${DOCKER} run --rm --name pgbouncer \ --net host \ -e PGBOUNCER_PORT=6432 \ -e PGBOUNCER_DATABASE=pgeltestdb \ -e POSTGRESQL_USERNAME=pgeltestuser \ -e POSTGRESQL_PASSWORD=pgeltest \ -e POSTGRESQL_HOST=localhost \ -e POSTGRESQL_PORT=5432 \ -d docker.io/bitnami/pgbouncer:latest sleep 5 PGEL_PORT=6432 $(MAKE) test ${DOCKER} stop pgbouncer # pgcat bouncer/sharding middleware # # https://github.com/postgresml/pgcat # https://github.com/postgresml/pgcat/blob/main/Dockerfile test-pgcat: test-pg.el cp pgcat-config.toml /tmp ${DOCKER} run --rm --name pgcat \ --pull=newer \ -v /tmp/pgcat-config.toml:/etc/pgcat/pgcat.toml \ --net host \ -d ghcr.io/postgresml/pgcat:latest sleep 5 PGURI=postgresql://pgeltestuser:pgeltest@127.0.0.1:6432/pgeltestdb $(MAKE) test ${DOCKER} stop pgcat # pgdog bouncer/sharding middleware (same developer as pgcat) # # https://github.com/pgdogdev/pgdog test-pgdog: test-pg.el cp pgdog-config.toml pgdog-users.toml /tmp ${DOCKER} run --rm --name pgdog \ --pull=newer \ -v /tmp/pgdog-config.toml:/pgdog/pgdog.toml \ -v /tmp/pgdog-users.toml:/pgdog/users.toml \ --net host \ -d ghcr.io/pgdogdev/pgdog:main sleep 5 PGURI=postgresql://pgeltestuser:pgeltest@127.0.0.1:5469/pgeltestdb $(MAKE) test ${DOCKER} stop pgdog # https://readyset.io/docs/get-started/install-rs/docker/postgres # https://readyset.io/docs/reference/cli/readyset test-readyset: test-pg.el ${DOCKER} run --rm --name bitnamipg \ --publish 5488:5488 \ -e POSTGRESQL_PORT_NUMBER=5488 \ -e POSTGRESQL_DATABASE=pgeltestdb \ -e POSTGRESQL_USERNAME=pgeltestuser \ -e POSTGRESQL_PASSWORD=pgeltest \ -d docker.io/bitnami/postgresql:latest sleep 5 ${DOCKER} run --rm --name readyset \ --pull=newer --net=host \ -e DISABLE_UPSTREAM_SSL_VERIFICATION=true \ -e UPSTREAM_DB_URL=postgresql://pgeltestuser:pgeltest@localhost:5488/pgeltestdb \ -e LISTEN_ADDRESS=127.0.0.1:5433 \ -d docker.io/readysettech/readyset:latest --disable-telemetry --database-type=postgresql sleep 10 PGURI=postgresql://pgeltestuser:pgeltest@127.0.0.1:5433/pgeltestdb $(MAKE) test ${DOCKER} stop readyset ${DOCKER} stop bitnamipg # CrateDB uses a default database name of "doc" that we can't set via Docker. Doesn't get very far # through the tests: CrateDB doesn't accept a query which only contains an SQL comment, and doesn't # implement the BYTEA, JSON, JSONB and HSTORE types, doesn't support COPY, doesn't support Unicode # identifiers. # # It even seems to lose some INSERT statements (failing in pg-test-insert on the count of rows # inserted into the row_count table). # # https://hub.docker.com/_/crate/ # https://cratedb.com/docs/guide/install/container/docker.html # https://cratedb.com/docs/crate/reference/en/latest/interfaces/postgres.html test-cratedb: test-pg.el ${DOCKER} run --rm --name cratedb \ --pull=newer \ --net host \ -e CRATE_HEAP_SIZE=1g \ -d docker.io/crate \ -Cnetwork.host=127.0.0.1 -Cdiscovery.type=single-node -Cpsql.port=5789 sleep 5 PGURI=postgresql://crate@127.0.0.1:5789/postgres $(MAKE) test ${DOCKER} stop cratedb # Doesn't get very far through the tests, with an internal error generated by our query for # pg-table-owner, and failing on the boolean vector syntax b'1001000'. # # Still affected as of 2024-12 by the panic bug https://github.com/cockroachdb/cockroach/issues/104009 # which was reported in May 2023! test-cockroachdb: test-pg.el ${DOCKER} run --rm --name cockroachdb \ --pull=newer \ -e COCKROACH_DATABASE=pgeltestdb \ -e COCKROACH_USER=pgeltestuser \ -e COCKROACH_PASSWORD=pgeltest \ --publish 26257:26257 \ -d docker.io/cockroachdb/cockroach start-single-node sleep 5 PGURI="postgresql://pgeltestuser:pgeltest@127.0.0.1:26257/pgeltestdb?sslmode=require" $(MAKE) test ${DOCKER} stop cockroachdb # This database (based on PostgreSQL 12.3 but which for some reason claims to have a backend major # version of 11) doesn't get very far through the tests; it fails on "SELECT 1::integer" because it # doesn't recognize integer as a type. Also, DELETE statements are not supported. # # Note: we could test the TLS support for the PostgreSQL wire protocol by setting parameters # tls.enabled=true # tls.demo.mode=true # # https://questdb.io/docs/configuration/ test-questdb: test-pg.el ${DOCKER} run --rm --name questdb \ --pull=newer \ --publish 127.0.0.1:8812:8812 \ --publish 127.0.0.1:9000:9000 \ -e QDB_PG_USER=pgeltestuser \ -e QDB_PG_PASSWORD=pgeltest \ -d docker.io/questdb/questdb sleep 5 PGURI=postgresql://pgeltestuser:pgeltest@127.0.0.1:8812/postgres $(MAKE) test ${DOCKER} stop questdb # Last tested 2025-03, Yugabyte 2.25 is based on PostgreSQL 15.2. This works very well, including # the HSTORE and pgvector extensions. The sequence test fails (SELECT last_value FROM pg_sequences). # Some more recent SQL evolutions such as "INTEGER GENERATED ALWAYS AS expression STORED" are not # supported. LISTEN/NOTIFY is not supported. # # TODO: test YSQL_PASSWORD # https://docs.yugabyte.com/preview/reference/configuration/yugabyted/ test-yugabyte: test-pg.el ${DOCKER} run --rm --name yugabyte \ --pull=newer \ --net host \ -e YSQL_DB=pgeltestdb \ -e YSQL_USER=pgeltestuser \ -d docker.io/yugabytedb/yugabyte:latest \ bin/yugabyted start \ --ysql_port 5493 \ --advertise_address 127.0.0.1 \ --base_dir=/tmp \ --background=false sleep 10 PGURI=postgresql://pgeltestuser@127.0.0.1:5493/pgeltestdb $(MAKE) test ${DOCKER} stop yugabyte # Materialize (here the "Materialize emulator" running in Docker). This proprietary differential # dataflow database has many limitations in its PostgreSQL compatibility: no support for primary # keys, unique constraints, check constraints, for the 'bit' type for example. # # https://materialize.com/blog/postgres-compatibility/ test-materialize: test-pg.el ${DOCKER} run --rm --name materialize \ --publish 6875:6875 \ -d docker.io/materialize/materialized:latest sleep 10 PGURI=postgresql://materialize@127.0.0.1:6875/materialize $(MAKE) test ${DOCKER} stop materialize # Yellowbrick Database Community Edition (requires Kubernetes, currently untested) # # https://docs.yellowbrick.com/7.1.0/platforms/cloud/ce/docker/ce_cloud_docker.html # https://hub.docker.com/r/yellowbrickdata/ybd-ce-k0s-amd64 test-yellowbrick: test-pg.el ${DOCKER} volume ls --format '{{ .Name }}' | grep -qw ybd-storage-rfs || podman volume create ybd-storage-rfs ${DOCKER} volume ls --format '{{ .Name }}' | grep -qw ybd-storage-lfs || podman volume create ybd-storage-lfs mkdir -p /tmp/yellowbrick ${DOCKER} run --rm --name yellowbrick \ --hostname yellowbrick \ --cgroupns=host \ -v ybd-storage-rfs:/var/lib/k0s \ -v ybd-storage-lfs:/tmp/yellowbrick \ -v /sys/fs/cgroup:/sys/fs/cgroup:rw \ --publish 5689:5432 \ -d docker.io/yellowbrickdata/ybd-ce-k0s-amd64:stable sleep 10 PGURI=postgresql://postgres@127.0.0.1:5689/postgres $(MAKE) test ${DOCKER} stop yellowbrick ${DOCKER} volume rm ybd-storage-rfs ${DOCKER} volume rm ybd-storage-lfs # https://docs.immudb.io/master/running/download.html # https://hub.docker.com/r/codenotary/immudb # # immadmin doesn't seem to provide a useful way to provide password via environment # not to be used in a non-interactive manner # # We see a protocol error "database name not provided" after the StartupMessage # whereas psql is able to connect when disabling TLS # psql "sslmode=disable host=localhost port=5667 dbname=pgeltestdb user=pgeltestuser password=pgeltest" # though few SQL commands work. test-immudb: test-pg.el ${DOCKER} run --rm --name immudb \ --net host \ -d docker.io/codenotary/immudb:latest \ --pgsql-server --pgsql-server-port 5667 \ --admin-password pgeltest --force-admin-password sleep 2 echo pgeltest|${DOCKER} exec -ti immudb immuadmin login immudb ${DOCKER} exec -ti immudb immuadmin database create pgeltestdb expect -c 'spawn ${DOCKER} exec -ti immudb immuadmin user create pgeltestuser readwrite pgeltestdb;sleep 0.1;expect "Choose a password for";sleep 0.1;send "pgeltest\r";expect "continue with your password instead.*Y/n";sleep 0.1;send "Y\r";expect "Confirm password";sleep 0.1;send "pgeltest\r";sleep 0.1;exit' PGURI=postgresql://pgeltestuser:pgeltest@localhost:5667/pgeltestdb $(MAKE) test ${DOCKER} stop immudb # https://hub.docker.com/r/andruche/greenplum # https://github.com/greenplum-db/gpdb-archive test-greenplum: test-pg.el ${DOCKER} run --rm --name greenplum \ --pull=newer \ --publish 5433:5432 \ -e PGPORT=5433 \ -d docker.io/andruche/greenplum:7 sleep 10 PGURI=postgresql://gpadmin@localhost:5433/postgres $(MAKE) test ${DOCKER} stop greenplum # The Cloudberry fork of Greenplum, incubated at Apache. # https://github.com/apache/cloudberry/ # https://hub.docker.com/r/apache/incubator-cloudberry/ test-cloudberry: test-pg.el ${DOCKER} run --rm --name cloudberry \ --publish 5661:5661 \ -h cdw -e PGPORT=5661 \ -d docker.io/apache/incubator-cloudberry:cbdb-test-rocky9-latest sleep 5 PGEL_DATABASE=postgres PGEL_USER=gpadmin PGEL_PASSWORD="greenplum" PGEL_PORT=5661 $(MAKE) test ${DOCKER} stop cloudberry # Google Spanner emulator # See https://github.com/GoogleCloudPlatform/pgadapter/blob/postgresql-dialect/docs/emulator.md # https://cloud.google.com/spanner/docs/pgadapter-start#docker # # Extremely limited PostgreSQL support. Basic types such as int2 are not supported. test-spanner: test-pg.el ${DOCKER} run --rm --name spanner \ --pull=newer \ --publish 127.0.0.1:5499:5432 \ -d gcr.io/cloud-spanner-pg-adapter/pgadapter-emulator:latest -d pgeltestdb sleep 2 PGURI=postgresql://postgres@127.0.0.1:5499/pgeltestdb $(MAKE) test ${DOCKER} stop spanner # YDB by Yandex. Last tested 2025-03 version 23.4. # # https://ydb.tech/docs/en/postgresql/docker-connect # https://hub.docker.com/r/ydbplatform/local-ydb/tags (this an older version) # # Fairly limited PostgreSQL support currently; for example all tables must have a primary key. # Bit vectors are not returned with a bitvector oid in the metainformation. # # Many supported functions, as per https://ydb.tech/docs/en/postgresql/functions # # There is apparently an environment variable YDB_PG_PORT but it seems to be ignored. test-ydb: test-pg.el ${DOCKER} run --rm --name ydb \ --pull=newer \ --publish 127.0.0.1:5119:5432 \ -e YDB_EXPERIMENTAL_PG=1 \ -e POSTGRES_USER=pgeltestuser \ -e POSTGRES_PASSWORD=pgeltest \ -e YDB_PG_DATABASE=pgeltestdb \ -e YDB_USE_IN_MEMORY_PDISKS=true \ -e YDB_FEATURE_FLAGS=enable_temp_tables \ -d ghcr.io/ydb-platform/local-ydb:nightly sleep 5 PGURI=postgresql://pgeltestuser:pgeltest@localhost:5119/local $(MAKE) test ${DOCKER} stop ydb # Last tested 2025-04 with version 25.1. Very limited PostgreSQL support: there is no pg_type table # so we can't retrieve information regarding the OID of builtin types. We have to be careful during # the initialization sequence not to send the query "SET datestyle = 'ISO'", which would fail and cause # the network connection to be reset (!). # Default values for config.xml file at # https://github.com/ClickHouse/ClickHouse/blob/c7996d54536492ebd4f436672e466464e8474ff9/programs/server/config.xml test-clickhouse: test-pg.el echo '549100' > /tmp/pgel-config.xml ${DOCKER} run --rm --name clickhouse \ --ulimit nofile=62144:62144 \ --ulimit core=234567:234567 \ -v /tmp/pgel-config.xml:/etc/clickhouse-server/config.d/pgel-config.xml \ --publish 127.0.0.1:5491:5491 \ --publish 127.0.0.1:18123:8123 \ --publish 127.0.0.1:9000:9000 \ -e CLICKHOUSE_DB=pgeltestdb \ -e CLICKHOUSE_USER=pgeltestuser \ -e CLICKHOUSE_PASSWORD=pgeltest \ -d docker.io/clickhouse/clickhouse-server sleep 5 PGEL_PORT=5491 PGEL_SERVER_VARIANT=clickhouse $(MAKE) test ${DOCKER} stop clickhouse # https://docs.greptime.com/getting-started/installation/greptimedb-standalone # # This database implements quite a lot of the PostgreSQL wire protocol, but the names it uses for # types in the pg_catalog.pg_types table are not the same as PostgreSQL, so our parsing machinery # does not work (we see 42 returned as "42"). # # postgresql://pgeltestuser:pgeltest@localhost:4003/public test-greptimedb: test-pg.el ${DOCKER} run --rm --name greptimedb \ --pull=newer \ --publish 127.0.0.1:4003:4003 \ -d docker.io/greptime/greptimedb:latest standalone start \ --http-addr 0.0.0.0:4000 \ --rpc-addr 0.0.0.0:4001 \ --mysql-addr 0.0.0.0:4002 \ --postgres-addr 0.0.0.0:4003 sleep 5 PGEL_PORT=4003 PGEL_DATABASE=public $(MAKE) test ${DOCKER} stop greptimedb # RisingWave event streaming database. # https://github.com/risingwavelabs/risingwave # Also at ghcr.io/risingwavelabs/risingwave # https://docs.risingwave.com/get-started/quickstart # # Fails on query "SELECT 'gday'::varchar(20)" # # Could test TLS support with environment variables RW_SSL_CERT and RW_SSL_KEY. test-risingwave: test-pg.el ${DOCKER} run --rm --name risingwave \ --pull=newer \ -e ENABLE_TELEMETRY=false \ --publish 127.0.0.1:4566:4566 \ -d docker.io/risingwavelabs/risingwave:latest single_node sleep 5 PGURI=postgresql://root@127.0.0.1:4566/dev $(MAKE) test ${DOCKER} stop risingwave # Google AlloyDB Omni. This is PostgreSQL with proprietary Google-developed extensions, including a # columnar storage extension, adaptive autovacuum, and an index advisor. # # https://cloud.google.com/alloydb/omni/docs/quickstart # https://hub.docker.com/r/google/alloydbomni # https://cloud.google.com/alloydb/docs/reference/database-flags # Seems to ignore the PGPORT environment variable test-alloydb: test-pg.el ${DOCKER} run --rm --name alloydb \ --pull=newer \ --publish 127.0.0.1:4481:5432 \ -e POSTGRES_DB=pgeltestdb \ -e POSTGRES_USER=pgeltestuser \ -e POSTGRES_PASSWORD=pgeltest \ -d docker.io/google/alloydbomni:latest -c google_columnar_engine.enabled=on sleep 10 PGURI=postgresql://pgeltestuser:pgeltest@127.0.0.1:4481/pgeltestdb $(MAKE) test ${DOCKER} stop alloydb # YottaDB Octo # # https://gitlab.com/YottaDB/DBMS/YDBOcto/-/blob/master/README.md#using-the-docker-images # https://docs.yottadb.com/Octo/config.html # # To give a user permission to modify schemas, recreate the user using ydboctoAdmin with the --allowschemachanges # yottadb -r %ydboctoAdmin add user OctoUser --readwrite --allowschemachanges test-octodb: test-pg.el cp octo-entrypoint.sh /tmp chmod og+x /tmp/octo-entrypoint.sh ${DOCKER} run --rm --name octodb \ --pull=newer \ --publish 127.0.0.1:5669:1337 \ -v /tmp/octo-entrypoint.sh:/entrypoint.sh \ -d docker.io/yottadb/octo:latest sleep 5 PGURI=postgresql://pgeltestuser:pgeltest@127.0.0.1:5669/hello $(MAKE) test ${DOCKER} stop octodb # https://github.com/risinglightdb/risinglight # # This educational database implementation is not very PostgreSQL compatible; it doesn't implement # version() for example. test-risinglight: test-pg.el cd ~/tmp/risinglight && cargo run -- --server --port 5367 & sleep 2 PGURI=postgresql://postgres@localhost:5367/postgres $(MAKE) test # ChronDB -- git-backed database # https://github.com/moclojer/chrondb # # This has extremely poor PostgreSQL wire protocol support (eg. no support for the extended query # protocol). test-chrondb: test-pg.el PGURI=postgresql://chrondb@127.0.0.1:5432/chrondb $(MAKE) test # Create and populate a new database with information concerning works by Shakespeare. # Data from https://github.com/catherinedevlin/opensourceshakespeare # # We assume that our user pgeltestuser has already been set up. setup-shakespeare: sudo -u postgres createdb --owner=pgeltestuser shakespeare curl -L https://raw.githubusercontent.com/catherinedevlin/opensourceshakespeare/master/shakespeare.sql \ | grep -v "^ALTER.*OWNER TO postgres;" \ | psql "host=localhost user=pgeltestuser dbname=shakespeare password=pgeltest" # Pagila demo database (sample DVD rental database) from https://github.com/devrimgunduz/pagila # # The data is published in a form for import by user postgres, but we don't want to allow random SQL # dumps on the internet to modify our database as the superuser. Therefore, we import as a user with # reduced privileges and delete all SQL statements that refer to the postgres user and prevent # import without privileges. setup-pagila: sudo -u postgres createdb --owner=pgeltestuser pagila curl -L https://github.com/devrimgunduz/pagila/raw/refs/heads/master/pagila-schema.sql \ | grep -v "^ALTER.*OWNER TO postgres;" \ | psql "host=localhost user=pgeltestuser dbname=pagila password=pgeltest" curl -L https://github.com/devrimgunduz/pagila/raw/refs/heads/master/pagila-schema-jsonb.sql \ | grep -v "^ALTER.*OWNER TO postgres;" \ | psql "host=localhost user=pgeltestuser dbname=pagila password=pgeltest" curl -L https://raw.githubusercontent.com/devrimgunduz/pagila/refs/heads/master/pagila-data.sql \ | grep -v "^ALTER.*OWNER TO postgres;" \ | psql "host=localhost user=pgeltestuser dbname=pagila password=pgeltest" curl -L https://github.com/devrimgunduz/pagila/raw/refs/heads/master/pagila-insert-data_apt-jsonb.sql \ | pg_restore -v --no-owner -d "host=localhost user=pgeltestuser dbname=pagila password=pgeltest" # Digital media store, data from https://github.com/morenoh149/postgresDBSamples/tree/master/chinook-1.4 # The most commonly available source of this database includes corrupted UTF-8 data. setup-chinook: sudo -u postgres createdb --owner=pgeltestuser chinook curl -L https://github.com/morenoh149/postgresDBSamples/raw/refs/heads/master/chinook-1.4/Chinook_PostgreSql_utf8.sql \ | grep -v "^ALTER.*OWNER TO postgres;" \ | psql "host=localhost user=pgeltestuser dbname=chinook password=pgeltest" # Testing the asynchronous notification support implemented in v0.24 to run a publish-subcribe test. # We run 4 separate Emacs instances, and one central PostgreSQL used as a "message broker" or "event # bus". Note that CPU usage in this simple demo is very low. pubsub: notification-subscriber.el notification-publisher.el install-deps ${EMACS} -Q --batch -L .. -L . -l load-deps.el -l ../pg.el -l notification-subscriber.el -f do-listener & ${EMACS} -Q --batch -L .. -L . -l load-deps.el -l ../pg.el -l notification-subscriber.el -f do-listener & ${EMACS} -Q --batch -L .. -L . -l load-deps.el -l ../pg.el -l notification-subscriber.el -f do-listener & sleep 1 ${EMACS} -Q --batch -L .. -L . -l load-deps.el -l ../pg.el -l notification-publisher.el -f do-publisher bench-uncompiled: test-pg.el install-deps ${EMACS} -Q --batch -L .. -L . -l load-deps.el -l ../pg.el -l test-pg.el -f pg-bench rm -rf ${DEPS_DIR} bench-bytecompiled: test-pg.el install-deps ${EMACS} -Q --batch -L .. -L . -l load-deps.el --eval '(byte-compile-file "../pg.el")' ${EMACS} -Q --batch -L .. -L . -l load-deps.el -l ../pg.elc -l test-pg.el -f pg-bench bench-nativecompiled: test-pg.el install-deps ${EMACS} -Q --batch -L .. -L . -l load-deps.el --eval "(load (native-compile \"../pg.el\"))" \ -l test-pg.el -f pg-bench bench-nativecompiled-speed: test-pg.el install-deps ${EMACS} -Q --batch -L .. -L . -l load-deps.el --eval "(progn (setq native-comp-speed 3) (load (native-compile \"../pg.el\")))" \ -l test-pg.el -f pg-bench pg-el-0.54/test/README.md000066400000000000000000000146331500535241500147130ustar00rootroot00000000000000# Testing code for pg.el Emacs Lisp socket-level interface to PostgreSQL This file contains some information on how to test the pg.el library against a locally accessible PostgreSQL server, or running in a Docker/Podman container. It also shows how to test with other databases that are compatible with the PostgreSQL wire protocol, including CockroachDB, CrateDB and QuestDB. It also shows how to test with old Emacs versions running in a Docker/Podman container. Some of these tests are set up in the GitHub Actions continuous integration service of our repository (see YAML files in the `.github/workflows` directory). ## Testing with a local PostgreSQL implementation To set up the tests, create a PostgreSQL user `pgeltestuser` who owns a database `pgeltestdb`, for example with sudo -u postgres createuser --createdb pgeltestuser sudo -u postgres createdb --owner=pgeltestuser pgeltestdb sudo -u postgres psql postgres=# alter user pgeltestuser with encrypted password 'pgeltest'; Check that you are able to connect to and authenticate with the database from Emacs: ELISP> (defvar *pg* (pg-connect "pgeltestdb" "pgeltestuser" "pgeltest" "localhost" 5432)) Adjust the username and password as necessary in `with-pgtest-connection` then run the tests from Emacs with ELISP> (pg-test) ELISP> (pg-test-tls) ELISP> (pg-test-local) to test over respectively a standard TCP connection, a TCP connection with TLS encryption, and a local Unix socket (on platforms on which this is supported). You can also run `make test` from the `test` directory to run these tests from the commandline (as well as `make test-tls`, `make test-local`). Cleaning up after running the tests: sudo -u postgres dropdb pgeltestdb sudo -u postgres dropuser pgeltestuser ## Testing with Docker/Podman images It is convenient to test different PostgreSQL versions using the [PostgreSQL Docker Community images](https://hub.docker.com/_/postgres/), using Docker or Podman. Example invocation: podman run -d --name pgsql \ -v /dev/log:/dev/log \ -v /var/run/postgresql:/var/run/postgresql \ --publish 5432:5432 \ -e POSTGRES_DB=pgeltestdb \ -e POSTGRES_USER=pgeltestuser \ -e POSTGRES_PASSWORD=pgeltest \ docker.io/library/postgres:13 then from Emacs ELISP> (pg-connect "pgeltestdb" "pgeltestuser" "pgeltest" "localhost" 5432) or to connect over a local Unix socket ELISP> (pg-connect-local "/var/run/postgresql/.s.PGSQL.5432" "pgeltestdb" "pgeltestuser "pgeltest") Note that these Docker images don't include TLS support. If you want to run the Debian-based images (it won't work with the Alpine-based ones) with a self-signed certificate, you can use podman run -d --name pgsql \ -v /dev/log:/dev/log \ -v /var/run/postgresql:/var/run/postgresql \ --publish 5432:5432 \ -e POSTGRES_DB=pgeltestdb \ -e POSTGRES_USER=pgeltestuser \ -e POSTGRES_PASSWORD=pgeltest \ docker.io/library/postgres:13 \ -c ssl=on \ -c ssl_cert_file=/etc/ssl/certs/ssl-cert-snakeoil.pem \ -c ssl_key_file=/etc/ssl/private/ssl-cert-snakeoil.key ## Testing the CockroachDB distributed database [CockroachDB](https://github.com/cockroachdb/cockroach) is an open source distributed database implemented in Golang, built on a strongly-consistent key-value store. It implements the PostgreSQL wire protocol. podman run --name cockroachdb \ -v /dev/log:/dev/log \ --publish 26257:26257 \ -d cockroachdb/cockroach start-single-node --insecure ELISP> (pg-connect "postgres" "root" "" "localhost" 26257) PGEL_DATABASE=postgres PGEL_USER=root PGEL_PASSWORD="" PGEL_PORT=26257 make test podman stop cockroachdb podman rm cockroachdb Note that CockroachDB does not have large object support. ## Testing the CrateDB distributed database [CrateDB](https://crate.io/) is an open source distributed database implemented in Java, that implements the PostgreSQL wire protocol. podman run --name cratedb \ --publish 5432:5432 \ -d docker.io/library/crate:latest -Cdiscovery.type=single-node # psql -h localhost -p 5432 -U crate crate=> CREATE USER pgeltestuser WITH (password = 'pgeltest'); CREATE 1 crate=> GRANT ALL PRIVILEGES TO pgeltestuser; GRANT 4 ELISP> (pg-connect "postgres" "pgeltestuser" "pgeltest" "localhost" 5432) PGEL_DATABASE=postgres PGEL_USER=pgeltestuser PGEL_PASSWORD="pgeltest" PGEL_PORT=5432 make test podman stop cratedb podman rm cratedb Note that CrateDB doesn't implement COPY or large object support, nor PostgreSQL's full-text search operators (it has specific features for text search). ## Testing the QuestDB time series database [QuestDB](https://questdb.io/) is an open source relational column-oriented database designed for time series and event data. It implements the PostgreSQL wire protocol. podman run --name questdb \ --publish 8812:8812 \ -d questdb/questdb ELISP> (pg-connect "ignored" "admin" "quest" "localhost" 8812) PGEL_DATABASE=postgres PGEL_USER=admin PGEL_PASSWORD="quest" PGEL_PORT=8812 make test podman stop questdb podman rm questdb Note that QuestDB is quite far from being compatible with the SQL understood by PostgreSQL (eg. no TIME type, COUNT statements can't take an argument). ## Testing the YugabyteDB distributed database [YugabyteDB](https://yugabyte.com/) is an open source distributed database designed for large volumes of data. It implements the PostgreSQL wire protocol. podman run --name yugabyte \ --publish 5433:5433 \ -d yugabytedb/yugabyte \ bin/yugabyted start \ --base_dir=/tmp \ --daemon=false ELISP> (pg-connect "yugabyte" "yugabyte" "" "localhost" 5433) PGEL_DATABASE=yugabyte PGEL_USER=yugabyte PGEL_PASSWORD="" PGEL_PORT=5433 make test podman stop yugabyte podman rm yugabyte ## Testing with older Emacs versions Docker/Podman images containing a range of old Emacs versions are maintained by Silex in the [docker-emacs project](https://github.com/Silex/docker-emacs). Here's how to run them from podman while allowing network access to your local host's network. cp ../pg.el test-pg.el ${WORKDIR} sudo podman run -it \ -v ${WORKDIR}:/tmp \ --network slirp4netns:allow_host_loopback=true -e PGEL_HOSTNAME=10.0.2.2 \ silex/emacs:25.3 \ emacs -Q --batch -l /tmp/pg.el -l /tmp/test-pg.el -f pg-test pg-el-0.54/test/install-deps.el000066400000000000000000000010721500535241500163460ustar00rootroot00000000000000;; -*- lexical-binding: t -*- (require 'cl-lib) (require 'package) (add-to-list 'package-archives '("melpa" . "https://melpa.org/packages/") t) (progn (setq package-user-dir (getenv "DEPS_DIR")) (package-refresh-contents) (if-let ((reqs (package-desc-reqs (package-buffer-info))) (transaction (package-compute-transaction nil reqs))) (progn (message "Installing %s..." (mapconcat (quote package-desc-full-name) transaction ", ")) (package-download-transaction transaction)) (message "Nothing to install"))) pg-el-0.54/test/load-deps.el000066400000000000000000000001631500535241500156170ustar00rootroot00000000000000;; -*- coding: utf-8; lexical-binding: t; -*- (setq package-user-dir (getenv "DEPS_DIR")) (package-activate-all) pg-el-0.54/test/notification-publisher.el000066400000000000000000000047301500535241500204340ustar00rootroot00000000000000;;; Asynchronous notification tests for the pg.el library -*- coding: utf-8; lexical-binding: t; -*- ;;; ;;; This allows implementation of basic publish-subscribe functionality. ;;; ;;; Author: Eric Marsden ;;; Copyright: (C) 2023 Eric Marsden (require 'cl-lib) (require 'pg) (require 'ert) (defmacro with-pgtest-connection (conn &rest body) (let ((db (or (getenv "PGEL_DATABASE") "pgeltestdb")) (user (or (getenv "PGEL_USER") "pgeltestuser")) (password (or (getenv "PGEL_PASSWORD") "pgeltest")) (host (or (getenv "PGEL_HOSTNAME") "localhost")) (port (let ((p (getenv "PGEL_PORT"))) (if p (string-to-number p) 5432)))) `(with-pg-connection ,conn (,db ,user ,password ,host ,port) ,@body))) ;; Connect to the database over an encrypted (TLS) connection (defmacro with-pgtest-connection-tls (conn &rest body) (let ((db (or (getenv "PGEL_DATABASE") "pgeltestdb")) (user (or (getenv "PGEL_USER") "pgeltestuser")) (password (or (getenv "PGEL_PASSWORD") "pgeltest")) (host (or (getenv "PGEL_HOSTNAME") "localhost")) (port (let ((p (getenv "PGEL_PORT"))) (if p (string-to-number p) 5432)))) `(with-pg-connection ,conn (,db ,user ,password ,host ,port t) ,@body))) (defmacro with-pgtest-connection-local (conn &rest body) (let* ((db (or (getenv "PGEL_DATABASE") "pgeltestdb")) (user (or (getenv "PGEL_USER") "pgeltestuser")) (password (or (getenv "PGEL_PASSWORD") "pgeltest")) (port (let ((p (getenv "PGEL_PORT"))) (if p (string-to-number p) 5432))) (path (or (getenv "PGEL_PATH") (format "/var/run/postgresql/.s.PGSQL.%s" port)))) `(with-pg-connection-local ,conn (,path ,db ,user ,password) ,@body))) (defun do-publisher () (cl-flet ((notification-handler (channel payload) (message "PUB> Async notification on %s: %s" channel payload))) (with-pgtest-connection-tls con (pg-add-notification-handler con #'notification-handler) (pg-exec con "NOTIFY yourheart, 'bizzles'") (sleep-for 4) (pg-exec con "NOTIFY yourheart, 'bazzles'") (pg-exec con "SELECT pg_sleep(4)") (sleep-for 3) (pg-exec con "NOTIFY yourheart, 'fooble'") (sleep-for 2) (pg-exec con "NOTIFY yourheart") (sleep-for 2) (dotimes (i 1000) (pg-exec con (format "NOTIFY counting, '%d'" i))) (sleep-for 2)))) pg-el-0.54/test/notification-subscriber.el000066400000000000000000000070001500535241500205730ustar00rootroot00000000000000;;; Async notification tests for the pg.el library -*- coding: utf-8; lexical-binding: t; -*- ;;; ;;; This allows implementation of basic publish-subscribe functionality. Say "make pubsub" to run ;;; this test with one message publisher and three message subscribers. ;;; ;;; Author: Eric Marsden ;;; Copyright: (C) 2023 Eric Marsden (require 'cl-lib) (require 'pg) (require 'ert) (defmacro with-pgtest-connection (conn &rest body) (let ((db (or (getenv "PGEL_DATABASE") "pgeltestdb")) (user (or (getenv "PGEL_USER") "pgeltestuser")) (password (or (getenv "PGEL_PASSWORD") "pgeltest")) (host (or (getenv "PGEL_HOSTNAME") "localhost")) (port (let ((p (getenv "PGEL_PORT"))) (if p (string-to-number p) 5432)))) `(with-pg-connection ,conn (,db ,user ,password ,host ,port) ,@body))) ;; Connect to the database over an encrypted (TLS) connection (defmacro with-pgtest-connection-tls (conn &rest body) (let ((db (or (getenv "PGEL_DATABASE") "pgeltestdb")) (user (or (getenv "PGEL_USER") "pgeltestuser")) (password (or (getenv "PGEL_PASSWORD") "pgeltest")) (host (or (getenv "PGEL_HOSTNAME") "localhost")) (port (let ((p (getenv "PGEL_PORT"))) (if p (string-to-number p) 5432)))) `(with-pg-connection ,conn (,db ,user ,password ,host ,port t) ,@body))) (defmacro with-pgtest-connection-local (conn &rest body) (let* ((db (or (getenv "PGEL_DATABASE") "pgeltestdb")) (user (or (getenv "PGEL_USER") "pgeltestuser")) (password (or (getenv "PGEL_PASSWORD") "pgeltest")) (port (let ((p (getenv "PGEL_PORT"))) (if p (string-to-number p) 5432))) (path (or (getenv "PGEL_PATH") (format "/var/run/postgresql/.s.PGSQL.%s" port)))) `(with-pg-connection-local ,conn (,path ,db ,user ,password) ,@body))) ;; Here we are listening to two notification channels, named yourheart and counting. The counting ;; channel receives 1000 notifications (simply the notification number as a string). ;; ;; We check here that notification data is not processed twice, once via the async notification ;; handler, and once via the synchronous request processing, thanks to the dummy SELECT statements. ;; A synchronous SELECT statement will cause any unprocessed notification messages to be processed ;; synchronously. (defun do-listener () (with-pgtest-connection-tls con (let ((seen (make-hash-table :test #'equal)) (notification-count 0)) (cl-flet ((notification-handler (_channel payload) (when (gethash payload seen) (message "Duplicate notification %s" payload)) (puthash payload t seen) (cl-incf notification-count))) (pg-add-notification-handler con #'notification-handler) (pg-enable-async-notification-handlers con) (pg-exec con "LISTEN yourheart") (sleep-for 1) (pg-exec con "LISTEN counting") (sleep-for 5) (pg-exec con "SELECT 42") (sleep-for 5) (pg-exec con "SELECT 42") (sleep-for 5) (pg-exec con "SELECT 42") (sleep-for 5) (pg-exec con "SELECT 42") (sleep-for 5) (pg-exec con "SELECT 42") (sleep-for 5) (pg-exec con "SELECT 42") (sleep-for 5) (pg-exec con "SELECT 42") (sleep-for 60) (message "Subscriber %s has seen %d notifications" (emacs-pid) (hash-table-count seen)))))) pg-el-0.54/test/octo-entrypoint.sh000066400000000000000000000022011500535241500171310ustar00rootroot00000000000000#!/bin/bash # Adapted from the entrypoint.sh script in the official Docker image, which does # not allow the user to set commandline options for rocto. # # https://gitlab.com/YottaDB/DBMS/YDBOcto/-/blob/master/tools/entrypoint.sh?ref_type=heads # If /data/octo.conf doesn't exist, it means that user passed in their own database # Therefore, do the set-up that was previously done in the docker file if [ ! -f /data/octo.conf ]; then cp /opt/yottadb/current/plugin/octo/octo.conf /data/octo.conf sed -i 's/address = "127.0.0.1"/address = "0.0.0.0"/' /data/octo.conf source /opt/yottadb/current/ydb_env_set octo -f $ydb_dist/plugin/octo/northwind.sql mupip load $ydb_dist/plugin/octo/northwind.zwr printf "ydbrocks\nydbrocks" | "$ydb_dist/yottadb" -r %ydboctoAdmin add user ydb source /opt/yottadb/current/ydb_env_unset fi # Set environment variables source /opt/yottadb/current/ydb_env_set printf "pgeltest\npgeltest" | yottadb -r %ydboctoAdmin add user pgeltestuser --readwrite --allowschemachanges # Run the rocto service (Must use exec to that CTRL-C goes to Rocto, not the bash script) exec rocto -v --allowschemachanges --readwrite pg-el-0.54/test/test-multithreaded.el000066400000000000000000000070001500535241500175540ustar00rootroot00000000000000;;; Multithreaded tests for the pg.el library -*- coding: utf-8; lexical-binding: t; -*- ;;; ;;; Author: Eric Marsden ;;; Copyright: (C) 2024 Eric Marsden (require 'cl-lib) (require 'pg) (require 'ert) (defmacro with-pgtest-connection (con &rest body) (let ((db (or (getenv "PGEL_DATABASE") "pgeltestdb")) (user (or (getenv "PGEL_USER") "pgeltestuser")) (password (or (getenv "PGEL_PASSWORD") "pgeltest")) (host (or (getenv "PGEL_HOSTNAME") "localhost")) (port (let ((p (getenv "PGEL_PORT"))) (if p (string-to-number p) 5432)))) `(with-pg-connection ,con (,db ,user ,password ,host ,port) ,@body))) ;; Connect to the database over an encrypted (TLS) connection (defmacro with-pgtest-connection-tls (con &rest body) (let ((db (or (getenv "PGEL_DATABASE") "pgeltestdb")) (user (or (getenv "PGEL_USER") "pgeltestuser")) (password (or (getenv "PGEL_PASSWORD") "pgeltest")) (host (or (getenv "PGEL_HOSTNAME") "localhost")) (port (let ((p (getenv "PGEL_PORT"))) (if p (string-to-number p) 5432)))) `(with-pg-connection ,con (,db ,user ,password ,host ,port t) ,@body))) (defmacro with-pgtest-connection-local (con &rest body) (let* ((db (or (getenv "PGEL_DATABASE") "pgeltestdb")) (user (or (getenv "PGEL_USER") "pgeltestuser")) (password (or (getenv "PGEL_PASSWORD") "pgeltest")) (port (let ((p (getenv "PGEL_PORT"))) (if p (string-to-number p) 5432))) (path (or (getenv "PGEL_PATH") (format "/var/run/postgresql/.s.PGSQL.%s" port)))) `(with-pg-connection-local ,con (,path ,db ,user ,password) ,@body))) (cl-defun pgtest-worker (table &optional (iterations 100)) (message "Starting pg worker %s" table) ;; or with-pgtest-connection-local (with-pgtest-connection con (dotimes (iter iterations) (message "pg worker %s iteration %d" table iter) (pg-exec con (format "DROP TABLE IF EXISTS %s" table)) (pg-exec con (format "CREATE TABLE %s(id BIGINT GENERATED ALWAYS AS IDENTITY PRIMARY KEY, value INTEGER)" table)) (let ((start (+ 3000 (random 4000)))) (dotimes (i 100) (pg-exec-prepared con (format "INSERT INTO %s(value) VALUES ($1)" table) `((,(+ start i) . "int4")))) (let* ((res (pg-exec con (format "SELECT COUNT(*) FROM %s" table))) (count (cl-first (pg-result res :tuple 0)))) (unless (eql count 100) (message "Row count failure on table %s" table))) (dotimes (i 100) (pg-exec-prepared con (format "DELETE FROM %s WHERE value=$1" table) `((,(+ start i) . "int4")))) (let* ((res (pg-exec con (format "SELECT COUNT(*) FROM %s" table))) (count (cl-first (pg-result res :tuple 0)))) (unless (eql count 0) (message "Row count failure on table %s" table))) (pg-exec con (format "DROP TABLE %s" table))))) (message "pg worker thread %s finished" table)) (defun pgtest-multithreaded () (let ((workers (list))) (dotimes (i 5) (push (make-thread (lambda () (pgtest-worker (format "pgtest_table_%d_%d" (emacs-pid) i))) (format "pgel-%d" i)) workers)) (message "Worker threads created; sleeping") (sit-for 10) (cl-loop while (cl-some #'thread-live-p workers) do (accept-process-output) (sit-for 1)))) pg-el-0.54/test/test-pg.el000077500000000000000000004370701500535241500153500ustar00rootroot00000000000000;;; Tests for the pg.el library -*- coding: utf-8; lexical-binding: t; -*- ;; ;; Author: Eric Marsden ;; Copyright: (C) 2022-2025 Eric Marsden ;; SPDX-License-Identifier: GPL-3.0-or-later (require 'cl-lib) (require 'hex-util) (require 'pg) (require 'pg-geometry) (require 'pg-gis) (require 'pg-bm25) (require 'ert) (setq debug-on-error t) ;; for performance testing ;; (setq process-adaptive-read-buffering nil) ;; Good practice for PostgreSQL is to replace use of the SERIAL type by "GENERATED ALWAYS AS ;; IDENTITY". However, several of the PostgreSQL variants that we want to test don't implement this ;; syntax, so we choose the syntax for this when we establish a connection. ;; ;; https://www.naiyerasif.com/post/2024/09/04/stop-using-serial-in-postgres/ ;; ;; Documentation on the way SERIAL is implemented in CockroachDB: ;; https://www.cockroachlabs.com/docs/stable/serial.html ;; ;; This formats SQL where %s is replaced by the appropriate SERIAL/AUTOINCREMENT type, or returns ;; NIL if this variant does not support an autoincrementing integer type. (cl-defun pgtest-massage (con sql &rest fmt-args) (let ((serial (pcase (pgcon-server-variant con) ('postgresql (if (< (pgcon-server-version-major con) 12) "SERIAL" "BIGINT GENERATED ALWAYS AS IDENTITY")) ('cratedb "TEXT DEFAULT gen_random_text_uuid()") ;; https://www.cockroachlabs.com/docs/stable/serial.html#generated-values-for-mode-sql_sequence ('cockroachdb "UUID NOT NULL DEFAULT gen_random_uuid()") ;; RisingWave does not (2025-03) implement NOT NULL constraints, nor an autoincrementing column type. ('risingwave nil) ('questdb "UUID NOT NULL DEFAULT gen_random_uuid()") ('materialize nil) (_ "SERIAL"))) (pk (pcase (pgcon-server-variant con) ('materialize "") ('questdb "") (_ "PRIMARY KEY")))) (when (cl-search "SERIAL" sql) (if serial (setq sql (string-replace "SERIAL" serial sql)) ;; If serial is nil, this variant doesn't implement an equivalent to SERIAL (cl-return-from pgtest-massage nil))) (setq sql (string-replace "PRIMARY KEY" pk sql)) (apply #'format (cons sql fmt-args)))) ;; Some PostgreSQL variants that focus on high-performance distributed operation operate with ;; "eventually consistent" semantics, and require an explict sync-like operation to ensure that ;; inserted rows are visible to a SELECT query. (defun pgtest-flush-table (con table) (pcase (pgcon-server-variant con) ('cratedb (pg-exec con (format "REFRESH TABLE %s" table))) ('risingwave (pg-exec con "FLUSH")))) (cl-defun pgtest-have-table (con table) (let* ((cs (pg-current-schema con)) (qtable (if (pg-qualified-name-p table) table (make-pg-qualified-name :schema cs :name table)))) (cl-flet ((matches (target) (let ((qtarget (if (pg-qualified-name-p target) target (make-pg-qualified-name :schema cs :name target)))) (equal qtarget qtable)))) (dolist (tbl (pg-tables con)) (when (matches tbl) (cl-return-from pgtest-have-table t))) nil))) (defmacro with-pgtest-connection (con &rest body) (cond ((getenv "PGURI") `(let ((,con (pg-connect/uri ,(getenv "PGURI")))) (unwind-protect (progn ,@body) (when ,con (pg-disconnect ,con))))) (t (let* ((db (or (getenv "PGEL_DATABASE") "pgeltestdb")) (user (or (getenv "PGEL_USER") "pgeltestuser")) (password (or (getenv "PGEL_PASSWORD") "pgeltest")) (host (or (getenv "PGEL_HOSTNAME") "localhost")) (port (let ((p (getenv "PGEL_PORT"))) (if p (string-to-number p) 5432))) (server-variant-str (getenv "PGEL_SERVER_VARIANT")) (server-variant (and server-variant-str (intern server-variant-str)))) `(with-pg-connection ,con (,db ,user ,password ,host ,port nil ',server-variant) ,@body))))) (put 'with-pgtest-connection 'lisp-indent-function 'defun) ;; Connect to the database over an encrypted (TLS) connection (defmacro with-pgtest-connection-tls (con &rest body) (cond ((getenv "PGURI") `(let ((,con (pg-connect/uri ,(getenv "PGURI")))) (unwind-protect (progn ,@body) (when ,con (pg-disconnect ,con))))) (t (let ((db (or (getenv "PGEL_DATABASE") "pgeltestdb")) (user (or (getenv "PGEL_USER") "pgeltestuser")) (password (or (getenv "PGEL_PASSWORD") "pgeltest")) (host (or (getenv "PGEL_HOSTNAME") "localhost")) (port (let ((p (getenv "PGEL_PORT"))) (if p (string-to-number p) 5432)))) `(with-pg-connection ,con (,db ,user ,password ,host ,port t) ,@body))))) (put 'with-pgtest-connection-tls 'lisp-indent-function 'defun) ;; Connect to the database presenting a client certificate as authentication (defmacro with-pgtest-connection-client-cert (con &rest body) (cond ((getenv "PGURI") `(let ((,con (pg-connect/uri ,(getenv "PGURI")))) (unwind-protect (progn ,@body) (when ,con (pg-disconnect ,con))))) (t (let ((db (or (getenv "PGEL_DATABASE") "pgeltestdb")) (user (or (getenv "PGEL_USER") "pgeltestuser")) (password (or (getenv "PGEL_PASSWORD") "pgeltest")) (host (or (getenv "PGEL_HOSTNAME") "localhost")) (port (let ((p (getenv "PGEL_PORT"))) (if p (string-to-number p) 5432))) (cert (getenv "PGEL_CLIENT_CERT")) (key (getenv "PGEL_CLIENT_CERT_KEY"))) `(progn (unless ,cert (error "Set $PGEL_CLIENT_CERT to point to file containing client certificate")) (unless ,key (error "Set $PGEL_CLIENT_CERT_KEY to point to file containing client certificate key")) (with-pg-connection ,con (,db ,user ,password ,host ,port '(:keylist ((,key ,cert)))) ,@body)))))) (put 'with-pgtest-connection-client-cert 'lisp-indent-function 'defun) (defmacro with-pgtest-connection-local (con &rest body) (cond ((getenv "PGURI") `(let ((,con (pg-connect/uri ,(getenv "PGURI")))) (unwind-protect (progn ,@body) (when ,con (pg-disconnect ,con))))) (t (let* ((db (or (getenv "PGEL_DATABASE") "pgeltestdb")) (user (or (getenv "PGEL_USER") "pgeltestuser")) (password (or (getenv "PGEL_PASSWORD") "pgeltest")) (port (let ((p (getenv "PGEL_PORT"))) (if p (string-to-number p) 5432))) (path (or (getenv "PGEL_PATH") (format "/var/run/postgresql/.s.PGSQL.%s" port)))) `(with-pg-connection-local ,con (,path ,db ,user ,password) ,@body))))) (put 'with-pg-connection-local 'lisp-indent-function 'defun) (defun pg-connection-tests () (dolist (v (list "host=localhost port=5432 dbname=pgeltestdb user=pgeltestuser password=pgeltest" "port=5432 dbname=pgeltestdb user=pgeltestuser password=pgeltest" "user=pgeltestuser sslmode=require port=5432 password=pgeltest dbname=pgeltestdb")) (let ((con (pg-connect/string v))) (should (process-live-p (pgcon-process con))) (pg-disconnect con))) (dolist (v (list "postgresql://pgeltestuser:pgeltest@localhost/pgeltestdb?application_name=testingtesting" "postgres://pgeltestuser:pgeltest@localhost/pgeltestdb?application_name=testingtesting" "postgres://pgeltestuser:pgeltest@localhost:5432/pgeltestdb" "postgres://pgeltestuser:pgeltest@localhost:5432/pgeltestdb?sslmode=prefer" "postgres://pgeltestuser:pgeltest@%2Fvar%2Frun%2Fpostgresql%2F.s.PGSQL.5432/pgeltestdb")) (let ((con (pg-connect/uri v))) (should (process-live-p (pgcon-process con))) (pg-disconnect con))) ;; Now testing various environment variables. For libpq the recognized names are in ;; https://www.postgresql.org/docs/current/libpq-envars.html (dolist (v (list "postgresql://pgeltestuser@localhost/pgeltestdb?application_name=testingtesting" "postgres://pgeltestuser@localhost/pgeltestdb?application_name=testingtesting" "postgres://pgeltestuser@localhost:5432/pgeltestdb" "postgres://pgeltestuser@localhost:5432/pgeltestdb?sslmode=prefer" "postgres://pgeltestuser@%2Fvar%2Frun%2Fpostgresql%2F.s.PGSQL.5432/pgeltestdb")) (setenv "PGPASSWORD" "pgeltest") (let ((con (pg-connect/uri v))) (should (process-live-p (pgcon-process con))) (pg-disconnect con))) (should (eql 'ok (condition-case nil (pg-connect "nonexistent-db" "pgeltestuser" "pgeltest") (pg-invalid-catalog-name 'ok))))) (defun pg-run-tests (con) (let ((tests (list))) (cl-flet ((pgtest-add (fun &key skip-variants need-emacs) (unless (member (pgcon-server-variant con) skip-variants) (when (if need-emacs (version< emacs-version need-emacs) t) (push fun tests))))) (pg-enable-query-log con) (message "Backend major-version is %s" (pgcon-server-version-major con)) (message "Detected backend variant: %s" (pgcon-server-variant con)) (unless (member (pgcon-server-variant con) '(cockroachdb cratedb yugabyte ydb xata greptimedb risingwave clickhouse octodb)) (when (> (pgcon-server-version-major con) 11) (let* ((res (pg-exec con "SELECT current_setting('ssl_library')")) (row (pg-result res :tuple 0))) (message "Backend compiled with SSL library %s" (cl-first row))))) (unless (member (pgcon-server-variant con) '(questdb cratedb ydb xata greptimedb risingwave clickhouse materialize)) (let* ((res (pg-exec con "SHOW ssl")) (row (pg-result res :tuple 0))) (message "PostgreSQL connection TLS: %s" (cl-first row)))) (message "Current schema: %s" (pg-current-schema con)) (message "List of schemas in db: %s" (pg-schemas con)) (message "List of tables in db: %s" (pg-tables con)) (when (eq 'orioledb (pgcon-server-variant con)) (pg-exec con "CREATE EXTENSION orioledb")) (unless (member (pgcon-server-variant con) '(clickhouse alloydb risingwave)) (pg-setup-postgis con)) (unless (member (pgcon-server-variant con) '(clickhouse risingwave)) (pg-vector-setup con)) (pgtest-add #'pg-test-basic) (pgtest-add #'pg-test-insert) (pgtest-add #'pg-test-procedures :skip-variants '(cratedb spanner risingwave materialize ydb xata questdb)) ;; RisingWave is not able to parse a TZ value of "UTC-01:00" (POSIX format). (pgtest-add #'pg-test-date :skip-variants '(cratedb risingwave materialize ydb) :need-emacs "29.1") ;; QuestDB does not support the timestamptz column type. (pgtest-add #'pg-run-tz-tests :skip-variants '(risingwave materialize ydb clickhouse spanner questdb readyset)) (pgtest-add #'pg-test-numeric) (pgtest-add #'pg-test-numeric-range :skip-variants '(xata cratedb cockroachdb ydb risingwave questdb clickhouse greptimedb spanner octodb)) (pgtest-add #'pg-test-prepared :skip-variants '(ydb) :need-emacs "28") ;; Risingwave v2.2.0 panics on this test (https://github.com/risingwavelabs/risingwave/issues/20367) (pgtest-add #'pg-test-prepared/multifetch :skip-variants '(risingwave ydb) :need-emacs "28") (pgtest-add #'pg-test-insert/prepared :skip-variants '(ydb) :need-emacs "28") ;; Risingwave v2.2.0 raises a spurious error "Duplicated portal name" here (pgtest-add #'pg-test-ensure-prepared :skip-variants '(risingwave ydb) :need-emacs "28") (pgtest-add #'pg-test-collation :skip-variants '(xata cratedb questdb clickhouse greptimedb octodb)) (pgtest-add #'pg-test-xml :skip-variants '(xata ydb cockroachdb yugabyte clickhouse alloydb)) (pgtest-add #'pg-test-uuid :skip-variants '(cratedb risingwave ydb clickhouse greptimedb spanner octodb)) ;; Risingwave doesn't support VARCHAR(N) type. YDB doesn't support SELECT generate_series(). (pgtest-add #'pg-test-result :skip-variants '(risingwave ydb spanner clickhouse)) (pgtest-add #'pg-test-cursors :skip-variants '(xata cratedb cockroachdb risingwave questdb greptimedb ydb materialize spanner octodb)) ;; CrateDB does not support the BYTEA type (!), nor sequences. Spanner does not support the encode() function. (pgtest-add #'pg-test-bytea :skip-variants '(cratedb risingwave spanner materialize)) ;; Spanner does not support the INCREMENT clause in CREATE SEQUENCE. (pgtest-add #'pg-test-sequence :skip-variants '(cratedb risingwave questdb materialize greptimedb ydb spanner clickhouse)) (pgtest-add #'pg-test-array :skip-variants '(cratedb risingwave questdb materialize clickhouse octodb)) (pgtest-add #'pg-test-enums :skip-variants '(cratedb risingwave questdb greptimedb ydb materialize spanner octodb clickhouse)) (pgtest-add #'pg-test-server-prepare :skip-variants '(cratedb risingwave questdb greptimedb ydb octodb)) (pgtest-add #'pg-test-comments :skip-variants '(ydb cratedb cockroachdb spanner questdb)) (pgtest-add #'pg-test-metadata :skip-variants '(cratedb cockroachdb risingwave materialize questdb greptimedb ydb spanner)) ;; CrateDB doesn't support the JSONB type. CockroachDB doesn't support casting to JSON. (pgtest-add #'pg-test-json :skip-variants '(xata cratedb risingwave questdb greptimedb ydb materialize spanner octodb)) (pgtest-add #'pg-test-schemas :skip-variants '(xata cratedb risingwave questdb ydb materialize)) (pgtest-add #'pg-test-hstore :skip-variants '(risingwave materialize octodb readyset)) ;; Xata doesn't support extensions, but doesn't signal an SQL error when we attempt to load the ;; pgvector extension, so our test fails despite being intended to be robust. (pgtest-add #'pg-test-vector :skip-variants '(xata cratedb materialize octodb)) (pgtest-add #'pg-test-tsvector :skip-variants '(xata cratedb cockroachdb risingwave questdb greptimedb ydb materialize spanner octodb)) (pgtest-add #'pg-test-bm25 :skip-variants '(xata cratedb cockroachdb risingwave materialize octodb)) (pgtest-add #'pg-test-geometric :skip-variants '(xata cratedb cockroachdb risingwave questdb materialize spanner octodb)) (pgtest-add #'pg-test-gis :skip-variants '(xata cratedb cockroachdb risingwave materialize octodb)) (pgtest-add #'pg-test-copy :skip-variants '(spanner ydb cratedb risingwave materialize questdb)) ;; QuestDB fails due to lack of support for the NUMERIC type (pgtest-add #'pg-test-copy-large :skip-variants '(spanner ydb cratedb risingwave questdb materialize)) ;; Apparently Xata does not support CREATE DATABASE (pgtest-add #'pg-test-createdb :skip-variants '(xata cratedb questdb ydb)) ;; Many PostgreSQL variants only support UTF8 as the client encoding. (pgtest-add #'pg-test-client-encoding :skip-variants '(cratedb cockroachdb ydb risingwave materialize spanner greptimedb xata)) (pgtest-add #'pg-test-unicode-names :skip-variants '(xata cratedb cockroachdb risingwave questdb ydb spanner)) (pgtest-add #'pg-test-returning :skip-variants '(risingwave questdb)) (pgtest-add #'pg-test-parameter-change-handlers :skip-variants '(cratedb risingwave)) (pgtest-add #'pg-test-errors) ;; CrateDB and Risingwave signal all errors as SQLSTATE XX000 meaning "internal error", rather ;; than returning a more granular error code. (pgtest-add #'pg-test-error-sqlstate :skip-variants '(cratedb risingwave)) (pgtest-add #'pg-test-notice) (pgtest-add #'pg-test-notify :skip-variants '(cratedb cockroachdb risingwave materialize greptimedb ydb questdb spanner)) (dolist (test (reverse tests)) (message "== Running test %s" test) (condition-case err (funcall test con) (error (message "Test failed: %s" err))) (pg-sync con))))) (defun pg-test-note-param-change (con name value) (message "PG> backend parameter %s=%s" name value)) (defun pg-test () (let ((pg-parameter-change-functions (cons #'pg-test-note-param-change pg-parameter-change-functions))) (with-pgtest-connection con (message "Running pg.el tests in %s against backend %s" (version) (pg-backend-version con)) (pg-run-tests con)))) (defun pg-test-tls () (let ((pg-parameter-change-functions (cons #'pg-test-note-param-change pg-parameter-change-functions))) (with-pgtest-connection-tls con (message "Running pg.el tests in %s against backend %s" (version) (pg-backend-version con)) (pg-run-tests con)))) (defun pg-test-client-cert () (let ((pg-parameter-change-functions (cons #'pg-test-note-param-change pg-parameter-change-functions))) (with-pgtest-connection-client-cert con (message "Running pg.el tests with client cert in %s against backend %s" (version) (pg-backend-version con)) (pg-run-tests con)))) ;; Run tests over local Unix socket connection to backend (defun pg-test-local () (let ((pg-parameter-change-functions (cons #'pg-test-note-param-change pg-parameter-change-functions))) (with-pgtest-connection-local conn (message "Running pg.el tests in %s against backend %s" (version) (pg-backend-version conn)) (pg-run-tests conn)))) ;; Simple connect and list tables test on a public RNAcentral PostgreSQL server hosted at ebi.ac.uk, see ;; https://rnacentral.org/help/public-database. (defun pg-test-ebiacuk () (let ((con (pg-connect/uri "postgres://reader:NWDMCE5xdipIjRrp@hh-pgsql-public.ebi.ac.uk/pfmegrnargs"))) (message "Connected to %s, %s" (cl-prin1-to-string con) (pg-backend-version con)) (dolist (table (pg-tables con)) (message " Table: %s" table)))) (defun pg-test-prepared (con) (cl-labels ((row (query args) (pg-result (pg-exec-prepared con query args) :tuple 0)) (scalar (query args) (car (row query args))) (approx= (x y) (< (/ (abs (- x y)) (max (abs x) (abs y))) 1e-5))) (should (equal 42 (scalar "SELECT 42" (list)))) (should (approx= 42.0 (scalar "SELECT 42.00" (list)))) (should (equal nil (scalar "SELECT NULL" (list)))) (unless (member (pgcon-server-variant con) '(immudb)) (should (equal (list t nil) (row "SELECT $1, $2" `((t . "bool") (nil . "bool"))))) (should (equal (list -33 "ZZz" 9999) (row "SELECT $1,$2,$3" `((-33 . "int4") ("ZZz" . "text") (9999 . "int8")))))) (unless (member (pgcon-server-variant con) '(ydb)) (pg-exec con "DEALLOCATE ALL") (should (equal nil (scalar "" (list)))) (pg-exec con "PREPARE pgtest_foobles(integer) AS SELECT $1 + 1") (let* ((res (pg-exec con "EXECUTE pgtest_foobles(41)")) (row (pg-result res :tuple 0))) (should (eql 42 (cl-first row))))) (unless (member (pgcon-server-variant con) '(cratedb risingwave materialize ydb)) (let ((bv1 (make-bool-vector 1 nil)) (bv2 (make-bool-vector 1 t))) (should (equal bv1 (scalar "SELECT $1::bit" `((,bv1 . "bit"))))) (should (equal bv1 (scalar "SELECT $1::varbit" `((,bv1 . "varbit"))))) (should (equal bv2 (scalar "SELECT $1::bit" `((,bv2 . "bit"))))) (should (equal bv2 (scalar "SELECT $1::varbit" `((,bv2 . "varbit"))))) (should (equal bv1 (scalar "SELECT $1" `((,bv1 . "bit"))))) (should (equal bv1 (scalar "SELECT $1" `((,bv1 . "varbit"))))) (should (equal bv2 (scalar "SELECT $1" `((,bv2 . "bit"))))) (should (equal bv2 (scalar "SELECT $1" `((,bv2 . "varbit")))))) ;; Now some bitvectors of length > 1, so shouldn't use the "bit" type which is interpreted as ;; bit(1). (let ((bv1 (bool-vector t nil t t t t)) (bv2 (bool-vector t nil t t nil nil t t t t nil t))) (should (equal bv1 (scalar "SELECT $1" `((,bv1 . "varbit"))))) (should (equal bv1 (scalar "SELECT $1::varbit" `((,bv1 . "varbit"))))) (should (equal bv2 (scalar "SELECT $1" `((,bv2 . "varbit"))))) (should (equal bv2 (scalar "SELECT $1::varbit" `((,bv2 . "varbit"))))) (should (equal (bool-vector-intersection bv2 bv2) (scalar "SELECT $1 & $2" `((,bv2 . "varbit") (,bv2 . "varbit"))))))) (should (eql 42 (scalar "SELECT $1 + 1" '((41 . "int2"))))) (should (eql 42 (scalar "SELECT $1 + 142" '((-100 . "int2"))))) (should (eql 42 (scalar "SELECT $1 + 1" '((41 . "int4"))))) (should (eql 42 (scalar "SELECT $1 + 142" '((-100 . "int4"))))) (should (eql 42 (scalar "SELECT $1 + 1" '((41 . "int8"))))) (should (eql 42 (scalar "SELECT $1 + 142" '((-100 . "int8"))))) (should (approx= -55.0 (scalar "SELECT $1" '((-55.0 . "float4"))))) (should (approx= -55.0 (scalar "SELECT $1" '((-55.0 . "float8"))))) (should (approx= 42.0 (scalar "SELECT $1 + 1" '((41.0 . "float4"))))) (should (approx= 42.0 (scalar "SELECT $1 + 85.0" '((-43.0 . "float4"))))) (should (approx= 42.0 (scalar "SELECT $1 + 1" '((41.0 . "float8"))))) (should (approx= 42.0 (scalar "SELECT $1 + 85" '((-43.0 . "float8"))))) (unless (member (pgcon-server-variant con) '(cratedb risingwave)) ;; CrateDB returns an incorrect value ?8 here (should (eql ?Q (scalar "SELECT $1" '((?Q . "char")))))) (should (equal (list t nil) (row "SELECT $1, $2" '((t . "bool") (nil . "bool"))))) (should (eql nil (scalar "SELECT $1 WHERE 0=1" '((42 . "int4"))))) (should (string= "foobles" (scalar "SELECT $1" '(("foobles" . "text"))))) (should (string= "foobles/var" (scalar "SELECT $1" '(("foobles/var" . "varchar"))))) (should (string= "çéà" (scalar "SELECT $1::text" '(("çéà" . "text"))))) (should (string= "fooblé" (scalar "SELECT $1" '(("fooblé" . "text"))))) (should (string= "Bîzzlô⚠️" (scalar "SELECT $1" '(("Bîzzlô⚠️" . "varchar"))))) (should (string= "foobles" (scalar "SELECT $1 || $2" '(("foo" . "text") ("bles" . "text"))))) (unless (or (member (pgcon-server-variant con) '(cratedb)) (zerop (scalar "SELECT COUNT(*) FROM pg_collation WHERE collname='fr_FR'" nil))) (should (string= "12 foé£èüñ¡" (scalar "SELECT lower($1) COLLATE \"fr_FR\"" '(("12 FOÉ£ÈÜÑ¡" . "text")))))) ;; Risingwave failed to parse the PT12S (unless (member (pgcon-server-variant con) '(risingwave materialize)) (should (equal "00:00:12" (scalar "SELECT $1::interval" '(("PT12S" . "text")))))) (should (equal -1 (scalar "SELECT $1::int" '((-1 . "int4"))))) (should (eql 1.0e+INF (scalar "SELECT $1::float4" '((1.0e+INF . "float4"))))) (should (eql 1.0e+INF (scalar "SELECT $1::float8" '((1.0e+INF . "float8"))))) (should (eql 0.0e+NaN (scalar "SELECT $1::float4" '((0.0e+NaN . "float4"))))) (should (eql 0.0e+NaN (scalar "SELECT $1::float8" '((0.0e+NaN . "float8"))))) ;; CrateDB does not support the BYTEA type. (unless (member (pgcon-server-variant con) '(cratedb)) (should (equal (byte-to-string 0) (scalar "SELECT $1::bytea" '(("\\000" . "text"))))) (should (equal (byte-to-string 0) (scalar "SELECT $1" `((,(byte-to-string 0) . "bytea"))))) (should (equal (decode-hex-string "DEADBEEF") (scalar "SELECT $1::bytea" '(("\\xDEADBEEF" . "text"))))) (should (equal (decode-hex-string "DEADBEEF") (scalar "SELECT $1" `((,(decode-hex-string "DEADBEEF") . "bytea")))))) ;; Risingwave does not support casting to JSON. (unless (member (pgcon-server-variant con) '(risingwave materialize)) (let ((json (scalar "SELECT $1::json" '(("[66.7,-42.0,8]" . "text"))))) (should (approx= 66.7 (aref json 0))) (should (approx= -42.0 (aref json 1))))) ;; CrateDB does not support the JSONB type, not casting {foo=bar} syntax to JSON. CockroachDB ;; supports JSONB but not JSON. (unless (member (pgcon-server-variant con) '(cratedb cockroachdb risingwave materialize)) (let ((json (scalar "SELECT $1::jsonb" '(("[66.7,-42.0,8]" . "text"))))) (should (approx= 66.7 (aref json 0))) (should (approx= -42.0 (aref json 1)))) (let ((json (scalar "SELECT $1::jsonb" '(("[5,7]" . "text"))))) (should (eql 5 (aref json 0)))) (let* ((ht (make-hash-table :test #'equal)) (_ (puthash "say" "foobles" ht)) (_ (puthash "biz" 42 ht)) (json (scalar "SELECT $1::json" `((,ht . "json"))))) (should (equal "foobles" (gethash "say" json))) (should (equal 42 (gethash "biz" json))))) (unless (member (pgcon-server-variant con) '(cratedb cockroachdb risingwave materialize)) (let ((ht (make-hash-table))) (puthash "biz" 45 ht) (puthash "boz" -5.5 ht) (puthash "comment" "good stuff" ht) (let* ((res (pg-exec-prepared con "SELECT $1->'biz'" `((,ht . "json")))) (row (pg-result res :tuple 0))) (should (eql 45 (cl-first row))))) (let ((ht (make-hash-table))) (puthash "biz" 45 ht) (puthash "boz" -5.5 ht) (puthash "comment" "good stuff" ht) (let* ((res (pg-exec-prepared con "SELECT $1 - 'boz'" `((,ht . "jsonb")))) (row (pg-result res :tuple 0))) (should (string= (gethash "comment" (cl-first row)) "good stuff"))))) (when (pg-hstore-setup con) (let ((hs (scalar "SELECT $1::hstore" '(("a=>1,b=>2" . "text"))))) (should (string= "1" (gethash "a" hs))) (should (eql 2 (hash-table-count hs)))) (let ((ht (make-hash-table :test #'equal))) ;; HSTORE only supports string keys and values (puthash "biz" "baz" ht) (puthash "foo" "bar" ht) (puthash "more" "than" ht) (let* ((res (pg-exec-prepared con "SELECT $1 ? 'foo'" `((,ht . "hstore")))) (row (pg-result res :tuple 0))) (should (eql (cl-first row) t))) (let* ((res (pg-exec-prepared con "SELECT $1 - 'more'::text" `((,ht . "hstore")))) (row (pg-result res :tuple 0))) (should (hash-table-p (cl-first row))) (should (eql 2 (hash-table-count (cl-first row))))))) ;; Little Bobby Tables (pg-exec con "DROP TABLE IF EXISTS students") (pg-exec con "CREATE TABLE students(name TEXT, age INT)") (let* ((bobby "Robert'); DROP TABLE students;--") (res (pg-exec-prepared con "INSERT INTO students(name) VALUES ($1)" `((,bobby . "text")))) (_ (pgtest-flush-table con "students")) (count (cl-first (row "SELECT COUNT(*) FROM students" nil))) (name (cl-first (row "SELECT name FROM students LIMIT 1" nil)))) (should (string-prefix-p "INSERT" (pg-result res :status))) (should (eql 1 count)) (should (cl-search "Robert" name))) (should-error (scalar "SELECT * FROM" '(("a" . "text")))) (pg-sync con) (should-error (scalar "SELECT $1::int4" '(("2147483649" . "int4")))) (pg-sync con))) ;; Materialize is returning incorrect values here, failing the test. (cl-defun pg-test-prepared/multifetch (con &optional (rows 1000)) (message "Running multiple fetch/suspended portal test") (let* ((res (pg-exec-prepared con "" nil)) (tuples (pg-result res :tuples))) (should (eql 0 (length tuples))) (should (not (pg-result res :incomplete)))) (let* ((res (pg-exec-prepared con "SELECT generate_series(1, $1)" `((,rows . "int4")) :max-rows 10)) (portal (pgresult-portal res)) (counter 0)) (should (pg-result res :incomplete)) ;; check the results from the initial pg-exec-prepared (dolist (tuple (pg-result res :tuples)) (should (eql (cl-first tuple) (cl-incf counter)))) ;; keep fetching and checking more rows until the portal is complete (while (pg-result res :incomplete) (setq res (pg-fetch con res :max-rows 7)) (dolist (tuple (pg-result res :tuples)) (should (eql (cl-first tuple) (cl-incf counter))))) (should (eql counter rows)) (pg-close-portal con portal)) (message "multiple fetch/suspend portal test complete") ;; check for unexpected pending messages in the stream (problem with old PostgreSQL versions) (let* ((res (pg-exec con "SELECT 55")) (tuple (pg-result res :tuple 0))) (should (eql 55 (cl-first tuple))))) (defun pg-test-basic (con) (cl-labels ((row (sql) (pg-result (pg-exec con sql) :tuple 0)) (scalar (sql) (cl-first (pg-result (pg-exec con sql) :tuple 0)))) (should (equal (list 42) (row "SELECT 42"))) (should (equal (list t) (row "SELECT true"))) (unless (member (pgcon-server-variant con) '(immudb)) (should (equal (list t nil) (row "SELECT true, false"))) (should (equal (list -33 "ZZ" 9999) (row "SELECT -33, 'ZZ', 9999")))) (should (eql -1 (scalar "SELECT -1::integer"))) (should (eql 66 (scalar "SELECT 66::int2"))) (should (eql -66 (scalar "SELECT -66::int2"))) (should (eql 44 (scalar "SELECT 44::int4"))) (should (eql -44 (scalar "SELECT -44::int4"))) (should (eql 12345 (scalar "SELECT 12345::int8"))) (should (eql -12345 (scalar "SELECT -12345::int8"))) (should (eql 100 (scalar "SELECT CAST ('100' AS INTEGER)"))) (should (eql nil (scalar "SELECT '0'::boolean"))) (should (equal (list "hey" "Jude") (row "SELECT 'hey', 'Jude'"))) (should (eql nil (scalar "SELECT NULL"))) (should (eql t (scalar "SELECT 42 = 42"))) ;; Empty strings are equal (should (eql t (scalar "SELECT '' = ''"))) (should (eql nil (scalar "SELECT 53 = 33"))) ;; Returns NULL because NULL is wierd in SQL (should (eql nil (scalar "SELECT NULL = NULL"))) ;; IS checks for NULL identity (should (eql t (scalar "SELECT NULL IS NULL"))) ;; This leads to a timeout with YDB (unless (member (pgcon-server-variant con) '(ydb)) (should (equal nil (row "")))) (unless (member (pgcon-server-variant con) '(cratedb)) (should (eql nil (row "-- comment"))) (should (eql nil (row " /* only a comment */ ")))) (should (eql 42 (scalar "SELECT /* FREE PALESTINE */ 42 "))) (should (equal (list 1 nil "all") (row "SELECT 1,NULL,'all'"))) (unless (member (pgcon-server-variant con) '(questdb spanner)) (should (string= "Z" (scalar "SELECT chr(90)")))) (should (eql 12 (scalar "SELECT length('(╯°□°)╯︵ ┻━┻')"))) (should (string= "::!!::" (scalar "SELECT '::!!::'::varchar"))) (should (string= "éàç⟶∪" (scalar "SELECT 'éàç⟶∪'"))) ;; This statement is strangely very poorly supported in semi-compatible PostgreSQL variants... (unless (member (pgcon-server-variant con) '(cratedb risingwave)) (let* ((res (pg-exec con "SELECT 42 as éléphant")) (col1 (cl-first (pg-result res :attributes)))) (should (string= "éléphant" (cl-first col1))))) ;; Note that we need to escape the ?\ character in an elisp string by repeating it. ;; CrateDB does not support the BYTEA type. (unless (member (pgcon-server-variant con) '(cratedb)) (should (eql 3 (length (scalar "SELECT '\\x123456'::bytea")))) (should (string= (string #x12 #x34 #x56) (scalar "SELECT '\\x123456'::bytea")))) (unless (member (pgcon-server-variant con) '(spanner)) (should (eql nil (row " SELECT 3 WHERE 1=0")))) (unless (member (pgcon-server-variant con) '(cratedb spanner ydb)) ;; these are row expressions, not standard SQL (should (string= (scalar "SELECT (1,2)") "(1,2)")) (should (string= (scalar "SELECT (null,1,2)") "(,1,2)"))) (unless (eq 'risingwave (pgcon-server-variant con)) (should (string= "foo\nbar" (scalar "SELECT $$foo bar$$")))) (should (string= "foo\tbar" (scalar "SELECT 'foo\tbar'"))) (should (string= "foo\rbar\nbiz" (scalar "SELECT 'foo\rbar\nbiz'"))) (should (string= "abcdef" (scalar "SELECT 'abc' || 'def'"))) (should (string= "howdy" (scalar "SELECT 'howdy'::text"))) (should (eql t (scalar "SELECT 'abc' LIKE 'a%'"))) ;; RisingWave does not support the VARCHAR(N) syntax. (unless (eq 'risingwave (pgcon-server-variant con)) (should (string= "gday" (scalar "SELECT 'gday'::varchar(20)")))) ;; CockroachDB is returning these byteas in a non-BYTEA format so they are twice as long as ;; expected. CrateDB does not implement the sha256 and sha512 functions. ;; ;; Could use digest('foobles', 'sha1') if we loaded the pgcrypto extension. (unless (member (pgcon-server-variant con) '(cratedb cockroachdb)) (should (eql 32 (length (scalar "SELECT sha256('foobles')")))) (should (eql 64 (length (scalar "SELECT sha512('foobles')"))))) (unless (member (pgcon-server-variant con) '(spanner)) (should (string= (md5 "foobles") (scalar "SELECT md5('foobles')")))) (let* ((res (pg-exec con "SELECT 11 as bizzle, 15 as bazzle")) (attr (pg-result res :attributes)) (col1 (cl-first attr)) (col2 (cl-second attr)) (row (pg-result res :tuple 0))) (should (eql 1 (length (pg-result res :tuples)))) (should (eql 11 (cl-first row))) (should (eql 15 (cl-second row))) (should (string= "bizzle" (cl-first col1))) (should (string= "bazzle" (cl-first col2)))) ;; This setting defined in PostgreSQL v8.2. A value of 120007 means major version 12, minor ;; version 7. The value in pgcon-server-version-major is obtained by parsing the server_version ;; string sent by the backend on startup. Not all servers return a value for this (for example ;; xata.sh servers return an empty string). (unless (member (pgcon-server-variant con) '(ydb)) (let* ((version-str (car (row "SELECT current_setting('server_version_num')"))) (version-num (and version-str (cl-parse-integer version-str)))) (if version-str (should (eql (pgcon-server-version-major con) (/ version-num 10000))) (message "This PostgreSQL server doesn't support current_setting('server_version_num')")))))) (defun pg-test-insert (con) (cl-flet ((scalar (sql) (cl-first (pg-result (pg-exec con sql) :tuple 0)))) (let ((count 100)) (when (pgtest-have-table con "count_test") (pg-exec con "DROP TABLE count_test")) (let ((sql (pgtest-massage con "CREATE TABLE count_test(key INT PRIMARY KEY, val INT) %s" (if (eq 'orioledb (pgcon-server-variant con)) " USING orioledb" "")))) (pg-exec con sql)) (should (pgtest-have-table con "count_test")) (should (member "val" (pg-columns con "count_test"))) (unless (member (pgcon-server-variant con) '(cratedb xata ydb spanner questdb)) (let ((user (or (nth 4 (pgcon-connect-info con)) "pgeltestuser")) (owner (pg-table-owner con "count_test"))) ;; Some hosted PostgreSQL servers that require you to use a username of the form ;; myuser@the-hostname only return "myuser" from pg-table-owner. (unless (cl-search "@" user) (should (string= user owner)) (should (string= user (pg-table-owner con (make-pg-qualified-name :name "count_test")))) (should (string= user (pg-table-owner con "count_test")))))) (cl-loop for i from 1 to count for sql = (format "INSERT INTO count_test VALUES(%s, %s)" i (* i i)) do (pg-exec con sql)) (unless (member (pgcon-server-variant con) '(cratedb cockroachdb ydb risingwave materialize xata)) (pg-exec con "VACUUM ANALYZE count_test")) (pgtest-flush-table con "count_test") (should (eql count (scalar "SELECT count(*) FROM count_test"))) (should (eql (/ (* count (1+ count)) 2) (scalar "SELECT sum(key) FROM count_test"))) (pg-exec con "DROP TABLE count_test") (should (not (pgtest-have-table con "count_test")))) ;; Test for specific bugs when we have a table name and column names of length 1 (could be ;; interpreted as a character rather than as a string). (pg-exec con "DROP TABLE IF EXISTS w") (when-let* ((sql (pgtest-massage con "CREATE TABLE w(i SERIAL PRIMARY KEY, v TEXT)"))) (pg-exec con sql) (unless (member (pgcon-server-variant con) '(ydb)) (setf (pg-table-comment con "w") "c")) (should (stringp (pg-table-owner con "w"))) (pg-exec con "INSERT INTO w(v) VALUES ('s')") (pg-exec con "INSERT INTO w(v) VALUES ('é')") (pg-exec-prepared con "INSERT INTO w(v) VALUES($1)" `(("a" . "text"))) (pgtest-flush-table con "w") (let ((res (pg-exec con "SELECT * FROM w"))) (should (eql 3 (length (pg-result res :tuples))))) (pg-exec con "DROP TABLE w")))) (defun pg-test-insert/prepared (con) (cl-flet ((scalar (sql) (cl-first (pg-result (pg-exec con sql) :tuple 0)))) (let ((count 100)) (when (pgtest-have-table con "count_test") (pg-exec con "DROP TABLE count_test")) (pg-exec con "CREATE TABLE count_test(key INT PRIMARY KEY, val INT)") (should (pgtest-have-table con "count_test")) (should (member "val" (pg-columns con "count_test"))) (unless (member (pgcon-server-variant con) '(cratedb risingwave ydb)) (pg-exec con "TRUNCATE TABLE count_test")) (dotimes (i count) (pg-exec-prepared con "INSERT INTO count_test VALUES($1, $2)" `((,i . "int4") (,(* i i) . "int4")))) (pgtest-flush-table con "count_test") (should (eql count (scalar "SELECT COUNT(*) FROM count_test"))) (should (eql (/ (* (1- count) count) 2) (scalar "SELECT sum(key) FROM count_test"))) (pg-exec con "DROP TABLE count_test") (should (not (pgtest-have-table con "count_test")))))) ;; Check the mixing of prepared queries, cached prepared statements, normal simple queries, to check ;; that the cache works as expected and that the backend retains prepared statements. TODO: should ;; add here different PostgreSQL connections to the test, to ensure that the caches are not being ;; mixed up. ;; ;; We are seeing problems with Tembo in the mixing of prepared statements and normal statements. (defun pg-test-ensure-prepared (con) (cl-flet ((scalar (sql) (cl-first (pg-result (pg-exec con sql) :tuple 0))) (pfp (ps-name args) (let ((res (pg-fetch-prepared con ps-name args))) (cl-first (pg-result res :tuple 0))))) (pg-exec con "DROP TABLE IF EXISTS prep") (pg-exec con "CREATE TABLE prep(a INTEGER PRIMARY KEY, b INTEGER)") (dotimes (i 10) (pg-exec-prepared con "INSERT INTO prep VALUES($1, $2)" `((,i . "int4") (,(* i i) . "int4")))) (pgtest-flush-table con "prep") (should (eql 10 (scalar "SELECT COUNT(*) FROM prep"))) (let* ((ps1 (pg-ensure-prepared-statement con "PGT-count1" "SELECT COUNT(*) FROM prep" nil)) (ps2 (pg-ensure-prepared-statement con "PGT-count2" "SELECT COUNT(*) FROM prep WHERE a >= $1" '("int4"))) (ps3 (pg-ensure-prepared-statement con "PGT-count3" "SELECT COUNT(*) FROM prep WHERE a + b >= $1" '("int4")))) (should (eql 10 (scalar "SELECT COUNT(*) FROM prep"))) (should (eql 10 (pfp ps1 nil))) (should (eql 10 (pfp ps2 `((0 . "int4"))))) (should (eql 10 (pfp ps3 `((0 . "int4"))))) (should (eql 10 (scalar "SELECT COUNT(*) FROM prep"))) (should (eql 10 (pfp ps2 `((0 . "int4"))))) (should (eql 10 (scalar "SELECT COUNT(*) FROM prep WHERE b >= 0"))) (dotimes (i 1000) (let ((v (pcase (random 4) (0 (scalar "SELECT COUNT(*) FROM prep")) (1 (pfp ps1 nil)) (2 (pfp ps2 `((0 . "int4")))) (3 (pfp ps3 `((0 . "int4"))))))) (should (eql v 10))))) (pg-exec con "DROP TABLE prep"))) ;; https://www.postgresql.org/docs/current/multibyte.html (defun pg-test-client-encoding (con) (cl-flet ((scalar (sql) (car (pg-result (pg-exec con sql) :tuple 0))) (row (sql) (pg-result (pg-exec con sql) :tuple 0))) (unwind-protect (progn ;; (pg-exec con "SET client_encoding TO 'SQL_ASCII'") ;; (setf (pgcon-client-encoding con) 'ascii) (pg-set-client-encoding con "SQL_ASCII") (should (equal "foobles" (scalar "SELECT 'foobles'"))) (should (eql 'ok (condition-case nil (pg-exec con "SELECT '😏'") (pg-encoding-error 'ok)))) (should (equal "FOOBLES" (scalar "SELECT 'FOOBLES'"))) ;; (pg-exec con "SET client_encoding TO 'UTF8'") ;; (setf (pgcon-client-encoding con) 'utf-8) (pg-set-client-encoding con "UTF8") (should (equal "foobles" (scalar "SELECT 'foobles'"))) (should (equal "föé൩" (scalar "SELECT 'föé൩'"))) (should (equal (list "é!à" "more😏than") (row "SELECT 'é!à', 'more😏than'"))) (should (equal "墲いfooローマ字入力" (scalar "SELECT '墲いfooローマ字入力'"))) ;; This works with 'iso-latin-1 but not with 'latin-1, due to an Emacs issue. ;; (pg-exec con "SET client_encoding TO 'LATIN1'") ;; (setf (pgcon-client-encoding con) 'iso-latin-1) (pg-set-client-encoding con "LATIN1") (should (equal "foobles" (scalar "SELECT 'foobles'"))) (should (equal "föéàµ" (scalar "SELECT 'föéàµ'"))) ;; (pg-exec con "SET client_encoding TO 'WIN1250'") ;; (setf (pgcon-client-encoding con) 'windows-1250) (pg-set-client-encoding con "WIN1250") (should (equal "foobles" (scalar "SELECT 'foobles'"))) (should (equal "ŐÇąěý" (scalar "SELECT 'ŐÇąěý'"))) ;; (pg-exec con "SET client_encoding TO 'EUC_JP'") ;; (setf (pgcon-client-encoding con) 'eucjp-ms) (pg-set-client-encoding con "EUC_JP") (should (equal "foobles" (scalar "SELECT 'foobles'"))) (should (equal "あえをビル" (scalar "SELECT 'あえをビル'")))) (pg-set-client-encoding con "UTF8")))) (defun pg-test-procedures (con) (cl-flet ((scalar (sql) (car (pg-result (pg-exec con sql) :tuple 0)))) (should (pg-function-p con "version")) (scalar "DROP FUNCTION IF EXISTS pgtest_difference") (let* ((sql "CREATE FUNCTION pgtest_difference(integer, integer) RETURNS integer AS 'select $1 - $2;' LANGUAGE SQL IMMUTABLE RETURNS NULL ON NULL INPUT") (res (pg-exec con sql))) (should (string-prefix-p "CREATE" (pg-result res :status))) (should (pg-function-p con "pgtest_difference")) (should (eql 5 (scalar "SELECT * FROM pgtest_difference(105, 100)"))) ;; Redefining an existing function should trigger an error. (should (eql 'ok (condition-case nil (pg-exec con "CREATE FUNCTION pgtest_difference(integer, integer) RETURNS integer AS 'select - ($2 - $1);' LANGUAGE SQL IMMUTABLE RETURNS NULL ON NULL INPUT") (pg-programming-error 'ok)))) (pg-exec con "DROP FUNCTION pgtest_difference") (should (not (pg-function-p con "pgtest_difference")))) (scalar "DROP FUNCTION IF EXISTS pgtest_increment") (let* ((sql "CREATE FUNCTION pgtest_increment(val integer) RETURNS integer AS $$ BEGIN RETURN val + 1; END; $$ LANGUAGE PLPGSQL") (res (pg-exec con sql))) (should (string-prefix-p "CREATE" (pg-result res :status))) (should (pg-function-p con "pgtest_increment")) (should (eql -42 (scalar "SELECT pgtest_increment(-43)"))) (pg-exec con "DROP FUNCTION pgtest_increment") (should (not (pg-function-p con "pgtest_increment")))))) ;; Testing for the date/time handling routines. (defun pg-test-date (con) (cl-flet ((scalar (sql) (car (pg-result (pg-exec con sql) :tuple 0)))) (with-environment-variables (("TZ" "UTC-01:00")) (pg-exec con "SET TimeZone = 'UTC-01:00'") (pg-exec con "DROP TABLE IF EXISTS date_test") (pg-exec con (pgtest-massage con "CREATE TABLE date_test( id INTEGER PRIMARY KEY, ts TIMESTAMP, tstz TIMESTAMPTZ, t TIME, ttz TIMETZ, d DATE)")) (unless (member (pgcon-server-variant con) '(cockroachdb)) (unwind-protect (progn (pg-exec con "INSERT INTO date_test(id, ts, tstz, t, ttz, d) VALUES " "(1, current_timestamp, current_timestamp, 'now', 'now', current_date)") (let* ((res (pg-exec con "SELECT * FROM date_test")) (row (pg-result res :tuple 0))) (message "timestamp = %s" (nth 1 row)) (message "timestamptz = %s" (nth 2 row)) (message "time = %s" (nth 3 row)) (message "timetz = %s" (nth 4 row)) (message "date = %s" (nth 5 row))) (pg-exec-prepared con "INSERT INTO date_test(id, ts, tstz, t, ttz, d) VALUES(2, $1, $2, $3, $4, $5)" `((,(pg-isodate-without-timezone-parser "2024-04-27T11:34:42" nil) . "timestamp") (,(pg-isodate-with-timezone-parser "2024-04-27T11:34:42.789+11" nil) . "timestamptz") ("11:34" . "time") ("16:55.33456+11" . "timetz") (,(pg-date-parser "2024-04-27" nil) . "date"))) (pgtest-flush-table con "date_test") (should (eql 2 (scalar "SELECT COUNT(*) FROM date_test")))) (pg-exec con "DROP TABLE date_test"))) (unless (member (pgcon-server-variant con) '(cockroachdb)) (should (equal (scalar "SELECT 'allballs'::time") "00:00:00"))) (should (equal (scalar "SELECT '2022-10-01'::date") (encode-time (list 0 0 0 1 10 2022)))) ;; When casting to DATE, the time portion is truncated (should (equal (scalar "SELECT '2063-03-31T22:13:02'::date") (encode-time (list 0 0 0 31 3 2063)))) ;; Here the hh:mm:ss are taken into account. (should (equal (scalar "SELECT '2063-03-31T22:13:02'::timestamp") (encode-time (list 2 13 22 31 3 2063 nil -1 nil)))) (unless (member (pgcon-server-variant con) '(ydb)) (message "TZ test: current PostgreSQL timezone is %s" (scalar "SHOW timezone"))) (message "TZ test: current Emacs timezone is %s" (current-time-zone)) (message "TZ test: no-DST value is 2010-02-05 14:42:21") (let* ((ts (encode-time (list 21 42 14 5 2 2010 nil -1 'wall))) (fmt (format-time-string "%Y-%m-%dT%H:%M:%S.%3N%z" ts t))) (message "TZ test: encode-time 21 42 14 5 2 2010 nil -1 'wall => %s %s" ts fmt)) (let ((pg-disable-type-coercion t)) (message "TZ test: no-DST raw timestamp from PostgreSQL: %s" (scalar "SELECT '2010-02-05 14:42:21'::timestamp"))) (message "TZ test: no-DST timestamptz from PostgreSQL: %s" (scalar "SELECT '2010-02-05 14:42:21'::timestamptz")) (message "TZ test: no-DST timestamp from PostgreSQL: %s" (scalar "SELECT '2010-02-05 14:42:21'::timestamp")) (message "TZ test: no-DST encoded time ZONE=nil = %s" (encode-time (list 21 42 14 5 2 2010 nil -1 nil))) (message "TZ test: no-DST encoded time UTC-01:00 = %s" (encode-time (list 21 42 14 5 2 2010 nil -1 "UTC-01:00"))) (message "TZ test: no-DST encoded time 'wall = %s" (encode-time (list 21 42 14 5 2 2010 nil -1 'wall))) (message "TZ test: w/DST value is 2010-06-05 14:42:21") (let ((pg-disable-type-coercion t)) (message "TZ test: w/DST raw timestamp from PostgreSQL: %s" (scalar "SELECT '2010-06-05 14:42:21'::timestamp"))) (message "TZ test: w/DST timestamptz from PostgreSQL: %s" (scalar "SELECT '2010-06-05 14:42:21'::timestamptz")) (message "TZ test: w/DST timestamp from PostgreSQL: %s" (scalar "SELECT '2010-06-05 14:42:21'::timestamp")) (message "TZ test: w/DST encoded time ZONE=nil = %s" (encode-time (list 21 42 14 5 6 2010 nil -1 nil))) (message "TZ test: w/DST encoded time UTC-01:00 = %s" (encode-time (list 21 42 14 5 6 2010 nil -1 "UTC-01:00"))) (message "TZ test: w/DST encoded time 'wall = %s" (encode-time (list 21 42 14 5 6 2010 nil -1 'wall))) ;; In this test, we have ensured that the PostgreSQL session timezone is the same as the ;; timezone used by Emacs for encode-time. Passing ZONE=nil means using Emacs' interpretation ;; of local time, which should correspond to that of PostgreSQL. ;; ;; 2025-02: this test is failing on YDB v23.4 (should (equal (scalar "SELECT '2010-04-05 14:42:21'::timestamp with time zone") ;; SECOND MINUTE HOUR DAY MONTH YEAR IGNORED DST ZONE (encode-time (list 21 42 14 5 4 2010 nil -1 "UTC-01:00")))) (should (equal (scalar "SELECT '2010-04-05 14:42:21'::timestamp without time zone") (encode-time (list 21 42 14 5 4 2010 nil -1 nil)))) (should (equal (scalar "SELECT 'PT42S'::interval") "00:00:42")) (should (equal (scalar "SELECT 'PT3H4M42S'::interval") "03:04:42")) (should (equal (scalar "select '05:00'::time") "05:00:00")) (should (equal (scalar "SELECT '04:15:31.445+05'::timetz") "04:15:31.445+05")) (should (equal (scalar "SELECT '2001-02-03 04:05:06'::timestamp") (encode-time (list 6 5 4 3 2 2001 nil -1 nil))))))) (defun pg-test-numeric (con) (cl-flet ((scalar (sql) (car (pg-result (pg-exec con sql) :tuple 0))) (approx= (x y) (< (/ (abs (- x y)) (max (abs x) (abs y))) 1e-5))) (should (eql -1 (scalar "SELECT '-1'::int"))) (should (eql 128 (scalar "SELECT 128::int2"))) (should (eql -5 (scalar "SELECT -5::int2"))) (should (eql 27890 (scalar "SELECT 27890::int4"))) (should (eql -128 (scalar "SELECT -128::int4"))) (should (eql 66 (scalar "SELECT 66::int8"))) (should (eql -1 (scalar "SELECT -1::int8"))) (should (eql 42 (scalar "SELECT '42'::smallint"))) ;; RisingWave doesn't support numeric(x, y) or decimal(x, y). (unless (member (pgcon-server-variant con) '(risingwave questdb)) (should (approx= 3.14 (scalar "SELECT 3.14::decimal(10,2) as pi")))) ;; CrateDB doesn't support the OID type, nor casting integers to bits. (unless (member (pgcon-server-variant con) '(cratedb risingwave materialize octodb)) (should (eql 123 (scalar "SELECT 123::oid"))) (should (equal (make-bool-vector 1 nil) (scalar "SELECT 0::bit"))) (should (equal (make-bool-vector 1 t) (scalar "SELECT 1::bit"))) (should (equal (make-bool-vector 8 t) (scalar "SELECT CAST(255 as bit(8))"))) (let ((bv (scalar "SELECT CAST(32 as BIT(16))"))) (should (eql nil (aref bv 0))) (should (eql nil (aref bv 3))) (should (eql t (aref bv 10))) (should (eql nil (aref bv 14))))) ;; Emacs version prior to 27 can't coerce to bool-vector type (when (> emacs-major-version 26) ;; RisingWave does not implement the bit type (unless (member (pgcon-server-variant con) '(risingwave materialize)) (should (equal (cl-coerce (vector t nil t nil) 'bool-vector) (scalar "SELECT '1010'::bit(4)")))) (unless (member (pgcon-server-variant con) '(cockroachdb risingwave materialize)) (should (equal (cl-coerce (vector t nil nil t nil nil nil) 'bool-vector) (scalar "SELECT b'1001000'")))) (unless (member (pgcon-server-variant con) '(cratedb risingwave materialize)) (should (equal (cl-coerce (vector t nil t t t t) 'bool-vector) (scalar "SELECT '101111'::varbit(6)"))))) ;; (should (eql 66 (scalar "SELECT 66::money"))) (should (eql (scalar "SELECT floor(42.3)") 42)) (unless (member (pgcon-server-variant con) '(ydb)) (should (eql (scalar "SELECT trunc(43.3)") 43)) (should (eql (scalar "SELECT trunc(-42.3)") -42))) (unless (member (pgcon-server-variant con) '(cockroachdb)) (should (approx= (scalar "SELECT log(100)") 2)) ;; bignums only supported from Emacs 27.2 onwards (unless (member (pgcon-server-variant con) '(cratedb risingwave materialize)) (when (fboundp 'bignump) (should (eql (scalar "SELECT factorial(25)") 15511210043330985984000000))))) (unless (member (pgcon-server-variant con) '(materialize)) (should (approx= (scalar "SELECT pi()") 3.1415626))) (should (approx= (scalar "SELECT -5.0") -5.0)) (should (approx= (scalar "SELECT 5e-14") 5e-14)) (should (approx= (scalar "SELECT 55.678::float4") 55.678)) (should (approx= (scalar "SELECT 55.678::float8") 55.678)) (should (approx= (scalar "SELECT 55.678::real") 55.678)) (should (approx= (scalar "SELECT 55.678::numeric") 55.678)) (should (approx= (scalar "SELECT -1000000000.123456789") -1000000000.123456789)) (should (eql 1.0e+INF (scalar "SELECT 'Infinity'::float4"))) (should (eql -1.0e+INF (scalar "SELECT '-Infinity'::float4"))) (should (eql 1.0e+INF (scalar "SELECT 'Infinity'::float8"))) (should (eql -1.0e+INF (scalar "SELECT '-Infinity'::float8"))) (should (isnan (scalar "SELECT 'NaN'::float4"))) (should (isnan (scalar "SELECT 'NaN'::float8"))) (should (string= (scalar "SELECT 42::decimal::text") "42")) (unless (member (pgcon-server-variant con) '(cratedb cockroachdb risingwave materialize)) (should (string= (scalar "SELECT macaddr '08002b:010203'") "08:00:2b:01:02:03"))) (should (eql (scalar "SELECT char_length('foo')") 3)) (should (string= (scalar "SELECT lower('FOO')") "foo")) (should (eql (scalar "SELECT ascii('a')") 97)) (should (eql (length (scalar "SELECT repeat('Q', 5000)")) 5000)) (let ((4days (scalar "SELECT interval '1 day' + interval '3 days'"))) (should (or (string= 4days "4 days") ;; CrateDB prints the result in this way (valid if not hugely helpful) (string= 4days "4 days 00:00:00")))) ;; CrateDB returns this as a string "3 days 00:00:00" (unless (member (pgcon-server-variant con) '(cratedb)) (should (eql (scalar "SELECT date '2001-10-01' - date '2001-09-28'") 3))))) (defun pg-test-numeric-range (con) (cl-flet ((scalar (sql) (car (pg-result (pg-exec con sql) :tuple 0))) (approx= (x y) (< (/ (abs (- x y)) (max (abs x) (abs y))) 1e-5))) (should (equal (list :range ?\[ 10 ?\) 20) (scalar "SELECT int4range(10, 20)"))) (should (equal (list :range ?\[ -4 ?\) 6) (scalar "SELECT int8range(-4, 6)"))) (should (equal (list :range ?\[ 5 ?\) 20) (scalar "SELECT int4range(5,15) + int4range(10,20)"))) (should (equal (list :range ?\[ 10 ?\) 15) (scalar "SELECT int8range(5,15) * int8range(10,20)"))) ;; Note that PostgreSQL has normalized the (3,7) discrete interval to [4,7) (should (equal (list :range ?\[ 4 ?\) 7) (scalar "SELECT '(3,7)'::int4range"))) (should (equal (list :range ?\[ 4 ?\) 5) (scalar "SELECT '[4,4]'::int4range"))) (should (equal (list :range ?\[ 2 ?\) 15) (scalar "SELECT int8range(1, 14, '(]')"))) ;; this is the empty range (should (equal (list :range) (scalar "SELECT '[4,4)'::int4range"))) (let ((range (scalar "SELECT numrange(33.33, 66.66)"))) (should (eql :range (nth 0 range))) (should (eql ?\[ (nth 1 range))) (should (approx= 33.33 (nth 2 range))) (should (eql ?\) (nth 3 range))) (should (approx= 66.66 (nth 4 range)))) (should (approx= -40.0 (scalar "SELECT upper(numrange(-50.0,-40.00))"))) ;; range is unbounded on lower side (let ((range (scalar "SELECT numrange(NULL, 2.2)"))) (should (eql :range (nth 0 range))) (should (eql ?\( (nth 1 range))) (should (eql nil (nth 2 range))) (should (eql ?\) (nth 3 range))) (should (approx= 2.2 (nth 4 range)))) (should (equal (list :range ?\[ 42 ?\) nil) (scalar "SELECT int8range(42,NULL)"))) (should (equal (list :range ?\( nil ?\) nil) (scalar "SELECT numrange(NULL, NULL)"))))) ;; https://www.postgresql.org/docs/current/datatype-xml.html#DATATYPE-XML-CREATING ;; ;; We are handling XML as an Emacs Lisp string. PostgreSQL is not always compiled with ;; XML support, so check for that first. (defun pg-test-xml (con) (cl-flet ((scalar (sql) (car (pg-result (pg-exec con sql) :tuple 0)))) (unless (zerop (scalar "SELECT COUNT(*) FROM pg_type WHERE typname='xml'")) (should (string= "bar" (scalar "SELECT xmlparse(CONTENT 'bar')"))) (should (string= (scalar "SELECT xmlforest('abc' AS foo, 123 AS bar)") "abc123")) (should (string= "" (scalar "SELECT xmlparse(CONTENT '')"))) (should (cl-search "Foobles" (scalar "SELECT xmlcomment('Foobles')"))) (should (eql 'ok (condition-case nil (scalar "SELECT xmlparse(CONTENT '<')") (pg-xml-error 'ok)))) (should (eql 'ok (condition-case nil (scalar "SELECT xmlparse(DOCUMENT '')") (pg-xml-error 'ok)))) (should (eql 'ok (condition-case nil (scalar "SELECT xmlparse(CONTENT '')") (pg-xml-error 'ok))))))) ;; https://www.postgresql.org/docs/current/datatype-uuid.html (defun pg-test-uuid (con) (cl-flet ((scalar (sql) (car (pg-result (pg-exec con sql) :tuple 0))) (scalar/p (sql args) (car (pg-result (pg-exec-prepared con sql args) :tuple 0)))) (should (string-equal-ignore-case "a0eebc99-9c0b-4ef8-bb6d-6bb9bd380a11" (scalar "SELECT 'a0eebc99-9c0b-4ef8-bb6d-6bb9bd380a11'::uuid"))) (should (string-equal-ignore-case "a0eebc99-9c0b-4ef8-bb6d-6bb9bd380a11" (scalar "SELECT 'A0EEBC99-9C0B-4EF8-BB6D-6BB9BD380A11'::uuid"))) ;; Apparently only defined from PostgreSQL v13 onwards. (when (pg-function-p con "gen_random_uuid") (dotimes (_i 30) (let ((uuid (scalar "SELECT gen_random_uuid()")) (re (concat "\\<[[:xdigit:]]\\{8\\}-" "[[:xdigit:]]\\{4\\}-" "[[:xdigit:]]\\{4\\}-" "[[:xdigit:]]\\{4\\}-" "[[:xdigit:]]\\{12\\}\\>"))) (should (string-match re uuid))))) (should (string-equal-ignore-case "a0eebc99-9c0b-4ef8-bb6d-6bb9bd380a11" (scalar/p "SELECT $1" `(("a0eebc99-9c0b-4ef8-bb6d-6bb9bd380a11" . "uuid"))))) (should (string-equal-ignore-case ;; PostgreSQL returns the UUID in canonical (lowercase) format, but some variants such as ;; QuestDB do not canonicalize. "a0eebc99-9c0b-4ef8-bb6d-6bb9bd380a11" (scalar/p "SELECT $1" `(("A0EEBC99-9C0B-4EF8-BB6D-6BB9BD380A11" . "uuid"))))))) ;; https://www.postgresql.org/docs/current/collation.html ;; ;; Case support in PostgreSQL (lower() and upper()) depend on the current collation rules. To remove ;; dependency on the collation specified when creating the current database, specify the desired ;; collation explicitly. (defun pg-test-collation (con) (cl-flet ((scalar (sql) (car (pg-result (pg-exec con sql) :tuple 0)))) ;; Check whether fr_FR collation is already available (unless (zerop (scalar "SELECT COUNT(*) FROM pg_collation WHERE collname='fr_FR'")) (should (string= (scalar "SELECT lower('FÔÖÉ' COLLATE \"fr_FR\")") "fôöé")) (should (string= (scalar "SELECT lower('FÔ🐘💥bz' COLLATE \"fr_FR\")") "fô🐘💥bz"))) ;; Check whether PostgreSQL was compiled with ICU support. If so, create a collation with ICU ;; provider. (unless (zerop (scalar "SELECT COUNT(*) FROM pg_collation WHERE collname='und-x-icu'")) (scalar "CREATE COLLATION IF NOT EXISTS \"french\" (provider = icu, locale = 'fr_FR')") (should (string= (scalar "SELECT lower('FÔÖÉ' COLLATE \"french\")") "fôöé")) (should (string= (scalar "SELECT lower('FÔ🐘💥bz' COLLATE \"french\")") "fô🐘💥bz"))))) ;; tests for BYTEA type (https://www.postgresql.org/docs/15/functions-binarystring.html) (defun pg-test-bytea (con) (pg-exec con "DROP TABLE IF EXISTS byteatest") (pg-exec con (pgtest-massage con "CREATE TABLE byteatest(id INT PRIMARY KEY, blob BYTEA)")) (pg-exec con "INSERT INTO byteatest VALUES(1, 'warning\\000'::bytea)") (pg-exec con "INSERT INTO byteatest VALUES(2, '\\001\\002\\003'::bytea)") (cl-flet ((scalar (sql) (car (pg-result (pg-exec con sql) :tuple 0)))) (should (equal (byte-to-string 0) (scalar "SELECT '\\000'::bytea"))) (should (equal (byte-to-string ?') (scalar "SELECT ''''::bytea"))) (should (equal (decode-hex-string "DEADBEEF") (scalar "SELECT '\\xDEADBEEF'::bytea"))) (should (equal (string 1 3 5) (scalar "SELECT '\\001\\003\\005'::bytea"))) (should (equal (decode-hex-string "123456789a00bcde") (scalar "SELECT '\\x123456'::bytea || '\\x789a00bcde'::bytea"))) ;; CockroachDB is returning an encoded hex string from sha256() instead of an integer. (unless (member (pgcon-server-variant con) '(cockroachdb)) (should (equal (secure-hash 'sha256 "foobles") (encode-hex-string (scalar "SELECT sha256('foobles'::bytea)"))))) (should (equal (base64-encode-string "foobles") (scalar "SELECT encode('foobles', 'base64')"))) (should (equal "foobles" (scalar "SELECT decode('Zm9vYmxlcw==', 'base64')"))) (should (equal "warning" (scalar "SELECT blob FROM byteatest WHERE id=1"))) (should (equal (string 1 2 3) (scalar "SELECT blob FROM byteatest WHERE id=2"))) ;; When sending binary data to PostgreSQL, either encode all potentially problematic octets ;; like NUL (as above), or send base64-encoded content and decode in PostgreSQL. (let* ((size 512) (random-octets (make-string size 0))) (dotimes (i size) (setf (aref random-octets i) (random 256))) (setf (aref random-octets 0) 0) (pg-exec con (format "INSERT INTO byteatest VALUES (3, decode('%s', 'base64'))" (base64-encode-string random-octets))) (should (equal random-octets (scalar "SELECT blob FROM byteatest WHERE id=3"))))) (pg-exec con "DROP TABLE byteatest")) (defun pg-test-sequence (con) (cl-flet ((scalar (sql) (car (pg-result (pg-exec con sql) :tuple 0)))) (pg-exec con "DROP SEQUENCE IF EXISTS foo_seq") (pg-exec con "CREATE SEQUENCE IF NOT EXISTS foo_seq INCREMENT 20 START WITH 400") (should (equal 400 (scalar "SELECT nextval('foo_seq')"))) (unless (member (pgcon-server-variant con) '(yugabyte)) (should (equal 400 (scalar "SELECT last_value FROM pg_sequences WHERE sequencename='foo_seq'")))) (should (equal 420 (scalar "SELECT nextval('foo_seq')"))) (should (equal 440 (scalar "SELECT nextval('foo_seq')"))) (pg-exec con "DROP SEQUENCE foo_seq"))) (defun pg-test-array (con) (cl-flet ((scalar (sql) (car (pg-result (pg-exec con sql) :tuple 0))) (approx= (x y) (< (/ (abs (- x y)) (max (abs x) (abs y))) 1e-5))) (should (equal (vector 7 8) (scalar "SELECT ARRAY[7,8]"))) (should (equal (vector 9 10 11) (scalar "SELECT '{9,10,11}'::int[]"))) (should (equal (vector 1234) (scalar "SELECT ARRAY[1234::int2]"))) (should (equal (vector -3456) (scalar "SELECT ARRAY[-3456::int4]"))) (should (equal (vector 9987) (scalar "SELECT ARRAY[9987::int8]"))) (should (equal (vector 2 8) (scalar "SELECT ARRAY[2,8]"))) (should (equal (vector) (scalar "SELECT ARRAY[]::integer[]"))) (should (equal (vector) (scalar "SELECT '{}'::int2[]"))) (should (equal (vector) (scalar "SELECT '{}'::int4[]"))) (should (equal (vector) (scalar "SELECT '{}'::int8[]"))) (should (equal (vector) (scalar "SELECT '{}'::char[]"))) (should (equal (vector) (scalar "SELECT '{}'::text[]"))) (should (equal (vector) (scalar "SELECT '{}'::bool[]"))) (should (equal (vector) (scalar "SELECT '{}'::float4[]"))) (should (equal (vector) (scalar "SELECT '{}'::float8[]"))) (let ((vec (scalar "SELECT ARRAY[3.14::float]"))) (should (floatp (aref vec 0))) (should (approx= 3.14 (aref vec 0)))) (let ((vec (scalar "SELECT ARRAY[CAST(3.14 AS DOUBLE PRECISION)]"))) (should (floatp (aref vec 0))) (should (approx= 3.14 (aref vec 0)))) (should (equal (vector 4 20) (scalar "SELECT ARRAY[4] || 20"))) (should (eql 6 (scalar "SELECT array_length('{1,2,3,4,5,6}'::int4[], 1)"))) (should (equal (vector 42) (scalar "SELECT array_agg(42)"))) (should (equal (vector 45 67 89) (scalar "SELECT '{45,67,89}'::smallint[]"))) (should (equal (vector t nil t nil t) (scalar "SELECT '{true, false, true, false, true}'::bool[]"))) ;; Risingwave doesn't implement the CHAR type. (unless (member (pgcon-server-variant con) '(risingwave)) (should (equal (vector ?A ?z ?5) (scalar "SELECT '{A,z,5}'::char[]"))) ;; this is returning _bpchar. (should (equal (vector ?a ?b ?c) (scalar "SELECT CAST('{a,b,c}' AS CHAR[])")))) (should (equal (vector "foo" "bar") (scalar "SELECT '{foo, bar}'::text[]"))) ;; (let* ((res (pg-exec-prepared con "SELECT $1" '(("{1,2,3}" . "_int4")))) ;; (row (pg-result res :tuple 0))) ;; (should (equal (vector 1 2 3) (cl-first row)))) (let ((vec (scalar "SELECT ARRAY[44.3, 8999.5]"))) (should (equal 2 (length vec))) (should (approx= 44.3 (aref vec 0))) (should (approx= 8999.5 (aref vec 1)))))) ;; TODO: we do not currently handle multidimension arrays correctly ;; (should (equal (vector (vector 4 5) (vector 6 7)) ;; (scalar "SELECT '{{4,5},{6,7}}'::int8[][]"))))) ;; Test functionality related to "COMMENT ON TABLE" and "COMMENT ON COLUMN" (defun pg-test-comments (con) (pg-exec con "DROP TABLE IF EXISTS comment_test") (pg-exec con "CREATE TABLE comment_test(cola INTEGER, colb TEXT)") (should (null (pg-table-comment con "comment_test"))) (dolist (cmt (list "Easy" "+++---" "éàÖ🫎")) (setf (pg-table-comment con "comment_test") cmt) (should (string= cmt (pg-table-comment con "comment_test")))) (setf (pg-table-comment con "comment_test") nil) (should (null (pg-table-comment con "comment_test"))) (dolist (cmt (list "Simple" "!!§§??$$$$$$$$$$$$$$$" "éàÖ🫎")) (setf (pg-column-comment con "comment_test" "cola") cmt) (should (string= cmt (pg-column-comment con "comment_test" "cola"))) (setf (pg-column-comment con "comment_test" "colb") cmt) (should (string= cmt (pg-column-comment con "comment_test" "colb")))) (setf (pg-column-comment con "comment_test" "cola") nil) (should (null (pg-column-comment con "comment_test" "cola"))) (setf (pg-column-comment con "comment_test" "colb") nil) (should (null (pg-column-comment con "comment_test" "colb"))) (pg-exec con "DROP TABLE comment_test") ;; Now test for a qualified-name with a custom schema (this will exercise different code paths for ;; some PostgreSQL variants). (pg-exec con "DROP SCHEMA IF EXISTS pgeltestschema CASCADE") (pg-exec con "CREATE SCHEMA pgeltestschema") (pg-exec con "CREATE TABLE pgeltestschema.comment_test(cola INTEGER, colb TEXT)") (let ((tname (make-pg-qualified-name :schema "pgeltestschema" :name "comment_test"))) (should (null (pg-table-comment con tname))) (dolist (cmt (list "Easy" "ç+++---" "éàÖ🐘")) (setf (pg-table-comment con tname) cmt) (should (string= cmt (pg-table-comment con tname)))) (setf (pg-table-comment con tname) nil) (should (null (pg-table-comment con tname))) (dolist (cmt (list "Simple" "!!§§??$$$$$$$$$$$$$$$" "🐘🫎éàÖ")) (setf (pg-column-comment con tname "cola") cmt) (should (string= cmt (pg-column-comment con tname "cola"))) (setf (pg-column-comment con tname "colb") cmt) (should (string= cmt (pg-column-comment con tname "colb")))) (setf (pg-column-comment con tname "cola") nil) (should (null (pg-column-comment con tname "cola"))) (setf (pg-column-comment con tname "colb") nil) (should (null (pg-column-comment con tname "colb"))) (pg-exec con "DROP TABLE pgeltestschema.comment_test") (pg-exec con "DROP SCHEMA pgeltestschema"))) (defun pg-test-metadata (con) ;; Check that the pg_user table exists and that we can parse the name type (let* ((res (pg-exec con "SELECT usename FROM pg_user")) (users (pg-result res :tuples))) (should (> (length users) 0))) ;; CrateDB does not implement SERIAL, because that would make it difficult to allow different ;; nodes to ingest data in parallel. (unless (member (pgcon-server-variant con) '(cratedb)) (pg-exec con "DROP TABLE IF EXISTS coldefault") (pg-exec con "CREATE TABLE coldefault(id SERIAL PRIMARY KEY, comment TEXT)") ;; note that the id column has a DEFAULT value due to the SERIAL (this is not present for a ;; GENERATED ALWAYS AS INTEGER column). (pg-exec con "INSERT INTO coldefault(comment) VALUES ('foobles')") (should (pg-column-default con "coldefault" "id")) (should (pg-column-autogenerated-p con "coldefault" "id")) (should (not (pg-column-default con "coldefault" "comment"))) (should (not (pg-column-autogenerated-p con "coldefault" "comment"))) (pg-exec con "DROP TABLE coldefault")) ;; GENERATED ALWAYS support was implemented in v12 it seems (when (and (not (member (pgcon-server-variant con) '(questdb))) (> (pgcon-server-version-major con) 11)) (pg-exec con "DROP TABLE IF EXISTS colgen_id") (pg-exec con "CREATE TABLE colgen_id(id BIGINT PRIMARY KEY GENERATED ALWAYS AS IDENTITY, comment TEXT)") (pg-exec con "INSERT INTO colgen_id(comment) VALUES('bizzles')") ;; A generated column does not have a DEFAULT, in the PostgreSQL sense (should (not (pg-column-default con "colgen_id" "id"))) (should (pg-column-autogenerated-p con "colgen_id" "id")) (should (not (pg-column-default con "colgen_id" "comment"))) (should (not (pg-column-autogenerated-p con "colgen_id" "comment"))) (pg-exec con "DROP TABLE colgen_id") (pg-exec con "DROP TABLE IF EXISTS colgen_expr") (pg-exec con "CREATE TABLE colgen_expr(count INTEGER PRIMARY KEY, double INTEGER GENERATED ALWAYS AS (count*2) STORED)") (pg-exec con "INSERT INTO colgen_expr(count) VALUES(5)") (should (not (pg-column-default con "colgen_expr" "double"))) (should (not (pg-column-default con "colgen_expr" "count"))) (should (not (pg-column-autogenerated-p con "colgen_expr" "count"))) (should (pg-column-autogenerated-p con "colgen_expr" "double")) (pg-exec con "DROP TABLE colgen_expr"))) ;; Schemas for qualified names such as public.tablename. (defun pg-test-schemas (con) (let ((res (pg-exec con "CREATE SCHEMA IF NOT EXISTS custom"))) (should (string-prefix-p "CREATE" (pg-result res :status)))) (let* ((sql (pgtest-massage con "CREATE TABLE IF NOT EXISTS custom.newtable(id INT4 PRIMARY KEY)")) (res (pg-exec con sql))) (should (string-prefix-p "CREATE" (pg-result res :status)))) (let ((tables (pg-tables con))) (should (cl-find "newtable" tables :test #'string= :key (lambda (tbl) (if (pg-qualified-name-p tbl) (pg-qualified-name-name tbl) tbl))))) ;; now try some strange names for schemas and tables to test quoting (let* ((sql (format "CREATE SCHEMA IF NOT EXISTS %s" (pg-escape-identifier "fan.cy"))) (res (pg-exec con sql))) (should (zerop (cl-search "CREATE" (pg-result res :status))))) (let* ((sql (pgtest-massage con "CREATE TABLE IF NOT EXISTS %s.%s(id INT4 PRIMARY KEY)" (pg-escape-identifier "fan.cy") (pg-escape-identifier "re'ally"))) (res (pg-exec con sql))) (should (zerop (cl-search "CREATE" (pg-result res :status))))) (let ((tables (pg-tables con))) (should (cl-find "re'ally" tables :test #'string= :key (lambda (tbl) (if (pg-qualified-name-p tbl) (pg-qualified-name-name tbl) tbl))))) (let* ((sql (pgtest-massage con "CREATE TABLE IF NOT EXISTS %s.%s(id INT4 PRIMARY KEY)" (pg-escape-identifier "fan.cy") (pg-escape-identifier "en-ough"))) (res (pg-exec con sql))) (should (zerop (cl-search "CREATE" (pg-result res :status))))) (let ((tables (pg-tables con))) (should (cl-find "en-ough" tables :test #'string= :key (lambda (tbl) (if (pg-qualified-name-p tbl) (pg-qualified-name-name tbl) tbl))))) (let* ((qn (make-pg-qualified-name :schema "fan.cy" :name "tri\"cks")) (sql (pgtest-massage con "CREATE TABLE IF NOT EXISTS %s(id INT4 PRIMARY KEY)" (pg-print-qualified-name qn))) (res (pg-exec con sql))) (should (zerop (cl-search "CREATE" (pg-result res :status))))) (let ((tables (pg-tables con))) (should (cl-find "tri\"cks" tables :test #'string= :key (lambda (tbl) (if (pg-qualified-name-p tbl) (pg-qualified-name-name tbl) tbl))))) ;; SQL query using "manual" escaping of the components of a qualified name (let* ((schema (pg-escape-identifier "fan.cy")) (table (pg-escape-identifier "re'ally")) (sql (format "INSERT INTO %s.%s VALUES($1)" schema table)) (res (pg-exec-prepared con sql `((42 . "int4"))))) (should (zerop (cl-search "INSERT" (pg-result res :status))))) ;; Dynamic SQL query using our printing support for qualified names (let* ((qn (make-pg-qualified-name :schema "fan.cy" :name "re'ally")) (pqn (pg-print-qualified-name qn)) (sql (format "INSERT INTO %s VALUES($1)" pqn)) (res (pg-exec-prepared con sql `((44 . "int4"))))) (should (zerop (cl-search "INSERT" (pg-result res :status))))) ;; SQL function call using a parameter and our printing support for qualified names. CockroachDB ;; has no support for pg_total_relation_size(). (unless (member (pgcon-server-variant con) '(cockroachdb)) (let* ((qn (make-pg-qualified-name :schema "fan.cy" :name "re'ally")) (pqn (pg-print-qualified-name qn)) (sql "SELECT pg_total_relation_size($1)") (res (pg-exec-prepared con sql `((,pqn . "text")))) (size (cl-first (pg-result res :tuple 0)))) ;; Note that Yugabyte for example has very large disk storage. (should (<= 0 size 10000000))) (let* ((qn (make-pg-qualified-name :schema "fan.cy" :name "tri\"cks")) (pqn (pg-print-qualified-name qn)) (sql "SELECT pg_total_relation_size($1)") (res (pg-exec-prepared con sql `((,pqn . "text")))) (size (cl-first (pg-result res :tuple 0)))) (should (<= 0 size 10000000)))) (let ((res (pg-exec con "DROP TABLE custom.newtable"))) (should (zerop (cl-search "DROP" (pg-result res :status))))) (let ((res (pg-exec con (format "DROP TABLE %s.%s" (pg-escape-identifier "fan.cy") (pg-escape-identifier "re'ally"))))) (should (zerop (cl-search "DROP" (pg-result res :status))))) (let ((res (pg-exec con (format "DROP TABLE %s.%s" (pg-escape-identifier "fan.cy") (pg-escape-identifier "en-ough"))))) (should (zerop (cl-search "DROP" (pg-result res :status))))) (let* ((qn (make-pg-qualified-name :schema "fan.cy" :name "tri\"cks")) (pqn (pg-print-qualified-name qn)) (res (pg-exec con (format "DROP TABLE %s" pqn)))) (should (zerop (cl-search "DROP" (pg-result res :status))))) (let ((res (pg-exec con "DROP SCHEMA custom"))) (should (zerop (cl-search "DROP" (pg-result res :status))))) (let ((res (pg-exec con (format "DROP SCHEMA %s" (pg-escape-identifier "fan.cy"))))) (should (zerop (cl-search "DROP" (pg-result res :status)))))) ;; https://www.postgresql.org/docs/current/datatype-enum.html ;; ;; PostgreSQL support for ENUMs: defining a new ENUM leads to the creation of a new PostgreSQL OID ;; value for the new type. This means our cache mapping oid to type name, created when we establish ;; the connection, might become invalid and need to be refreshed. (defun pg-test-enums (con) (cl-flet ((scalar (sql) (car (pg-result (pg-exec con sql) :tuple 0)))) (pg-exec con "DROP TYPE IF EXISTS FRUIT") (pg-exec con "CREATE TYPE FRUIT AS ENUM('banana', 'orange', 'apple', 'pear')") (let* ((res (pg-exec con "SELECT 'apple'::fruit")) (attr (pg-result res :attributes))) (should (string= "apple" (car (pg-result res :tuple 0)))) (should (string= "fruit" (caar attr)))) (pcase (pgcon-server-variant con) ;; CockroachDB does not implement DROP TYPE CASCADE ('cockroachdb (pg-exec con "DROP TYPE IF EXISTS rating")) (_ (pg-exec con "DROP TYPE IF EXISTS rating CASCADE"))) (pg-exec con "CREATE TYPE rating AS ENUM('ungood', 'good', 'plusgood'," "'doubleplusgood', 'plusungood', 'doubleplusungood')") (pg-exec con "DROP TABLE IF EXISTS act") (pg-exec con (pgtest-massage con "CREATE TABLE act(name TEXT PRIMARY KEY, value RATING)")) (pg-exec con "INSERT INTO act VALUES('thoughtcrime', 'doubleplusungood')") (pg-exec con "INSERT INTO act VALUES('thinkpol', 'doubleplusgood')") (pg-exec-prepared con "INSERT INTO act VALUES('blackwhite', $1)" `(("good" . "rating"))) (message "Rating plusgood is %s" (scalar "SELECT 'plusgood'::rating")) (pg-exec con "DROP TABLE act") (pg-exec con "DROP TYPE rating"))) ;; https://www.postgresql.org/docs/15/functions-json.html (defun pg-test-json (con) (cl-flet ((scalar (sql) (car (pg-result (pg-exec con sql) :tuple 0))) (approx= (x y) (< (/ (abs (- x y)) (max (abs x) (abs y))) 1e-5))) (should (eql 42 (scalar "SELECT to_json(42)"))) (should (eql -56 (scalar "SELECT CAST ('-56' as json)"))) (let ((json (scalar "SELECT '[5,7]'::json"))) (should (eql 5 (aref json 0)))) (let ((json (scalar "SELECT '[5,7]'::jsonb"))) (should (eql 5 (aref json 0)))) (let ((json (scalar "SELECT '[66.7,-42.0,8]'::json"))) (should (approx= 66.7 (aref json 0))) (should (approx= -42.0 (aref json 1)))) (let ((json (scalar "SELECT '[66.7,-42.0,8]'::jsonb"))) (should (approx= 66.7 (aref json 0))) (should (approx= -42.0 (aref json 1)))) ;; JSON null in JSONB type is not the same as PostgreSQL NULL value! (should (eql nil (scalar "SELECT 'null'::jsonb is null"))) (should (eql nil (scalar "SELECT '{\"name\": null}'::jsonb->'name' IS NULL"))) ;; JSON handling (handling of dictionaries, of NULL, false, [] and {}, etc.) differs between ;; the native JSON support and the json elisp libary. We only test the native support. (when (and (fboundp 'json-parse-string) (fboundp 'json-available-p) (json-available-p)) (should (eql :null (scalar "SELECT 'null'::json"))) (should (equal (vector) (scalar "SELECT '[]'::json"))) (should (equal (vector) (scalar "SELECT '[]'::jsonb"))) (let ((json (scalar "SELECT '{}'::json"))) (should (eql 0 (hash-table-count json)))) (let ((json (scalar "SELECT '{}'::jsonb"))) (should (eql 0 (hash-table-count json)))) (should (equal (vector :null) (scalar "SELECT '[null]'::json"))) (should (equal (vector :null) (scalar "SELECT '[null]'::jsonb"))) (should (equal (vector 42 :null 77) (scalar "SELECT '[42,null,77]'::json"))) (should (equal :null (gethash "a" (scalar "SELECT '{\"a\": null}'::json")))) (should (equal (vector t :false 42) (scalar "SELECT '[true,false,42]'::json"))) (should (equal (vector t :false 42) (scalar "SELECT '[true,false,42]'::jsonb"))) (let* ((res (pg-exec con "SELECT jsonb_array_elements('[true,false,42]'::jsonb)")) (rows (pg-result res :tuples))) (should (equal '((t) (:false) (42)) rows))) (unless (member (pgcon-server-variant con) '(cockroachdb)) (let ((json (scalar "SELECT json_object_agg(42, 66)"))) (should (eql 66 (gethash "42" json))))) (let ((json (scalar "SELECT '{\"a\":1,\"b\":-22}'::json"))) (should (eql 1 (gethash "a" json))) (should (eql -22 (gethash "b" json)))) (let ((json (scalar "SELECT '[{\"a\":\"foo\"},{\"b\":\"bar\"},{\"c\":\"baz\"}]'::json"))) (should (string= "bar" (gethash "b" (aref json 1))))) (let ((json (scalar "SELECT '{\"a\": [0,1,2,null]}'::json"))) (should (eql 2 (aref (gethash "a" json) 2))))) (when (> (pgcon-server-version-major con) 11) (unless (member (pgcon-server-variant con) '(cockroachdb)) (should (string= "true" (scalar "SELECT 'true'::jsonpath"))) (should (string= "$[*]?(@ < 1 || @ > 5)" (scalar "SELECT '$[*] ? (@ < 1 || @ > 5)'::jsonpath"))) (let* ((sql "SELECT jsonb_path_query($1::jsonb, $2)") (res (pg-exec-prepared con sql `(("{\"h\": 9.2}" . "text") ("$.h.floor()" . "jsonpath")))) (row (pg-result res :tuple 0))) (should (eql 9 (cl-first row)))) (let* ((sql "SELECT jsonb_path_query($1, $2)") (dict (make-hash-table :test #'equal)) (_ (puthash "h" 5.6 dict)) (params `((,dict . "jsonb") ("$.h.floor()" . "jsonpath"))) (res (pg-exec-prepared con sql params)) (row (pg-result res :tuple 0))) (should (eql 5 (cl-first row))))) (when (>= (pgcon-server-version-major con) 17) ;; The json_scalar function is new in PostgreSQL 17.0, as is the .bigint() JSON path function (let* ((sql "SELECT jsonb_path_query(to_jsonb($1), $2)") (big 12567833445508910) (query "$.bigint()") (res (pg-exec-prepared con sql `((,big . "int8") (,query . "jsonpath")))) (row (pg-result res :tuple 0))) (should (eql big (cl-first row)))) (let* ((sql "SELECT jsonb_path_query(cast(json_scalar($1) as jsonb), $2)") (tstamp "12:34:56.789 +05:30") (query "$.time_tz(2)") (res (pg-exec-prepared con sql `((,tstamp . "text") (,query . "jsonpath")))) (row (pg-result res :tuple 0))) (should (string= "12:34:56.79+05:30" (cl-first row)))) ;; The json_array function is new in PostgreSQL 17.0 (let* ((sql "SELECT json_array('pg-el', NULL, 42)") (res (pg-exec con sql)) (row (pg-result res :tuple 0))) ;; Default is to drop nulls in the input list (should (equal (vector "pg-el" 42) (cl-first row)))) (let* ((sql "SELECT json_array('pg-el', NULL, 42 NULL ON NULL)") (res (pg-exec con sql)) (row (pg-result res :tuple 0))) ;; Default is to drop nulls in the input list (should (equal (vector "pg-el" :null 42) (cl-first row)))))))) (defun pg-test-server-prepare (con) (cl-flet ((scalar (sql) (car (pg-result (pg-exec con sql) :tuple 0)))) (pg-exec con "PREPARE foobles AS SELECT 2 * $1::int4") (should (eql 66 (scalar "EXECUTE foobles(33)"))))) (defun pg-test-hstore (con) ;; We need to call this before using HSTORE datatypes to load the extension if necessary, and ;; to set up our parser support for the HSTORE type. (when (pg-hstore-setup con) (message "Testing HSTORE extension") (cl-flet ((scalar (sql) (car (pg-result (pg-exec con sql) :tuple 0)))) (let ((hs (scalar "SELECT 'foo=>bar'::hstore"))) (should (string= "bar" (gethash "foo" hs))) (should (eql 1 (hash-table-count hs)))) (let ((hs (scalar "SELECT 'a=>1,b=>2'::hstore"))) (should (string= "1" (gethash "a" hs))) (should (eql 2 (hash-table-count hs)))) ;; There is no guarantee as to the value stored for the 'a' key (duplicate) (let ((hs (scalar "SELECT 'a=>1,foobles=>2,a=>66'::hstore"))) (should (eql 2 (hash-table-count hs))) (should (string= "2" (gethash "foobles" hs)))) (let ((hs (scalar "SELECT 'a=>b, c=>d'::hstore || 'c=>x, d=>q'::hstore"))) (should (string= "x" (gethash "c" hs)))) (let ((hs (scalar "SELECT 'a=>1, b=>2, c=>3'::hstore - 'b'::text"))) (should (eql 2 (hash-table-count hs))) (should (string= "3" (gethash "c" hs)))) (let ((hs (scalar "SELECT hstore(ARRAY['a','1','b','42'])"))) (should (eql 2 (hash-table-count hs))) (should (string= "42" (gethash "b" hs)))) (let ((hs (scalar "SELECT hstore('aaa=>bq, b=>NULL, \"\"=>1')"))) (should (eql nil (gethash "b" hs))) (should (string= "1" (gethash "" hs)))) (let ((arr (scalar "SELECT akeys('biz=>NULL,baz=>42,boz=>66'::hstore)"))) (should (cl-find "biz" arr :test #'string=)) (should (cl-find "boz" arr :test #'string=))) ;; see https://github.com/postgres/postgres/blob/9c40db3b02a41e978ebeb2c61930498a36812bbf/contrib/hstore/sql/hstore_utf8.sql (let ((hs (scalar "SELECT 'ą=>é'::hstore"))) (should (string= (gethash "ą" hs) "é"))) ;; now test serialization support (pg-exec con "DROP TABLE IF EXISTS hstored") (pg-exec con (pgtest-massage con "CREATE TABLE hstored(id INT8 PRIMARY KEY, meta HSTORE)")) (dotimes (i 10) (let ((hs (make-hash-table :test #'equal))) (puthash (format "foobles-%d" i) (format "bazzles-%d" i) hs) (puthash (format "a%d" (1+ i)) (format "%d" (- i)) hs) (puthash (format "föéê-%d" i) (format "bâçé-%d" i) hs) (puthash (format "a👿%d" (1+ i)) (format "%d" (- i)) hs) (pg-exec-prepared con "INSERT INTO hstored(id,meta) VALUES ($1, $2)" `((,i . "int8") (,hs . "hstore"))))) (pgtest-flush-table con "hstored") (let ((rows (scalar "SELECT COUNT(*) FROM hstored"))) (should (eql 10 rows))) (let* ((res (pg-exec con "SELECT meta FROM hstored")) (rows (pg-result res :tuples))) (dolist (ht (mapcar #'car rows)) (maphash (lambda (k v) (should (or (cl-search "foobles" k) (cl-search "föéê" k) (eql ?a (aref k 0)) (cl-search "a👿" k))) (should (or (cl-search "bazzles" v) (cl-search "bâçé" v) (ignore-errors (string-to-number v))))) ht)))))) ;; Testing support for the pgvector extension. (defun pg-test-vector (con) (when (pg-vector-setup con) (message "Testing pgvector extension") (cl-flet ((scalar (sql) (car (pg-result (pg-exec con sql) :tuple 0)))) (let ((v (scalar "SELECT '[4,5,6]'::vector"))) (should (eql 4 (aref v 0)))) (let ((v (scalar "SELECT '[0.003,0.004,1.567,6.777]'::vector"))) (should (eql 4 (length v))) (should (<= 6 (aref v 3) 7))) (let ((d (scalar "SELECT inner_product('[1,2]'::vector, '[3,4]')"))) (should (eql 11 d))) (let ((d (scalar "SELECT l2_distance('[0,0]'::vector, '[3,4]')"))) (should (eql 5 d))) (let ((d (scalar "SELECT cosine_distance('[1,2]'::vector, '[0,0]')"))) (should (eql 0.0e+NaN d))) (when (pg-function-p con "gen_random_uuid") (pg-exec con "DROP TABLE IF EXISTS items") (let ((sql (pgtest-massage con "CREATE TABLE items ( id UUID NOT NULL DEFAULT gen_random_uuid() PRIMARY KEY, embedding vector(4))"))) (pg-exec con sql)) (dotimes (_ 1000) (let ((new (vector (random 55) (random 66) (random 77) (random 88)))) (pg-exec-prepared con "INSERT INTO items(embedding) VALUES($1)" `((,new . "vector"))))) (let ((res (pg-exec con "SELECT embedding FROM items ORDER BY embedding <-> '[1,1,1,1]' LIMIT 1"))) (message "PGVECTOR> closest = %s" (car (pg-result res :tuple 0)))) (pg-exec con "DROP TABLE items"))))) ;; Testing support for the tsvector type used for full text search. ;; See https://www.postgresql.org/docs/current/datatype-textsearch.html (defun pg-test-tsvector (con) (cl-flet ((scalar (sql) (car (pg-result (pg-exec con sql) :tuple 0)))) (should (equal (list (make-pg-ts :lexeme "foo")) (scalar "SELECT 'foo'::tsvector"))) (let ((tsvec (scalar "SELECT 'foo bar'::tsvector"))) (should (cl-find (make-pg-ts :lexeme "foo") tsvec :test #'equal)) (should (cl-find (make-pg-ts :lexeme "bar") tsvec :test #'equal))) (let ((tsvec (scalar "SELECT $$the lexeme ' ' contains spaces$$::tsvector"))) (should (cl-find (make-pg-ts :lexeme "contains") tsvec :test #'equal)) (should (cl-find (make-pg-ts :lexeme " ") tsvec :test #'equal))) (let ((tsvec (scalar "SELECT 'a:1 fat:2 cat:3 sat:4 on:5 a:6 mat:7 and:8 ate:9 a:10 fat:11 rat:12'::tsvector"))) (should (cl-find (make-pg-ts :lexeme "and" :weighted-positions '((8 . :D))) tsvec :test #'equal)) (should (cl-find (make-pg-ts :lexeme "mat" :weighted-positions '((7 . :D))) tsvec :test #'equal)) (should (cl-find (make-pg-ts :lexeme "fat" :weighted-positions '((2 . :D) (11 . :D))) tsvec :test #'equal))) (let ((tsvec (scalar "SELECT 'a:1A fat:2B,4C cat:5D'::tsvector"))) (should (cl-find (make-pg-ts :lexeme "a" :weighted-positions '((1 . :A))) tsvec :test #'equal)) (should (cl-find (make-pg-ts :lexeme "fat" :weighted-positions '((2 . :B) (4 . :C))) tsvec :test #'equal)) (should (cl-find (make-pg-ts :lexeme "cat" :weighted-positions '((5 . :D))) tsvec :test #'equal))) (let ((tsvec (scalar "SELECT $$the lexeme 'Joe''s' contains a quote$$::tsvector"))) (should (cl-find (make-pg-ts :lexeme "a") tsvec :test #'equal)) (should (cl-find (make-pg-ts :lexeme "quote") tsvec :test #'equal)) (should (cl-find (make-pg-ts :lexeme "Joe's") tsvec :test #'equal))) (let ((tsvec (scalar "SELECT 'The Fat Rats'::tsvector"))) (should (cl-find (make-pg-ts :lexeme "Fat") tsvec :test #'equal)) (should (cl-find (make-pg-ts :lexeme "Rats") tsvec :test #'equal))) (pg-exec con "DROP TABLE IF EXISTS documents") (pg-exec con "CREATE TABLE documents(id SERIAL PRIMARY KEY, content TEXT, cvec tsvector)") (dolist (phrase (list "PostgreSQL is a powerful, open-source database system." "Full-text search in PostgreSQL is efficient and scalable." "ts-vector support provides reasonably good search functionality.")) (pg-exec-prepared con "INSERT INTO documents(content, cvec) VALUES ($1,to_tsvector($1))" `((,phrase . "text")))) (pg-exec con "CREATE INDEX idx_content_vector ON documents USING GIN (cvec)") ;; Query using tsvector, rank results with ts_rank, and leverage the GIN index (let* ((sql "SELECT id, content, ts_rank(cvec, to_tsquery('english', 'PostgreSQL & search')) AS rank FROM documents WHERE cvec @@ to_tsquery('english', 'PostgreSQL & search') ORDER BY rank DESC") (res (pg-exec con sql)) (best (pg-result res :tuple 0))) (should (cl-search "efficient" (cl-second best)))) (pg-exec con "DROP TABLE documents"))) ;; Specific tests for the VectorChord BM25 extension. ;; ;; https://github.com/tensorchord/VectorChord-bm25/ (defun pg-test-bm25 (con) (when (pg-setup-bm25 con) (message "Testing Vectorchord BM25 extension support") (should (member "bm25_catalog" (pg-schemas con))) (let* ((sql "SELECT tokenize('A quick brown fox jumps over the lazy dog.', 'Bert')") (res (pg-exec con sql)) (out (cl-first (pg-result res :tuple 0)))) ;; or the form "{2474:1, 2829:1, 3899:1, 4248:1, 4419:1, 5376:1, 5831:1}" (should (eql ?{ (aref out 0))) (should (eql ?} (aref out (1- (length out)))))) (pg-exec con "DROP TABLE IF EXISTS documents") (let* ((sql "CREATE TABLE documents(id SERIAL PRIMARY KEY, passage TEXT, embedding bm25vector)") (res (pg-exec con sql))) (should (string-prefix-p "CREATE" (pg-result res :status)))) (dolist (text (list "PostgreSQL is a powerful, open-source object-relational database system. It has over 15 years of active development." "Full-text search is a technique for searching in plain-text documents or textual database fields. PostgreSQL supports this with tsvector." "BM25 is a ranking function used by search engines to estimate the relevance of documents to a given search query." "PostgreSQL provides many advanced features like full-text search, window functions, and more." "Search and ranking in databases are important in building effective information retrieval systems." "The BM25 ranking algorithm is derived from the probabilistic retrieval framework." "Full-text search indexes documents to allow fast text queries. PostgreSQL supports this through its GIN and GiST indexes." "The PostgreSQL community is active and regularly improves the database system." "Relational databases such as PostgreSQL can handle both structured and unstructured data." "Effective search ranking algorithms, such as BM25, improve search results by understanding relevance.")) (pg-exec-prepared con "INSERT INTO documents(passage) VALUES ($1)" `((,text . "text")))) (pg-exec con "UPDATE documents SET embedding = tokenize(passage, 'Bert')") (pg-exec con "CREATE INDEX documents_embedding_bm25 ON documents USING bm25 (embedding bm25_ops)") (let* ((sql "SELECT id, passage, embedding <&> to_bm25query('documents_embedding_bm25', 'PostgreSQL', 'Bert') AS rank FROM documents ORDER BY rank LIMIT 3") (row (pg-result (pg-exec con sql) :tuple 0))) (should (cl-search "PostgreSQL community" (cl-second row)))))) (defun pg-test-geometric (con) (cl-labels ((row (query args) (pg-result (pg-exec-prepared con query args) :tuple 0)) (scalar (query args) (car (row query args))) (approx= (x y) (< (/ (abs (- x y)) (max (abs x) (abs y))) 1e-5))) (pg-geometry-setup con) (let* ((raw "(45.6,67) ") (p1 (pg--point-parser "(45.6,67) " nil))) (message "Parse of point %s -> %s" raw p1) (should (eql 67 (cdr p1)))) (let ((p2 (pg--point-parser " (33, 0)" nil))) (should (eql 33 (car p2)))) (let ((p3 (pg--point-parser " (0.34, -9.111111145677888) " nil))) (should (floatp (cdr p3))) (should (<= -10 (cdr p3) -9))) (let ((p4 (pg--point-parser "(33e4, -3.1456e4)" nil))) (should (approx= 33e4 (car p4))) (should (<= -35000 (cdr p4) 31000))) (let ((p5 (pg--point-parser "(a,b)" nil))) (should (eql nil p5))) (should (eql nil (pg--point-parser "" nil))) (let ((p7 (pg--point-parser "(3,4)" nil))) (should (eql 3 (car p7))) (should (eql 4 (cdr p7)))) (let ((p8 (pg--point-parser "(12.1,4e-4) " nil))) (should (approx= 4 (* 1e4 (cdr p8))))) (let ((p9 (pg--point-parser " (55,7866677)" nil))) (should (eql 55 (car p9)))) (let ((p10 (pg--point-parser "(22.6,6) " nil))) (should (eql 6 (cdr p10)))) (let ((point (scalar "SELECT '(82,91.0)'::point" nil))) (should (consp point)) (should (eql 82 (car point))) (should (approx= 91.0 (cdr point)))) (when (pg-function-p con "gen_random_uuid") (pg-exec con "DROP TABLE IF EXISTS with_point") (pg-exec con (pgtest-massage con "CREATE TABLE with_point( id UUID NOT NULL DEFAULT gen_random_uuid() PRIMARY KEY, p POINT)")) (pg-exec con "INSERT INTO with_point(p) VALUES('(33,44)')") (pg-exec con "INSERT INTO with_point(p) VALUES('(33.1,4.4)')") (pg-exec con "INSERT INTO with_point(p) VALUES('(1,0)')") (pg-exec con "INSERT INTO with_point(p) VALUES('(3.12345663,78.1)')") (pg-exec con "INSERT INTO with_point(p) VALUES('(-4,44)')") (pg-exec con "INSERT INTO with_point(p) VALUES('(3,-55.7)')") (pg-exec con "INSERT INTO with_point(p) VALUES('(1,111e-5)')") (pg-exec con "INSERT INTO with_point(p) VALUES('(34e3,1e10)')") (pg-exec con "INSERT INTO with_point(p) VALUES(NULL)") (pg-exec-prepared con "INSERT INTO with_point(p) VALUES($1)" `((,(cons 45.5 0.111) . "point"))) (let* ((p1 (cons 2 3)) (res (pg-exec-prepared con "SELECT $1" `((,p1 . "point")))) (row (pg-result res :tuple 0)) (point (cl-first row))) (should (eql 2 (car point)))) (let* ((res (pg-exec con "SELECT * FROM with_point")) (rows (pg-result res :tuples))) (dolist (row rows) (message "Point out --> %s" (cl-second row)))) (pg-exec con "DROP TABLE with_point") (let ((l1 (pg--line-parser "{45.6,1.11,-2.9}" nil))) (should (<= 45 (aref l1 0) 46))) (pg-exec con "DROP TABLE IF EXISTS with_line") (pg-exec con (pgtest-massage con "CREATE TABLE with_line( id UUID NOT NULL DEFAULT gen_random_uuid() PRIMARY KEY, ln LINE)")) (pg-exec con "INSERT INTO with_line(ln) VALUES('{1,2,3}')") (pg-exec con "INSERT INTO with_line(ln) VALUES('{-1,2,-3}')") (pg-exec con "INSERT INTO with_line(ln) VALUES('{1.55,-0.234,3e6}')") (pg-exec con "INSERT INTO with_line(ln) VALUES('{0, 34.9999992,-3e2}')") (pg-exec con "INSERT INTO with_line(ln) VALUES(' {7,-44.44, 2.1}')") (pg-exec con "INSERT INTO with_line(ln) VALUES('{ 0,01, 03.00}')") (pg-exec con "INSERT INTO with_line(ln) VALUES('{-3.567e-4,2,3}')") (pg-exec con "INSERT INTO with_line(ln) VALUES('{1,0.0000,3e-3}')") (let* ((ln (vector -5 -6 -7)) (res (pg-exec-prepared con "SELECT $1" `((,ln . "line")))) (row (pg-result res :tuple 0)) (line (cl-first row))) (should (eql -5 (aref line 0))) (should (eql -6 (aref line 1))) (should (eql -7 (aref line 2)))) (let* ((res (pg-exec con "SELECT * FROM with_line")) (rows (pg-result res :tuples))) (dolist (row rows) (message "Line out --> %s" (cl-second row)))) (pg-exec con "DROP TABLE with_line") (let ((lseg (pg--lseg-parser " [(4,5), (6.7, 4e1)]" nil))) (should (eql 4 (car (aref lseg 0)))) (should (approx= 4e1 (cdr (aref lseg 1))))) (pg-exec con "DROP TABLE IF EXISTS with_lseg") (pg-exec con (pgtest-massage con "CREATE TABLE with_lseg( id UUID NOT NULL DEFAULT gen_random_uuid() PRIMARY KEY, ls LSEG)")) (pg-exec con "INSERT INTO with_lseg(ls) VALUES('[(4,5), (6.6,7.7)]')") (let* ((ls (vector (cons 2 3) (cons 55.5 66.6))) (res (pg-exec-prepared con "SELECT $1" `((,ls . "lseg")))) (ls (cl-first (pg-result res :tuple 0)))) (should (eql 2 (car (aref ls 0)))) (should (eql 3 (cdr (aref ls 0)))) (should (approx= 55.5 (car (aref ls 1))))) (pg-exec con "DROP TABLE with_lseg") (let ((box (pg--box-parser "(4,5), (-66,-77e0) " nil))) (should (eql 4 (car (aref box 0)))) (should (eql -66 (car (aref box 1))))) (pg-exec con "DROP TABLE IF EXISTS with_box") (pg-exec con (pgtest-massage con "CREATE TABLE with_box( id UUID NOT NULL DEFAULT gen_random_uuid() PRIMARY KEY, bx BOX)")) (pg-exec con "INSERT INTO with_box(bx) VALUES('(33.3,5),(5,-67e1)')") (let* ((bx (vector (cons 2 3) (cons 55.6 -23.2))) (res (pg-exec-prepared con "SELECT $1" `((,bx . "box")))) (bx (cl-first (pg-result res :tuple 0)))) ;; the box corners are output in the order upper-right, lower-left (should (approx= 55.6 (car (aref bx 0)))) (should (eql 3 (cdr (aref bx 0)))) (should (approx= -23.2 (cdr (aref bx 1))))) (pg-exec con "DROP TABLE with_box") (let* ((path (pg--path-parser "[(4,5),(6,7), (55e1,66.1),(0,0) ]" nil)) (points (pg-geometry-path-points path))) (should (eql :open (pg-geometry-path-type path))) (should (eql 4 (length points))) (should (eql 7 (cdr (nth 1 points))))) (pg-exec con "DROP TABLE IF EXISTS with_path") (pg-exec con (pgtest-massage con "CREATE TABLE with_path( id UUID NOT NULL DEFAULT gen_random_uuid() PRIMARY KEY, pt PATH)")) (pg-exec con "INSERT INTO with_path(pt) VALUES('[(22,33.3), (4.5,1)]')") (pg-exec con "INSERT INTO with_path(pt) VALUES('[(22,33.3), (4.5,1),(-66,-1)]')") (pg-exec con "INSERT INTO with_path(pt) VALUES('((22,33.3),(4.5,1),(0,0),(0,0))')") (let* ((pth (make-pg-geometry-path :type :closed :points '((2 . 3) (4 . 5) (55.5 . 66.6) (-1 . -1)))) (res (pg-exec-prepared con "SELECT $1" `((,pth . "path")))) (pth (cl-first (pg-result res :tuple 0))) (points (pg-geometry-path-points pth))) (should (eql 4 (length points))) (should (eql :closed (pg-geometry-path-type pth))) (should (eql 3 (cdr (cl-first points)))) (should (eql -1 (car (cl-fourth points))))) (pg-exec con "DROP TABLE with_path") (let* ((polygon (pg--polygon-parser "((4,5), (6,7),(55.0,-43.0),(1,1),(0,0))" nil)) (points (pg-geometry-polygon-points polygon))) (should (eql 5 (length points))) (should (eql 4 (car (cl-first points)))) (should (eql 5 (cdr (cl-first points)))) (should (eql 0 (car (car (last points)))))) (pg-exec con "DROP TABLE IF EXISTS with_polygon") (pg-exec con (pgtest-massage con "CREATE TABLE with_polygon( id UUID NOT NULL DEFAULT gen_random_uuid() PRIMARY KEY, pg POLYGON)")) (pg-exec con "INSERT INTO with_polygon(pg) VALUES('((3,4),(5,6),(44.4,55.5))')") (let* ((pg (make-pg-geometry-polygon :points '((2 . 3) (3 . 4) (4 . 5) (6.6 . 7.77)))) (res (pg-exec-prepared con "SELECT $1" `((,pg . "polygon")))) (pg (cl-first (pg-result res :tuple 0))) (points (pg-geometry-polygon-points pg))) (should (eql 4 (length points))) (should (eql 3 (cdr (cl-first points)))) (should (approx= 7.77 (cdr (car (last points)))))) (pg-exec con "DROP TABLE with_polygon")))) ;; PostGIS parsing tests. These tests require the geosop commandline utility to be installed. (defun pg-test-gis (con) (cl-labels ((row (query) (pg-result (pg-exec con query) :tuple 0)) (scalar (query) (car (row query))) (approx= (x y) (< (/ (abs (- x y)) (max (abs x) (abs y))) 1e-5))) (when (pg-setup-postgis con) (message "Testing PostGIS support...") (let* ((res (pg-exec con "SELECT 'SRID=4326;POINT(0 0)'::geometry")) (tuple (pg-result res :tuple 0))) (message "GIS/POINT> %s" (car tuple))) (should (string= (scalar "SELECT 'POINT(4 5)'::geometry") "POINT (4 5)")) (let ((pg-gis-use-geosop nil)) (should (string= (scalar "SELECT 'POINT(4 5)'::geometry") "010100000000000000000010400000000000001440"))) (should (string= (scalar "SELECT 'SRID=4326;POINT(45 70.0)'::geometry") "POINT (45 70)")) (should (string= (scalar "SELECT 'MULTILINESTRING((-118.584 38.374 20,-118.583 38.5 30),(-71.05957 42.3589 75, -71.061 43 90))'::geometry") "MULTILINESTRING Z ((-118.584 38.374 20, -118.583 38.5 30), (-71.05957 42.3589 75, -71.061 43 90))")) (should (string= (scalar "SELECT 'GEOMETRYCOLLECTION(POINT(2 0),POLYGON((0 0, 1 0, 1 1, 0 1, 0 0)))'::geometry") "GEOMETRYCOLLECTION (POINT (2 0), POLYGON ((0 0, 1 0, 1 1, 0 1, 0 0)))")) (should (string= (scalar "SELECT 'POLYGON((0 0, 1 0, 1 1, 0 1, 0 0))'::geometry") "POLYGON ((0 0, 1 0, 1 1, 0 1, 0 0))")) (should (string= (scalar "SELECT 'POINT(2 43)'::geography") "POINT (2 43)")) (should (string= (scalar "SELECT 'POINT(2.223 43.001)'::geography") "POINT (2.223 43.001)")) (should (string= (scalar "SELECT ST_GeographyFromText('POINT(2.5559 49.0083)')") "POINT (2.5559 49.0083)")) (should (string= (scalar "SELECT 'SRID=4326;POINT(45 80.0)'::geography") ;; "0101000020E610000000000000008046400000000000005440" "POINT (45 80)")) (should (string= (scalar "SELECT 'SPHEROID[\"GRS_1980\",6378137,298.2572]'::spheroid") "SPHEROID(\"GRS_1980\",6378137,298.2572)")) (should (string= (scalar "SELECT Box2D(ST_GeomFromText('LINESTRING(1 2, 3 4, 5 6)'))") "BOX(1 2,5 6)")) (should (string= (scalar "SELECT ST_GeomFromText('LINESTRING(1 2, 3 4, 5 6)')::box2d") "BOX(1 2,5 6)")) (should (string= (scalar "SELECT Box3D(ST_GeomFromEWKT('LINESTRING(1 2 3, 3 4 5, 5 6 5)'))") "BOX3D(1 2 3,5 6 5)")) (should (string= (scalar "SELECT Box3D(ST_GeomFromEWKT('CIRCULARSTRING(220268 150415 1,220227 150505 1,220227 150406 1)'))") "BOX3D(220186.99512189245 150406 1,220288.24878054656 150506.12682932706 1)"))))) ;; https://www.postgresql.org/docs/current/sql-copy.html (defun pg-test-copy (con) (message "Testing COPY...") (cl-flet ((ascii (n) (+ ?A (mod n 26))) (random-word () (apply #'string (cl-loop for count to 10 collect (+ ?a (random 26)))))) (pg-exec con "DROP TABLE IF EXISTS copy_tsv") (pg-exec con "CREATE TABLE copy_tsv (a INTEGER, b CHAR, c TEXT)") (with-temp-buffer (dotimes (i 42) (insert (format "%d\t%c\t%s\n" i (ascii i) (random-word)))) (pg-copy-from-buffer con "COPY copy_tsv(a,b,c) FROM STDIN" (current-buffer)) (let ((res (pg-exec con "SELECT count(*) FROM copy_tsv"))) (should (eql 42 (car (pg-result res :tuple 0))))) (let ((res (pg-exec con "SELECT sum(a) FROM copy_tsv"))) (should (eql 861 (car (pg-result res :tuple 0))))) (let ((res (pg-exec con "SELECT * FROM copy_tsv LIMIT 5"))) (message "COPYTSV> %s" (pg-result res :tuples)))) (pg-exec con "DROP TABLE copy_tsv") (pg-exec con "DROP TABLE IF EXISTS copy_csv") (pg-exec con "CREATE TABLE copy_csv (a INT2, b INTEGER, c CHAR, d TEXT)") (with-temp-buffer (dotimes (i 500) (insert (format "%d,%d,%c,%s\n" i (* i i) (ascii i) (random-word)))) (dotimes (i 500) ;; Check that quoted strings are accepted by PostgreSQL (insert (format "%d,%d,%c,\"%sfôt\"\n" i (* i i) (ascii i) (random-word)))) (pg-copy-from-buffer con "COPY copy_csv(a,b,c,d) FROM STDIN WITH (FORMAT CSV)" (current-buffer)) (let ((res (pg-exec con "SELECT count(*) FROM copy_csv"))) (should (eql 1000 (car (pg-result res :tuple 0))))) (let ((res (pg-exec con "SELECT max(b) FROM copy_csv"))) (should (eql (* 499 499) (car (pg-result res :tuple 0))))) (let ((res (pg-exec con "SELECT * FROM copy_csv LIMIT 3"))) (message "COPYCSV> %s" (pg-result res :tuples))) (pg-exec con "DROP TABLE copy_csv")) ;; testing COPY TO STDOUT (pg-exec con "DROP TABLE IF EXISTS copy_from") (pg-exec con "CREATE TABLE copy_from (a INT2, b INTEGER, c CHAR, d TEXT)") (dotimes (_i 100) (pg-exec-prepared con "INSERT INTO copy_from VALUES($1,$2,$3,$4)" `((,(random 100) . "int2") (,(- (random 1000000) 500000) . "int4") (,(+ ?A (random 26)) . "char") (,(random-word) . "text")))) (with-temp-buffer (pg-copy-to-buffer con "COPY copy_from TO STDOUT" (current-buffer)) ;; We should have 100 lines in the output buffer (should (eql 100 (cl-first (buffer-line-statistics)))) (should (eql 300 (cl-count ?\t (buffer-string))))) (with-temp-buffer (pg-copy-to-buffer con "COPY copy_from TO STDOUT WITH (FORMAT CSV, HEADER TRUE)" (current-buffer)) (should (eql 101 (cl-first (buffer-line-statistics)))) (should (eql 303 (cl-count ?, (buffer-string))))) (pg-exec con "DROP TABLE copy_from"))) ;; Test COPY FROM STDIN on a non-trivial CSV file, which contains UTF-8 data (defun pg-test-copy-large (con) (with-temp-buffer (url-insert-file-contents "https://www.data.gouv.fr/fr/datasets/r/51606633-fb13-4820-b795-9a2a575a72f1") (pg-exec con "DROP TABLE IF EXISTS cities") (pg-exec con "CREATE TABLE cities( insee_code TEXT NOT NULL, city_code TEXT, zip_code NUMERIC, label TEXT NOT NULL, latitude FLOAT, longitude FLOAT, department_name TEXT, department_number VARCHAR(3), region_name TEXT, region_geojson_name TEXT)") (pg-copy-from-buffer con "COPY cities FROM STDIN WITH (FORMAT CSV, DELIMITER ',', HEADER TRUE)" (current-buffer)) (pg-exec con "ALTER TABLE cities DROP COLUMN region_name") (pg-exec con "ALTER TABLE cities DROP COLUMN region_geojson_name") (pg-exec con "ALTER TABLE cities DROP COLUMN label") (pg-exec con "DROP TABLE cities"))) ;; "SELECT xmlcomment("42") -> "" (defun pg-test-xmlbinary (_con) nil) ;; Testing for the data access functions. Expected output is something ;; like ;; ;; ============================================== ;; status of CREATE is CREATE ;; status of INSERT is INSERT 22506 1 ;; oid of INSERT is 22506 ;; status of SELECT is SELECT ;; attributes of SELECT are ((a 23 4) (b 1043 65535)) ;; tuples of SELECT are ((3 zae) (66 poiu)) ;; second tuple of SELECT is (66 poiu) ;; status of DROP is DROP ;; ============================================== (defun pg-test-result (con) (pg-exec con "DROP TABLE IF EXISTS resulttest") (let ((r1 (pg-exec con (pgtest-massage con "CREATE TABLE resulttest (a INT PRIMARY KEY, b VARCHAR(4))"))) (r2 (pg-exec con "INSERT INTO resulttest VALUES (3, 'zae')")) (r3 (pg-exec con "INSERT INTO resulttest VALUES (66, 'poiu')")) (_ (pgtest-flush-table con "resulttest")) (r4 (pg-exec con "SELECT * FROM resulttest")) (r5 (pg-exec con "UPDATE resulttest SET b='foob' WHERE a=66")) (_ (pgtest-flush-table con "resulttest")) (r6 (pg-exec con "SELECT b FROM resulttest WHERE a=66")) (r7 (pg-exec con "DROP TABLE resulttest")) (r8 (pg-exec con "SELECT generate_series(1, 10)"))) (message "==============================================") (message "status of CREATE is %s" (pg-result r1 :status)) ;; CrateDB returns "CREATE 1" instead of "CREATE TABLE"... (unless (member (pgcon-server-variant con) '(cratedb)) (should (string= "CREATE TABLE" (pg-result r1 :status)))) (message "status of INSERT is %s" (pg-result r2 :status)) (should (string= "INSERT 0 1" (pg-result r2 :status))) (message "oid of INSERT is %s" (pg-result r2 :oid)) (should (integerp (pg-result r2 :oid))) (should (string= "INSERT 0 1" (pg-result r3 :status))) (message "status of SELECT is %s" (pg-result r4 :status)) (should (string= "SELECT 2" (pg-result r4 :status))) (message "attributes of SELECT are %s" (pg-result r4 :attributes)) (message "tuples of SELECT are %s" (pg-result r4 :tuples)) (should (eql 2 (length (pg-result r4 :tuples)))) (message "second tuple of SELECT is %s" (pg-result r4 :tuple 1)) (should (string= "UPDATE 1" (pg-result r5 :status))) (should (string= "foob" (car (pg-result r6 :tuple 0)))) (message "status of DROP is %s" (pg-result r7 :status)) (unless (member (pgcon-server-variant con) '(cratedb)) (should (string= "DROP TABLE" (pg-result r7 :status)))) (should (eql (length (pg-result r8 :tuples)) 10)) (message "==============================================")) (let ((res (pg-exec con "SELECT 1 UNION SELECT 2"))) (should (equal '((1) (2)) (pg-result res :tuples)))) (let ((res (pg-exec con "SELECT 1,2,3,'soleil'"))) (should (equal '(1 2 3 "soleil") (pg-result res :tuple 0)))) (let ((res (pg-exec con "SELECT 42 as z"))) (should (string= "z" (caar (pg-result res :attributes))))) (let* ((res (pg-exec con "SELECT 42 as z, 'bob' as bob")) (attr (pg-result res :attributes))) (should (string= "z" (caar attr))) (should (string= "bob" (caadr attr)))) (unless (member (pgcon-server-variant con) '(cratedb risingwave)) (let* ((res (pg-exec con "SELECT 32 as éléphant")) (attr (pg-result res :attributes))) (should (string= "éléphant" (caar attr))) (should (eql 32 (car (pg-result res :tuple 0)))))) ;; Test PREPARE / EXECUTE (unless (member (pgcon-server-variant con) '(cratedb)) (pg-exec con "PREPARE ps42 AS SELECT 42") (let ((res (pg-exec con "EXECUTE ps42"))) (should (eql 42 (car (pg-result res :tuple 0))))) (pg-exec con "DEALLOCATE ps42")) (unless (member (pgcon-server-variant con) '(xata materialize)) (let ((res (pg-exec con "EXPLAIN ANALYZE SELECT 42"))) ;; CrateDB returns "EXPLAIN 1". The output from EXPLAIN ANALYZE is returned as a hash table. (unless (member (pgcon-server-variant con) '(cratedb)) (should (string= "EXPLAIN" (pg-result res :status))) (should (cl-every (lambda (r) (stringp (car r))) (pg-result res :tuples)))))) ;; check query with empty column list (unless (member (pgcon-server-variant con) '(cratedb)) (let ((res (pg-exec con "SELECT FROM information_schema.routines"))) (should (eql nil (pg-result res :attributes))) (should (cl-every #'null (pg-result res :tuples)))))) (defun pg-test-cursors (con) (when (member "cursor_test" (pg-tables con)) (pg-exec con "DROP TABLE cursor_test")) (let ((res (pg-exec con "BEGIN"))) (should (string= "BEGIN" (pg-result res :status)))) (pg-exec con (pgtest-massage con "CREATE TABLE cursor_test (a INTEGER PRIMARY KEY, b TEXT)")) (dotimes (i 10) (pg-exec con (format "INSERT INTO cursor_test VALUES(%d, '%d')" i i))) (let ((res (pg-exec con "DECLARE crsr42 CURSOR FOR SELECT * FROM cursor_test WHERE a=2"))) (should (string= "DECLARE CURSOR" (pg-result res :status)))) (let ((res (pg-exec con "FETCH 1000 FROM crsr42"))) (should (string= "FETCH 1" (pg-result res :status))) (should (eql 1 (length (pg-result res :tuples))))) (let ((res (pg-exec con "CLOSE crsr42"))) (should (string= "CLOSE CURSOR" (pg-result res :status)))) (let ((res (pg-exec con "COMMIT"))) (should (string= "COMMIT" (pg-result res :status)))) (pg-exec con "DROP TABLE cursor_test")) (defun pg-test-createdb (con) (when (member "pgeltestextra" (pg-databases con)) (pg-exec con "DROP DATABASE pgeltestextra")) (pg-exec con "CREATE DATABASE pgeltestextra") (should (member "pgeltestextra" (pg-databases con))) ;; CockroachDB and YugabyteDB don't implement REINDEX. Also, REINDEX at the database level is ;; disabled on certain installations (e.g. Supabase), so we check reindexing of a table. (unless (member (pgcon-server-variant con) '(cockroachdb yugabyte)) (pg-exec con "DROP TABLE IF EXISTS foobles") (pg-exec con (pgtest-massage con "CREATE TABLE foobles(a INTEGER PRIMARY KEY, b TEXT)")) (pg-exec con "CREATE INDEX idx_foobles ON foobles(a)") (pg-exec con "INSERT INTO foobles VALUES (42, 'foo')") (pg-exec con "INSERT INTO foobles VALUES (66, 'bizzle')") (when (and (> (pgcon-server-version-major con) 11) (not (member (pgcon-server-variant con) '(risingwave greenplum)))) (pg-exec con "REINDEX TABLE CONCURRENTLY foobles")) (pg-exec con "DROP TABLE foobles")) (let* ((r (pg-exec con "SHOW ALL")) (config (pg-result r :tuples))) (cl-loop for row in config when (string= "port" (car row)) do (message "Connected to PostgreSQL on port %s" (cadr row)))) (pg-exec con "DROP DATABASE pgeltestextra")) (defun pg-test-unicode-names (con) (when (member "pgel😎" (pg-databases con)) (pg-exec con "DROP DATABASE pgel😎")) (pg-exec con "CREATE DATABASE pgel😎") (should (member "pgel😎" (pg-databases con))) (pg-exec con "DROP DATABASE pgel😎") (pg-exec con "CREATE TEMPORARY TABLE pgel😏(data TEXT)") (pg-exec con "INSERT INTO pgel😏 VALUES('Foobles')") (let ((r (pg-exec con "SELECT * FROM pgel😏"))) (should (eql 1 (length (pg-result r :tuples))))) (pg-exec-prepared con "CREATE SCHEMA IF NOT EXISTS un␂icode" nil) (pg-exec-prepared con (pgtest-massage con "CREATE TABLE IF NOT EXISTS un␂icode.ma🪄c(data TEXT PRIMARY KEY)") nil) (pg-exec-prepared con "INSERT INTO un␂icode.ma🪄c VALUES($1)" '(("hi" . "text"))) (let ((r (pg-exec con "SELECT * FROM un␂icode.ma🪄c"))) (should (eql 1 (length (pg-result r :tuples))))) (pg-exec con "DROP TABLE un␂icode.ma🪄c") (pg-exec con "DROP SCHEMA un␂icode") (pg-exec con (pgtest-massage con "CREATE TEMPORARY TABLE pgeltestunicode(pg→el TEXT PRIMARY KEY)")) (pg-exec con "INSERT INTO pgeltestunicode(pg→el) VALUES ('Foobles')") (pg-exec con "INSERT INTO pgeltestunicode(pg→el) VALUES ('Bizzles')") (let ((r (pg-exec con "SELECT pg→el FROM pgeltestunicode"))) (should (eql 2 (length (pg-result r :tuples))))) ;; Check that Emacs is doing Unicode normalization for us. The first 'á' is LATIN SMALL LETTER A ;; with COMBINING ACUTE ACCENT, the second 'á' is the normalized form LATIN SMALL LETTER A WITH ;; ACUTE. If you run this query in psql the answer will be false, because psql does not do Unicode ;; normalization. With pg-el, the query is encoded to the client-encoding UTF-8 using function ;; encode-coding-string, but this encoding does not involve normalization. (let ((r (pg-exec con "SELECT 'á' = 'á'"))) (should (eql nil (cl-first (pg-result r :tuple 0))))) (let ((r (pg-exec-prepared con "SELECT $1 = $2" '(("á" . "text") ("á" . "text"))))) (should (eql nil (cl-first (pg-result r :tuple 0)))))) (defun pg-test-returning (con) (when (pgtest-have-table con "pgeltestr") (pg-exec con "DROP TABLE pgeltestr")) (pg-exec con (pgtest-massage con "CREATE TABLE pgeltestr(id INTEGER NOT NULL PRIMARY KEY, data TEXT)")) (let* ((res (pg-exec con "INSERT INTO pgeltestr VALUES (1, 'Foobles') RETURNING id")) (id (cl-first (pg-result res :tuple 0))) (_ (pgtest-flush-table con "pgeltestr")) (res (pg-exec con (format "SELECT data from pgeltestr WHERE id=%s" id)))) (should (string= (car (pg-result res :tuple 0)) "Foobles"))) (pg-exec con "DROP TABLE pgeltestr")) ;; Test our support for handling ParameterStatus messages, via the pg-parameter-change-functions ;; variable. When we change the session timezone, the backend should send us a ParameterStatus ;; message with TimeZone=. (defun pg-test-parameter-change-handlers (con) (let ((handler-called nil)) (cl-flet ((tz-handler (_con name _value) (when (string= "TimeZone" name) (setq handler-called t)))) (cl-pushnew #'tz-handler pg-parameter-change-functions) ;; The backend will only send us a ParameterStatus message when the timezone changes, so ;; we make two changes to make sure at least one of them generates a ParameterStatus message. (pg-exec con "SET SESSION TIME ZONE 'Europe/Paris'") (pg-exec con "SET SESSION TIME ZONE 'America/Chicago'") (pg-exec con "SELECT 42") (should (eql t handler-called))))) ;; Check that we raise errors when expected, that we resync with the backend after an error so can ;; handle successive errors, and that we can handle errors with CONDITION-CASE. (defun pg-test-errors (con) (pg-cancel con) (cl-flet ((scalar (sql) (car (pg-result (pg-exec con sql) :tuple 0)))) (should-error (pg-exec con "SELECT * FROM")) (should (eql 42 (scalar "SELECT 42"))) (should-error (pg-exec con "SELECT 42#")) (should (eql 9 (scalar "SELECT 4+5"))) (should (eql 2 (condition-case nil (pg-exec con "SELECT ###") (pg-error 2)))) ;; PostgreSQL should signal numerical overflow (should-error (scalar "SELECT 2147483649::int4")) (should (eql -42 (scalar "SELECT -42"))) (should-error (scalar "SELECT 'foobles'::unexistingtype")) (should (eql -55 (scalar "SELECT -55"))))) ;; Here we test that the SQLSTATE component of errors signaled by the backend is valid. (defun pg-test-error-sqlstate (con) (cl-flet ((scalar (sql) (car (pg-result (pg-exec con sql) :tuple 0)))) (should (eql 'ok (condition-case nil (scalar "SELECT 42/0") (pg-division-by-zero 'ok)))) (should (eql 'ok (condition-case nil (pg-exec-prepared con "SELECT 1/0" nil) (pg-division-by-zero 'ok)))) (should (eql 'ok (condition-case nil (scalar "SELECT sqrt(-5.0)") (pg-floating-point-exception 'ok)))) (should (eql 'ok (condition-case nil (scalar "SELECT log(-2.1)") (pg-floating-point-exception 'ok)))) (should (eql 'ok (condition-case nil ;; numerical overflow (scalar "SELECT 2147483649::int4") (pg-numeric-value-out-of-range 'ok)))) ;; xata.io fails on this test; returns a generic pg-error. (should (eql 'ok (condition-case nil (scalar "SELECT happiness(42)") (pg-undefined-function 'ok)))) (should (eql 'ok (condition-case nil (scalar "SELECTING 42") (pg-syntax-error 'ok)))) (should (eql 'ok (condition-case nil (scalar "SELECT '[1,2,3]'::json ->> {}") (pg-syntax-error 'ok)))) (when (> (pgcon-server-version-major con) 11) (unless (member (pgcon-server-variant con) '(cockroachdb)) (should (eql 'ok (condition-case nil (scalar "SELECT jsonb_path_query('{\"a\":42}'::jsonb, '$$.foo')") (pg-syntax-error 'ok)))))) ;; The json_serialize() function is new in PostgreSQL 17 (unless (or (member (pgcon-server-variant con) '(cockroachdb yugabyte)) (< (pgcon-server-version-major con) 17)) (should (eql 'ok (condition-case nil (scalar "SELECT json_serialize('{\"a\": \"foo\", 42: 43 }')") (pg-invalid-text-representation 'ok))))) (should (eql 'ok (condition-case nil (scalar "SELECT CAST('55Y' AS INTEGER)") (pg-invalid-text-representation 'ok)))) (should (eql 'ok (condition-case nil (scalar "SELECT * FROM nonexistent_table") (pg-undefined-table 'ok)))) (scalar "CREATE TABLE pgtest_foobles(a INTEGER PRIMARY KEY)") (should (eql 'ok (condition-case nil (scalar "ALTER TABLE pgtest_foobles DROP COLUMN nonexistent") (pg-programming-error 'ok)))) (should (eql 'ok (condition-case nil (scalar "CREATE INDEX pgtest_idx ON pgtest_foobles(inexist)") (pg-programming-error 'ok)))) (scalar "DROP TABLE pgtest_foobles") (should (eql 'ok (condition-case nil (scalar "DROP INDEX nonexist_idx") (pg-programming-error 'ok)))) (should (eql 'ok (condition-case nil (scalar "DROP VIEW nonexist_view") (pg-programming-error 'ok)))) (should (eql 'ok (condition-case nil (scalar "SELECT unexist FROM pg_catalog.pg_type") (pg-undefined-column 'ok)))) (should (eql 'ok (condition-case nil (scalar "SELECTING incorrect-syntax") (pg-syntax-error 'ok)))) ;; Here check that a pg-syntax-error is raised when using the extended query protocol, in ;; addition to the simple query protocol. (should (eql 'ok (condition-case nil (pg-exec-prepared con "SELECTING incorrect-syntax" nil) (pg-syntax-error 'ok)))) (should (eql 'ok (condition-case nil (scalar "SELECT * FRÖM VALUES(1,2)") (pg-syntax-error 'ok)))) (should (eql 'ok (condition-case nil (scalar "SELECT '[1,2,3]'::json ->> gg") (pg-undefined-column 'ok)))) ;; The ? operator is only defined for jsonb ? text (unless (member (pgcon-server-variant con) '(cockroachdb)) (should (eql 'ok (condition-case nil (scalar "SELECT '{\"a\":1, \"b\":2}'::jsonb ? 52") (pg-undefined-function 'ok)))) (should (eql 'ok (condition-case nil (pg-exec-prepared con "SELECT $1[5]" '(("[1,2,3]" . "json"))) (pg-datatype-mismatch 'ok))))) (when (pg-function-p con "jsonb_path_query") (should (eql 'ok (condition-case nil (scalar "SELECT jsonb_path_query('{\"h\": 1.7}', '$.floor()')") (pg-json-error 'ok))))) (should (eql 'ok (condition-case nil (scalar "SELECT E'\\xDEADBEEF'") ;; "Invalid byte sequence for encoding" (pg-character-not-in-repertoire 'ok) ;; CockroachDB reports this as a syntax error (different SQLSTATE value) (pg-syntax-error 'ok)))) (should (eql 'ok (condition-case nil (scalar "SELECT '2024-15-01'::date") (pg-datetime-field-overflow 'ok)))) (should (eql 'ok (condition-case nil (scalar "CREATE TABLE pgtest_dupcol(a INTEGER PRIMARY KEY, a VARCHAR)") (pg-programming-error 'ok)))) (should (eql 'ok (condition-case nil (scalar "CREATE TABLE -----(a INTEGER PRIMARY KEY)") (pg-programming-error 'ok)))) (should (eql 'ok (condition-case nil (scalar "CREATE TABLE table(a INTEGER PRIMARY KEY)") (pg-reserved-name 'ok) (pg-syntax-error 'ok)))) (should (eql 'ok (unwind-protect (progn (pg-exec con "CREATE TABLE pgtest_notnull(a INTEGER NOT NULL PRIMARY KEY)") (pg-exec con "INSERT INTO pgtest_notnull(a) VALUES (6)") (condition-case nil (pg-exec con "INSERT INTO pgtest_notnull(a) VALUES (NULL)") (pg-not-null-violation 'ok))) (pg-exec con "DROP TABLE pgtest_notnull")))) (should (eql 'ok (unwind-protect (progn (pg-exec con "CREATE TABLE pgtest_unique(a INTEGER PRIMARY KEY)") (pg-exec con "INSERT INTO pgtest_unique(a) VALUES (6)") (condition-case nil (pg-exec con "INSERT INTO pgtest_unique(a) VALUES (6)") (pg-unique-violation 'ok))) (pg-exec con "DROP TABLE pgtest_unique")))) (should (eql 'ok (unwind-protect (progn (pg-exec con "CREATE TABLE pgtest_check(a INTEGER PRIMARY KEY CHECK (a > 0))") (pg-exec con "INSERT INTO pgtest_check(a) VALUES (6)") (condition-case nil (pg-exec con "INSERT INTO pgtest_check(a) VALUES (-2)") (pg-check-violation 'ok))) (pg-exec con "DROP TABLE pgtest_check")))) ;; As of 2025-02, yugabyte and CockroachDB do not implement EXCLUDE constraints. (unless (member (pgcon-server-variant con) '(yugabyte cockroachdb)) (should (eql 'ok (unwind-protect (progn (pg-exec con "CREATE TABLE pgtest_exclude(a INTEGER, EXCLUDE (a WITH =))") (pg-exec con "INSERT INTO pgtest_exclude(a) VALUES (6)") (condition-case nil (pg-exec con "INSERT INTO pgtest_exclude(a) VALUES (6)") (pg-exclusion-violation 'ok))) (pg-exec con "DROP TABLE pgtest_exclude"))))) ;; Greenplum does not implement FOREIGN KEY integrity constraints (unless (member (pgcon-server-variant con) '(greenplum)) (unwind-protect (progn (pg-exec con "DROP TABLE IF EXISTS pgtest_referencing") (pg-exec con "DROP TABLE IF EXISTS pgtest_referenced") (pg-exec con "CREATE TABLE pgtest_referenced(a INTEGER PRIMARY KEY)") (pg-exec con "CREATE TABLE pgtest_referencing(a INTEGER NOT NULL REFERENCES pgtest_referenced(a))") (pg-exec con "INSERT INTO pgtest_referenced(a) VALUES (6)") (pg-exec con "INSERT INTO pgtest_referencing(a) VALUES (6)") (should (eql 'ok (condition-case nil (pg-exec con "INSERT INTO pgtest_referencing(a) VALUES (1)") (pg-foreign-key-violation 'ok))))) (pg-exec con "DROP TABLE pgtest_referencing") (pg-exec con "DROP TABLE pgtest_referenced"))) (should (eql 'ok (unwind-protect (progn (pg-exec con "SET default_transaction_read_only TO on") (pg-exec con "BEGIN") (condition-case nil (pg-exec con "CREATE TABLE erroring(id SERIAL)") (pg-error 'ok))) (pg-exec con "END") (pg-exec con "SET default_transaction_read_only TO off")))) ;; handler-bind is new in Emacs 30. Here we check the printed representation of our ;; pg-undefined-function error class. (when (fboundp 'handler-bind) (should (eql 'ok (catch 'pgtest-undefined-function (handler-bind ((pg-undefined-function (lambda (e) (should (cl-search "undef" (prin1-to-string e))) (throw 'pgtest-undefined-function 'ok))) (pg-error (lambda (e) (error "Unexpected error class")))) (scalar "SELECT undef(42)")) 'nok)))) ;; (should (eql 'ok (condition-case nil ;; (pg-exec-prepared con "SELECT $1[-5]" '(("{1,2,3}" . "_int4"))) ;; (pg-syntax-error 'ok)))) )) ;; Check our handling of NoticeMessage messages, and the correct operation of ;; `pg-handle-notice-functions'. (defun pg-test-notice (con) (message "Testing handler functions for NOTICE messages") ;; The DROP TABLE will generate a NOTICE. We install a handler function that checks for the ;; name of the table in the NOTICE message (the message will be localized, but hopefully the ;; table name will always be present). (cl-flet ((deity-p (ntc) (should (cl-search "deity" (pgerror-message ntc))))) (let ((pg-handle-notice-functions (list #'deity-p))) (pg-exec con "DROP TABLE IF EXISTS deity"))) ;; CrateDB does not support ROLLBACK (unless (member (pgcon-server-variant con) '(cratedb)) (cl-flet ((check-user-abort (ntc) (should (string= "25P01" (pgerror-sqlstate ntc))) (should (string= "UserAbortTransactionBlock" (pgerror-routine ntc))))) (let ((pg-handle-notice-functions (list #'check-user-abort))) (pg-exec con "ROLLBACK")))) ;; CrateDB and Spanner do not support DO. GreptimeDB does not support SET client_min_messages. (unless (member (pgcon-server-variant con) '(cratedb spanner greptimedb questdb)) (cl-flet ((check-shibboleth (ntc) (should (cl-search "ShibboleTH" (pgerror-message ntc))))) (let ((pg-handle-notice-functions (list #'check-shibboleth))) (pg-exec con "SET client_min_messages TO notice") (pg-exec con "DO $$BEGIN raise notice 'Hi! ShibboleTH'; END$$ LANGUAGE PLPGSQL"))) (cl-flet ((check-shibboleth (ntc) (should (cl-search "ShibboleTH" (pgerror-message ntc))) (should (string= "WARNING" (pgerror-severity ntc))))) (let ((pg-handle-notice-functions (list #'check-shibboleth))) (pg-exec con "SET client_min_messages TO warning") (pg-exec con "DO $$BEGIN raise notice 'Intruder here'; END$$ LANGUAGE PLPGSQL") (pg-exec con "DO $$BEGIN raise warning 'Hi! ShibboleTH'; END$$ LANGUAGE PLPGSQL"))))) ;; Check handling of asynchronous notifications, as generated by LISTEN/NOTIFY. Note that this test ;; is not actually relying on any asynchronous functionality; the notification is received in ;; response to the dummy SELECT request. (defun pg-test-notify (con) (cl-flet ((notification-handler (channel payload) (message "Async notification on %s: %s" channel payload))) (pg-add-notification-handler con #'notification-handler) (pg-exec con "LISTEN yourheart") (pg-exec con "NOTIFY yourheart, 'foobles'") (pg-exec con "SELECT 'ignored'") (pg-exec con "NOTIFY yourheart, 'bazzles'") (sleep-for 10) (pg-exec con "SELECT 'ignored'") (pg-exec con "NOTIFY yourheart") (pg-exec con "SELECT 'ignored'") ;; The function pg_notify is an alternative to the LISTEN statement, and more flexible if your ;; channel name is determined by a variable. It is not implemented in all ;; PostgreSQL-semi-compatible databases. (unless (member (pgcon-server-variant con) '(xata)) (pg-exec con "SELECT pg_notify('yourheart', 'leaving')")) (pg-exec con "SELECT 'ignored'") (pg-exec con "UNLISTEN yourheart") (pg-exec con "NOTIFY yourheart, 'Et redit in nihilum quod fuit ante nihil.'"))) ;; Only the superuser can issue a VACUUM. A bunch of NOTICEs will be emitted indicating this. This ;; test is not robust across PostgreSQL versions, however. ; (let ((notice-counter 0)) ; (let ((pg-handle-notice-functions (list (lambda (_n) (cl-incf notice-counter))))) ; (pg-exec con "VACUUM") ; (should (> notice-counter 0))))) ;; test of large-object interface. Note the use of with-pg-transaction ;; to wrap the requests in a BEGIN..END transaction which is necessary ;; when working with large objects. (defun pg-test-lo-read (con) (with-pg-transaction con (let* ((oid (pg-lo-create con "rw")) (fd (pg-lo-open con oid "rw"))) (message "==================================================") (pg-lo-write con fd "Hi there mate") (pg-lo-lseek con fd 3 0) ; SEEK_SET = 0 (unless (= 3 (pg-lo-tell con fd)) (error "lo-tell test failed!")) (message "Read %s from lo" (pg-lo-read con fd 7)) (message "==================================================") (pg-lo-close con fd) (pg-lo-unlink con oid)))) (defun pg-test-lo-import (con) (with-pg-transaction con (let ((oid (pg-lo-import con "/etc/group"))) (pg-lo-export con oid "/tmp/group") (cond ((zerop (call-process "diff" nil nil nil "/tmp/group" "/etc/group")) (message "lo-import test succeeded") (delete-file "/tmp/group")) (t (message "lo-import test failed: check differences") (message "between files /etc/group and /tmp/group"))) (pg-lo-unlink con oid)))) (defun pg-cleanup () (interactive) (dolist (b (buffer-list)) (when (string-match " \\*PostgreSQL\\*" (buffer-name b)) (let ((p (get-buffer-process b))) (when p (delete-process p))) (kill-buffer b)))) (defun pg-bench () (let* ((time (current-time)) (_ (pg-test)) (elapsed (float-time (time-since time)))) (message "Emacs version %s: %s" (version) elapsed))) (defmacro pg-assert-string= (expected test-form) `(unless (string= ,expected ,test-form) (error "Test failure: %s => %s (expecting %s)" ',test-form ,test-form ,expected))) (defun pg-run-tz-tests (con) (message "Testing timezone handling ...") (pg-exec con "DROP TABLE IF EXISTS tz_test") (pg-exec con (pgtest-massage con "CREATE TABLE tz_test(id INTEGER PRIMARY KEY, ts TIMESTAMP, tstz TIMESTAMPTZ)")) ;; This is the same as CET: in a Posix time zone specification, a positive sign is used for zones ;; west of Greenwich, which is the opposite (!) of the ISO-8601 sign convention used when printing ;; timestamps. However, Emacs on certain platforms like Windows has a very limited ability to ;; interpret timezones like Europe/Paris or CET, so we use this format instead. (with-environment-variables (("TZ" "UTC-01:00")) (pg-exec con "SET TimeZone = 'UTC-01:00'") (unwind-protect (progn (pg-test-iso8601-regexp) (when (version<= "29.1" emacs-version) (pg-test-parse-ts con)) (pg-test-serialize-ts con) (unless (member (pgcon-server-variant con) '(cratedb)) ;; CrateDB is returning "1709033682789" instead of "2024-02-27 11:34:42.789" for ts::text (pg-test-insert-literal-ts con) (when (version<= "29.1" emacs-version) (pg-test-insert-parsed-ts con)))) (pg-exec con "DROP TABLE tz_test")))) (defun pg-test-iso8601-regexp () (message "Test iso8601 regexp ...") (let ((regexp pg--ISODATE_REGEX)) (pg-assert-does-not-match "" regexp) (pg-assert-does-not-match "2024-02-2711:34:42.789+04" regexp) (pg-assert-does-not-match "2024-02-27T11:34:42+4" regexp) (pg-assert-matches "2024-02-27T11:34:42.78901+04:00" regexp) (pg-assert-matches "2024-02-27 11:34:42.78901+04:00" regexp) (pg-assert-matches "2024-02-27T11:34:42.78901" regexp) (pg-assert-matches "2024-02-27T11:34:42+04" regexp) (pg-assert-matches "2024-02-27T11:34:42" regexp) (pg-assert-matches "2024-02-27 11:34:42" regexp) (pg-assert-matches "2024-02-27T11:34:42.78901+04:30" regexp) (pg-assert-matches "2024-02-27T11:34:42.78901+04" regexp) (pg-assert-matches "2024-02-27T11:34:42.78901+0430" regexp) (pg-assert-matches "2024-02-27T11:34:42.78901Z" regexp) (pg-assert-matches "2024-02-27T11:34:42.78901z" regexp))) (defun pg-test-parse-ts (_con) (message "Test parsing of timestamps ...") (let ((ts (pg-isodate-without-timezone-parser "2024-02-27T11:34:42.789+04" nil)) (ts-dst (pg-isodate-without-timezone-parser "2024-05-27T11:34:42.789+04" nil)) (ts-no-tz (pg-isodate-without-timezone-parser "2024-02-27T11:34:42.789" nil)) (ts-zulu (pg-isodate-without-timezone-parser "2024-02-27T11:34:42.789Z" nil)) (tstz (pg-isodate-with-timezone-parser "2024-02-27T15:34:42.789+04" nil)) (tstz-dst (pg-isodate-with-timezone-parser "2024-05-27T15:34:42.789+04" nil)) (tstz-no-tz (pg-isodate-with-timezone-parser "2024-02-27T15:34:42.789" nil)) (tstz-zulu (pg-isodate-with-timezone-parser "2024-02-27T15:34:42.789Z" nil))) ;; This function is being run with TZ=UTC-1. There is a one hour difference between UTC and ;; UTC-1. If we were using a location-based timezone such as Europe/Paris, there would be a 1 ;; hour difference with UTC in February, and a 2 hour difference in May. We don't test this ;; because the GitHub actions runners are not all able to parse a Europe/Paris timezone. (should (string= "2024-02-27T10:34:42.789+0000" (pg-fmt-ts-utc ts))) (pg-assert-string= "2024-05-27T10:34:42.789+0000" (pg-fmt-ts-utc ts-dst)) (pg-assert-string= "2024-02-27T10:34:42.789+0000" (pg-fmt-ts-utc ts-no-tz)) (pg-assert-string= "2024-02-27T10:34:42.789+0000" (pg-fmt-ts-utc ts-zulu)) (pg-assert-string= "2024-02-27T11:34:42.789+0000" (pg-fmt-ts-utc tstz)) (pg-assert-string= "2024-05-27T11:34:42.789+0000" (pg-fmt-ts-utc tstz-dst)) (pg-assert-string= "2024-02-27T14:34:42.789+0000" (pg-fmt-ts-utc tstz-no-tz)) (pg-assert-string= "2024-02-27T15:34:42.789+0000" (pg-fmt-ts-utc tstz-zulu)))) (defun pg-test-serialize-ts (_con) (message "Test serialization of timestamps ...") (let* ((ts (encode-time (iso8601-parse "2024-02-27T15:34:42.789+04" t))) (ts-ser (pg--serialize-encoded-time ts nil))) (pg-assert-string= "2024-02-27T11:34:42.789000000+0000" ts-ser))) ;; The timestamp with timezone type is converted to UTC on input and stored without any timezone ;; information. On output (during the cast to text) the timezone is converted and printed in the ;; current session's timezone. ;; ;; https://www.postgresql.org/docs/current/datatype-datetime.html ;; https://www.postgresql.org/docs/14//datetime-posix-timezone-specs.html (defun pg-test-insert-literal-ts (con) (message "Test literal (string) timestamp insertion ...") ;; We take this as reference. It behaves exactly like psql. ;; Entering literals works as expected. Note that we cast to text to rule out deserialization errors. (pg-exec con "SET TimeZone = 'Etc/UTC'") (pg-exec con "INSERT INTO tz_test(id, ts, tstz) VALUES(1, '2024-02-27T11:34:42.789+04', '2024-02-27T15:34:42.789+04')") (let* ((data (pg-result (pg-exec con "SELECT ts::text, tstz::text FROM tz_test WHERE id=1") :tuple 0)) (ts (nth 0 data)) (tstz (nth 1 data))) ;; Here we are assuming that DateStyle=ISO (this is the default setting) (pg-assert-string= "2024-02-27 11:34:42.789" ts) (pg-assert-string= "2024-02-27 11:34:42.789+00" tstz)) (pg-exec con "SET TimeZone = 'UTC-01:00'") (let* ((data (pg-result (pg-exec con "SELECT ts::text, tstz::text FROM tz_test WHERE id=1") :tuple 0)) (ts (nth 0 data)) (tstz (nth 1 data))) (pg-assert-string= "2024-02-27 11:34:42.789" ts) (pg-assert-string= "2024-02-27 12:34:42.789+01" tstz))) (defun pg-test-insert-parsed-ts (con) (message "Test object timestamp insertion ...") (pg-exec-prepared con "INSERT INTO tz_test(id, ts, tstz) VALUES(2, $1, $2)" `((,(pg-isodate-without-timezone-parser "2024-02-27T11:34:42.789+04" nil) . "timestamp") (,(pg-isodate-with-timezone-parser "2024-02-27T15:34:42.789+04:00" nil) . "timestamptz"))) (pg-exec con "SET TimeZone = 'Etc/UTC'") (let* ((data (pg-result (pg-exec con "SELECT ts::text, tstz::text FROM tz_test WHERE id=2") :tuple 0)) (ts (nth 0 data)) (tstz (nth 1 data))) (pg-assert-string= "2024-02-27 10:34:42.789" ts) (pg-assert-string= "2024-02-27 11:34:42.789+00" tstz)) (pg-exec con "SET TimeZone = 'UTC-01:00'") (let* ((data (pg-result (pg-exec con "SELECT ts::text, tstz::text FROM tz_test WHERE id=2") :tuple 0)) (tstz (nth 1 data))) (pg-assert-string= "2024-02-27 12:34:42.789+01" tstz))) (defun pg-assert-matches (str regexp) (should (string-match regexp str))) (defun pg-assert-does-not-match (str regexp) (should-not (string-match regexp str))) (defun pg-fmt-ts-utc (ts) (let ((ft "%Y-%m-%dT%H:%M:%S.%3N%z")) ;; Last argument of t means "UTC" (format-time-string ft ts t))) ;; EOF