root/src/sqlite.c

DEFINITIONS

1. load_dll_functions
2. init_sqlite_functions
3. sqlite_free
4. encode_string
5. make_sqlite
6. check_sqlite
7. DEFUN
8. DEFUN
9. bind_values
10. row_to_value
11. sqlite_prepare_errdata
12. column_names
13. sqlite_exec
14. DEFUN
15. DEFUN
16. DEFUN
17. DEFUN
18. DEFUN
19. DEFUN
20. DEFUN
21. DEFUN
22. DEFUN
23. DEFUN
24. syms_of_sqlite

     1 /* Support for accessing SQLite databases.
     2 
     3 Copyright (C) 2021-2023 Free Software Foundation, Inc.
     4 
     5 This file is part of GNU Emacs.
     6 
     7 GNU Emacs is free software: you can redistribute it and/or modify
     8 it under the terms of the GNU General Public License as published by
     9 the Free Software Foundation, either version 3 of the License, or (at
    10 your option) any later version.
    11 
    12 GNU Emacs is distributed in the hope that it will be useful,
    13 but WITHOUT ANY WARRANTY; without even the implied warranty of
    14 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
    15 GNU General Public License for more details.
    16 
    17 You should have received a copy of the GNU General Public License
    18 along with GNU Emacs.  If not, see <https://www.gnu.org/licenses/>.
    19 
    20 This file is based on the emacs-sqlite3 package written by Syohei
    21 YOSHIDA <syohex@gmail.com>, which can be found at:
    22 
    23    https://github.com/syohex/emacs-sqlite3  */
    24 
    25 #include <config.h>
    26 
    27 #include <c-strcase.h>
    28 #include "lisp.h"
    29 #include "coding.h"
    30 
    31 #ifdef HAVE_SQLITE3
    32 
    33 #include <sqlite3.h>
    34 
    35 /* Support for loading SQLite extensions requires the ability to
    36    enable and disable loading of extensions (by default this is
    37    disabled, and we want to keep it that way).  The required macro is
    38    available since SQLite 3.13.  */
    39 # if defined HAVE_SQLITE3_LOAD_EXTENSION && \
    40      defined SQLITE_DBCONFIG_ENABLE_LOAD_EXTENSION
    41 #  define HAVE_LOAD_EXTENSION 1
    42 # else
    43 #  define HAVE_LOAD_EXTENSION 0
    44 # endif
    45 
    46 #ifdef WINDOWSNT
    47 
    48 # include <windows.h>
    49 # include "w32common.h"
    50 # include "w32.h"
    51 
    52 DEF_DLL_FN (SQLITE_API int, sqlite3_finalize, (sqlite3_stmt*));
    53 DEF_DLL_FN (SQLITE_API int, sqlite3_close, (sqlite3*));
    54 DEF_DLL_FN (SQLITE_API int, sqlite3_open_v2,
    55             (const char*, sqlite3**, int, const char*));
    56 DEF_DLL_FN (SQLITE_API int, sqlite3_reset, (sqlite3_stmt*));
    57 DEF_DLL_FN (SQLITE_API int, sqlite3_bind_text,
    58             (sqlite3_stmt*, int, const char*, int, void(*)(void*)));
    59 DEF_DLL_FN (SQLITE_API int, sqlite3_bind_blob,
    60             (sqlite3_stmt*, int, const char*, int, void(*)(void*)));
    61 DEF_DLL_FN (SQLITE_API int, sqlite3_bind_int64,
    62             (sqlite3_stmt*, int, sqlite3_int64));
    63 DEF_DLL_FN (SQLITE_API int, sqlite3_bind_double, (sqlite3_stmt*, int, double));
    64 DEF_DLL_FN (SQLITE_API int, sqlite3_bind_null, (sqlite3_stmt*, int));
    65 DEF_DLL_FN (SQLITE_API int, sqlite3_bind_int, (sqlite3_stmt*, int, int));
    66 DEF_DLL_FN (SQLITE_API int, sqlite3_extended_errcode, (sqlite3*));
    67 DEF_DLL_FN (SQLITE_API const char*, sqlite3_errmsg, (sqlite3*));
    68 #if SQLITE_VERSION_NUMBER >= 3007015
    69 DEF_DLL_FN (SQLITE_API const char*, sqlite3_errstr, (int));
    70 #endif
    71 DEF_DLL_FN (SQLITE_API const char*, sqlite3_libversion, (void));
    72 DEF_DLL_FN (SQLITE_API int, sqlite3_step, (sqlite3_stmt*));
    73 DEF_DLL_FN (SQLITE_API int, sqlite3_changes, (sqlite3*));
    74 DEF_DLL_FN (SQLITE_API int, sqlite3_column_count, (sqlite3_stmt*));
    75 DEF_DLL_FN (SQLITE_API int, sqlite3_column_type, (sqlite3_stmt*, int));
    76 DEF_DLL_FN (SQLITE_API sqlite3_int64, sqlite3_column_int64,
    77             (sqlite3_stmt*, int));
    78 DEF_DLL_FN (SQLITE_API double, sqlite3_column_double, (sqlite3_stmt*, int));
    79 DEF_DLL_FN (SQLITE_API const void*, sqlite3_column_blob,
    80             (sqlite3_stmt*, int));
    81 DEF_DLL_FN (SQLITE_API int, sqlite3_column_bytes, (sqlite3_stmt*, int));
    82 DEF_DLL_FN (SQLITE_API const unsigned char*, sqlite3_column_text,
    83             (sqlite3_stmt*, int));
    84 DEF_DLL_FN (SQLITE_API const char*, sqlite3_column_name, (sqlite3_stmt*, int));
    85 DEF_DLL_FN (SQLITE_API int, sqlite3_exec,
    86             (sqlite3*, const char*, int (*callback)(void*,int,char**,char**),
    87              void*, char**));
    88 DEF_DLL_FN (SQLITE_API int, sqlite3_prepare_v2,
    89             (sqlite3*, const char*, int, sqlite3_stmt**, const char**));
    90 
    91 # if HAVE_LOAD_EXTENSION
    92 DEF_DLL_FN (SQLITE_API int, sqlite3_load_extension,
    93             (sqlite3*, const char*, const char*, char**));
    94 #  undef sqlite3_load_extension
    95 #  define sqlite3_load_extension fn_sqlite3_load_extension
    96 DEF_DLL_FN (SQLITE_API int, sqlite3_db_config, (sqlite3*, int, ...));
    97 #  undef sqlite3_db_config
    98 #  define sqlite3_db_config fn_sqlite3_db_config
    99 # endif
   100 
   101 # undef sqlite3_finalize
   102 # undef sqlite3_close
   103 # undef sqlite3_open_v2
   104 # undef sqlite3_reset
   105 # undef sqlite3_bind_text
   106 # undef sqlite3_bind_blob
   107 # undef sqlite3_bind_int64
   108 # undef sqlite3_bind_double
   109 # undef sqlite3_bind_null
   110 # undef sqlite3_bind_int
   111 # undef sqlite3_extended_errcode
   112 # undef sqlite3_errmsg
   113 # if SQLITE_VERSION_NUMBER >= 3007015
   114 #  undef sqlite3_errstr
   115 # endif
   116 # undef sqlite3_libversion
   117 # undef sqlite3_step
   118 # undef sqlite3_changes
   119 # undef sqlite3_column_count
   120 # undef sqlite3_column_type
   121 # undef sqlite3_column_int64
   122 # undef sqlite3_column_double
   123 # undef sqlite3_column_blob
   124 # undef sqlite3_column_bytes
   125 # undef sqlite3_column_text
   126 # undef sqlite3_column_name
   127 # undef sqlite3_exec
   128 # undef sqlite3_prepare_v2
   129 
   130 # define sqlite3_finalize fn_sqlite3_finalize
   131 # define sqlite3_close fn_sqlite3_close
   132 # define sqlite3_open_v2 fn_sqlite3_open_v2
   133 # define sqlite3_reset fn_sqlite3_reset
   134 # define sqlite3_bind_text fn_sqlite3_bind_text
   135 # define sqlite3_bind_blob fn_sqlite3_bind_blob
   136 # define sqlite3_bind_int64 fn_sqlite3_bind_int64
   137 # define sqlite3_bind_double fn_sqlite3_bind_double
   138 # define sqlite3_bind_null fn_sqlite3_bind_null
   139 # define sqlite3_bind_int fn_sqlite3_bind_int
   140 # define sqlite3_extended_errcode fn_sqlite3_extended_errcode
   141 # define sqlite3_errmsg fn_sqlite3_errmsg
   142 # if SQLITE_VERSION_NUMBER >= 3007015
   143 #  define sqlite3_errstr fn_sqlite3_errstr
   144 # endif
   145 # define sqlite3_libversion fn_sqlite3_libversion
   146 # define sqlite3_step fn_sqlite3_step
   147 # define sqlite3_changes fn_sqlite3_changes
   148 # define sqlite3_column_count fn_sqlite3_column_count
   149 # define sqlite3_column_type fn_sqlite3_column_type
   150 # define sqlite3_column_int64 fn_sqlite3_column_int64
   151 # define sqlite3_column_double fn_sqlite3_column_double
   152 # define sqlite3_column_blob fn_sqlite3_column_blob
   153 # define sqlite3_column_bytes fn_sqlite3_column_bytes
   154 # define sqlite3_column_text fn_sqlite3_column_text
   155 # define sqlite3_column_name fn_sqlite3_column_name
   156 # define sqlite3_exec fn_sqlite3_exec
   157 # define sqlite3_prepare_v2 fn_sqlite3_prepare_v2
   158 
   159 static bool
   160 load_dll_functions (HMODULE library)
   161 {
   162   LOAD_DLL_FN (library, sqlite3_finalize);
   163   LOAD_DLL_FN (library, sqlite3_close);
   164   LOAD_DLL_FN (library, sqlite3_open_v2);
   165   LOAD_DLL_FN (library, sqlite3_reset);
   166   LOAD_DLL_FN (library, sqlite3_bind_text);
   167   LOAD_DLL_FN (library, sqlite3_bind_blob);
   168   LOAD_DLL_FN (library, sqlite3_bind_int64);
   169   LOAD_DLL_FN (library, sqlite3_bind_double);
   170   LOAD_DLL_FN (library, sqlite3_bind_null);
   171   LOAD_DLL_FN (library, sqlite3_bind_int);
   172   LOAD_DLL_FN (library, sqlite3_extended_errcode);
   173   LOAD_DLL_FN (library, sqlite3_errmsg);
   174 #if SQLITE_VERSION_NUMBER >= 3007015
   175   LOAD_DLL_FN (library, sqlite3_errstr);
   176 #endif
   177   LOAD_DLL_FN (library, sqlite3_libversion);
   178   LOAD_DLL_FN (library, sqlite3_step);
   179   LOAD_DLL_FN (library, sqlite3_changes);
   180   LOAD_DLL_FN (library, sqlite3_column_count);
   181   LOAD_DLL_FN (library, sqlite3_column_type);
   182   LOAD_DLL_FN (library, sqlite3_column_int64);
   183   LOAD_DLL_FN (library, sqlite3_column_double);
   184   LOAD_DLL_FN (library, sqlite3_column_blob);
   185   LOAD_DLL_FN (library, sqlite3_column_bytes);
   186   LOAD_DLL_FN (library, sqlite3_column_text);
   187   LOAD_DLL_FN (library, sqlite3_column_name);
   188   LOAD_DLL_FN (library, sqlite3_exec);
   189 # if HAVE_LOAD_EXTENSION
   190   LOAD_DLL_FN (library, sqlite3_load_extension);
   191   LOAD_DLL_FN (library, sqlite3_db_config);
   192 # endif
   193   LOAD_DLL_FN (library, sqlite3_prepare_v2);
   194   return true;
   195 }
   196 #endif /* WINDOWSNT */
   197 
   198 static bool
   199 init_sqlite_functions (void)
   200 {
   201 #ifdef WINDOWSNT
   202   static bool sqlite3_initialized;
   203 
   204   if (!sqlite3_initialized)
   205     {
   206       HMODULE library = w32_delayed_load (Qsqlite3);
   207 
   208       if (!library)
   209         message1 ("sqlite3 library was not found");
   210       else if (load_dll_functions (library))
   211         {
   212           sqlite3_initialized = true;
   213           Vlibrary_cache = Fcons (Fcons (Qsqlite3, Qt), Vlibrary_cache);
   214         }
   215       else
   216         {
   217           message1 ("sqlite3 library was found, but could not be loaded successfully");
   218           Vlibrary_cache = Fcons (Fcons (Qsqlite3, Qnil), Vlibrary_cache);
   219         }
   220     }
   221   return sqlite3_initialized;
   222 #else  /* !WINDOWSNT */
   223   return true;
   224 #endif  /* !WINDOWSNT */
   225 }
   226 
   227 
   228 static void
   229 sqlite_free (void *arg)
   230 {
   231   struct Lisp_Sqlite *ptr = (struct Lisp_Sqlite *)arg;
   232   if (ptr->is_statement)
   233     sqlite3_finalize (ptr->stmt);
   234   else if (ptr->db)
   235     sqlite3_close (ptr->db);
   236   xfree (ptr->name);
   237   xfree (ptr);
   238 }
   239 
   240 static Lisp_Object
   241 encode_string (Lisp_Object string)
   242 {
   243   if (STRING_MULTIBYTE (string))
   244     return encode_string_utf_8 (string, Qnil, 0, Qt, Qt);
   245   else
   246     return string;
   247 }
   248 
   249 static Lisp_Object
   250 make_sqlite (bool is_statement, void *db, void *stmt, char *name)
   251 {
   252   struct Lisp_Sqlite *ptr
   253     = ALLOCATE_PLAIN_PSEUDOVECTOR (struct Lisp_Sqlite, PVEC_SQLITE);
   254   ptr->is_statement = is_statement;
   255   ptr->finalizer = sqlite_free;
   256   ptr->db = db;
   257   ptr->name = name;
   258   ptr->stmt = stmt;
   259   ptr->eof = false;
   260   return make_lisp_ptr (ptr, Lisp_Vectorlike);
   261 }
   262 
   263 static void
   264 check_sqlite (Lisp_Object db, bool is_statement)
   265 {
   266   init_sqlite_functions ();
   267   CHECK_SQLITE (db);
   268   if (is_statement && !XSQLITE (db)->is_statement)
   269     xsignal1 (Qsqlite_error, build_string ("Invalid set object"));
   270   else if (!is_statement && XSQLITE (db)->is_statement)
   271     xsignal1 (Qsqlite_error, build_string ("Invalid database object"));
   272   if (!is_statement && !XSQLITE (db)->db)
   273     xsignal1 (Qsqlite_error, build_string ("Database closed"));
   274   else if (is_statement && !XSQLITE (db)->db)
   275     xsignal1 (Qsqlite_error, build_string ("Statement closed"));
   276 }
   277 
   278 static int db_count = 0;
   279 
   280 DEFUN ("sqlite-open", Fsqlite_open, Ssqlite_open, 0, 1, 0,
   281        doc: /* Open FILE as an sqlite database.
   282 If FILE is nil, an in-memory database will be opened instead.  */)
   283   (Lisp_Object file)
   284 {
   285   Lisp_Object name;
   286   int flags = (SQLITE_OPEN_CREATE  | SQLITE_OPEN_READWRITE);
   287 #ifdef SQLITE_OPEN_FULLMUTEX
   288   flags |= SQLITE_OPEN_FULLMUTEX;
   289 #endif
   290 #ifdef SQLITE_OPEN_URI
   291   flags |= SQLITE_OPEN_URI;
   292 #endif
   293 
   294   if (!init_sqlite_functions ())
   295     xsignal1 (Qsqlite_error, build_string ("sqlite support is not available"));
   296 
   297   if (!NILP (file))
   298     name = ENCODE_FILE (Fexpand_file_name (file, Qnil));
   299   else
   300     {
   301 #ifdef SQLITE_OPEN_MEMORY
   302       /* In-memory database.  These have to have different names to
   303          refer to different databases.  */
   304       AUTO_STRING (memory_fmt, ":memory:%d");
   305       name = CALLN (Fformat, memory_fmt, make_int (++db_count));
   306       flags |= SQLITE_OPEN_MEMORY;
   307 #else
   308       xsignal1 (Qsqlite_error, build_string ("sqlite in-memory is not available"));
   309 #endif
   310     }
   311 
   312   sqlite3 *sdb;
   313   if (sqlite3_open_v2 (SSDATA (name), &sdb, flags, NULL) != SQLITE_OK)
   314     return Qnil;
   315 
   316   return make_sqlite (false, sdb, NULL, xstrdup (SSDATA (name)));
   317 }
   318 
   319 DEFUN ("sqlite-close", Fsqlite_close, Ssqlite_close, 1, 1, 0,
   320        doc: /* Close the sqlite database DB.  */)
   321   (Lisp_Object db)
   322 {
   323   check_sqlite (db, false);
   324   sqlite3_close (XSQLITE (db)->db);
   325   XSQLITE (db)->db = NULL;
   326   return Qt;
   327 }
   328 
   329 /* Bind values in a statement like
   330    "insert into foo values (?, ?, ?)".  */
   331 static const char *
   332 bind_values (sqlite3 *db, sqlite3_stmt *stmt, Lisp_Object values)
   333 {
   334   sqlite3_reset (stmt);
   335   int len;
   336   if (VECTORP (values))
   337     len = ASIZE (values);
   338   else
   339     len = list_length (values);
   340 
   341   for (int i = 0; i < len; ++i)
   342     {
   343       int ret = SQLITE_MISMATCH;
   344       Lisp_Object value;
   345       if (VECTORP (values))
   346         value = AREF (values, i);
   347       else
   348         {
   349           value = XCAR (values);
   350           values = XCDR (values);
   351         }
   352       Lisp_Object type = Ftype_of (value);
   353 
   354       if (EQ (type, Qstring))
   355         {
   356           Lisp_Object encoded;
   357           bool blob = false;
   358 
   359           if (SBYTES (value) == 0)
   360             encoded = value;
   361           else
   362             {
   363               Lisp_Object coding_system =
   364                 Fget_text_property (make_fixnum (0), Qcoding_system, value);
   365               if (NILP (coding_system))
   366                 /* Default to utf-8.  */
   367                 encoded = encode_string (value);
   368               else if (EQ (coding_system, Qbinary))
   369                 blob = true;
   370               else
   371                 encoded = Fencode_coding_string (value, coding_system,
   372                                                  Qnil, Qnil);
   373             }
   374 
   375           if (blob)
   376             {
   377               if (SBYTES (value) != SCHARS (value))
   378                 xsignal1 (Qsqlite_error, build_string ("BLOB values must be unibyte"));
   379             ret = sqlite3_bind_blob (stmt, i + 1,
   380                                        SSDATA (value), SBYTES (value),
   381                                        NULL);
   382             }
   383             else
   384               ret = sqlite3_bind_text (stmt, i + 1,
   385                                        SSDATA (encoded), SBYTES (encoded),
   386                                        NULL);
   387         }
   388       else if (EQ (type, Qinteger))
   389         {
   390           if (BIGNUMP (value))
   391             ret = sqlite3_bind_int64 (stmt, i + 1, bignum_to_intmax (value));
   392           else
   393             ret = sqlite3_bind_int64 (stmt, i + 1, XFIXNUM (value));
   394         }
   395       else if (EQ (type, Qfloat))
   396         ret = sqlite3_bind_double (stmt, i + 1, XFLOAT_DATA (value));
   397       else if (NILP (value))
   398         ret = sqlite3_bind_null (stmt, i + 1);
   399       else if (EQ (value, Qt))
   400         ret = sqlite3_bind_int (stmt, i + 1, 1);
   401       else if (EQ (value, Qfalse))
   402         ret = sqlite3_bind_int (stmt, i + 1, 0);
   403       else
   404         return "invalid argument";
   405 
   406       if (ret != SQLITE_OK)
   407         return sqlite3_errmsg (db);
   408     }
   409 
   410   return NULL;
   411 }
   412 
   413 static Lisp_Object
   414 row_to_value (sqlite3_stmt *stmt)
   415 {
   416   int len = sqlite3_column_count (stmt);
   417   Lisp_Object values = Qnil;
   418 
   419   for (int i = len - 1; i >= 0; i--)
   420     {
   421       Lisp_Object v = Qnil;
   422 
   423       switch (sqlite3_column_type (stmt, i))
   424         {
   425         case SQLITE_INTEGER:
   426           v = make_int (sqlite3_column_int64 (stmt, i));
   427           break;
   428 
   429         case SQLITE_FLOAT:
   430           v = make_float (sqlite3_column_double (stmt, i));
   431           break;
   432 
   433         case SQLITE_BLOB:
   434           v = make_unibyte_string (sqlite3_column_blob (stmt, i),
   435                                    sqlite3_column_bytes (stmt, i));
   436           break;
   437 
   438         case SQLITE_NULL:
   439           v = Qnil;
   440           break;
   441 
   442         case SQLITE_TEXT:
   443           v =
   444             code_convert_string_norecord
   445             (make_unibyte_string ((const char *)sqlite3_column_text (stmt, i),
   446                                   sqlite3_column_bytes (stmt, i)),
   447              Qutf_8, false);
   448           break;
   449         }
   450 
   451       values = Fcons (v, values);
   452     }
   453 
   454   return values;
   455 }
   456 
   457 static Lisp_Object
   458 sqlite_prepare_errdata (int code, sqlite3 *sdb)
   459 {
   460   Lisp_Object errcode = make_fixnum (code);
   461   const char *errmsg = sqlite3_errmsg (sdb);
   462   Lisp_Object lerrmsg = errmsg ? build_string (errmsg) : Qnil;
   463   Lisp_Object errstr, ext_errcode;
   464 
   465 #if SQLITE_VERSION_NUMBER >= 3007015
   466   errstr = build_string (sqlite3_errstr (code));
   467 #else
   468   /* The internet says this is identical to sqlite3_errstr (code).  */
   469   errstr = lerrmsg;
   470 #endif
   471 
   472   /* More details about what went wrong.  */
   473 #if SQLITE_VERSION_NUMBER >= 3006005
   474   ext_errcode = make_fixnum (sqlite3_extended_errcode (sdb));
   475 #else
   476   /* What value to use here?  */
   477   ext_errcode = make_fixnum (0);
   478 #endif
   479 
   480   return list4 (errstr, lerrmsg, errcode, ext_errcode);
   481 }
   482 
   483 DEFUN ("sqlite-execute", Fsqlite_execute, Ssqlite_execute, 2, 3, 0,
   484        doc: /* Execute a non-select SQL statement.
   485 If VALUES is non-nil, it should be a vector or a list of values
   486 to bind when executing a statement like
   487 
   488    insert into foo values (?, ?, ...)
   489 
   490 Value is the number of affected rows.  */)
   491   (Lisp_Object db, Lisp_Object query, Lisp_Object values)
   492 {
   493   check_sqlite (db, false);
   494   CHECK_STRING (query);
   495   if (!(NILP (values) || CONSP (values) || VECTORP (values)))
   496     xsignal1 (Qsqlite_error, build_string ("VALUES must be a list or a vector"));
   497 
   498   sqlite3 *sdb = XSQLITE (db)->db;
   499   Lisp_Object errmsg = Qnil,
   500     encoded = encode_string (query);
   501   sqlite3_stmt *stmt = NULL;
   502 
   503   /* We only execute the first statement -- if there's several
   504      (separated by a semicolon), the subsequent statements won't be
   505      done.  */
   506   int ret = sqlite3_prepare_v2 (sdb, SSDATA (encoded), -1, &stmt, NULL);
   507   if (ret != SQLITE_OK)
   508     {
   509       if (stmt != NULL)
   510         {
   511           sqlite3_finalize (stmt);
   512           sqlite3_reset (stmt);
   513         }
   514 
   515       errmsg = sqlite_prepare_errdata (ret, sdb);
   516       goto exit;
   517     }
   518 
   519   /* Bind ? values.  */
   520   if (!NILP (values))
   521     {
   522       const char *err = bind_values (sdb, stmt, values);
   523       if (err != NULL)
   524         {
   525           errmsg = build_string (err);
   526           goto exit;
   527         }
   528     }
   529 
   530   ret = sqlite3_step (stmt);
   531 
   532   if (ret == SQLITE_ROW)
   533     {
   534       Lisp_Object data = Qnil;
   535       do
   536         data = Fcons (row_to_value (stmt), data);
   537       while (sqlite3_step (stmt) == SQLITE_ROW);
   538 
   539       sqlite3_finalize (stmt);
   540       return Fnreverse (data);
   541     }
   542   else if (ret == SQLITE_OK || ret == SQLITE_DONE)
   543     {
   544       Lisp_Object rows = make_fixnum (sqlite3_changes (sdb));
   545       sqlite3_finalize (stmt);
   546       return rows;
   547     }
   548   else
   549     errmsg = build_string (sqlite3_errmsg (sdb));
   550 
   551  exit:
   552   sqlite3_finalize (stmt);
   553   xsignal1 (ret == SQLITE_LOCKED || ret == SQLITE_BUSY?
   554             Qsqlite_locked_error: Qsqlite_error,
   555             errmsg);
   556 }
   557 
   558 static Lisp_Object
   559 column_names (sqlite3_stmt *stmt)
   560 {
   561   Lisp_Object columns = Qnil;
   562   int count = sqlite3_column_count (stmt);
   563   for (int i = 0; i < count; ++i)
   564     columns = Fcons (build_string (sqlite3_column_name (stmt, i)), columns);
   565 
   566   return Fnreverse (columns);
   567 }
   568 
   569 DEFUN ("sqlite-select", Fsqlite_select, Ssqlite_select, 2, 4, 0,
   570        doc: /* Select data from the database DB that matches QUERY.
   571 If VALUES is non-nil, it should be a list or a vector specifying the
   572 values that will be interpolated into a parameterized statement.
   573 
   574 By default, the return value is a list, whose contents depend on
   575 the value of the optional argument RETURN-TYPE.
   576 
   577 If RETURN-TYPE is nil or omitted, the function returns a list of rows
   578 matching QUERY.  If RETURN-TYPE is `full', the function returns a
   579 list whose first element is the list of column names, and the rest
   580 of the elements are the rows matching QUERY.  If RETURN-TYPE is `set',
   581 the function returns a set object that can be queried with functions
   582 like `sqlite-next' etc., in order to get the data.  */)
   583   (Lisp_Object db, Lisp_Object query, Lisp_Object values,
   584    Lisp_Object return_type)
   585 {
   586   check_sqlite (db, false);
   587   CHECK_STRING (query);
   588 
   589   if (!(NILP (values) || CONSP (values) || VECTORP (values)))
   590     xsignal1 (Qsqlite_error, build_string ("VALUES must be a list or a vector"));
   591 
   592   sqlite3 *sdb = XSQLITE (db)->db;
   593   Lisp_Object retval = Qnil, errmsg = Qnil,
   594     encoded = encode_string (query);
   595 
   596   sqlite3_stmt *stmt = NULL;
   597   int ret = sqlite3_prepare_v2 (sdb, SSDATA (encoded), SBYTES (encoded),
   598                                 &stmt, NULL);
   599   if (ret != SQLITE_OK)
   600     {
   601       if (stmt)
   602         sqlite3_finalize (stmt);
   603       errmsg = sqlite_prepare_errdata (ret, sdb);
   604       goto exit;
   605     }
   606 
   607   /* Query with parameters.  */
   608   if (!NILP (values))
   609     {
   610       const char *err = bind_values (sdb, stmt, values);
   611       if (err != NULL)
   612         {
   613           sqlite3_finalize (stmt);
   614           errmsg = build_string (err);
   615           goto exit;
   616         }
   617     }
   618 
   619   /* Return a handle to get the data.  */
   620   if (EQ (return_type, Qset))
   621     {
   622       retval = make_sqlite (true, sdb, stmt, XSQLITE (db)->name);
   623       goto exit;
   624     }
   625 
   626   /* Return the data directly.  */
   627   Lisp_Object data = Qnil;
   628   while (sqlite3_step (stmt) == SQLITE_ROW)
   629     data = Fcons (row_to_value (stmt), data);
   630 
   631   if (EQ (return_type, Qfull))
   632     retval = Fcons (column_names (stmt), Fnreverse (data));
   633   else
   634     retval = Fnreverse (data);
   635   sqlite3_finalize (stmt);
   636 
   637  exit:
   638   if (! NILP (errmsg))
   639     xsignal1 (Qsqlite_error, errmsg);
   640 
   641   return retval;
   642 }
   643 
   644 static Lisp_Object
   645 sqlite_exec (sqlite3 *sdb, const char *query)
   646 {
   647   int ret = sqlite3_exec (sdb, query, NULL, NULL, NULL);
   648   if (ret != SQLITE_OK)
   649     return Qnil;
   650 
   651   return Qt;
   652 }
   653 
   654 DEFUN ("sqlite-transaction", Fsqlite_transaction, Ssqlite_transaction, 1, 1, 0,
   655        doc: /* Start a transaction in DB.  */)
   656   (Lisp_Object db)
   657 {
   658   check_sqlite (db, false);
   659   return sqlite_exec (XSQLITE (db)->db, "begin");
   660 }
   661 
   662 DEFUN ("sqlite-commit", Fsqlite_commit, Ssqlite_commit, 1, 1, 0,
   663        doc: /* Commit a transaction in DB.  */)
   664   (Lisp_Object db)
   665 {
   666   check_sqlite (db, false);
   667   return sqlite_exec (XSQLITE (db)->db, "commit");
   668 }
   669 
   670 DEFUN ("sqlite-rollback", Fsqlite_rollback, Ssqlite_rollback, 1, 1, 0,
   671        doc: /* Roll back a transaction in DB.  */)
   672   (Lisp_Object db)
   673 {
   674   check_sqlite (db, false);
   675   return sqlite_exec (XSQLITE (db)->db, "rollback");
   676 }
   677 
   678 DEFUN ("sqlite-pragma", Fsqlite_pragma, Ssqlite_pragma, 2, 2, 0,
   679        doc: /* Execute PRAGMA in DB.  */)
   680   (Lisp_Object db, Lisp_Object pragma)
   681 {
   682   check_sqlite (db, false);
   683   CHECK_STRING (pragma);
   684 
   685   return sqlite_exec (XSQLITE (db)->db,
   686                       SSDATA (concat2 (build_string ("PRAGMA "), pragma)));
   687 }
   688 
   689 #if HAVE_LOAD_EXTENSION
   690 DEFUN ("sqlite-load-extension", Fsqlite_load_extension,
   691        Ssqlite_load_extension, 2, 2, 0,
   692        doc: /* Load an SQlite MODULE into DB.
   693 MODULE should be the name of an SQlite module's file, a
   694 shared library in the system-dependent format and having a
   695 system-dependent file-name extension.
   696 
   697 Only modules on Emacs' list of allowed modules can be loaded.  */)
   698   (Lisp_Object db, Lisp_Object module)
   699 {
   700   check_sqlite (db, false);
   701   CHECK_STRING (module);
   702 
   703   /* Add names of useful and free modules here.  */
   704   const char *allowlist[] = {
   705     "base64",
   706     "cksumvfs",
   707     "compress",
   708     "csv",
   709     "csvtable",
   710     "fts3",
   711     "icu",
   712     "pcre",
   713     "percentile",
   714     "regexp",
   715     "rot13",
   716     "rtree",
   717     "sha1",
   718     "uuid",
   719     "vfslog",
   720     "zipfile",
   721     NULL
   722   };
   723   char *name = SSDATA (Ffile_name_nondirectory (module));
   724   /* Possibly skip past a common prefix (libsqlite3_mod_ is used by
   725      Debian, see https://packages.debian.org/source/sid/sqliteodbc).  */
   726   const char *prefix = "libsqlite3_mod_";
   727   if (!strncmp (name, prefix, strlen (prefix)))
   728     name += strlen (prefix);
   729 
   730   bool do_allow = false;
   731   for (const char **allow = allowlist; *allow; allow++)
   732     {
   733       ptrdiff_t allow_len = strlen (*allow);
   734       if (allow_len < strlen (name)
   735           && !strncmp (*allow, name, allow_len)
   736           && (!strcmp (name + allow_len, ".so")
   737               ||!strcmp (name + allow_len, ".dylib")
   738               || !strcasecmp (name + allow_len, ".dll")))
   739         {
   740           do_allow = true;
   741           break;
   742         }
   743     }
   744 
   745   if (!do_allow)
   746     xsignal1 (Qsqlite_error, build_string ("Module name not on allowlist"));
   747 
   748   /* Expand all Lisp data explicitly, so as to avoid signaling an
   749      error while extension loading is enabled -- we don't want to
   750      "leak" this outside this function.  */
   751   sqlite3 *sdb = XSQLITE (db)->db;
   752   char *ext_fn = SSDATA (ENCODE_FILE (Fexpand_file_name (module, Qnil)));
   753   /* Temporarily enable loading extensions via the C API.  */
   754   int result = sqlite3_db_config (sdb, SQLITE_DBCONFIG_ENABLE_LOAD_EXTENSION, 1,
   755                                   NULL);
   756   if (result == SQLITE_OK)
   757     {
   758       result = sqlite3_load_extension (sdb, ext_fn, NULL, NULL);
   759       /* Disable loading extensions via C API.  */
   760       sqlite3_db_config (sdb, SQLITE_DBCONFIG_ENABLE_LOAD_EXTENSION, 0, NULL);
   761       if (result == SQLITE_OK)
   762         return Qt;
   763     }
   764   return Qnil;
   765 }
   766 #endif /* HAVE_LOAD_EXTENSION */
   767 
   768 DEFUN ("sqlite-next", Fsqlite_next, Ssqlite_next, 1, 1, 0,
   769        doc: /* Return the next result set from SET.
   770 Return nil when the statement has finished executing successfully.  */)
   771   (Lisp_Object set)
   772 {
   773   check_sqlite (set, true);
   774 
   775   if (XSQLITE (set)->eof)
   776     return Qnil;
   777 
   778   int ret = sqlite3_step (XSQLITE (set)->stmt);
   779   if (ret != SQLITE_ROW && ret != SQLITE_OK && ret != SQLITE_DONE)
   780     xsignal1 (Qsqlite_error, build_string (sqlite3_errmsg (XSQLITE (set)->db)));
   781 
   782   if (ret == SQLITE_DONE)
   783     {
   784       XSQLITE (set)->eof = true;
   785       return Qnil;
   786     }
   787 
   788   return row_to_value (XSQLITE (set)->stmt);
   789 }
   790 
   791 DEFUN ("sqlite-columns", Fsqlite_columns, Ssqlite_columns, 1, 1, 0,
   792        doc: /* Return the column names of SET.  */)
   793   (Lisp_Object set)
   794 {
   795   check_sqlite (set, true);
   796   return column_names (XSQLITE (set)->stmt);
   797 }
   798 
   799 DEFUN ("sqlite-more-p", Fsqlite_more_p, Ssqlite_more_p, 1, 1, 0,
   800        doc: /* Say whether there are any further results in SET.  */)
   801   (Lisp_Object set)
   802 {
   803   check_sqlite (set, true);
   804 
   805   if (XSQLITE (set)->eof)
   806     return Qnil;
   807   else
   808     return Qt;
   809 }
   810 
   811 DEFUN ("sqlite-finalize", Fsqlite_finalize, Ssqlite_finalize, 1, 1, 0,
   812        doc: /* Mark this SET as being finished.
   813 This will free the resources held by SET.  */)
   814   (Lisp_Object set)
   815 {
   816   check_sqlite (set, true);
   817   sqlite3_finalize (XSQLITE (set)->stmt);
   818   XSQLITE (set)->db = NULL;
   819   return Qt;
   820 }
   821 
   822 DEFUN ("sqlite-version", Fsqlite_version, Ssqlite_version, 0, 0, 0,
   823        doc: /* Return the version string of the SQLite library.
   824 Signal an error if SQLite support is not available.  */)
   825   (void)
   826 {
   827   if (!init_sqlite_functions ())
   828     error ("sqlite support is not available");
   829   return build_string (sqlite3_libversion ());
   830 }
   831 
   832 #endif /* HAVE_SQLITE3 */
   833 
   834 DEFUN ("sqlitep", Fsqlitep, Ssqlitep, 1, 1, 0,
   835        doc: /* Say whether OBJECT is an SQlite object.  */)
   836   (Lisp_Object object)
   837 {
   838 #ifdef HAVE_SQLITE3
   839   return SQLITE (object)? Qt: Qnil;
   840 #else
   841   return Qnil;
   842 #endif
   843 }
   844 
   845 DEFUN ("sqlite-available-p", Fsqlite_available_p, Ssqlite_available_p, 0, 0, 0,
   846        doc: /* Return t if sqlite3 support is available in this instance of Emacs.*/)
   847   (void)
   848 {
   849 #ifdef HAVE_SQLITE3
   850 # ifdef WINDOWSNT
   851   Lisp_Object found = Fassq (Qsqlite3, Vlibrary_cache);
   852   if (CONSP (found))
   853     return XCDR (found);
   854   else
   855     return init_sqlite_functions () ? Qt : Qnil;
   856 # else
   857   return Qt;
   858 #endif
   859 #else
   860   return Qnil;
   861 #endif
   862 }
   863 
   864 void
   865 syms_of_sqlite (void)
   866 {
   867 #ifdef HAVE_SQLITE3
   868   defsubr (&Ssqlite_open);
   869   defsubr (&Ssqlite_close);
   870   defsubr (&Ssqlite_execute);
   871   defsubr (&Ssqlite_select);
   872   defsubr (&Ssqlite_transaction);
   873   defsubr (&Ssqlite_commit);
   874   defsubr (&Ssqlite_rollback);
   875   defsubr (&Ssqlite_pragma);
   876 #if HAVE_LOAD_EXTENSION
   877   defsubr (&Ssqlite_load_extension);
   878 #endif
   879   defsubr (&Ssqlite_next);
   880   defsubr (&Ssqlite_columns);
   881   defsubr (&Ssqlite_more_p);
   882   defsubr (&Ssqlite_finalize);
   883   defsubr (&Ssqlite_version);
   884   DEFSYM (Qset, "set");
   885   DEFSYM (Qfull, "full");
   886 #endif
   887   defsubr (&Ssqlitep);
   888   defsubr (&Ssqlite_available_p);
   889 
   890   DEFSYM (Qsqlite_error, "sqlite-error");
   891   Fput (Qsqlite_error, Qerror_conditions,
   892         Fpurecopy (list2 (Qsqlite_error, Qerror)));
   893   Fput (Qsqlite_error, Qerror_message,
   894         build_pure_c_string ("Database error"));
   895 
   896   DEFSYM (Qsqlite_locked_error, "sqlite-locked-error");
   897   Fput (Qsqlite_locked_error, Qerror_conditions,
   898         Fpurecopy (list3 (Qsqlite_locked_error, Qsqlite_error, Qerror)));
   899   Fput (Qsqlite_locked_error, Qerror_message,
   900         build_pure_c_string ("Database locked"));
   901 
   902   DEFSYM (Qsqlitep, "sqlitep");
   903   DEFSYM (Qfalse, "false");
   904   DEFSYM (Qsqlite, "sqlite");
   905   DEFSYM (Qsqlite3, "sqlite3");
   906   DEFSYM (Qbinary, "binary");
   907   DEFSYM (Qcoding_system, "coding-system");
   908 }