Home | History | Annotate | Download | only in src
      1 /*
      2 ** 2001 September 15
      3 **
      4 ** The author disclaims copyright to this source code.  In place of
      5 ** a legal notice, here is a blessing:
      6 **
      7 **    May you do good and not evil.
      8 **    May you find forgiveness for yourself and forgive others.
      9 **    May you share freely, never taking more than you give.
     10 **
     11 *************************************************************************
     12 ** A TCL Interface to SQLite.  Append this file to sqlite3.c and
     13 ** compile the whole thing to build a TCL-enabled version of SQLite.
     14 **
     15 ** Compile-time options:
     16 **
     17 **  -DTCLSH=1             Add a "main()" routine that works as a tclsh.
     18 **
     19 **  -DSQLITE_TCLMD5       When used in conjuction with -DTCLSH=1, add
     20 **                        four new commands to the TCL interpreter for
     21 **                        generating MD5 checksums:  md5, md5file,
     22 **                        md5-10x8, and md5file-10x8.
     23 **
     24 **  -DSQLITE_TEST         When used in conjuction with -DTCLSH=1, add
     25 **                        hundreds of new commands used for testing
     26 **                        SQLite.  This option implies -DSQLITE_TCLMD5.
     27 */
     28 #include "tcl.h"
     29 #include <errno.h>
     30 
     31 /*
     32 ** Some additional include files are needed if this file is not
     33 ** appended to the amalgamation.
     34 */
     35 #ifndef SQLITE_AMALGAMATION
     36 # include "sqlite3.h"
     37 # include <stdlib.h>
     38 # include <string.h>
     39 # include <assert.h>
     40   typedef unsigned char u8;
     41 #endif
     42 #include <ctype.h>
     43 
     44 /*
     45  * Windows needs to know which symbols to export.  Unix does not.
     46  * BUILD_sqlite should be undefined for Unix.
     47  */
     48 #ifdef BUILD_sqlite
     49 #undef TCL_STORAGE_CLASS
     50 #define TCL_STORAGE_CLASS DLLEXPORT
     51 #endif /* BUILD_sqlite */
     52 
     53 #define NUM_PREPARED_STMTS 10
     54 #define MAX_PREPARED_STMTS 100
     55 
     56 /*
     57 ** If TCL uses UTF-8 and SQLite is configured to use iso8859, then we
     58 ** have to do a translation when going between the two.  Set the
     59 ** UTF_TRANSLATION_NEEDED macro to indicate that we need to do
     60 ** this translation.
     61 */
     62 #if defined(TCL_UTF_MAX) && !defined(SQLITE_UTF8)
     63 # define UTF_TRANSLATION_NEEDED 1
     64 #endif
     65 
     66 /*
     67 ** New SQL functions can be created as TCL scripts.  Each such function
     68 ** is described by an instance of the following structure.
     69 */
     70 typedef struct SqlFunc SqlFunc;
     71 struct SqlFunc {
     72   Tcl_Interp *interp;   /* The TCL interpret to execute the function */
     73   Tcl_Obj *pScript;     /* The Tcl_Obj representation of the script */
     74   int useEvalObjv;      /* True if it is safe to use Tcl_EvalObjv */
     75   char *zName;          /* Name of this function */
     76   SqlFunc *pNext;       /* Next function on the list of them all */
     77 };
     78 
     79 /*
     80 ** New collation sequences function can be created as TCL scripts.  Each such
     81 ** function is described by an instance of the following structure.
     82 */
     83 typedef struct SqlCollate SqlCollate;
     84 struct SqlCollate {
     85   Tcl_Interp *interp;   /* The TCL interpret to execute the function */
     86   char *zScript;        /* The script to be run */
     87   SqlCollate *pNext;    /* Next function on the list of them all */
     88 };
     89 
     90 /*
     91 ** Prepared statements are cached for faster execution.  Each prepared
     92 ** statement is described by an instance of the following structure.
     93 */
     94 typedef struct SqlPreparedStmt SqlPreparedStmt;
     95 struct SqlPreparedStmt {
     96   SqlPreparedStmt *pNext;  /* Next in linked list */
     97   SqlPreparedStmt *pPrev;  /* Previous on the list */
     98   sqlite3_stmt *pStmt;     /* The prepared statement */
     99   int nSql;                /* chars in zSql[] */
    100   const char *zSql;        /* Text of the SQL statement */
    101   int nParm;               /* Size of apParm array */
    102   Tcl_Obj **apParm;        /* Array of referenced object pointers */
    103 };
    104 
    105 typedef struct IncrblobChannel IncrblobChannel;
    106 
    107 /*
    108 ** There is one instance of this structure for each SQLite database
    109 ** that has been opened by the SQLite TCL interface.
    110 */
    111 typedef struct SqliteDb SqliteDb;
    112 struct SqliteDb {
    113   sqlite3 *db;               /* The "real" database structure. MUST BE FIRST */
    114   Tcl_Interp *interp;        /* The interpreter used for this database */
    115   char *zBusy;               /* The busy callback routine */
    116   char *zCommit;             /* The commit hook callback routine */
    117   char *zTrace;              /* The trace callback routine */
    118   char *zProfile;            /* The profile callback routine */
    119   char *zProgress;           /* The progress callback routine */
    120   char *zAuth;               /* The authorization callback routine */
    121   int disableAuth;           /* Disable the authorizer if it exists */
    122   char *zNull;               /* Text to substitute for an SQL NULL value */
    123   SqlFunc *pFunc;            /* List of SQL functions */
    124   Tcl_Obj *pUpdateHook;      /* Update hook script (if any) */
    125   Tcl_Obj *pRollbackHook;    /* Rollback hook script (if any) */
    126   Tcl_Obj *pWalHook;         /* WAL hook script (if any) */
    127   Tcl_Obj *pUnlockNotify;    /* Unlock notify script (if any) */
    128   SqlCollate *pCollate;      /* List of SQL collation functions */
    129   int rc;                    /* Return code of most recent sqlite3_exec() */
    130   Tcl_Obj *pCollateNeeded;   /* Collation needed script */
    131   SqlPreparedStmt *stmtList; /* List of prepared statements*/
    132   SqlPreparedStmt *stmtLast; /* Last statement in the list */
    133   int maxStmt;               /* The next maximum number of stmtList */
    134   int nStmt;                 /* Number of statements in stmtList */
    135   IncrblobChannel *pIncrblob;/* Linked list of open incrblob channels */
    136   int nStep, nSort, nIndex;  /* Statistics for most recent operation */
    137   int nTransaction;          /* Number of nested [transaction] methods */
    138 };
    139 
    140 struct IncrblobChannel {
    141   sqlite3_blob *pBlob;      /* sqlite3 blob handle */
    142   SqliteDb *pDb;            /* Associated database connection */
    143   int iSeek;                /* Current seek offset */
    144   Tcl_Channel channel;      /* Channel identifier */
    145   IncrblobChannel *pNext;   /* Linked list of all open incrblob channels */
    146   IncrblobChannel *pPrev;   /* Linked list of all open incrblob channels */
    147 };
    148 
    149 /*
    150 ** Compute a string length that is limited to what can be stored in
    151 ** lower 30 bits of a 32-bit signed integer.
    152 */
    153 static int strlen30(const char *z){
    154   const char *z2 = z;
    155   while( *z2 ){ z2++; }
    156   return 0x3fffffff & (int)(z2 - z);
    157 }
    158 
    159 
    160 #ifndef SQLITE_OMIT_INCRBLOB
    161 /*
    162 ** Close all incrblob channels opened using database connection pDb.
    163 ** This is called when shutting down the database connection.
    164 */
    165 static void closeIncrblobChannels(SqliteDb *pDb){
    166   IncrblobChannel *p;
    167   IncrblobChannel *pNext;
    168 
    169   for(p=pDb->pIncrblob; p; p=pNext){
    170     pNext = p->pNext;
    171 
    172     /* Note: Calling unregister here call Tcl_Close on the incrblob channel,
    173     ** which deletes the IncrblobChannel structure at *p. So do not
    174     ** call Tcl_Free() here.
    175     */
    176     Tcl_UnregisterChannel(pDb->interp, p->channel);
    177   }
    178 }
    179 
    180 /*
    181 ** Close an incremental blob channel.
    182 */
    183 static int incrblobClose(ClientData instanceData, Tcl_Interp *interp){
    184   IncrblobChannel *p = (IncrblobChannel *)instanceData;
    185   int rc = sqlite3_blob_close(p->pBlob);
    186   sqlite3 *db = p->pDb->db;
    187 
    188   /* Remove the channel from the SqliteDb.pIncrblob list. */
    189   if( p->pNext ){
    190     p->pNext->pPrev = p->pPrev;
    191   }
    192   if( p->pPrev ){
    193     p->pPrev->pNext = p->pNext;
    194   }
    195   if( p->pDb->pIncrblob==p ){
    196     p->pDb->pIncrblob = p->pNext;
    197   }
    198 
    199   /* Free the IncrblobChannel structure */
    200   Tcl_Free((char *)p);
    201 
    202   if( rc!=SQLITE_OK ){
    203     Tcl_SetResult(interp, (char *)sqlite3_errmsg(db), TCL_VOLATILE);
    204     return TCL_ERROR;
    205   }
    206   return TCL_OK;
    207 }
    208 
    209 /*
    210 ** Read data from an incremental blob channel.
    211 */
    212 static int incrblobInput(
    213   ClientData instanceData,
    214   char *buf,
    215   int bufSize,
    216   int *errorCodePtr
    217 ){
    218   IncrblobChannel *p = (IncrblobChannel *)instanceData;
    219   int nRead = bufSize;         /* Number of bytes to read */
    220   int nBlob;                   /* Total size of the blob */
    221   int rc;                      /* sqlite error code */
    222 
    223   nBlob = sqlite3_blob_bytes(p->pBlob);
    224   if( (p->iSeek+nRead)>nBlob ){
    225     nRead = nBlob-p->iSeek;
    226   }
    227   if( nRead<=0 ){
    228     return 0;
    229   }
    230 
    231   rc = sqlite3_blob_read(p->pBlob, (void *)buf, nRead, p->iSeek);
    232   if( rc!=SQLITE_OK ){
    233     *errorCodePtr = rc;
    234     return -1;
    235   }
    236 
    237   p->iSeek += nRead;
    238   return nRead;
    239 }
    240 
    241 /*
    242 ** Write data to an incremental blob channel.
    243 */
    244 static int incrblobOutput(
    245   ClientData instanceData,
    246   CONST char *buf,
    247   int toWrite,
    248   int *errorCodePtr
    249 ){
    250   IncrblobChannel *p = (IncrblobChannel *)instanceData;
    251   int nWrite = toWrite;        /* Number of bytes to write */
    252   int nBlob;                   /* Total size of the blob */
    253   int rc;                      /* sqlite error code */
    254 
    255   nBlob = sqlite3_blob_bytes(p->pBlob);
    256   if( (p->iSeek+nWrite)>nBlob ){
    257     *errorCodePtr = EINVAL;
    258     return -1;
    259   }
    260   if( nWrite<=0 ){
    261     return 0;
    262   }
    263 
    264   rc = sqlite3_blob_write(p->pBlob, (void *)buf, nWrite, p->iSeek);
    265   if( rc!=SQLITE_OK ){
    266     *errorCodePtr = EIO;
    267     return -1;
    268   }
    269 
    270   p->iSeek += nWrite;
    271   return nWrite;
    272 }
    273 
    274 /*
    275 ** Seek an incremental blob channel.
    276 */
    277 static int incrblobSeek(
    278   ClientData instanceData,
    279   long offset,
    280   int seekMode,
    281   int *errorCodePtr
    282 ){
    283   IncrblobChannel *p = (IncrblobChannel *)instanceData;
    284 
    285   switch( seekMode ){
    286     case SEEK_SET:
    287       p->iSeek = offset;
    288       break;
    289     case SEEK_CUR:
    290       p->iSeek += offset;
    291       break;
    292     case SEEK_END:
    293       p->iSeek = sqlite3_blob_bytes(p->pBlob) + offset;
    294       break;
    295 
    296     default: assert(!"Bad seekMode");
    297   }
    298 
    299   return p->iSeek;
    300 }
    301 
    302 
    303 static void incrblobWatch(ClientData instanceData, int mode){
    304   /* NO-OP */
    305 }
    306 static int incrblobHandle(ClientData instanceData, int dir, ClientData *hPtr){
    307   return TCL_ERROR;
    308 }
    309 
    310 static Tcl_ChannelType IncrblobChannelType = {
    311   "incrblob",                        /* typeName                             */
    312   TCL_CHANNEL_VERSION_2,             /* version                              */
    313   incrblobClose,                     /* closeProc                            */
    314   incrblobInput,                     /* inputProc                            */
    315   incrblobOutput,                    /* outputProc                           */
    316   incrblobSeek,                      /* seekProc                             */
    317   0,                                 /* setOptionProc                        */
    318   0,                                 /* getOptionProc                        */
    319   incrblobWatch,                     /* watchProc (this is a no-op)          */
    320   incrblobHandle,                    /* getHandleProc (always returns error) */
    321   0,                                 /* close2Proc                           */
    322   0,                                 /* blockModeProc                        */
    323   0,                                 /* flushProc                            */
    324   0,                                 /* handlerProc                          */
    325   0,                                 /* wideSeekProc                         */
    326 };
    327 
    328 /*
    329 ** Create a new incrblob channel.
    330 */
    331 static int createIncrblobChannel(
    332   Tcl_Interp *interp,
    333   SqliteDb *pDb,
    334   const char *zDb,
    335   const char *zTable,
    336   const char *zColumn,
    337   sqlite_int64 iRow,
    338   int isReadonly
    339 ){
    340   IncrblobChannel *p;
    341   sqlite3 *db = pDb->db;
    342   sqlite3_blob *pBlob;
    343   int rc;
    344   int flags = TCL_READABLE|(isReadonly ? 0 : TCL_WRITABLE);
    345 
    346   /* This variable is used to name the channels: "incrblob_[incr count]" */
    347   static int count = 0;
    348   char zChannel[64];
    349 
    350   rc = sqlite3_blob_open(db, zDb, zTable, zColumn, iRow, !isReadonly, &pBlob);
    351   if( rc!=SQLITE_OK ){
    352     Tcl_SetResult(interp, (char *)sqlite3_errmsg(pDb->db), TCL_VOLATILE);
    353     return TCL_ERROR;
    354   }
    355 
    356   p = (IncrblobChannel *)Tcl_Alloc(sizeof(IncrblobChannel));
    357   p->iSeek = 0;
    358   p->pBlob = pBlob;
    359 
    360   sqlite3_snprintf(sizeof(zChannel), zChannel, "incrblob_%d", ++count);
    361   p->channel = Tcl_CreateChannel(&IncrblobChannelType, zChannel, p, flags);
    362   Tcl_RegisterChannel(interp, p->channel);
    363 
    364   /* Link the new channel into the SqliteDb.pIncrblob list. */
    365   p->pNext = pDb->pIncrblob;
    366   p->pPrev = 0;
    367   if( p->pNext ){
    368     p->pNext->pPrev = p;
    369   }
    370   pDb->pIncrblob = p;
    371   p->pDb = pDb;
    372 
    373   Tcl_SetResult(interp, (char *)Tcl_GetChannelName(p->channel), TCL_VOLATILE);
    374   return TCL_OK;
    375 }
    376 #else  /* else clause for "#ifndef SQLITE_OMIT_INCRBLOB" */
    377   #define closeIncrblobChannels(pDb)
    378 #endif
    379 
    380 /*
    381 ** Look at the script prefix in pCmd.  We will be executing this script
    382 ** after first appending one or more arguments.  This routine analyzes
    383 ** the script to see if it is safe to use Tcl_EvalObjv() on the script
    384 ** rather than the more general Tcl_EvalEx().  Tcl_EvalObjv() is much
    385 ** faster.
    386 **
    387 ** Scripts that are safe to use with Tcl_EvalObjv() consists of a
    388 ** command name followed by zero or more arguments with no [...] or $
    389 ** or {...} or ; to be seen anywhere.  Most callback scripts consist
    390 ** of just a single procedure name and they meet this requirement.
    391 */
    392 static int safeToUseEvalObjv(Tcl_Interp *interp, Tcl_Obj *pCmd){
    393   /* We could try to do something with Tcl_Parse().  But we will instead
    394   ** just do a search for forbidden characters.  If any of the forbidden
    395   ** characters appear in pCmd, we will report the string as unsafe.
    396   */
    397   const char *z;
    398   int n;
    399   z = Tcl_GetStringFromObj(pCmd, &n);
    400   while( n-- > 0 ){
    401     int c = *(z++);
    402     if( c=='$' || c=='[' || c==';' ) return 0;
    403   }
    404   return 1;
    405 }
    406 
    407 /*
    408 ** Find an SqlFunc structure with the given name.  Or create a new
    409 ** one if an existing one cannot be found.  Return a pointer to the
    410 ** structure.
    411 */
    412 static SqlFunc *findSqlFunc(SqliteDb *pDb, const char *zName){
    413   SqlFunc *p, *pNew;
    414   int i;
    415   pNew = (SqlFunc*)Tcl_Alloc( sizeof(*pNew) + strlen30(zName) + 1 );
    416   pNew->zName = (char*)&pNew[1];
    417   for(i=0; zName[i]; i++){ pNew->zName[i] = tolower(zName[i]); }
    418   pNew->zName[i] = 0;
    419   for(p=pDb->pFunc; p; p=p->pNext){
    420     if( strcmp(p->zName, pNew->zName)==0 ){
    421       Tcl_Free((char*)pNew);
    422       return p;
    423     }
    424   }
    425   pNew->interp = pDb->interp;
    426   pNew->pScript = 0;
    427   pNew->pNext = pDb->pFunc;
    428   pDb->pFunc = pNew;
    429   return pNew;
    430 }
    431 
    432 /*
    433 ** Finalize and free a list of prepared statements
    434 */
    435 static void flushStmtCache( SqliteDb *pDb ){
    436   SqlPreparedStmt *pPreStmt;
    437 
    438   while(  pDb->stmtList ){
    439     sqlite3_finalize( pDb->stmtList->pStmt );
    440     pPreStmt = pDb->stmtList;
    441     pDb->stmtList = pDb->stmtList->pNext;
    442     Tcl_Free( (char*)pPreStmt );
    443   }
    444   pDb->nStmt = 0;
    445   pDb->stmtLast = 0;
    446 }
    447 
    448 /*
    449 ** TCL calls this procedure when an sqlite3 database command is
    450 ** deleted.
    451 */
    452 static void DbDeleteCmd(void *db){
    453   SqliteDb *pDb = (SqliteDb*)db;
    454   flushStmtCache(pDb);
    455   closeIncrblobChannels(pDb);
    456   sqlite3_close(pDb->db);
    457   while( pDb->pFunc ){
    458     SqlFunc *pFunc = pDb->pFunc;
    459     pDb->pFunc = pFunc->pNext;
    460     Tcl_DecrRefCount(pFunc->pScript);
    461     Tcl_Free((char*)pFunc);
    462   }
    463   while( pDb->pCollate ){
    464     SqlCollate *pCollate = pDb->pCollate;
    465     pDb->pCollate = pCollate->pNext;
    466     Tcl_Free((char*)pCollate);
    467   }
    468   if( pDb->zBusy ){
    469     Tcl_Free(pDb->zBusy);
    470   }
    471   if( pDb->zTrace ){
    472     Tcl_Free(pDb->zTrace);
    473   }
    474   if( pDb->zProfile ){
    475     Tcl_Free(pDb->zProfile);
    476   }
    477   if( pDb->zAuth ){
    478     Tcl_Free(pDb->zAuth);
    479   }
    480   if( pDb->zNull ){
    481     Tcl_Free(pDb->zNull);
    482   }
    483   if( pDb->pUpdateHook ){
    484     Tcl_DecrRefCount(pDb->pUpdateHook);
    485   }
    486   if( pDb->pRollbackHook ){
    487     Tcl_DecrRefCount(pDb->pRollbackHook);
    488   }
    489   if( pDb->pWalHook ){
    490     Tcl_DecrRefCount(pDb->pWalHook);
    491   }
    492   if( pDb->pCollateNeeded ){
    493     Tcl_DecrRefCount(pDb->pCollateNeeded);
    494   }
    495   Tcl_Free((char*)pDb);
    496 }
    497 
    498 /*
    499 ** This routine is called when a database file is locked while trying
    500 ** to execute SQL.
    501 */
    502 static int DbBusyHandler(void *cd, int nTries){
    503   SqliteDb *pDb = (SqliteDb*)cd;
    504   int rc;
    505   char zVal[30];
    506 
    507   sqlite3_snprintf(sizeof(zVal), zVal, "%d", nTries);
    508   rc = Tcl_VarEval(pDb->interp, pDb->zBusy, " ", zVal, (char*)0);
    509   if( rc!=TCL_OK || atoi(Tcl_GetStringResult(pDb->interp)) ){
    510     return 0;
    511   }
    512   return 1;
    513 }
    514 
    515 #ifndef SQLITE_OMIT_PROGRESS_CALLBACK
    516 /*
    517 ** This routine is invoked as the 'progress callback' for the database.
    518 */
    519 static int DbProgressHandler(void *cd){
    520   SqliteDb *pDb = (SqliteDb*)cd;
    521   int rc;
    522 
    523   assert( pDb->zProgress );
    524   rc = Tcl_Eval(pDb->interp, pDb->zProgress);
    525   if( rc!=TCL_OK || atoi(Tcl_GetStringResult(pDb->interp)) ){
    526     return 1;
    527   }
    528   return 0;
    529 }
    530 #endif
    531 
    532 #ifndef SQLITE_OMIT_TRACE
    533 /*
    534 ** This routine is called by the SQLite trace handler whenever a new
    535 ** block of SQL is executed.  The TCL script in pDb->zTrace is executed.
    536 */
    537 static void DbTraceHandler(void *cd, const char *zSql){
    538   SqliteDb *pDb = (SqliteDb*)cd;
    539   Tcl_DString str;
    540 
    541   Tcl_DStringInit(&str);
    542   Tcl_DStringAppend(&str, pDb->zTrace, -1);
    543   Tcl_DStringAppendElement(&str, zSql);
    544   Tcl_Eval(pDb->interp, Tcl_DStringValue(&str));
    545   Tcl_DStringFree(&str);
    546   Tcl_ResetResult(pDb->interp);
    547 }
    548 #endif
    549 
    550 #ifndef SQLITE_OMIT_TRACE
    551 /*
    552 ** This routine is called by the SQLite profile handler after a statement
    553 ** SQL has executed.  The TCL script in pDb->zProfile is evaluated.
    554 */
    555 static void DbProfileHandler(void *cd, const char *zSql, sqlite_uint64 tm){
    556   SqliteDb *pDb = (SqliteDb*)cd;
    557   Tcl_DString str;
    558   char zTm[100];
    559 
    560   sqlite3_snprintf(sizeof(zTm)-1, zTm, "%lld", tm);
    561   Tcl_DStringInit(&str);
    562   Tcl_DStringAppend(&str, pDb->zProfile, -1);
    563   Tcl_DStringAppendElement(&str, zSql);
    564   Tcl_DStringAppendElement(&str, zTm);
    565   Tcl_Eval(pDb->interp, Tcl_DStringValue(&str));
    566   Tcl_DStringFree(&str);
    567   Tcl_ResetResult(pDb->interp);
    568 }
    569 #endif
    570 
    571 /*
    572 ** This routine is called when a transaction is committed.  The
    573 ** TCL script in pDb->zCommit is executed.  If it returns non-zero or
    574 ** if it throws an exception, the transaction is rolled back instead
    575 ** of being committed.
    576 */
    577 static int DbCommitHandler(void *cd){
    578   SqliteDb *pDb = (SqliteDb*)cd;
    579   int rc;
    580 
    581   rc = Tcl_Eval(pDb->interp, pDb->zCommit);
    582   if( rc!=TCL_OK || atoi(Tcl_GetStringResult(pDb->interp)) ){
    583     return 1;
    584   }
    585   return 0;
    586 }
    587 
    588 static void DbRollbackHandler(void *clientData){
    589   SqliteDb *pDb = (SqliteDb*)clientData;
    590   assert(pDb->pRollbackHook);
    591   if( TCL_OK!=Tcl_EvalObjEx(pDb->interp, pDb->pRollbackHook, 0) ){
    592     Tcl_BackgroundError(pDb->interp);
    593   }
    594 }
    595 
    596 /*
    597 ** This procedure handles wal_hook callbacks.
    598 */
    599 static int DbWalHandler(
    600   void *clientData,
    601   sqlite3 *db,
    602   const char *zDb,
    603   int nEntry
    604 ){
    605   int ret = SQLITE_OK;
    606   Tcl_Obj *p;
    607   SqliteDb *pDb = (SqliteDb*)clientData;
    608   Tcl_Interp *interp = pDb->interp;
    609   assert(pDb->pWalHook);
    610 
    611   p = Tcl_DuplicateObj(pDb->pWalHook);
    612   Tcl_IncrRefCount(p);
    613   Tcl_ListObjAppendElement(interp, p, Tcl_NewStringObj(zDb, -1));
    614   Tcl_ListObjAppendElement(interp, p, Tcl_NewIntObj(nEntry));
    615   if( TCL_OK!=Tcl_EvalObjEx(interp, p, 0)
    616    || TCL_OK!=Tcl_GetIntFromObj(interp, Tcl_GetObjResult(interp), &ret)
    617   ){
    618     Tcl_BackgroundError(interp);
    619   }
    620   Tcl_DecrRefCount(p);
    621 
    622   return ret;
    623 }
    624 
    625 #if defined(SQLITE_TEST) && defined(SQLITE_ENABLE_UNLOCK_NOTIFY)
    626 static void setTestUnlockNotifyVars(Tcl_Interp *interp, int iArg, int nArg){
    627   char zBuf[64];
    628   sprintf(zBuf, "%d", iArg);
    629   Tcl_SetVar(interp, "sqlite_unlock_notify_arg", zBuf, TCL_GLOBAL_ONLY);
    630   sprintf(zBuf, "%d", nArg);
    631   Tcl_SetVar(interp, "sqlite_unlock_notify_argcount", zBuf, TCL_GLOBAL_ONLY);
    632 }
    633 #else
    634 # define setTestUnlockNotifyVars(x,y,z)
    635 #endif
    636 
    637 #ifdef SQLITE_ENABLE_UNLOCK_NOTIFY
    638 static void DbUnlockNotify(void **apArg, int nArg){
    639   int i;
    640   for(i=0; i<nArg; i++){
    641     const int flags = (TCL_EVAL_GLOBAL|TCL_EVAL_DIRECT);
    642     SqliteDb *pDb = (SqliteDb *)apArg[i];
    643     setTestUnlockNotifyVars(pDb->interp, i, nArg);
    644     assert( pDb->pUnlockNotify);
    645     Tcl_EvalObjEx(pDb->interp, pDb->pUnlockNotify, flags);
    646     Tcl_DecrRefCount(pDb->pUnlockNotify);
    647     pDb->pUnlockNotify = 0;
    648   }
    649 }
    650 #endif
    651 
    652 static void DbUpdateHandler(
    653   void *p,
    654   int op,
    655   const char *zDb,
    656   const char *zTbl,
    657   sqlite_int64 rowid
    658 ){
    659   SqliteDb *pDb = (SqliteDb *)p;
    660   Tcl_Obj *pCmd;
    661 
    662   assert( pDb->pUpdateHook );
    663   assert( op==SQLITE_INSERT || op==SQLITE_UPDATE || op==SQLITE_DELETE );
    664 
    665   pCmd = Tcl_DuplicateObj(pDb->pUpdateHook);
    666   Tcl_IncrRefCount(pCmd);
    667   Tcl_ListObjAppendElement(0, pCmd, Tcl_NewStringObj(
    668     ( (op==SQLITE_INSERT)?"INSERT":(op==SQLITE_UPDATE)?"UPDATE":"DELETE"), -1));
    669   Tcl_ListObjAppendElement(0, pCmd, Tcl_NewStringObj(zDb, -1));
    670   Tcl_ListObjAppendElement(0, pCmd, Tcl_NewStringObj(zTbl, -1));
    671   Tcl_ListObjAppendElement(0, pCmd, Tcl_NewWideIntObj(rowid));
    672   Tcl_EvalObjEx(pDb->interp, pCmd, TCL_EVAL_DIRECT);
    673   Tcl_DecrRefCount(pCmd);
    674 }
    675 
    676 static void tclCollateNeeded(
    677   void *pCtx,
    678   sqlite3 *db,
    679   int enc,
    680   const char *zName
    681 ){
    682   SqliteDb *pDb = (SqliteDb *)pCtx;
    683   Tcl_Obj *pScript = Tcl_DuplicateObj(pDb->pCollateNeeded);
    684   Tcl_IncrRefCount(pScript);
    685   Tcl_ListObjAppendElement(0, pScript, Tcl_NewStringObj(zName, -1));
    686   Tcl_EvalObjEx(pDb->interp, pScript, 0);
    687   Tcl_DecrRefCount(pScript);
    688 }
    689 
    690 /*
    691 ** This routine is called to evaluate an SQL collation function implemented
    692 ** using TCL script.
    693 */
    694 static int tclSqlCollate(
    695   void *pCtx,
    696   int nA,
    697   const void *zA,
    698   int nB,
    699   const void *zB
    700 ){
    701   SqlCollate *p = (SqlCollate *)pCtx;
    702   Tcl_Obj *pCmd;
    703 
    704   pCmd = Tcl_NewStringObj(p->zScript, -1);
    705   Tcl_IncrRefCount(pCmd);
    706   Tcl_ListObjAppendElement(p->interp, pCmd, Tcl_NewStringObj(zA, nA));
    707   Tcl_ListObjAppendElement(p->interp, pCmd, Tcl_NewStringObj(zB, nB));
    708   Tcl_EvalObjEx(p->interp, pCmd, TCL_EVAL_DIRECT);
    709   Tcl_DecrRefCount(pCmd);
    710   return (atoi(Tcl_GetStringResult(p->interp)));
    711 }
    712 
    713 /*
    714 ** This routine is called to evaluate an SQL function implemented
    715 ** using TCL script.
    716 */
    717 static void tclSqlFunc(sqlite3_context *context, int argc, sqlite3_value**argv){
    718   SqlFunc *p = sqlite3_user_data(context);
    719   Tcl_Obj *pCmd;
    720   int i;
    721   int rc;
    722 
    723   if( argc==0 ){
    724     /* If there are no arguments to the function, call Tcl_EvalObjEx on the
    725     ** script object directly.  This allows the TCL compiler to generate
    726     ** bytecode for the command on the first invocation and thus make
    727     ** subsequent invocations much faster. */
    728     pCmd = p->pScript;
    729     Tcl_IncrRefCount(pCmd);
    730     rc = Tcl_EvalObjEx(p->interp, pCmd, 0);
    731     Tcl_DecrRefCount(pCmd);
    732   }else{
    733     /* If there are arguments to the function, make a shallow copy of the
    734     ** script object, lappend the arguments, then evaluate the copy.
    735     **
    736     ** By "shallow" copy, we mean a only the outer list Tcl_Obj is duplicated.
    737     ** The new Tcl_Obj contains pointers to the original list elements.
    738     ** That way, when Tcl_EvalObjv() is run and shimmers the first element
    739     ** of the list to tclCmdNameType, that alternate representation will
    740     ** be preserved and reused on the next invocation.
    741     */
    742     Tcl_Obj **aArg;
    743     int nArg;
    744     if( Tcl_ListObjGetElements(p->interp, p->pScript, &nArg, &aArg) ){
    745       sqlite3_result_error(context, Tcl_GetStringResult(p->interp), -1);
    746       return;
    747     }
    748     pCmd = Tcl_NewListObj(nArg, aArg);
    749     Tcl_IncrRefCount(pCmd);
    750     for(i=0; i<argc; i++){
    751       sqlite3_value *pIn = argv[i];
    752       Tcl_Obj *pVal;
    753 
    754       /* Set pVal to contain the i'th column of this row. */
    755       switch( sqlite3_value_type(pIn) ){
    756         case SQLITE_BLOB: {
    757           int bytes = sqlite3_value_bytes(pIn);
    758           pVal = Tcl_NewByteArrayObj(sqlite3_value_blob(pIn), bytes);
    759           break;
    760         }
    761         case SQLITE_INTEGER: {
    762           sqlite_int64 v = sqlite3_value_int64(pIn);
    763           if( v>=-2147483647 && v<=2147483647 ){
    764             pVal = Tcl_NewIntObj(v);
    765           }else{
    766             pVal = Tcl_NewWideIntObj(v);
    767           }
    768           break;
    769         }
    770         case SQLITE_FLOAT: {
    771           double r = sqlite3_value_double(pIn);
    772           pVal = Tcl_NewDoubleObj(r);
    773           break;
    774         }
    775         case SQLITE_NULL: {
    776           pVal = Tcl_NewStringObj("", 0);
    777           break;
    778         }
    779         default: {
    780           int bytes = sqlite3_value_bytes(pIn);
    781           pVal = Tcl_NewStringObj((char *)sqlite3_value_text(pIn), bytes);
    782           break;
    783         }
    784       }
    785       rc = Tcl_ListObjAppendElement(p->interp, pCmd, pVal);
    786       if( rc ){
    787         Tcl_DecrRefCount(pCmd);
    788         sqlite3_result_error(context, Tcl_GetStringResult(p->interp), -1);
    789         return;
    790       }
    791     }
    792     if( !p->useEvalObjv ){
    793       /* Tcl_EvalObjEx() will automatically call Tcl_EvalObjv() if pCmd
    794       ** is a list without a string representation.  To prevent this from
    795       ** happening, make sure pCmd has a valid string representation */
    796       Tcl_GetString(pCmd);
    797     }
    798     rc = Tcl_EvalObjEx(p->interp, pCmd, TCL_EVAL_DIRECT);
    799     Tcl_DecrRefCount(pCmd);
    800   }
    801 
    802   if( rc && rc!=TCL_RETURN ){
    803     sqlite3_result_error(context, Tcl_GetStringResult(p->interp), -1);
    804   }else{
    805     Tcl_Obj *pVar = Tcl_GetObjResult(p->interp);
    806     int n;
    807     u8 *data;
    808     const char *zType = (pVar->typePtr ? pVar->typePtr->name : "");
    809     char c = zType[0];
    810     if( c=='b' && strcmp(zType,"bytearray")==0 && pVar->bytes==0 ){
    811       /* Only return a BLOB type if the Tcl variable is a bytearray and
    812       ** has no string representation. */
    813       data = Tcl_GetByteArrayFromObj(pVar, &n);
    814       sqlite3_result_blob(context, data, n, SQLITE_TRANSIENT);
    815     }else if( c=='b' && strcmp(zType,"boolean")==0 ){
    816       Tcl_GetIntFromObj(0, pVar, &n);
    817       sqlite3_result_int(context, n);
    818     }else if( c=='d' && strcmp(zType,"double")==0 ){
    819       double r;
    820       Tcl_GetDoubleFromObj(0, pVar, &r);
    821       sqlite3_result_double(context, r);
    822     }else if( (c=='w' && strcmp(zType,"wideInt")==0) ||
    823           (c=='i' && strcmp(zType,"int")==0) ){
    824       Tcl_WideInt v;
    825       Tcl_GetWideIntFromObj(0, pVar, &v);
    826       sqlite3_result_int64(context, v);
    827     }else{
    828       data = (unsigned char *)Tcl_GetStringFromObj(pVar, &n);
    829       sqlite3_result_text(context, (char *)data, n, SQLITE_TRANSIENT);
    830     }
    831   }
    832 }
    833 
    834 #ifndef SQLITE_OMIT_AUTHORIZATION
    835 /*
    836 ** This is the authentication function.  It appends the authentication
    837 ** type code and the two arguments to zCmd[] then invokes the result
    838 ** on the interpreter.  The reply is examined to determine if the
    839 ** authentication fails or succeeds.
    840 */
    841 static int auth_callback(
    842   void *pArg,
    843   int code,
    844   const char *zArg1,
    845   const char *zArg2,
    846   const char *zArg3,
    847   const char *zArg4
    848 ){
    849   char *zCode;
    850   Tcl_DString str;
    851   int rc;
    852   const char *zReply;
    853   SqliteDb *pDb = (SqliteDb*)pArg;
    854   if( pDb->disableAuth ) return SQLITE_OK;
    855 
    856   switch( code ){
    857     case SQLITE_COPY              : zCode="SQLITE_COPY"; break;
    858     case SQLITE_CREATE_INDEX      : zCode="SQLITE_CREATE_INDEX"; break;
    859     case SQLITE_CREATE_TABLE      : zCode="SQLITE_CREATE_TABLE"; break;
    860     case SQLITE_CREATE_TEMP_INDEX : zCode="SQLITE_CREATE_TEMP_INDEX"; break;
    861     case SQLITE_CREATE_TEMP_TABLE : zCode="SQLITE_CREATE_TEMP_TABLE"; break;
    862     case SQLITE_CREATE_TEMP_TRIGGER: zCode="SQLITE_CREATE_TEMP_TRIGGER"; break;
    863     case SQLITE_CREATE_TEMP_VIEW  : zCode="SQLITE_CREATE_TEMP_VIEW"; break;
    864     case SQLITE_CREATE_TRIGGER    : zCode="SQLITE_CREATE_TRIGGER"; break;
    865     case SQLITE_CREATE_VIEW       : zCode="SQLITE_CREATE_VIEW"; break;
    866     case SQLITE_DELETE            : zCode="SQLITE_DELETE"; break;
    867     case SQLITE_DROP_INDEX        : zCode="SQLITE_DROP_INDEX"; break;
    868     case SQLITE_DROP_TABLE        : zCode="SQLITE_DROP_TABLE"; break;
    869     case SQLITE_DROP_TEMP_INDEX   : zCode="SQLITE_DROP_TEMP_INDEX"; break;
    870     case SQLITE_DROP_TEMP_TABLE   : zCode="SQLITE_DROP_TEMP_TABLE"; break;
    871     case SQLITE_DROP_TEMP_TRIGGER : zCode="SQLITE_DROP_TEMP_TRIGGER"; break;
    872     case SQLITE_DROP_TEMP_VIEW    : zCode="SQLITE_DROP_TEMP_VIEW"; break;
    873     case SQLITE_DROP_TRIGGER      : zCode="SQLITE_DROP_TRIGGER"; break;
    874     case SQLITE_DROP_VIEW         : zCode="SQLITE_DROP_VIEW"; break;
    875     case SQLITE_INSERT            : zCode="SQLITE_INSERT"; break;
    876     case SQLITE_PRAGMA            : zCode="SQLITE_PRAGMA"; break;
    877     case SQLITE_READ              : zCode="SQLITE_READ"; break;
    878     case SQLITE_SELECT            : zCode="SQLITE_SELECT"; break;
    879     case SQLITE_TRANSACTION       : zCode="SQLITE_TRANSACTION"; break;
    880     case SQLITE_UPDATE            : zCode="SQLITE_UPDATE"; break;
    881     case SQLITE_ATTACH            : zCode="SQLITE_ATTACH"; break;
    882     case SQLITE_DETACH            : zCode="SQLITE_DETACH"; break;
    883     case SQLITE_ALTER_TABLE       : zCode="SQLITE_ALTER_TABLE"; break;
    884     case SQLITE_REINDEX           : zCode="SQLITE_REINDEX"; break;
    885     case SQLITE_ANALYZE           : zCode="SQLITE_ANALYZE"; break;
    886     case SQLITE_CREATE_VTABLE     : zCode="SQLITE_CREATE_VTABLE"; break;
    887     case SQLITE_DROP_VTABLE       : zCode="SQLITE_DROP_VTABLE"; break;
    888     case SQLITE_FUNCTION          : zCode="SQLITE_FUNCTION"; break;
    889     case SQLITE_SAVEPOINT         : zCode="SQLITE_SAVEPOINT"; break;
    890     default                       : zCode="????"; break;
    891   }
    892   Tcl_DStringInit(&str);
    893   Tcl_DStringAppend(&str, pDb->zAuth, -1);
    894   Tcl_DStringAppendElement(&str, zCode);
    895   Tcl_DStringAppendElement(&str, zArg1 ? zArg1 : "");
    896   Tcl_DStringAppendElement(&str, zArg2 ? zArg2 : "");
    897   Tcl_DStringAppendElement(&str, zArg3 ? zArg3 : "");
    898   Tcl_DStringAppendElement(&str, zArg4 ? zArg4 : "");
    899   rc = Tcl_GlobalEval(pDb->interp, Tcl_DStringValue(&str));
    900   Tcl_DStringFree(&str);
    901   zReply = Tcl_GetStringResult(pDb->interp);
    902   if( strcmp(zReply,"SQLITE_OK")==0 ){
    903     rc = SQLITE_OK;
    904   }else if( strcmp(zReply,"SQLITE_DENY")==0 ){
    905     rc = SQLITE_DENY;
    906   }else if( strcmp(zReply,"SQLITE_IGNORE")==0 ){
    907     rc = SQLITE_IGNORE;
    908   }else{
    909     rc = 999;
    910   }
    911   return rc;
    912 }
    913 #endif /* SQLITE_OMIT_AUTHORIZATION */
    914 
    915 /*
    916 ** zText is a pointer to text obtained via an sqlite3_result_text()
    917 ** or similar interface. This routine returns a Tcl string object,
    918 ** reference count set to 0, containing the text. If a translation
    919 ** between iso8859 and UTF-8 is required, it is preformed.
    920 */
    921 static Tcl_Obj *dbTextToObj(char const *zText){
    922   Tcl_Obj *pVal;
    923 #ifdef UTF_TRANSLATION_NEEDED
    924   Tcl_DString dCol;
    925   Tcl_DStringInit(&dCol);
    926   Tcl_ExternalToUtfDString(NULL, zText, -1, &dCol);
    927   pVal = Tcl_NewStringObj(Tcl_DStringValue(&dCol), -1);
    928   Tcl_DStringFree(&dCol);
    929 #else
    930   pVal = Tcl_NewStringObj(zText, -1);
    931 #endif
    932   return pVal;
    933 }
    934 
    935 /*
    936 ** This routine reads a line of text from FILE in, stores
    937 ** the text in memory obtained from malloc() and returns a pointer
    938 ** to the text.  NULL is returned at end of file, or if malloc()
    939 ** fails.
    940 **
    941 ** The interface is like "readline" but no command-line editing
    942 ** is done.
    943 **
    944 ** copied from shell.c from '.import' command
    945 */
    946 static char *local_getline(char *zPrompt, FILE *in){
    947   char *zLine;
    948   int nLine;
    949   int n;
    950   int eol;
    951 
    952   nLine = 100;
    953   zLine = malloc( nLine );
    954   if( zLine==0 ) return 0;
    955   n = 0;
    956   eol = 0;
    957   while( !eol ){
    958     if( n+100>nLine ){
    959       nLine = nLine*2 + 100;
    960       zLine = realloc(zLine, nLine);
    961       if( zLine==0 ) return 0;
    962     }
    963     if( fgets(&zLine[n], nLine - n, in)==0 ){
    964       if( n==0 ){
    965         free(zLine);
    966         return 0;
    967       }
    968       zLine[n] = 0;
    969       eol = 1;
    970       break;
    971     }
    972     while( zLine[n] ){ n++; }
    973     if( n>0 && zLine[n-1]=='\n' ){
    974       n--;
    975       zLine[n] = 0;
    976       eol = 1;
    977     }
    978   }
    979   zLine = realloc( zLine, n+1 );
    980   return zLine;
    981 }
    982 
    983 
    984 /*
    985 ** This function is part of the implementation of the command:
    986 **
    987 **   $db transaction [-deferred|-immediate|-exclusive] SCRIPT
    988 **
    989 ** It is invoked after evaluating the script SCRIPT to commit or rollback
    990 ** the transaction or savepoint opened by the [transaction] command.
    991 */
    992 static int DbTransPostCmd(
    993   ClientData data[],                   /* data[0] is the Sqlite3Db* for $db */
    994   Tcl_Interp *interp,                  /* Tcl interpreter */
    995   int result                           /* Result of evaluating SCRIPT */
    996 ){
    997   static const char *azEnd[] = {
    998     "RELEASE _tcl_transaction",        /* rc==TCL_ERROR, nTransaction!=0 */
    999     "COMMIT",                          /* rc!=TCL_ERROR, nTransaction==0 */
   1000     "ROLLBACK TO _tcl_transaction ; RELEASE _tcl_transaction",
   1001     "ROLLBACK"                         /* rc==TCL_ERROR, nTransaction==0 */
   1002   };
   1003   SqliteDb *pDb = (SqliteDb*)data[0];
   1004   int rc = result;
   1005   const char *zEnd;
   1006 
   1007   pDb->nTransaction--;
   1008   zEnd = azEnd[(rc==TCL_ERROR)*2 + (pDb->nTransaction==0)];
   1009 
   1010   pDb->disableAuth++;
   1011   if( sqlite3_exec(pDb->db, zEnd, 0, 0, 0) ){
   1012       /* This is a tricky scenario to handle. The most likely cause of an
   1013       ** error is that the exec() above was an attempt to commit the
   1014       ** top-level transaction that returned SQLITE_BUSY. Or, less likely,
   1015       ** that an IO-error has occured. In either case, throw a Tcl exception
   1016       ** and try to rollback the transaction.
   1017       **
   1018       ** But it could also be that the user executed one or more BEGIN,
   1019       ** COMMIT, SAVEPOINT, RELEASE or ROLLBACK commands that are confusing
   1020       ** this method's logic. Not clear how this would be best handled.
   1021       */
   1022     if( rc!=TCL_ERROR ){
   1023       Tcl_AppendResult(interp, sqlite3_errmsg(pDb->db), 0);
   1024       rc = TCL_ERROR;
   1025     }
   1026     sqlite3_exec(pDb->db, "ROLLBACK", 0, 0, 0);
   1027   }
   1028   pDb->disableAuth--;
   1029 
   1030   return rc;
   1031 }
   1032 
   1033 /*
   1034 ** Search the cache for a prepared-statement object that implements the
   1035 ** first SQL statement in the buffer pointed to by parameter zIn. If
   1036 ** no such prepared-statement can be found, allocate and prepare a new
   1037 ** one. In either case, bind the current values of the relevant Tcl
   1038 ** variables to any $var, :var or @var variables in the statement. Before
   1039 ** returning, set *ppPreStmt to point to the prepared-statement object.
   1040 **
   1041 ** Output parameter *pzOut is set to point to the next SQL statement in
   1042 ** buffer zIn, or to the '\0' byte at the end of zIn if there is no
   1043 ** next statement.
   1044 **
   1045 ** If successful, TCL_OK is returned. Otherwise, TCL_ERROR is returned
   1046 ** and an error message loaded into interpreter pDb->interp.
   1047 */
   1048 static int dbPrepareAndBind(
   1049   SqliteDb *pDb,                  /* Database object */
   1050   char const *zIn,                /* SQL to compile */
   1051   char const **pzOut,             /* OUT: Pointer to next SQL statement */
   1052   SqlPreparedStmt **ppPreStmt     /* OUT: Object used to cache statement */
   1053 ){
   1054   const char *zSql = zIn;         /* Pointer to first SQL statement in zIn */
   1055   sqlite3_stmt *pStmt;            /* Prepared statement object */
   1056   SqlPreparedStmt *pPreStmt;      /* Pointer to cached statement */
   1057   int nSql;                       /* Length of zSql in bytes */
   1058   int nVar;                       /* Number of variables in statement */
   1059   int iParm = 0;                  /* Next free entry in apParm */
   1060   int i;
   1061   Tcl_Interp *interp = pDb->interp;
   1062 
   1063   *ppPreStmt = 0;
   1064 
   1065   /* Trim spaces from the start of zSql and calculate the remaining length. */
   1066   while( isspace(zSql[0]) ){ zSql++; }
   1067   nSql = strlen30(zSql);
   1068 
   1069   for(pPreStmt = pDb->stmtList; pPreStmt; pPreStmt=pPreStmt->pNext){
   1070     int n = pPreStmt->nSql;
   1071     if( nSql>=n
   1072         && memcmp(pPreStmt->zSql, zSql, n)==0
   1073         && (zSql[n]==0 || zSql[n-1]==';')
   1074     ){
   1075       pStmt = pPreStmt->pStmt;
   1076       *pzOut = &zSql[pPreStmt->nSql];
   1077 
   1078       /* When a prepared statement is found, unlink it from the
   1079       ** cache list.  It will later be added back to the beginning
   1080       ** of the cache list in order to implement LRU replacement.
   1081       */
   1082       if( pPreStmt->pPrev ){
   1083         pPreStmt->pPrev->pNext = pPreStmt->pNext;
   1084       }else{
   1085         pDb->stmtList = pPreStmt->pNext;
   1086       }
   1087       if( pPreStmt->pNext ){
   1088         pPreStmt->pNext->pPrev = pPreStmt->pPrev;
   1089       }else{
   1090         pDb->stmtLast = pPreStmt->pPrev;
   1091       }
   1092       pDb->nStmt--;
   1093       nVar = sqlite3_bind_parameter_count(pStmt);
   1094       break;
   1095     }
   1096   }
   1097 
   1098   /* If no prepared statement was found. Compile the SQL text. Also allocate
   1099   ** a new SqlPreparedStmt structure.  */
   1100   if( pPreStmt==0 ){
   1101     int nByte;
   1102 
   1103     if( SQLITE_OK!=sqlite3_prepare_v2(pDb->db, zSql, -1, &pStmt, pzOut) ){
   1104       Tcl_SetObjResult(interp, dbTextToObj(sqlite3_errmsg(pDb->db)));
   1105       return TCL_ERROR;
   1106     }
   1107     if( pStmt==0 ){
   1108       if( SQLITE_OK!=sqlite3_errcode(pDb->db) ){
   1109         /* A compile-time error in the statement. */
   1110         Tcl_SetObjResult(interp, dbTextToObj(sqlite3_errmsg(pDb->db)));
   1111         return TCL_ERROR;
   1112       }else{
   1113         /* The statement was a no-op.  Continue to the next statement
   1114         ** in the SQL string.
   1115         */
   1116         return TCL_OK;
   1117       }
   1118     }
   1119 
   1120     assert( pPreStmt==0 );
   1121     nVar = sqlite3_bind_parameter_count(pStmt);
   1122     nByte = sizeof(SqlPreparedStmt) + nVar*sizeof(Tcl_Obj *);
   1123     pPreStmt = (SqlPreparedStmt*)Tcl_Alloc(nByte);
   1124     memset(pPreStmt, 0, nByte);
   1125 
   1126     pPreStmt->pStmt = pStmt;
   1127     pPreStmt->nSql = (*pzOut - zSql);
   1128     pPreStmt->zSql = sqlite3_sql(pStmt);
   1129     pPreStmt->apParm = (Tcl_Obj **)&pPreStmt[1];
   1130   }
   1131   assert( pPreStmt );
   1132   assert( strlen30(pPreStmt->zSql)==pPreStmt->nSql );
   1133   assert( 0==memcmp(pPreStmt->zSql, zSql, pPreStmt->nSql) );
   1134 
   1135   /* Bind values to parameters that begin with $ or : */
   1136   for(i=1; i<=nVar; i++){
   1137     const char *zVar = sqlite3_bind_parameter_name(pStmt, i);
   1138     if( zVar!=0 && (zVar[0]=='$' || zVar[0]==':' || zVar[0]=='@') ){
   1139       Tcl_Obj *pVar = Tcl_GetVar2Ex(interp, &zVar[1], 0, 0);
   1140       if( pVar ){
   1141         int n;
   1142         u8 *data;
   1143         const char *zType = (pVar->typePtr ? pVar->typePtr->name : "");
   1144         char c = zType[0];
   1145         if( zVar[0]=='@' ||
   1146            (c=='b' && strcmp(zType,"bytearray")==0 && pVar->bytes==0) ){
   1147           /* Load a BLOB type if the Tcl variable is a bytearray and
   1148           ** it has no string representation or the host
   1149           ** parameter name begins with "@". */
   1150           data = Tcl_GetByteArrayFromObj(pVar, &n);
   1151           sqlite3_bind_blob(pStmt, i, data, n, SQLITE_STATIC);
   1152           Tcl_IncrRefCount(pVar);
   1153           pPreStmt->apParm[iParm++] = pVar;
   1154         }else if( c=='b' && strcmp(zType,"boolean")==0 ){
   1155           Tcl_GetIntFromObj(interp, pVar, &n);
   1156           sqlite3_bind_int(pStmt, i, n);
   1157         }else if( c=='d' && strcmp(zType,"double")==0 ){
   1158           double r;
   1159           Tcl_GetDoubleFromObj(interp, pVar, &r);
   1160           sqlite3_bind_double(pStmt, i, r);
   1161         }else if( (c=='w' && strcmp(zType,"wideInt")==0) ||
   1162               (c=='i' && strcmp(zType,"int")==0) ){
   1163           Tcl_WideInt v;
   1164           Tcl_GetWideIntFromObj(interp, pVar, &v);
   1165           sqlite3_bind_int64(pStmt, i, v);
   1166         }else{
   1167           data = (unsigned char *)Tcl_GetStringFromObj(pVar, &n);
   1168           sqlite3_bind_text(pStmt, i, (char *)data, n, SQLITE_STATIC);
   1169           Tcl_IncrRefCount(pVar);
   1170           pPreStmt->apParm[iParm++] = pVar;
   1171         }
   1172       }else{
   1173         sqlite3_bind_null(pStmt, i);
   1174       }
   1175     }
   1176   }
   1177   pPreStmt->nParm = iParm;
   1178   *ppPreStmt = pPreStmt;
   1179 
   1180   return TCL_OK;
   1181 }
   1182 
   1183 
   1184 /*
   1185 ** Release a statement reference obtained by calling dbPrepareAndBind().
   1186 ** There should be exactly one call to this function for each call to
   1187 ** dbPrepareAndBind().
   1188 **
   1189 ** If the discard parameter is non-zero, then the statement is deleted
   1190 ** immediately. Otherwise it is added to the LRU list and may be returned
   1191 ** by a subsequent call to dbPrepareAndBind().
   1192 */
   1193 static void dbReleaseStmt(
   1194   SqliteDb *pDb,                  /* Database handle */
   1195   SqlPreparedStmt *pPreStmt,      /* Prepared statement handle to release */
   1196   int discard                     /* True to delete (not cache) the pPreStmt */
   1197 ){
   1198   int i;
   1199 
   1200   /* Free the bound string and blob parameters */
   1201   for(i=0; i<pPreStmt->nParm; i++){
   1202     Tcl_DecrRefCount(pPreStmt->apParm[i]);
   1203   }
   1204   pPreStmt->nParm = 0;
   1205 
   1206   if( pDb->maxStmt<=0 || discard ){
   1207     /* If the cache is turned off, deallocated the statement */
   1208     sqlite3_finalize(pPreStmt->pStmt);
   1209     Tcl_Free((char *)pPreStmt);
   1210   }else{
   1211     /* Add the prepared statement to the beginning of the cache list. */
   1212     pPreStmt->pNext = pDb->stmtList;
   1213     pPreStmt->pPrev = 0;
   1214     if( pDb->stmtList ){
   1215      pDb->stmtList->pPrev = pPreStmt;
   1216     }
   1217     pDb->stmtList = pPreStmt;
   1218     if( pDb->stmtLast==0 ){
   1219       assert( pDb->nStmt==0 );
   1220       pDb->stmtLast = pPreStmt;
   1221     }else{
   1222       assert( pDb->nStmt>0 );
   1223     }
   1224     pDb->nStmt++;
   1225 
   1226     /* If we have too many statement in cache, remove the surplus from
   1227     ** the end of the cache list.  */
   1228     while( pDb->nStmt>pDb->maxStmt ){
   1229       sqlite3_finalize(pDb->stmtLast->pStmt);
   1230       pDb->stmtLast = pDb->stmtLast->pPrev;
   1231       Tcl_Free((char*)pDb->stmtLast->pNext);
   1232       pDb->stmtLast->pNext = 0;
   1233       pDb->nStmt--;
   1234     }
   1235   }
   1236 }
   1237 
   1238 /*
   1239 ** Structure used with dbEvalXXX() functions:
   1240 **
   1241 **   dbEvalInit()
   1242 **   dbEvalStep()
   1243 **   dbEvalFinalize()
   1244 **   dbEvalRowInfo()
   1245 **   dbEvalColumnValue()
   1246 */
   1247 typedef struct DbEvalContext DbEvalContext;
   1248 struct DbEvalContext {
   1249   SqliteDb *pDb;                  /* Database handle */
   1250   Tcl_Obj *pSql;                  /* Object holding string zSql */
   1251   const char *zSql;               /* Remaining SQL to execute */
   1252   SqlPreparedStmt *pPreStmt;      /* Current statement */
   1253   int nCol;                       /* Number of columns returned by pStmt */
   1254   Tcl_Obj *pArray;                /* Name of array variable */
   1255   Tcl_Obj **apColName;            /* Array of column names */
   1256 };
   1257 
   1258 /*
   1259 ** Release any cache of column names currently held as part of
   1260 ** the DbEvalContext structure passed as the first argument.
   1261 */
   1262 static void dbReleaseColumnNames(DbEvalContext *p){
   1263   if( p->apColName ){
   1264     int i;
   1265     for(i=0; i<p->nCol; i++){
   1266       Tcl_DecrRefCount(p->apColName[i]);
   1267     }
   1268     Tcl_Free((char *)p->apColName);
   1269     p->apColName = 0;
   1270   }
   1271   p->nCol = 0;
   1272 }
   1273 
   1274 /*
   1275 ** Initialize a DbEvalContext structure.
   1276 **
   1277 ** If pArray is not NULL, then it contains the name of a Tcl array
   1278 ** variable. The "*" member of this array is set to a list containing
   1279 ** the names of the columns returned by the statement as part of each
   1280 ** call to dbEvalStep(), in order from left to right. e.g. if the names
   1281 ** of the returned columns are a, b and c, it does the equivalent of the
   1282 ** tcl command:
   1283 **
   1284 **     set ${pArray}(*) {a b c}
   1285 */
   1286 static void dbEvalInit(
   1287   DbEvalContext *p,               /* Pointer to structure to initialize */
   1288   SqliteDb *pDb,                  /* Database handle */
   1289   Tcl_Obj *pSql,                  /* Object containing SQL script */
   1290   Tcl_Obj *pArray                 /* Name of Tcl array to set (*) element of */
   1291 ){
   1292   memset(p, 0, sizeof(DbEvalContext));
   1293   p->pDb = pDb;
   1294   p->zSql = Tcl_GetString(pSql);
   1295   p->pSql = pSql;
   1296   Tcl_IncrRefCount(pSql);
   1297   if( pArray ){
   1298     p->pArray = pArray;
   1299     Tcl_IncrRefCount(pArray);
   1300   }
   1301 }
   1302 
   1303 /*
   1304 ** Obtain information about the row that the DbEvalContext passed as the
   1305 ** first argument currently points to.
   1306 */
   1307 static void dbEvalRowInfo(
   1308   DbEvalContext *p,               /* Evaluation context */
   1309   int *pnCol,                     /* OUT: Number of column names */
   1310   Tcl_Obj ***papColName           /* OUT: Array of column names */
   1311 ){
   1312   /* Compute column names */
   1313   if( 0==p->apColName ){
   1314     sqlite3_stmt *pStmt = p->pPreStmt->pStmt;
   1315     int i;                        /* Iterator variable */
   1316     int nCol;                     /* Number of columns returned by pStmt */
   1317     Tcl_Obj **apColName = 0;      /* Array of column names */
   1318 
   1319     p->nCol = nCol = sqlite3_column_count(pStmt);
   1320     if( nCol>0 && (papColName || p->pArray) ){
   1321       apColName = (Tcl_Obj**)Tcl_Alloc( sizeof(Tcl_Obj*)*nCol );
   1322       for(i=0; i<nCol; i++){
   1323         apColName[i] = dbTextToObj(sqlite3_column_name(pStmt,i));
   1324         Tcl_IncrRefCount(apColName[i]);
   1325       }
   1326       p->apColName = apColName;
   1327     }
   1328 
   1329     /* If results are being stored in an array variable, then create
   1330     ** the array(*) entry for that array
   1331     */
   1332     if( p->pArray ){
   1333       Tcl_Interp *interp = p->pDb->interp;
   1334       Tcl_Obj *pColList = Tcl_NewObj();
   1335       Tcl_Obj *pStar = Tcl_NewStringObj("*", -1);
   1336 
   1337       for(i=0; i<nCol; i++){
   1338         Tcl_ListObjAppendElement(interp, pColList, apColName[i]);
   1339       }
   1340       Tcl_IncrRefCount(pStar);
   1341       Tcl_ObjSetVar2(interp, p->pArray, pStar, pColList, 0);
   1342       Tcl_DecrRefCount(pStar);
   1343     }
   1344   }
   1345 
   1346   if( papColName ){
   1347     *papColName = p->apColName;
   1348   }
   1349   if( pnCol ){
   1350     *pnCol = p->nCol;
   1351   }
   1352 }
   1353 
   1354 /*
   1355 ** Return one of TCL_OK, TCL_BREAK or TCL_ERROR. If TCL_ERROR is
   1356 ** returned, then an error message is stored in the interpreter before
   1357 ** returning.
   1358 **
   1359 ** A return value of TCL_OK means there is a row of data available. The
   1360 ** data may be accessed using dbEvalRowInfo() and dbEvalColumnValue(). This
   1361 ** is analogous to a return of SQLITE_ROW from sqlite3_step(). If TCL_BREAK
   1362 ** is returned, then the SQL script has finished executing and there are
   1363 ** no further rows available. This is similar to SQLITE_DONE.
   1364 */
   1365 static int dbEvalStep(DbEvalContext *p){
   1366   while( p->zSql[0] || p->pPreStmt ){
   1367     int rc;
   1368     if( p->pPreStmt==0 ){
   1369       rc = dbPrepareAndBind(p->pDb, p->zSql, &p->zSql, &p->pPreStmt);
   1370       if( rc!=TCL_OK ) return rc;
   1371     }else{
   1372       int rcs;
   1373       SqliteDb *pDb = p->pDb;
   1374       SqlPreparedStmt *pPreStmt = p->pPreStmt;
   1375       sqlite3_stmt *pStmt = pPreStmt->pStmt;
   1376 
   1377       rcs = sqlite3_step(pStmt);
   1378       if( rcs==SQLITE_ROW ){
   1379         return TCL_OK;
   1380       }
   1381       if( p->pArray ){
   1382         dbEvalRowInfo(p, 0, 0);
   1383       }
   1384       rcs = sqlite3_reset(pStmt);
   1385 
   1386       pDb->nStep = sqlite3_stmt_status(pStmt,SQLITE_STMTSTATUS_FULLSCAN_STEP,1);
   1387       pDb->nSort = sqlite3_stmt_status(pStmt,SQLITE_STMTSTATUS_SORT,1);
   1388       pDb->nIndex = sqlite3_stmt_status(pStmt,SQLITE_STMTSTATUS_AUTOINDEX,1);
   1389       dbReleaseColumnNames(p);
   1390       p->pPreStmt = 0;
   1391 
   1392       if( rcs!=SQLITE_OK ){
   1393         /* If a run-time error occurs, report the error and stop reading
   1394         ** the SQL.  */
   1395         Tcl_SetObjResult(pDb->interp, dbTextToObj(sqlite3_errmsg(pDb->db)));
   1396         dbReleaseStmt(pDb, pPreStmt, 1);
   1397         return TCL_ERROR;
   1398       }else{
   1399         dbReleaseStmt(pDb, pPreStmt, 0);
   1400       }
   1401     }
   1402   }
   1403 
   1404   /* Finished */
   1405   return TCL_BREAK;
   1406 }
   1407 
   1408 /*
   1409 ** Free all resources currently held by the DbEvalContext structure passed
   1410 ** as the first argument. There should be exactly one call to this function
   1411 ** for each call to dbEvalInit().
   1412 */
   1413 static void dbEvalFinalize(DbEvalContext *p){
   1414   if( p->pPreStmt ){
   1415     sqlite3_reset(p->pPreStmt->pStmt);
   1416     dbReleaseStmt(p->pDb, p->pPreStmt, 0);
   1417     p->pPreStmt = 0;
   1418   }
   1419   if( p->pArray ){
   1420     Tcl_DecrRefCount(p->pArray);
   1421     p->pArray = 0;
   1422   }
   1423   Tcl_DecrRefCount(p->pSql);
   1424   dbReleaseColumnNames(p);
   1425 }
   1426 
   1427 /*
   1428 ** Return a pointer to a Tcl_Obj structure with ref-count 0 that contains
   1429 ** the value for the iCol'th column of the row currently pointed to by
   1430 ** the DbEvalContext structure passed as the first argument.
   1431 */
   1432 static Tcl_Obj *dbEvalColumnValue(DbEvalContext *p, int iCol){
   1433   sqlite3_stmt *pStmt = p->pPreStmt->pStmt;
   1434   switch( sqlite3_column_type(pStmt, iCol) ){
   1435     case SQLITE_BLOB: {
   1436       int bytes = sqlite3_column_bytes(pStmt, iCol);
   1437       const char *zBlob = sqlite3_column_blob(pStmt, iCol);
   1438       if( !zBlob ) bytes = 0;
   1439       return Tcl_NewByteArrayObj((u8*)zBlob, bytes);
   1440     }
   1441     case SQLITE_INTEGER: {
   1442       sqlite_int64 v = sqlite3_column_int64(pStmt, iCol);
   1443       if( v>=-2147483647 && v<=2147483647 ){
   1444         return Tcl_NewIntObj(v);
   1445       }else{
   1446         return Tcl_NewWideIntObj(v);
   1447       }
   1448     }
   1449     case SQLITE_FLOAT: {
   1450       return Tcl_NewDoubleObj(sqlite3_column_double(pStmt, iCol));
   1451     }
   1452     case SQLITE_NULL: {
   1453       return dbTextToObj(p->pDb->zNull);
   1454     }
   1455   }
   1456 
   1457   return dbTextToObj((char *)sqlite3_column_text(pStmt, iCol));
   1458 }
   1459 
   1460 /*
   1461 ** If using Tcl version 8.6 or greater, use the NR functions to avoid
   1462 ** recursive evalution of scripts by the [db eval] and [db trans]
   1463 ** commands. Even if the headers used while compiling the extension
   1464 ** are 8.6 or newer, the code still tests the Tcl version at runtime.
   1465 ** This allows stubs-enabled builds to be used with older Tcl libraries.
   1466 */
   1467 #if TCL_MAJOR_VERSION>8 || (TCL_MAJOR_VERSION==8 && TCL_MINOR_VERSION>=6)
   1468 # define SQLITE_TCL_NRE 1
   1469 static int DbUseNre(void){
   1470   int major, minor;
   1471   Tcl_GetVersion(&major, &minor, 0, 0);
   1472   return( (major==8 && minor>=6) || major>8 );
   1473 }
   1474 #else
   1475 /*
   1476 ** Compiling using headers earlier than 8.6. In this case NR cannot be
   1477 ** used, so DbUseNre() to always return zero. Add #defines for the other
   1478 ** Tcl_NRxxx() functions to prevent them from causing compilation errors,
   1479 ** even though the only invocations of them are within conditional blocks
   1480 ** of the form:
   1481 **
   1482 **   if( DbUseNre() ) { ... }
   1483 */
   1484 # define SQLITE_TCL_NRE 0
   1485 # define DbUseNre() 0
   1486 # define Tcl_NRAddCallback(a,b,c,d,e,f) 0
   1487 # define Tcl_NREvalObj(a,b,c) 0
   1488 # define Tcl_NRCreateCommand(a,b,c,d,e,f) 0
   1489 #endif
   1490 
   1491 /*
   1492 ** This function is part of the implementation of the command:
   1493 **
   1494 **   $db eval SQL ?ARRAYNAME? SCRIPT
   1495 */
   1496 static int DbEvalNextCmd(
   1497   ClientData data[],                   /* data[0] is the (DbEvalContext*) */
   1498   Tcl_Interp *interp,                  /* Tcl interpreter */
   1499   int result                           /* Result so far */
   1500 ){
   1501   int rc = result;                     /* Return code */
   1502 
   1503   /* The first element of the data[] array is a pointer to a DbEvalContext
   1504   ** structure allocated using Tcl_Alloc(). The second element of data[]
   1505   ** is a pointer to a Tcl_Obj containing the script to run for each row
   1506   ** returned by the queries encapsulated in data[0]. */
   1507   DbEvalContext *p = (DbEvalContext *)data[0];
   1508   Tcl_Obj *pScript = (Tcl_Obj *)data[1];
   1509   Tcl_Obj *pArray = p->pArray;
   1510 
   1511   while( (rc==TCL_OK || rc==TCL_CONTINUE) && TCL_OK==(rc = dbEvalStep(p)) ){
   1512     int i;
   1513     int nCol;
   1514     Tcl_Obj **apColName;
   1515     dbEvalRowInfo(p, &nCol, &apColName);
   1516     for(i=0; i<nCol; i++){
   1517       Tcl_Obj *pVal = dbEvalColumnValue(p, i);
   1518       if( pArray==0 ){
   1519         Tcl_ObjSetVar2(interp, apColName[i], 0, pVal, 0);
   1520       }else{
   1521         Tcl_ObjSetVar2(interp, pArray, apColName[i], pVal, 0);
   1522       }
   1523     }
   1524 
   1525     /* The required interpreter variables are now populated with the data
   1526     ** from the current row. If using NRE, schedule callbacks to evaluate
   1527     ** script pScript, then to invoke this function again to fetch the next
   1528     ** row (or clean up if there is no next row or the script throws an
   1529     ** exception). After scheduling the callbacks, return control to the
   1530     ** caller.
   1531     **
   1532     ** If not using NRE, evaluate pScript directly and continue with the
   1533     ** next iteration of this while(...) loop.  */
   1534     if( DbUseNre() ){
   1535       Tcl_NRAddCallback(interp, DbEvalNextCmd, (void*)p, (void*)pScript, 0, 0);
   1536       return Tcl_NREvalObj(interp, pScript, 0);
   1537     }else{
   1538       rc = Tcl_EvalObjEx(interp, pScript, 0);
   1539     }
   1540   }
   1541 
   1542   Tcl_DecrRefCount(pScript);
   1543   dbEvalFinalize(p);
   1544   Tcl_Free((char *)p);
   1545 
   1546   if( rc==TCL_OK || rc==TCL_BREAK ){
   1547     Tcl_ResetResult(interp);
   1548     rc = TCL_OK;
   1549   }
   1550   return rc;
   1551 }
   1552 
   1553 /*
   1554 ** The "sqlite" command below creates a new Tcl command for each
   1555 ** connection it opens to an SQLite database.  This routine is invoked
   1556 ** whenever one of those connection-specific commands is executed
   1557 ** in Tcl.  For example, if you run Tcl code like this:
   1558 **
   1559 **       sqlite3 db1  "my_database"
   1560 **       db1 close
   1561 **
   1562 ** The first command opens a connection to the "my_database" database
   1563 ** and calls that connection "db1".  The second command causes this
   1564 ** subroutine to be invoked.
   1565 */
   1566 static int DbObjCmd(void *cd, Tcl_Interp *interp, int objc,Tcl_Obj *const*objv){
   1567   SqliteDb *pDb = (SqliteDb*)cd;
   1568   int choice;
   1569   int rc = TCL_OK;
   1570   static const char *DB_strs[] = {
   1571     "authorizer",         "backup",            "busy",
   1572     "cache",              "changes",           "close",
   1573     "collate",            "collation_needed",  "commit_hook",
   1574     "complete",           "copy",              "enable_load_extension",
   1575     "errorcode",          "eval",              "exists",
   1576     "function",           "incrblob",          "interrupt",
   1577     "last_insert_rowid",  "nullvalue",         "onecolumn",
   1578     "profile",            "progress",          "rekey",
   1579     "restore",            "rollback_hook",     "status",
   1580     "timeout",            "total_changes",     "trace",
   1581     "transaction",        "unlock_notify",     "update_hook",
   1582     "version",            "wal_hook",          0
   1583   };
   1584   enum DB_enum {
   1585     DB_AUTHORIZER,        DB_BACKUP,           DB_BUSY,
   1586     DB_CACHE,             DB_CHANGES,          DB_CLOSE,
   1587     DB_COLLATE,           DB_COLLATION_NEEDED, DB_COMMIT_HOOK,
   1588     DB_COMPLETE,          DB_COPY,             DB_ENABLE_LOAD_EXTENSION,
   1589     DB_ERRORCODE,         DB_EVAL,             DB_EXISTS,
   1590     DB_FUNCTION,          DB_INCRBLOB,         DB_INTERRUPT,
   1591     DB_LAST_INSERT_ROWID, DB_NULLVALUE,        DB_ONECOLUMN,
   1592     DB_PROFILE,           DB_PROGRESS,         DB_REKEY,
   1593     DB_RESTORE,           DB_ROLLBACK_HOOK,    DB_STATUS,
   1594     DB_TIMEOUT,           DB_TOTAL_CHANGES,    DB_TRACE,
   1595     DB_TRANSACTION,       DB_UNLOCK_NOTIFY,    DB_UPDATE_HOOK,
   1596     DB_VERSION,           DB_WAL_HOOK
   1597   };
   1598   /* don't leave trailing commas on DB_enum, it confuses the AIX xlc compiler */
   1599 
   1600   if( objc<2 ){
   1601     Tcl_WrongNumArgs(interp, 1, objv, "SUBCOMMAND ...");
   1602     return TCL_ERROR;
   1603   }
   1604   if( Tcl_GetIndexFromObj(interp, objv[1], DB_strs, "option", 0, &choice) ){
   1605     return TCL_ERROR;
   1606   }
   1607 
   1608   switch( (enum DB_enum)choice ){
   1609 
   1610   /*    $db authorizer ?CALLBACK?
   1611   **
   1612   ** Invoke the given callback to authorize each SQL operation as it is
   1613   ** compiled.  5 arguments are appended to the callback before it is
   1614   ** invoked:
   1615   **
   1616   **   (1) The authorization type (ex: SQLITE_CREATE_TABLE, SQLITE_INSERT, ...)
   1617   **   (2) First descriptive name (depends on authorization type)
   1618   **   (3) Second descriptive name
   1619   **   (4) Name of the database (ex: "main", "temp")
   1620   **   (5) Name of trigger that is doing the access
   1621   **
   1622   ** The callback should return on of the following strings: SQLITE_OK,
   1623   ** SQLITE_IGNORE, or SQLITE_DENY.  Any other return value is an error.
   1624   **
   1625   ** If this method is invoked with no arguments, the current authorization
   1626   ** callback string is returned.
   1627   */
   1628   case DB_AUTHORIZER: {
   1629 #ifdef SQLITE_OMIT_AUTHORIZATION
   1630     Tcl_AppendResult(interp, "authorization not available in this build", 0);
   1631     return TCL_ERROR;
   1632 #else
   1633     if( objc>3 ){
   1634       Tcl_WrongNumArgs(interp, 2, objv, "?CALLBACK?");
   1635       return TCL_ERROR;
   1636     }else if( objc==2 ){
   1637       if( pDb->zAuth ){
   1638         Tcl_AppendResult(interp, pDb->zAuth, 0);
   1639       }
   1640     }else{
   1641       char *zAuth;
   1642       int len;
   1643       if( pDb->zAuth ){
   1644         Tcl_Free(pDb->zAuth);
   1645       }
   1646       zAuth = Tcl_GetStringFromObj(objv[2], &len);
   1647       if( zAuth && len>0 ){
   1648         pDb->zAuth = Tcl_Alloc( len + 1 );
   1649         memcpy(pDb->zAuth, zAuth, len+1);
   1650       }else{
   1651         pDb->zAuth = 0;
   1652       }
   1653       if( pDb->zAuth ){
   1654         pDb->interp = interp;
   1655         sqlite3_set_authorizer(pDb->db, auth_callback, pDb);
   1656       }else{
   1657         sqlite3_set_authorizer(pDb->db, 0, 0);
   1658       }
   1659     }
   1660 #endif
   1661     break;
   1662   }
   1663 
   1664   /*    $db backup ?DATABASE? FILENAME
   1665   **
   1666   ** Open or create a database file named FILENAME.  Transfer the
   1667   ** content of local database DATABASE (default: "main") into the
   1668   ** FILENAME database.
   1669   */
   1670   case DB_BACKUP: {
   1671     const char *zDestFile;
   1672     const char *zSrcDb;
   1673     sqlite3 *pDest;
   1674     sqlite3_backup *pBackup;
   1675 
   1676     if( objc==3 ){
   1677       zSrcDb = "main";
   1678       zDestFile = Tcl_GetString(objv[2]);
   1679     }else if( objc==4 ){
   1680       zSrcDb = Tcl_GetString(objv[2]);
   1681       zDestFile = Tcl_GetString(objv[3]);
   1682     }else{
   1683       Tcl_WrongNumArgs(interp, 2, objv, "?DATABASE? FILENAME");
   1684       return TCL_ERROR;
   1685     }
   1686     rc = sqlite3_open(zDestFile, &pDest);
   1687     if( rc!=SQLITE_OK ){
   1688       Tcl_AppendResult(interp, "cannot open target database: ",
   1689            sqlite3_errmsg(pDest), (char*)0);
   1690       sqlite3_close(pDest);
   1691       return TCL_ERROR;
   1692     }
   1693     pBackup = sqlite3_backup_init(pDest, "main", pDb->db, zSrcDb);
   1694     if( pBackup==0 ){
   1695       Tcl_AppendResult(interp, "backup failed: ",
   1696            sqlite3_errmsg(pDest), (char*)0);
   1697       sqlite3_close(pDest);
   1698       return TCL_ERROR;
   1699     }
   1700     while(  (rc = sqlite3_backup_step(pBackup,100))==SQLITE_OK ){}
   1701     sqlite3_backup_finish(pBackup);
   1702     if( rc==SQLITE_DONE ){
   1703       rc = TCL_OK;
   1704     }else{
   1705       Tcl_AppendResult(interp, "backup failed: ",
   1706            sqlite3_errmsg(pDest), (char*)0);
   1707       rc = TCL_ERROR;
   1708     }
   1709     sqlite3_close(pDest);
   1710     break;
   1711   }
   1712 
   1713   /*    $db busy ?CALLBACK?
   1714   **
   1715   ** Invoke the given callback if an SQL statement attempts to open
   1716   ** a locked database file.
   1717   */
   1718   case DB_BUSY: {
   1719     if( objc>3 ){
   1720       Tcl_WrongNumArgs(interp, 2, objv, "CALLBACK");
   1721       return TCL_ERROR;
   1722     }else if( objc==2 ){
   1723       if( pDb->zBusy ){
   1724         Tcl_AppendResult(interp, pDb->zBusy, 0);
   1725       }
   1726     }else{
   1727       char *zBusy;
   1728       int len;
   1729       if( pDb->zBusy ){
   1730         Tcl_Free(pDb->zBusy);
   1731       }
   1732       zBusy = Tcl_GetStringFromObj(objv[2], &len);
   1733       if( zBusy && len>0 ){
   1734         pDb->zBusy = Tcl_Alloc( len + 1 );
   1735         memcpy(pDb->zBusy, zBusy, len+1);
   1736       }else{
   1737         pDb->zBusy = 0;
   1738       }
   1739       if( pDb->zBusy ){
   1740         pDb->interp = interp;
   1741         sqlite3_busy_handler(pDb->db, DbBusyHandler, pDb);
   1742       }else{
   1743         sqlite3_busy_handler(pDb->db, 0, 0);
   1744       }
   1745     }
   1746     break;
   1747   }
   1748 
   1749   /*     $db cache flush
   1750   **     $db cache size n
   1751   **
   1752   ** Flush the prepared statement cache, or set the maximum number of
   1753   ** cached statements.
   1754   */
   1755   case DB_CACHE: {
   1756     char *subCmd;
   1757     int n;
   1758 
   1759     if( objc<=2 ){
   1760       Tcl_WrongNumArgs(interp, 1, objv, "cache option ?arg?");
   1761       return TCL_ERROR;
   1762     }
   1763     subCmd = Tcl_GetStringFromObj( objv[2], 0 );
   1764     if( *subCmd=='f' && strcmp(subCmd,"flush")==0 ){
   1765       if( objc!=3 ){
   1766         Tcl_WrongNumArgs(interp, 2, objv, "flush");
   1767         return TCL_ERROR;
   1768       }else{
   1769         flushStmtCache( pDb );
   1770       }
   1771     }else if( *subCmd=='s' && strcmp(subCmd,"size")==0 ){
   1772       if( objc!=4 ){
   1773         Tcl_WrongNumArgs(interp, 2, objv, "size n");
   1774         return TCL_ERROR;
   1775       }else{
   1776         if( TCL_ERROR==Tcl_GetIntFromObj(interp, objv[3], &n) ){
   1777           Tcl_AppendResult( interp, "cannot convert \"",
   1778                Tcl_GetStringFromObj(objv[3],0), "\" to integer", 0);
   1779           return TCL_ERROR;
   1780         }else{
   1781           if( n<0 ){
   1782             flushStmtCache( pDb );
   1783             n = 0;
   1784           }else if( n>MAX_PREPARED_STMTS ){
   1785             n = MAX_PREPARED_STMTS;
   1786           }
   1787           pDb->maxStmt = n;
   1788         }
   1789       }
   1790     }else{
   1791       Tcl_AppendResult( interp, "bad option \"",
   1792           Tcl_GetStringFromObj(objv[2],0), "\": must be flush or size", 0);
   1793       return TCL_ERROR;
   1794     }
   1795     break;
   1796   }
   1797 
   1798   /*     $db changes
   1799   **
   1800   ** Return the number of rows that were modified, inserted, or deleted by
   1801   ** the most recent INSERT, UPDATE or DELETE statement, not including
   1802   ** any changes made by trigger programs.
   1803   */
   1804   case DB_CHANGES: {
   1805     Tcl_Obj *pResult;
   1806     if( objc!=2 ){
   1807       Tcl_WrongNumArgs(interp, 2, objv, "");
   1808       return TCL_ERROR;
   1809     }
   1810     pResult = Tcl_GetObjResult(interp);
   1811     Tcl_SetIntObj(pResult, sqlite3_changes(pDb->db));
   1812     break;
   1813   }
   1814 
   1815   /*    $db close
   1816   **
   1817   ** Shutdown the database
   1818   */
   1819   case DB_CLOSE: {
   1820     Tcl_DeleteCommand(interp, Tcl_GetStringFromObj(objv[0], 0));
   1821     break;
   1822   }
   1823 
   1824   /*
   1825   **     $db collate NAME SCRIPT
   1826   **
   1827   ** Create a new SQL collation function called NAME.  Whenever
   1828   ** that function is called, invoke SCRIPT to evaluate the function.
   1829   */
   1830   case DB_COLLATE: {
   1831     SqlCollate *pCollate;
   1832     char *zName;
   1833     char *zScript;
   1834     int nScript;
   1835     if( objc!=4 ){
   1836       Tcl_WrongNumArgs(interp, 2, objv, "NAME SCRIPT");
   1837       return TCL_ERROR;
   1838     }
   1839     zName = Tcl_GetStringFromObj(objv[2], 0);
   1840     zScript = Tcl_GetStringFromObj(objv[3], &nScript);
   1841     pCollate = (SqlCollate*)Tcl_Alloc( sizeof(*pCollate) + nScript + 1 );
   1842     if( pCollate==0 ) return TCL_ERROR;
   1843     pCollate->interp = interp;
   1844     pCollate->pNext = pDb->pCollate;
   1845     pCollate->zScript = (char*)&pCollate[1];
   1846     pDb->pCollate = pCollate;
   1847     memcpy(pCollate->zScript, zScript, nScript+1);
   1848     if( sqlite3_create_collation(pDb->db, zName, SQLITE_UTF8,
   1849         pCollate, tclSqlCollate) ){
   1850       Tcl_SetResult(interp, (char *)sqlite3_errmsg(pDb->db), TCL_VOLATILE);
   1851       return TCL_ERROR;
   1852     }
   1853     break;
   1854   }
   1855 
   1856   /*
   1857   **     $db collation_needed SCRIPT
   1858   **
   1859   ** Create a new SQL collation function called NAME.  Whenever
   1860   ** that function is called, invoke SCRIPT to evaluate the function.
   1861   */
   1862   case DB_COLLATION_NEEDED: {
   1863     if( objc!=3 ){
   1864       Tcl_WrongNumArgs(interp, 2, objv, "SCRIPT");
   1865       return TCL_ERROR;
   1866     }
   1867     if( pDb->pCollateNeeded ){
   1868       Tcl_DecrRefCount(pDb->pCollateNeeded);
   1869     }
   1870     pDb->pCollateNeeded = Tcl_DuplicateObj(objv[2]);
   1871     Tcl_IncrRefCount(pDb->pCollateNeeded);
   1872     sqlite3_collation_needed(pDb->db, pDb, tclCollateNeeded);
   1873     break;
   1874   }
   1875 
   1876   /*    $db commit_hook ?CALLBACK?
   1877   **
   1878   ** Invoke the given callback just before committing every SQL transaction.
   1879   ** If the callback throws an exception or returns non-zero, then the
   1880   ** transaction is aborted.  If CALLBACK is an empty string, the callback
   1881   ** is disabled.
   1882   */
   1883   case DB_COMMIT_HOOK: {
   1884     if( objc>3 ){
   1885       Tcl_WrongNumArgs(interp, 2, objv, "?CALLBACK?");
   1886       return TCL_ERROR;
   1887     }else if( objc==2 ){
   1888       if( pDb->zCommit ){
   1889         Tcl_AppendResult(interp, pDb->zCommit, 0);
   1890       }
   1891     }else{
   1892       char *zCommit;
   1893       int len;
   1894       if( pDb->zCommit ){
   1895         Tcl_Free(pDb->zCommit);
   1896       }
   1897       zCommit = Tcl_GetStringFromObj(objv[2], &len);
   1898       if( zCommit && len>0 ){
   1899         pDb->zCommit = Tcl_Alloc( len + 1 );
   1900         memcpy(pDb->zCommit, zCommit, len+1);
   1901       }else{
   1902         pDb->zCommit = 0;
   1903       }
   1904       if( pDb->zCommit ){
   1905         pDb->interp = interp;
   1906         sqlite3_commit_hook(pDb->db, DbCommitHandler, pDb);
   1907       }else{
   1908         sqlite3_commit_hook(pDb->db, 0, 0);
   1909       }
   1910     }
   1911     break;
   1912   }
   1913 
   1914   /*    $db complete SQL
   1915   **
   1916   ** Return TRUE if SQL is a complete SQL statement.  Return FALSE if
   1917   ** additional lines of input are needed.  This is similar to the
   1918   ** built-in "info complete" command of Tcl.
   1919   */
   1920   case DB_COMPLETE: {
   1921 #ifndef SQLITE_OMIT_COMPLETE
   1922     Tcl_Obj *pResult;
   1923     int isComplete;
   1924     if( objc!=3 ){
   1925       Tcl_WrongNumArgs(interp, 2, objv, "SQL");
   1926       return TCL_ERROR;
   1927     }
   1928     isComplete = sqlite3_complete( Tcl_GetStringFromObj(objv[2], 0) );
   1929     pResult = Tcl_GetObjResult(interp);
   1930     Tcl_SetBooleanObj(pResult, isComplete);
   1931 #endif
   1932     break;
   1933   }
   1934 
   1935   /*    $db copy conflict-algorithm table filename ?SEPARATOR? ?NULLINDICATOR?
   1936   **
   1937   ** Copy data into table from filename, optionally using SEPARATOR
   1938   ** as column separators.  If a column contains a null string, or the
   1939   ** value of NULLINDICATOR, a NULL is inserted for the column.
   1940   ** conflict-algorithm is one of the sqlite conflict algorithms:
   1941   **    rollback, abort, fail, ignore, replace
   1942   ** On success, return the number of lines processed, not necessarily same
   1943   ** as 'db changes' due to conflict-algorithm selected.
   1944   **
   1945   ** This code is basically an implementation/enhancement of
   1946   ** the sqlite3 shell.c ".import" command.
   1947   **
   1948   ** This command usage is equivalent to the sqlite2.x COPY statement,
   1949   ** which imports file data into a table using the PostgreSQL COPY file format:
   1950   **   $db copy $conflit_algo $table_name $filename \t \\N
   1951   */
   1952   case DB_COPY: {
   1953     char *zTable;               /* Insert data into this table */
   1954     char *zFile;                /* The file from which to extract data */
   1955     char *zConflict;            /* The conflict algorithm to use */
   1956     sqlite3_stmt *pStmt;        /* A statement */
   1957     int nCol;                   /* Number of columns in the table */
   1958     int nByte;                  /* Number of bytes in an SQL string */
   1959     int i, j;                   /* Loop counters */
   1960     int nSep;                   /* Number of bytes in zSep[] */
   1961     int nNull;                  /* Number of bytes in zNull[] */
   1962     char *zSql;                 /* An SQL statement */
   1963     char *zLine;                /* A single line of input from the file */
   1964     char **azCol;               /* zLine[] broken up into columns */
   1965     char *zCommit;              /* How to commit changes */
   1966     FILE *in;                   /* The input file */
   1967     int lineno = 0;             /* Line number of input file */
   1968     char zLineNum[80];          /* Line number print buffer */
   1969     Tcl_Obj *pResult;           /* interp result */
   1970 
   1971     char *zSep;
   1972     char *zNull;
   1973     if( objc<5 || objc>7 ){
   1974       Tcl_WrongNumArgs(interp, 2, objv,
   1975          "CONFLICT-ALGORITHM TABLE FILENAME ?SEPARATOR? ?NULLINDICATOR?");
   1976       return TCL_ERROR;
   1977     }
   1978     if( objc>=6 ){
   1979       zSep = Tcl_GetStringFromObj(objv[5], 0);
   1980     }else{
   1981       zSep = "\t";
   1982     }
   1983     if( objc>=7 ){
   1984       zNull = Tcl_GetStringFromObj(objv[6], 0);
   1985     }else{
   1986       zNull = "";
   1987     }
   1988     zConflict = Tcl_GetStringFromObj(objv[2], 0);
   1989     zTable = Tcl_GetStringFromObj(objv[3], 0);
   1990     zFile = Tcl_GetStringFromObj(objv[4], 0);
   1991     nSep = strlen30(zSep);
   1992     nNull = strlen30(zNull);
   1993     if( nSep==0 ){
   1994       Tcl_AppendResult(interp,"Error: non-null separator required for copy",0);
   1995       return TCL_ERROR;
   1996     }
   1997     if(strcmp(zConflict, "rollback") != 0 &&
   1998        strcmp(zConflict, "abort"   ) != 0 &&
   1999        strcmp(zConflict, "fail"    ) != 0 &&
   2000        strcmp(zConflict, "ignore"  ) != 0 &&
   2001        strcmp(zConflict, "replace" ) != 0 ) {
   2002       Tcl_AppendResult(interp, "Error: \"", zConflict,
   2003             "\", conflict-algorithm must be one of: rollback, "
   2004             "abort, fail, ignore, or replace", 0);
   2005       return TCL_ERROR;
   2006     }
   2007     zSql = sqlite3_mprintf("SELECT * FROM '%q'", zTable);
   2008     if( zSql==0 ){
   2009       Tcl_AppendResult(interp, "Error: no such table: ", zTable, 0);
   2010       return TCL_ERROR;
   2011     }
   2012     nByte = strlen30(zSql);
   2013     rc = sqlite3_prepare(pDb->db, zSql, -1, &pStmt, 0);
   2014     sqlite3_free(zSql);
   2015     if( rc ){
   2016       Tcl_AppendResult(interp, "Error: ", sqlite3_errmsg(pDb->db), 0);
   2017       nCol = 0;
   2018     }else{
   2019       nCol = sqlite3_column_count(pStmt);
   2020     }
   2021     sqlite3_finalize(pStmt);
   2022     if( nCol==0 ) {
   2023       return TCL_ERROR;
   2024     }
   2025     zSql = malloc( nByte + 50 + nCol*2 );
   2026     if( zSql==0 ) {
   2027       Tcl_AppendResult(interp, "Error: can't malloc()", 0);
   2028       return TCL_ERROR;
   2029     }
   2030     sqlite3_snprintf(nByte+50, zSql, "INSERT OR %q INTO '%q' VALUES(?",
   2031          zConflict, zTable);
   2032     j = strlen30(zSql);
   2033     for(i=1; i<nCol; i++){
   2034       zSql[j++] = ',';
   2035       zSql[j++] = '?';
   2036     }
   2037     zSql[j++] = ')';
   2038     zSql[j] = 0;
   2039     rc = sqlite3_prepare(pDb->db, zSql, -1, &pStmt, 0);
   2040     free(zSql);
   2041     if( rc ){
   2042       Tcl_AppendResult(interp, "Error: ", sqlite3_errmsg(pDb->db), 0);
   2043       sqlite3_finalize(pStmt);
   2044       return TCL_ERROR;
   2045     }
   2046     in = fopen(zFile, "rb");
   2047     if( in==0 ){
   2048       Tcl_AppendResult(interp, "Error: cannot open file: ", zFile, NULL);
   2049       sqlite3_finalize(pStmt);
   2050       return TCL_ERROR;
   2051     }
   2052     azCol = malloc( sizeof(azCol[0])*(nCol+1) );
   2053     if( azCol==0 ) {
   2054       Tcl_AppendResult(interp, "Error: can't malloc()", 0);
   2055       fclose(in);
   2056       return TCL_ERROR;
   2057     }
   2058     (void)sqlite3_exec(pDb->db, "BEGIN", 0, 0, 0);
   2059     zCommit = "COMMIT";
   2060     while( (zLine = local_getline(0, in))!=0 ){
   2061       char *z;
   2062       i = 0;
   2063       lineno++;
   2064       azCol[0] = zLine;
   2065       for(i=0, z=zLine; *z; z++){
   2066         if( *z==zSep[0] && strncmp(z, zSep, nSep)==0 ){
   2067           *z = 0;
   2068           i++;
   2069           if( i<nCol ){
   2070             azCol[i] = &z[nSep];
   2071             z += nSep-1;
   2072           }
   2073         }
   2074       }
   2075       if( i+1!=nCol ){
   2076         char *zErr;
   2077         int nErr = strlen30(zFile) + 200;
   2078         zErr = malloc(nErr);
   2079         if( zErr ){
   2080           sqlite3_snprintf(nErr, zErr,
   2081              "Error: %s line %d: expected %d columns of data but found %d",
   2082              zFile, lineno, nCol, i+1);
   2083           Tcl_AppendResult(interp, zErr, 0);
   2084           free(zErr);
   2085         }
   2086         zCommit = "ROLLBACK";
   2087         break;
   2088       }
   2089       for(i=0; i<nCol; i++){
   2090         /* check for null data, if so, bind as null */
   2091         if( (nNull>0 && strcmp(azCol[i], zNull)==0)
   2092           || strlen30(azCol[i])==0
   2093         ){
   2094           sqlite3_bind_null(pStmt, i+1);
   2095         }else{
   2096           sqlite3_bind_text(pStmt, i+1, azCol[i], -1, SQLITE_STATIC);
   2097         }
   2098       }
   2099       sqlite3_step(pStmt);
   2100       rc = sqlite3_reset(pStmt);
   2101       free(zLine);
   2102       if( rc!=SQLITE_OK ){
   2103         Tcl_AppendResult(interp,"Error: ", sqlite3_errmsg(pDb->db), 0);
   2104         zCommit = "ROLLBACK";
   2105         break;
   2106       }
   2107     }
   2108     free(azCol);
   2109     fclose(in);
   2110     sqlite3_finalize(pStmt);
   2111     (void)sqlite3_exec(pDb->db, zCommit, 0, 0, 0);
   2112 
   2113     if( zCommit[0] == 'C' ){
   2114       /* success, set result as number of lines processed */
   2115       pResult = Tcl_GetObjResult(interp);
   2116       Tcl_SetIntObj(pResult, lineno);
   2117       rc = TCL_OK;
   2118     }else{
   2119       /* failure, append lineno where failed */
   2120       sqlite3_snprintf(sizeof(zLineNum), zLineNum,"%d",lineno);
   2121       Tcl_AppendResult(interp,", failed while processing line: ",zLineNum,0);
   2122       rc = TCL_ERROR;
   2123     }
   2124     break;
   2125   }
   2126 
   2127   /*
   2128   **    $db enable_load_extension BOOLEAN
   2129   **
   2130   ** Turn the extension loading feature on or off.  It if off by
   2131   ** default.
   2132   */
   2133   case DB_ENABLE_LOAD_EXTENSION: {
   2134 #ifndef SQLITE_OMIT_LOAD_EXTENSION
   2135     int onoff;
   2136     if( objc!=3 ){
   2137       Tcl_WrongNumArgs(interp, 2, objv, "BOOLEAN");
   2138       return TCL_ERROR;
   2139     }
   2140     if( Tcl_GetBooleanFromObj(interp, objv[2], &onoff) ){
   2141       return TCL_ERROR;
   2142     }
   2143     sqlite3_enable_load_extension(pDb->db, onoff);
   2144     break;
   2145 #else
   2146     Tcl_AppendResult(interp, "extension loading is turned off at compile-time",
   2147                      0);
   2148     return TCL_ERROR;
   2149 #endif
   2150   }
   2151 
   2152   /*
   2153   **    $db errorcode
   2154   **
   2155   ** Return the numeric error code that was returned by the most recent
   2156   ** call to sqlite3_exec().
   2157   */
   2158   case DB_ERRORCODE: {
   2159     Tcl_SetObjResult(interp, Tcl_NewIntObj(sqlite3_errcode(pDb->db)));
   2160     break;
   2161   }
   2162 
   2163   /*
   2164   **    $db exists $sql
   2165   **    $db onecolumn $sql
   2166   **
   2167   ** The onecolumn method is the equivalent of:
   2168   **     lindex [$db eval $sql] 0
   2169   */
   2170   case DB_EXISTS:
   2171   case DB_ONECOLUMN: {
   2172     DbEvalContext sEval;
   2173     if( objc!=3 ){
   2174       Tcl_WrongNumArgs(interp, 2, objv, "SQL");
   2175       return TCL_ERROR;
   2176     }
   2177 
   2178     dbEvalInit(&sEval, pDb, objv[2], 0);
   2179     rc = dbEvalStep(&sEval);
   2180     if( choice==DB_ONECOLUMN ){
   2181       if( rc==TCL_OK ){
   2182         Tcl_SetObjResult(interp, dbEvalColumnValue(&sEval, 0));
   2183       }
   2184     }else if( rc==TCL_BREAK || rc==TCL_OK ){
   2185       Tcl_SetObjResult(interp, Tcl_NewBooleanObj(rc==TCL_OK));
   2186     }
   2187     dbEvalFinalize(&sEval);
   2188 
   2189     if( rc==TCL_BREAK ){
   2190       rc = TCL_OK;
   2191     }
   2192     break;
   2193   }
   2194 
   2195   /*
   2196   **    $db eval $sql ?array? ?{  ...code... }?
   2197   **
   2198   ** The SQL statement in $sql is evaluated.  For each row, the values are
   2199   ** placed in elements of the array named "array" and ...code... is executed.
   2200   ** If "array" and "code" are omitted, then no callback is every invoked.
   2201   ** If "array" is an empty string, then the values are placed in variables
   2202   ** that have the same name as the fields extracted by the query.
   2203   */
   2204   case DB_EVAL: {
   2205     if( objc<3 || objc>5 ){
   2206       Tcl_WrongNumArgs(interp, 2, objv, "SQL ?ARRAY-NAME? ?SCRIPT?");
   2207       return TCL_ERROR;
   2208     }
   2209 
   2210     if( objc==3 ){
   2211       DbEvalContext sEval;
   2212       Tcl_Obj *pRet = Tcl_NewObj();
   2213       Tcl_IncrRefCount(pRet);
   2214       dbEvalInit(&sEval, pDb, objv[2], 0);
   2215       while( TCL_OK==(rc = dbEvalStep(&sEval)) ){
   2216         int i;
   2217         int nCol;
   2218         dbEvalRowInfo(&sEval, &nCol, 0);
   2219         for(i=0; i<nCol; i++){
   2220           Tcl_ListObjAppendElement(interp, pRet, dbEvalColumnValue(&sEval, i));
   2221         }
   2222       }
   2223       dbEvalFinalize(&sEval);
   2224       if( rc==TCL_BREAK ){
   2225         Tcl_SetObjResult(interp, pRet);
   2226         rc = TCL_OK;
   2227       }
   2228       Tcl_DecrRefCount(pRet);
   2229     }else{
   2230       ClientData cd[2];
   2231       DbEvalContext *p;
   2232       Tcl_Obj *pArray = 0;
   2233       Tcl_Obj *pScript;
   2234 
   2235       if( objc==5 && *(char *)Tcl_GetString(objv[3]) ){
   2236         pArray = objv[3];
   2237       }
   2238       pScript = objv[objc-1];
   2239       Tcl_IncrRefCount(pScript);
   2240 
   2241       p = (DbEvalContext *)Tcl_Alloc(sizeof(DbEvalContext));
   2242       dbEvalInit(p, pDb, objv[2], pArray);
   2243 
   2244       cd[0] = (void *)p;
   2245       cd[1] = (void *)pScript;
   2246       rc = DbEvalNextCmd(cd, interp, TCL_OK);
   2247     }
   2248     break;
   2249   }
   2250 
   2251   /*
   2252   **     $db function NAME [-argcount N] SCRIPT
   2253   **
   2254   ** Create a new SQL function called NAME.  Whenever that function is
   2255   ** called, invoke SCRIPT to evaluate the function.
   2256   */
   2257   case DB_FUNCTION: {
   2258     SqlFunc *pFunc;
   2259     Tcl_Obj *pScript;
   2260     char *zName;
   2261     int nArg = -1;
   2262     if( objc==6 ){
   2263       const char *z = Tcl_GetString(objv[3]);
   2264       int n = strlen30(z);
   2265       if( n>2 && strncmp(z, "-argcount",n)==0 ){
   2266         if( Tcl_GetIntFromObj(interp, objv[4], &nArg) ) return TCL_ERROR;
   2267         if( nArg<0 ){
   2268           Tcl_AppendResult(interp, "number of arguments must be non-negative",
   2269                            (char*)0);
   2270           return TCL_ERROR;
   2271         }
   2272       }
   2273       pScript = objv[5];
   2274     }else if( objc!=4 ){
   2275       Tcl_WrongNumArgs(interp, 2, objv, "NAME [-argcount N] SCRIPT");
   2276       return TCL_ERROR;
   2277     }else{
   2278       pScript = objv[3];
   2279     }
   2280     zName = Tcl_GetStringFromObj(objv[2], 0);
   2281     pFunc = findSqlFunc(pDb, zName);
   2282     if( pFunc==0 ) return TCL_ERROR;
   2283     if( pFunc->pScript ){
   2284       Tcl_DecrRefCount(pFunc->pScript);
   2285     }
   2286     pFunc->pScript = pScript;
   2287     Tcl_IncrRefCount(pScript);
   2288     pFunc->useEvalObjv = safeToUseEvalObjv(interp, pScript);
   2289     rc = sqlite3_create_function(pDb->db, zName, nArg, SQLITE_UTF8,
   2290         pFunc, tclSqlFunc, 0, 0);
   2291     if( rc!=SQLITE_OK ){
   2292       rc = TCL_ERROR;
   2293       Tcl_SetResult(interp, (char *)sqlite3_errmsg(pDb->db), TCL_VOLATILE);
   2294     }
   2295     break;
   2296   }
   2297 
   2298   /*
   2299   **     $db incrblob ?-readonly? ?DB? TABLE COLUMN ROWID
   2300   */
   2301   case DB_INCRBLOB: {
   2302 #ifdef SQLITE_OMIT_INCRBLOB
   2303     Tcl_AppendResult(interp, "incrblob not available in this build", 0);
   2304     return TCL_ERROR;
   2305 #else
   2306     int isReadonly = 0;
   2307     const char *zDb = "main";
   2308     const char *zTable;
   2309     const char *zColumn;
   2310     sqlite_int64 iRow;
   2311 
   2312     /* Check for the -readonly option */
   2313     if( objc>3 && strcmp(Tcl_GetString(objv[2]), "-readonly")==0 ){
   2314       isReadonly = 1;
   2315     }
   2316 
   2317     if( objc!=(5+isReadonly) && objc!=(6+isReadonly) ){
   2318       Tcl_WrongNumArgs(interp, 2, objv, "?-readonly? ?DB? TABLE COLUMN ROWID");
   2319       return TCL_ERROR;
   2320     }
   2321 
   2322     if( objc==(6+isReadonly) ){
   2323       zDb = Tcl_GetString(objv[2]);
   2324     }
   2325     zTable = Tcl_GetString(objv[objc-3]);
   2326     zColumn = Tcl_GetString(objv[objc-2]);
   2327     rc = Tcl_GetWideIntFromObj(interp, objv[objc-1], &iRow);
   2328 
   2329     if( rc==TCL_OK ){
   2330       rc = createIncrblobChannel(
   2331           interp, pDb, zDb, zTable, zColumn, iRow, isReadonly
   2332       );
   2333     }
   2334 #endif
   2335     break;
   2336   }
   2337 
   2338   /*
   2339   **     $db interrupt
   2340   **
   2341   ** Interrupt the execution of the inner-most SQL interpreter.  This
   2342   ** causes the SQL statement to return an error of SQLITE_INTERRUPT.
   2343   */
   2344   case DB_INTERRUPT: {
   2345     sqlite3_interrupt(pDb->db);
   2346     break;
   2347   }
   2348 
   2349   /*
   2350   **     $db nullvalue ?STRING?
   2351   **
   2352   ** Change text used when a NULL comes back from the database. If ?STRING?
   2353   ** is not present, then the current string used for NULL is returned.
   2354   ** If STRING is present, then STRING is returned.
   2355   **
   2356   */
   2357   case DB_NULLVALUE: {
   2358     if( objc!=2 && objc!=3 ){
   2359       Tcl_WrongNumArgs(interp, 2, objv, "NULLVALUE");
   2360       return TCL_ERROR;
   2361     }
   2362     if( objc==3 ){
   2363       int len;
   2364       char *zNull = Tcl_GetStringFromObj(objv[2], &len);
   2365       if( pDb->zNull ){
   2366         Tcl_Free(pDb->zNull);
   2367       }
   2368       if( zNull && len>0 ){
   2369         pDb->zNull = Tcl_Alloc( len + 1 );
   2370         strncpy(pDb->zNull, zNull, len);
   2371         pDb->zNull[len] = '\0';
   2372       }else{
   2373         pDb->zNull = 0;
   2374       }
   2375     }
   2376     Tcl_SetObjResult(interp, dbTextToObj(pDb->zNull));
   2377     break;
   2378   }
   2379 
   2380   /*
   2381   **     $db last_insert_rowid
   2382   **
   2383   ** Return an integer which is the ROWID for the most recent insert.
   2384   */
   2385   case DB_LAST_INSERT_ROWID: {
   2386     Tcl_Obj *pResult;
   2387     Tcl_WideInt rowid;
   2388     if( objc!=2 ){
   2389       Tcl_WrongNumArgs(interp, 2, objv, "");
   2390       return TCL_ERROR;
   2391     }
   2392     rowid = sqlite3_last_insert_rowid(pDb->db);
   2393     pResult = Tcl_GetObjResult(interp);
   2394     Tcl_SetWideIntObj(pResult, rowid);
   2395     break;
   2396   }
   2397 
   2398   /*
   2399   ** The DB_ONECOLUMN method is implemented together with DB_EXISTS.
   2400   */
   2401 
   2402   /*    $db progress ?N CALLBACK?
   2403   **
   2404   ** Invoke the given callback every N virtual machine opcodes while executing
   2405   ** queries.
   2406   */
   2407   case DB_PROGRESS: {
   2408     if( objc==2 ){
   2409       if( pDb->zProgress ){
   2410         Tcl_AppendResult(interp, pDb->zProgress, 0);
   2411       }
   2412     }else if( objc==4 ){
   2413       char *zProgress;
   2414       int len;
   2415       int N;
   2416       if( TCL_OK!=Tcl_GetIntFromObj(interp, objv[2], &N) ){
   2417         return TCL_ERROR;
   2418       };
   2419       if( pDb->zProgress ){
   2420         Tcl_Free(pDb->zProgress);
   2421       }
   2422       zProgress = Tcl_GetStringFromObj(objv[3], &len);
   2423       if( zProgress && len>0 ){
   2424         pDb->zProgress = Tcl_Alloc( len + 1 );
   2425         memcpy(pDb->zProgress, zProgress, len+1);
   2426       }else{
   2427         pDb->zProgress = 0;
   2428       }
   2429 #ifndef SQLITE_OMIT_PROGRESS_CALLBACK
   2430       if( pDb->zProgress ){
   2431         pDb->interp = interp;
   2432         sqlite3_progress_handler(pDb->db, N, DbProgressHandler, pDb);
   2433       }else{
   2434         sqlite3_progress_handler(pDb->db, 0, 0, 0);
   2435       }
   2436 #endif
   2437     }else{
   2438       Tcl_WrongNumArgs(interp, 2, objv, "N CALLBACK");
   2439       return TCL_ERROR;
   2440     }
   2441     break;
   2442   }
   2443 
   2444   /*    $db profile ?CALLBACK?
   2445   **
   2446   ** Make arrangements to invoke the CALLBACK routine after each SQL statement
   2447   ** that has run.  The text of the SQL and the amount of elapse time are
   2448   ** appended to CALLBACK before the script is run.
   2449   */
   2450   case DB_PROFILE: {
   2451     if( objc>3 ){
   2452       Tcl_WrongNumArgs(interp, 2, objv, "?CALLBACK?");
   2453       return TCL_ERROR;
   2454     }else if( objc==2 ){
   2455       if( pDb->zProfile ){
   2456         Tcl_AppendResult(interp, pDb->zProfile, 0);
   2457       }
   2458     }else{
   2459       char *zProfile;
   2460       int len;
   2461       if( pDb->zProfile ){
   2462         Tcl_Free(pDb->zProfile);
   2463       }
   2464       zProfile = Tcl_GetStringFromObj(objv[2], &len);
   2465       if( zProfile && len>0 ){
   2466         pDb->zProfile = Tcl_Alloc( len + 1 );
   2467         memcpy(pDb->zProfile, zProfile, len+1);
   2468       }else{
   2469         pDb->zProfile = 0;
   2470       }
   2471 #if !defined(SQLITE_OMIT_TRACE) && !defined(SQLITE_OMIT_FLOATING_POINT)
   2472       if( pDb->zProfile ){
   2473         pDb->interp = interp;
   2474         sqlite3_profile(pDb->db, DbProfileHandler, pDb);
   2475       }else{
   2476         sqlite3_profile(pDb->db, 0, 0);
   2477       }
   2478 #endif
   2479     }
   2480     break;
   2481   }
   2482 
   2483   /*
   2484   **     $db rekey KEY
   2485   **
   2486   ** Change the encryption key on the currently open database.
   2487   */
   2488   case DB_REKEY: {
   2489     int nKey;
   2490     void *pKey;
   2491     if( objc!=3 ){
   2492       Tcl_WrongNumArgs(interp, 2, objv, "KEY");
   2493       return TCL_ERROR;
   2494     }
   2495     pKey = Tcl_GetByteArrayFromObj(objv[2], &nKey);
   2496 #ifdef SQLITE_HAS_CODEC
   2497     rc = sqlite3_rekey(pDb->db, pKey, nKey);
   2498     if( rc ){
   2499       Tcl_AppendResult(interp, sqlite3ErrStr(rc), 0);
   2500       rc = TCL_ERROR;
   2501     }
   2502 #endif
   2503     break;
   2504   }
   2505 
   2506   /*    $db restore ?DATABASE? FILENAME
   2507   **
   2508   ** Open a database file named FILENAME.  Transfer the content
   2509   ** of FILENAME into the local database DATABASE (default: "main").
   2510   */
   2511   case DB_RESTORE: {
   2512     const char *zSrcFile;
   2513     const char *zDestDb;
   2514     sqlite3 *pSrc;
   2515     sqlite3_backup *pBackup;
   2516     int nTimeout = 0;
   2517 
   2518     if( objc==3 ){
   2519       zDestDb = "main";
   2520       zSrcFile = Tcl_GetString(objv[2]);
   2521     }else if( objc==4 ){
   2522       zDestDb = Tcl_GetString(objv[2]);
   2523       zSrcFile = Tcl_GetString(objv[3]);
   2524     }else{
   2525       Tcl_WrongNumArgs(interp, 2, objv, "?DATABASE? FILENAME");
   2526       return TCL_ERROR;
   2527     }
   2528     rc = sqlite3_open_v2(zSrcFile, &pSrc, SQLITE_OPEN_READONLY, 0);
   2529     if( rc!=SQLITE_OK ){
   2530       Tcl_AppendResult(interp, "cannot open source database: ",
   2531            sqlite3_errmsg(pSrc), (char*)0);
   2532       sqlite3_close(pSrc);
   2533       return TCL_ERROR;
   2534     }
   2535     pBackup = sqlite3_backup_init(pDb->db, zDestDb, pSrc, "main");
   2536     if( pBackup==0 ){
   2537       Tcl_AppendResult(interp, "restore failed: ",
   2538            sqlite3_errmsg(pDb->db), (char*)0);
   2539       sqlite3_close(pSrc);
   2540       return TCL_ERROR;
   2541     }
   2542     while( (rc = sqlite3_backup_step(pBackup,100))==SQLITE_OK
   2543               || rc==SQLITE_BUSY ){
   2544       if( rc==SQLITE_BUSY ){
   2545         if( nTimeout++ >= 3 ) break;
   2546         sqlite3_sleep(100);
   2547       }
   2548     }
   2549     sqlite3_backup_finish(pBackup);
   2550     if( rc==SQLITE_DONE ){
   2551       rc = TCL_OK;
   2552     }else if( rc==SQLITE_BUSY || rc==SQLITE_LOCKED ){
   2553       Tcl_AppendResult(interp, "restore failed: source database busy",
   2554                        (char*)0);
   2555       rc = TCL_ERROR;
   2556     }else{
   2557       Tcl_AppendResult(interp, "restore failed: ",
   2558            sqlite3_errmsg(pDb->db), (char*)0);
   2559       rc = TCL_ERROR;
   2560     }
   2561     sqlite3_close(pSrc);
   2562     break;
   2563   }
   2564 
   2565   /*
   2566   **     $db status (step|sort|autoindex)
   2567   **
   2568   ** Display SQLITE_STMTSTATUS_FULLSCAN_STEP or
   2569   ** SQLITE_STMTSTATUS_SORT for the most recent eval.
   2570   */
   2571   case DB_STATUS: {
   2572     int v;
   2573     const char *zOp;
   2574     if( objc!=3 ){
   2575       Tcl_WrongNumArgs(interp, 2, objv, "(step|sort|autoindex)");
   2576       return TCL_ERROR;
   2577     }
   2578     zOp = Tcl_GetString(objv[2]);
   2579     if( strcmp(zOp, "step")==0 ){
   2580       v = pDb->nStep;
   2581     }else if( strcmp(zOp, "sort")==0 ){
   2582       v = pDb->nSort;
   2583     }else if( strcmp(zOp, "autoindex")==0 ){
   2584       v = pDb->nIndex;
   2585     }else{
   2586       Tcl_AppendResult(interp,
   2587             "bad argument: should be autoindex, step, or sort",
   2588             (char*)0);
   2589       return TCL_ERROR;
   2590     }
   2591     Tcl_SetObjResult(interp, Tcl_NewIntObj(v));
   2592     break;
   2593   }
   2594 
   2595   /*
   2596   **     $db timeout MILLESECONDS
   2597   **
   2598   ** Delay for the number of milliseconds specified when a file is locked.
   2599   */
   2600   case DB_TIMEOUT: {
   2601     int ms;
   2602     if( objc!=3 ){
   2603       Tcl_WrongNumArgs(interp, 2, objv, "MILLISECONDS");
   2604       return TCL_ERROR;
   2605     }
   2606     if( Tcl_GetIntFromObj(interp, objv[2], &ms) ) return TCL_ERROR;
   2607     sqlite3_busy_timeout(pDb->db, ms);
   2608     break;
   2609   }
   2610 
   2611   /*
   2612   **     $db total_changes
   2613   **
   2614   ** Return the number of rows that were modified, inserted, or deleted
   2615   ** since the database handle was created.
   2616   */
   2617   case DB_TOTAL_CHANGES: {
   2618     Tcl_Obj *pResult;
   2619     if( objc!=2 ){
   2620       Tcl_WrongNumArgs(interp, 2, objv, "");
   2621       return TCL_ERROR;
   2622     }
   2623     pResult = Tcl_GetObjResult(interp);
   2624     Tcl_SetIntObj(pResult, sqlite3_total_changes(pDb->db));
   2625     break;
   2626   }
   2627 
   2628   /*    $db trace ?CALLBACK?
   2629   **
   2630   ** Make arrangements to invoke the CALLBACK routine for each SQL statement
   2631   ** that is executed.  The text of the SQL is appended to CALLBACK before
   2632   ** it is executed.
   2633   */
   2634   case DB_TRACE: {
   2635     if( objc>3 ){
   2636       Tcl_WrongNumArgs(interp, 2, objv, "?CALLBACK?");
   2637       return TCL_ERROR;
   2638     }else if( objc==2 ){
   2639       if( pDb->zTrace ){
   2640         Tcl_AppendResult(interp, pDb->zTrace, 0);
   2641       }
   2642     }else{
   2643       char *zTrace;
   2644       int len;
   2645       if( pDb->zTrace ){
   2646         Tcl_Free(pDb->zTrace);
   2647       }
   2648       zTrace = Tcl_GetStringFromObj(objv[2], &len);
   2649       if( zTrace && len>0 ){
   2650         pDb->zTrace = Tcl_Alloc( len + 1 );
   2651         memcpy(pDb->zTrace, zTrace, len+1);
   2652       }else{
   2653         pDb->zTrace = 0;
   2654       }
   2655 #if !defined(SQLITE_OMIT_TRACE) && !defined(SQLITE_OMIT_FLOATING_POINT)
   2656       if( pDb->zTrace ){
   2657         pDb->interp = interp;
   2658         sqlite3_trace(pDb->db, DbTraceHandler, pDb);
   2659       }else{
   2660         sqlite3_trace(pDb->db, 0, 0);
   2661       }
   2662 #endif
   2663     }
   2664     break;
   2665   }
   2666 
   2667   /*    $db transaction [-deferred|-immediate|-exclusive] SCRIPT
   2668   **
   2669   ** Start a new transaction (if we are not already in the midst of a
   2670   ** transaction) and execute the TCL script SCRIPT.  After SCRIPT
   2671   ** completes, either commit the transaction or roll it back if SCRIPT
   2672   ** throws an exception.  Or if no new transation was started, do nothing.
   2673   ** pass the exception on up the stack.
   2674   **
   2675   ** This command was inspired by Dave Thomas's talk on Ruby at the
   2676   ** 2005 O'Reilly Open Source Convention (OSCON).
   2677   */
   2678   case DB_TRANSACTION: {
   2679     Tcl_Obj *pScript;
   2680     const char *zBegin = "SAVEPOINT _tcl_transaction";
   2681     if( objc!=3 && objc!=4 ){
   2682       Tcl_WrongNumArgs(interp, 2, objv, "[TYPE] SCRIPT");
   2683       return TCL_ERROR;
   2684     }
   2685 
   2686     if( pDb->nTransaction==0 && objc==4 ){
   2687       static const char *TTYPE_strs[] = {
   2688         "deferred",   "exclusive",  "immediate", 0
   2689       };
   2690       enum TTYPE_enum {
   2691         TTYPE_DEFERRED, TTYPE_EXCLUSIVE, TTYPE_IMMEDIATE
   2692       };
   2693       int ttype;
   2694       if( Tcl_GetIndexFromObj(interp, objv[2], TTYPE_strs, "transaction type",
   2695                               0, &ttype) ){
   2696         return TCL_ERROR;
   2697       }
   2698       switch( (enum TTYPE_enum)ttype ){
   2699         case TTYPE_DEFERRED:    /* no-op */;                 break;
   2700         case TTYPE_EXCLUSIVE:   zBegin = "BEGIN EXCLUSIVE";  break;
   2701         case TTYPE_IMMEDIATE:   zBegin = "BEGIN IMMEDIATE";  break;
   2702       }
   2703     }
   2704     pScript = objv[objc-1];
   2705 
   2706     /* Run the SQLite BEGIN command to open a transaction or savepoint. */
   2707     pDb->disableAuth++;
   2708     rc = sqlite3_exec(pDb->db, zBegin, 0, 0, 0);
   2709     pDb->disableAuth--;
   2710     if( rc!=SQLITE_OK ){
   2711       Tcl_AppendResult(interp, sqlite3_errmsg(pDb->db), 0);
   2712       return TCL_ERROR;
   2713     }
   2714     pDb->nTransaction++;
   2715 
   2716     /* If using NRE, schedule a callback to invoke the script pScript, then
   2717     ** a second callback to commit (or rollback) the transaction or savepoint
   2718     ** opened above. If not using NRE, evaluate the script directly, then
   2719     ** call function DbTransPostCmd() to commit (or rollback) the transaction
   2720     ** or savepoint.  */
   2721     if( DbUseNre() ){
   2722       Tcl_NRAddCallback(interp, DbTransPostCmd, cd, 0, 0, 0);
   2723       Tcl_NREvalObj(interp, pScript, 0);
   2724     }else{
   2725       rc = DbTransPostCmd(&cd, interp, Tcl_EvalObjEx(interp, pScript, 0));
   2726     }
   2727     break;
   2728   }
   2729 
   2730   /*
   2731   **    $db unlock_notify ?script?
   2732   */
   2733   case DB_UNLOCK_NOTIFY: {
   2734 #ifndef SQLITE_ENABLE_UNLOCK_NOTIFY
   2735     Tcl_AppendResult(interp, "unlock_notify not available in this build", 0);
   2736     rc = TCL_ERROR;
   2737 #else
   2738     if( objc!=2 && objc!=3 ){
   2739       Tcl_WrongNumArgs(interp, 2, objv, "?SCRIPT?");
   2740       rc = TCL_ERROR;
   2741     }else{
   2742       void (*xNotify)(void **, int) = 0;
   2743       void *pNotifyArg = 0;
   2744 
   2745       if( pDb->pUnlockNotify ){
   2746         Tcl_DecrRefCount(pDb->pUnlockNotify);
   2747         pDb->pUnlockNotify = 0;
   2748       }
   2749 
   2750       if( objc==3 ){
   2751         xNotify = DbUnlockNotify;
   2752         pNotifyArg = (void *)pDb;
   2753         pDb->pUnlockNotify = objv[2];
   2754         Tcl_IncrRefCount(pDb->pUnlockNotify);
   2755       }
   2756 
   2757       if( sqlite3_unlock_notify(pDb->db, xNotify, pNotifyArg) ){
   2758         Tcl_AppendResult(interp, sqlite3_errmsg(pDb->db), 0);
   2759         rc = TCL_ERROR;
   2760       }
   2761     }
   2762 #endif
   2763     break;
   2764   }
   2765 
   2766   /*
   2767   **    $db wal_hook ?script?
   2768   **    $db update_hook ?script?
   2769   **    $db rollback_hook ?script?
   2770   */
   2771   case DB_WAL_HOOK:
   2772   case DB_UPDATE_HOOK:
   2773   case DB_ROLLBACK_HOOK: {
   2774 
   2775     /* set ppHook to point at pUpdateHook or pRollbackHook, depending on
   2776     ** whether [$db update_hook] or [$db rollback_hook] was invoked.
   2777     */
   2778     Tcl_Obj **ppHook;
   2779     if( choice==DB_UPDATE_HOOK ){
   2780       ppHook = &pDb->pUpdateHook;
   2781     }else if( choice==DB_WAL_HOOK ){
   2782       ppHook = &pDb->pWalHook;
   2783     }else{
   2784       ppHook = &pDb->pRollbackHook;
   2785     }
   2786 
   2787     if( objc!=2 && objc!=3 ){
   2788        Tcl_WrongNumArgs(interp, 2, objv, "?SCRIPT?");
   2789        return TCL_ERROR;
   2790     }
   2791     if( *ppHook ){
   2792       Tcl_SetObjResult(interp, *ppHook);
   2793       if( objc==3 ){
   2794         Tcl_DecrRefCount(*ppHook);
   2795         *ppHook = 0;
   2796       }
   2797     }
   2798     if( objc==3 ){
   2799       assert( !(*ppHook) );
   2800       if( Tcl_GetCharLength(objv[2])>0 ){
   2801         *ppHook = objv[2];
   2802         Tcl_IncrRefCount(*ppHook);
   2803       }
   2804     }
   2805 
   2806     sqlite3_update_hook(pDb->db, (pDb->pUpdateHook?DbUpdateHandler:0), pDb);
   2807     sqlite3_rollback_hook(pDb->db,(pDb->pRollbackHook?DbRollbackHandler:0),pDb);
   2808     sqlite3_wal_hook(pDb->db,(pDb->pWalHook?DbWalHandler:0),pDb);
   2809 
   2810     break;
   2811   }
   2812 
   2813   /*    $db version
   2814   **
   2815   ** Return the version string for this database.
   2816   */
   2817   case DB_VERSION: {
   2818     Tcl_SetResult(interp, (char *)sqlite3_libversion(), TCL_STATIC);
   2819     break;
   2820   }
   2821 
   2822 
   2823   } /* End of the SWITCH statement */
   2824   return rc;
   2825 }
   2826 
   2827 #if SQLITE_TCL_NRE
   2828 /*
   2829 ** Adaptor that provides an objCmd interface to the NRE-enabled
   2830 ** interface implementation.
   2831 */
   2832 static int DbObjCmdAdaptor(
   2833   void *cd,
   2834   Tcl_Interp *interp,
   2835   int objc,
   2836   Tcl_Obj *const*objv
   2837 ){
   2838   return Tcl_NRCallObjProc(interp, DbObjCmd, cd, objc, objv);
   2839 }
   2840 #endif /* SQLITE_TCL_NRE */
   2841 
   2842 /*
   2843 **   sqlite3 DBNAME FILENAME ?-vfs VFSNAME? ?-key KEY? ?-readonly BOOLEAN?
   2844 **                           ?-create BOOLEAN? ?-nomutex BOOLEAN?
   2845 **
   2846 ** This is the main Tcl command.  When the "sqlite" Tcl command is
   2847 ** invoked, this routine runs to process that command.
   2848 **
   2849 ** The first argument, DBNAME, is an arbitrary name for a new
   2850 ** database connection.  This command creates a new command named
   2851 ** DBNAME that is used to control that connection.  The database
   2852 ** connection is deleted when the DBNAME command is deleted.
   2853 **
   2854 ** The second argument is the name of the database file.
   2855 **
   2856 */
   2857 static int DbMain(void *cd, Tcl_Interp *interp, int objc,Tcl_Obj *const*objv){
   2858   SqliteDb *p;
   2859   void *pKey = 0;
   2860   int nKey = 0;
   2861   const char *zArg;
   2862   char *zErrMsg;
   2863   int i;
   2864   const char *zFile;
   2865   const char *zVfs = 0;
   2866   int flags;
   2867   Tcl_DString translatedFilename;
   2868 
   2869   /* In normal use, each TCL interpreter runs in a single thread.  So
   2870   ** by default, we can turn of mutexing on SQLite database connections.
   2871   ** However, for testing purposes it is useful to have mutexes turned
   2872   ** on.  So, by default, mutexes default off.  But if compiled with
   2873   ** SQLITE_TCL_DEFAULT_FULLMUTEX then mutexes default on.
   2874   */
   2875 #ifdef SQLITE_TCL_DEFAULT_FULLMUTEX
   2876   flags = SQLITE_OPEN_READWRITE | SQLITE_OPEN_CREATE | SQLITE_OPEN_FULLMUTEX;
   2877 #else
   2878   flags = SQLITE_OPEN_READWRITE | SQLITE_OPEN_CREATE | SQLITE_OPEN_NOMUTEX;
   2879 #endif
   2880 
   2881   if( objc==2 ){
   2882     zArg = Tcl_GetStringFromObj(objv[1], 0);
   2883     if( strcmp(zArg,"-version")==0 ){
   2884       Tcl_AppendResult(interp,sqlite3_version,0);
   2885       return TCL_OK;
   2886     }
   2887     if( strcmp(zArg,"-has-codec")==0 ){
   2888 #ifdef SQLITE_HAS_CODEC
   2889       Tcl_AppendResult(interp,"1",0);
   2890 #else
   2891       Tcl_AppendResult(interp,"0",0);
   2892 #endif
   2893       return TCL_OK;
   2894     }
   2895   }
   2896   for(i=3; i+1<objc; i+=2){
   2897     zArg = Tcl_GetString(objv[i]);
   2898     if( strcmp(zArg,"-key")==0 ){
   2899       pKey = Tcl_GetByteArrayFromObj(objv[i+1], &nKey);
   2900     }else if( strcmp(zArg, "-vfs")==0 ){
   2901       zVfs = Tcl_GetString(objv[i+1]);
   2902     }else if( strcmp(zArg, "-readonly")==0 ){
   2903       int b;
   2904       if( Tcl_GetBooleanFromObj(interp, objv[i+1], &b) ) return TCL_ERROR;
   2905       if( b ){
   2906         flags &= ~(SQLITE_OPEN_READWRITE|SQLITE_OPEN_CREATE);
   2907         flags |= SQLITE_OPEN_READONLY;
   2908       }else{
   2909         flags &= ~SQLITE_OPEN_READONLY;
   2910         flags |= SQLITE_OPEN_READWRITE;
   2911       }
   2912     }else if( strcmp(zArg, "-create")==0 ){
   2913       int b;
   2914       if( Tcl_GetBooleanFromObj(interp, objv[i+1], &b) ) return TCL_ERROR;
   2915       if( b && (flags & SQLITE_OPEN_READONLY)==0 ){
   2916         flags |= SQLITE_OPEN_CREATE;
   2917       }else{
   2918         flags &= ~SQLITE_OPEN_CREATE;
   2919       }
   2920     }else if( strcmp(zArg, "-nomutex")==0 ){
   2921       int b;
   2922       if( Tcl_GetBooleanFromObj(interp, objv[i+1], &b) ) return TCL_ERROR;
   2923       if( b ){
   2924         flags |= SQLITE_OPEN_NOMUTEX;
   2925         flags &= ~SQLITE_OPEN_FULLMUTEX;
   2926       }else{
   2927         flags &= ~SQLITE_OPEN_NOMUTEX;
   2928       }
   2929    }else if( strcmp(zArg, "-fullmutex")==0 ){
   2930       int b;
   2931       if( Tcl_GetBooleanFromObj(interp, objv[i+1], &b) ) return TCL_ERROR;
   2932       if( b ){
   2933         flags |= SQLITE_OPEN_FULLMUTEX;
   2934         flags &= ~SQLITE_OPEN_NOMUTEX;
   2935       }else{
   2936         flags &= ~SQLITE_OPEN_FULLMUTEX;
   2937       }
   2938     }else{
   2939       Tcl_AppendResult(interp, "unknown option: ", zArg, (char*)0);
   2940       return TCL_ERROR;
   2941     }
   2942   }
   2943   if( objc<3 || (objc&1)!=1 ){
   2944     Tcl_WrongNumArgs(interp, 1, objv,
   2945       "HANDLE FILENAME ?-vfs VFSNAME? ?-readonly BOOLEAN? ?-create BOOLEAN?"
   2946       " ?-nomutex BOOLEAN? ?-fullmutex BOOLEAN?"
   2947 #ifdef SQLITE_HAS_CODEC
   2948       " ?-key CODECKEY?"
   2949 #endif
   2950     );
   2951     return TCL_ERROR;
   2952   }
   2953   zErrMsg = 0;
   2954   p = (SqliteDb*)Tcl_Alloc( sizeof(*p) );
   2955   if( p==0 ){
   2956     Tcl_SetResult(interp, "malloc failed", TCL_STATIC);
   2957     return TCL_ERROR;
   2958   }
   2959   memset(p, 0, sizeof(*p));
   2960   zFile = Tcl_GetStringFromObj(objv[2], 0);
   2961   zFile = Tcl_TranslateFileName(interp, zFile, &translatedFilename);
   2962   sqlite3_open_v2(zFile, &p->db, flags, zVfs);
   2963   Tcl_DStringFree(&translatedFilename);
   2964   if( SQLITE_OK!=sqlite3_errcode(p->db) ){
   2965     zErrMsg = sqlite3_mprintf("%s", sqlite3_errmsg(p->db));
   2966     sqlite3_close(p->db);
   2967     p->db = 0;
   2968   }
   2969 #ifdef SQLITE_HAS_CODEC
   2970   if( p->db ){
   2971     sqlite3_key(p->db, pKey, nKey);
   2972   }
   2973 #endif
   2974   if( p->db==0 ){
   2975     Tcl_SetResult(interp, zErrMsg, TCL_VOLATILE);
   2976     Tcl_Free((char*)p);
   2977     sqlite3_free(zErrMsg);
   2978     return TCL_ERROR;
   2979   }
   2980   p->maxStmt = NUM_PREPARED_STMTS;
   2981   p->interp = interp;
   2982   zArg = Tcl_GetStringFromObj(objv[1], 0);
   2983   if( DbUseNre() ){
   2984     Tcl_NRCreateCommand(interp, zArg, DbObjCmdAdaptor, DbObjCmd,
   2985                         (char*)p, DbDeleteCmd);
   2986   }else{
   2987     Tcl_CreateObjCommand(interp, zArg, DbObjCmd, (char*)p, DbDeleteCmd);
   2988   }
   2989   return TCL_OK;
   2990 }
   2991 
   2992 /*
   2993 ** Provide a dummy Tcl_InitStubs if we are using this as a static
   2994 ** library.
   2995 */
   2996 #ifndef USE_TCL_STUBS
   2997 # undef  Tcl_InitStubs
   2998 # define Tcl_InitStubs(a,b,c)
   2999 #endif
   3000 
   3001 /*
   3002 ** Make sure we have a PACKAGE_VERSION macro defined.  This will be
   3003 ** defined automatically by the TEA makefile.  But other makefiles
   3004 ** do not define it.
   3005 */
   3006 #ifndef PACKAGE_VERSION
   3007 # define PACKAGE_VERSION SQLITE_VERSION
   3008 #endif
   3009 
   3010 /*
   3011 ** Initialize this module.
   3012 **
   3013 ** This Tcl module contains only a single new Tcl command named "sqlite".
   3014 ** (Hence there is no namespace.  There is no point in using a namespace
   3015 ** if the extension only supplies one new name!)  The "sqlite" command is
   3016 ** used to open a new SQLite database.  See the DbMain() routine above
   3017 ** for additional information.
   3018 **
   3019 ** The EXTERN macros are required by TCL in order to work on windows.
   3020 */
   3021 EXTERN int Sqlite3_Init(Tcl_Interp *interp){
   3022   Tcl_InitStubs(interp, "8.4", 0);
   3023   Tcl_CreateObjCommand(interp, "sqlite3", (Tcl_ObjCmdProc*)DbMain, 0, 0);
   3024   Tcl_PkgProvide(interp, "sqlite3", PACKAGE_VERSION);
   3025 
   3026 #ifndef SQLITE_3_SUFFIX_ONLY
   3027   /* The "sqlite" alias is undocumented.  It is here only to support
   3028   ** legacy scripts.  All new scripts should use only the "sqlite3"
   3029   ** command.
   3030   */
   3031   Tcl_CreateObjCommand(interp, "sqlite", (Tcl_ObjCmdProc*)DbMain, 0, 0);
   3032 #endif
   3033 
   3034   return TCL_OK;
   3035 }
   3036 EXTERN int Tclsqlite3_Init(Tcl_Interp *interp){ return Sqlite3_Init(interp); }
   3037 EXTERN int Sqlite3_SafeInit(Tcl_Interp *interp){ return TCL_OK; }
   3038 EXTERN int Tclsqlite3_SafeInit(Tcl_Interp *interp){ return TCL_OK; }
   3039 EXTERN int Sqlite3_Unload(Tcl_Interp *interp, int flags){ return TCL_OK; }
   3040 EXTERN int Tclsqlite3_Unload(Tcl_Interp *interp, int flags){ return TCL_OK; }
   3041 EXTERN int Sqlite3_SafeUnload(Tcl_Interp *interp, int flags){ return TCL_OK; }
   3042 EXTERN int Tclsqlite3_SafeUnload(Tcl_Interp *interp, int flags){ return TCL_OK;}
   3043 
   3044 
   3045 #ifndef SQLITE_3_SUFFIX_ONLY
   3046 int Sqlite_Init(Tcl_Interp *interp){ return Sqlite3_Init(interp); }
   3047 int Tclsqlite_Init(Tcl_Interp *interp){ return Sqlite3_Init(interp); }
   3048 int Sqlite_SafeInit(Tcl_Interp *interp){ return TCL_OK; }
   3049 int Tclsqlite_SafeInit(Tcl_Interp *interp){ return TCL_OK; }
   3050 int Sqlite_Unload(Tcl_Interp *interp, int flags){ return TCL_OK; }
   3051 int Tclsqlite_Unload(Tcl_Interp *interp, int flags){ return TCL_OK; }
   3052 int Sqlite_SafeUnload(Tcl_Interp *interp, int flags){ return TCL_OK; }
   3053 int Tclsqlite_SafeUnload(Tcl_Interp *interp, int flags){ return TCL_OK;}
   3054 #endif
   3055 
   3056 #ifdef TCLSH
   3057 /*****************************************************************************
   3058 ** All of the code that follows is used to build standalone TCL interpreters
   3059 ** that are statically linked with SQLite.  Enable these by compiling
   3060 ** with -DTCLSH=n where n can be 1 or 2.  An n of 1 generates a standard
   3061 ** tclsh but with SQLite built in.  An n of 2 generates the SQLite space
   3062 ** analysis program.
   3063 */
   3064 
   3065 #if defined(SQLITE_TEST) || defined(SQLITE_TCLMD5)
   3066 /*
   3067  * This code implements the MD5 message-digest algorithm.
   3068  * The algorithm is due to Ron Rivest.  This code was
   3069  * written by Colin Plumb in 1993, no copyright is claimed.
   3070  * This code is in the public domain; do with it what you wish.
   3071  *
   3072  * Equivalent code is available from RSA Data Security, Inc.
   3073  * This code has been tested against that, and is equivalent,
   3074  * except that you don't need to include two pages of legalese
   3075  * with every copy.
   3076  *
   3077  * To compute the message digest of a chunk of bytes, declare an
   3078  * MD5Context structure, pass it to MD5Init, call MD5Update as
   3079  * needed on buffers full of bytes, and then call MD5Final, which
   3080  * will fill a supplied 16-byte array with the digest.
   3081  */
   3082 
   3083 /*
   3084  * If compiled on a machine that doesn't have a 32-bit integer,
   3085  * you just set "uint32" to the appropriate datatype for an
   3086  * unsigned 32-bit integer.  For example:
   3087  *
   3088  *       cc -Duint32='unsigned long' md5.c
   3089  *
   3090  */
   3091 #ifndef uint32
   3092 #  define uint32 unsigned int
   3093 #endif
   3094 
   3095 struct MD5Context {
   3096   int isInit;
   3097   uint32 buf[4];
   3098   uint32 bits[2];
   3099   unsigned char in[64];
   3100 };
   3101 typedef struct MD5Context MD5Context;
   3102 
   3103 /*
   3104  * Note: this code is harmless on little-endian machines.
   3105  */
   3106 static void byteReverse (unsigned char *buf, unsigned longs){
   3107         uint32 t;
   3108         do {
   3109                 t = (uint32)((unsigned)buf[3]<<8 | buf[2]) << 16 |
   3110                             ((unsigned)buf[1]<<8 | buf[0]);
   3111                 *(uint32 *)buf = t;
   3112                 buf += 4;
   3113         } while (--longs);
   3114 }
   3115 /* The four core functions - F1 is optimized somewhat */
   3116 
   3117 /* #define F1(x, y, z) (x & y | ~x & z) */
   3118 #define F1(x, y, z) (z ^ (x & (y ^ z)))
   3119 #define F2(x, y, z) F1(z, x, y)
   3120 #define F3(x, y, z) (x ^ y ^ z)
   3121 #define F4(x, y, z) (y ^ (x | ~z))
   3122 
   3123 /* This is the central step in the MD5 algorithm. */
   3124 #define MD5STEP(f, w, x, y, z, data, s) \
   3125         ( w += f(x, y, z) + data,  w = w<<s | w>>(32-s),  w += x )
   3126 
   3127 /*
   3128  * The core of the MD5 algorithm, this alters an existing MD5 hash to
   3129  * reflect the addition of 16 longwords of new data.  MD5Update blocks
   3130  * the data and converts bytes into longwords for this routine.
   3131  */
   3132 static void MD5Transform(uint32 buf[4], const uint32 in[16]){
   3133         register uint32 a, b, c, d;
   3134 
   3135         a = buf[0];
   3136         b = buf[1];
   3137         c = buf[2];
   3138         d = buf[3];
   3139 
   3140         MD5STEP(F1, a, b, c, d, in[ 0]+0xd76aa478,  7);
   3141         MD5STEP(F1, d, a, b, c, in[ 1]+0xe8c7b756, 12);
   3142         MD5STEP(F1, c, d, a, b, in[ 2]+0x242070db, 17);
   3143         MD5STEP(F1, b, c, d, a, in[ 3]+0xc1bdceee, 22);
   3144         MD5STEP(F1, a, b, c, d, in[ 4]+0xf57c0faf,  7);
   3145         MD5STEP(F1, d, a, b, c, in[ 5]+0x4787c62a, 12);
   3146         MD5STEP(F1, c, d, a, b, in[ 6]+0xa8304613, 17);
   3147         MD5STEP(F1, b, c, d, a, in[ 7]+0xfd469501, 22);
   3148         MD5STEP(F1, a, b, c, d, in[ 8]+0x698098d8,  7);
   3149         MD5STEP(F1, d, a, b, c, in[ 9]+0x8b44f7af, 12);
   3150         MD5STEP(F1, c, d, a, b, in[10]+0xffff5bb1, 17);
   3151         MD5STEP(F1, b, c, d, a, in[11]+0x895cd7be, 22);
   3152         MD5STEP(F1, a, b, c, d, in[12]+0x6b901122,  7);
   3153         MD5STEP(F1, d, a, b, c, in[13]+0xfd987193, 12);
   3154         MD5STEP(F1, c, d, a, b, in[14]+0xa679438e, 17);
   3155         MD5STEP(F1, b, c, d, a, in[15]+0x49b40821, 22);
   3156 
   3157         MD5STEP(F2, a, b, c, d, in[ 1]+0xf61e2562,  5);
   3158         MD5STEP(F2, d, a, b, c, in[ 6]+0xc040b340,  9);
   3159         MD5STEP(F2, c, d, a, b, in[11]+0x265e5a51, 14);
   3160         MD5STEP(F2, b, c, d, a, in[ 0]+0xe9b6c7aa, 20);
   3161         MD5STEP(F2, a, b, c, d, in[ 5]+0xd62f105d,  5);
   3162         MD5STEP(F2, d, a, b, c, in[10]+0x02441453,  9);
   3163         MD5STEP(F2, c, d, a, b, in[15]+0xd8a1e681, 14);
   3164         MD5STEP(F2, b, c, d, a, in[ 4]+0xe7d3fbc8, 20);
   3165         MD5STEP(F2, a, b, c, d, in[ 9]+0x21e1cde6,  5);
   3166         MD5STEP(F2, d, a, b, c, in[14]+0xc33707d6,  9);
   3167         MD5STEP(F2, c, d, a, b, in[ 3]+0xf4d50d87, 14);
   3168         MD5STEP(F2, b, c, d, a, in[ 8]+0x455a14ed, 20);
   3169         MD5STEP(F2, a, b, c, d, in[13]+0xa9e3e905,  5);
   3170         MD5STEP(F2, d, a, b, c, in[ 2]+0xfcefa3f8,  9);
   3171         MD5STEP(F2, c, d, a, b, in[ 7]+0x676f02d9, 14);
   3172         MD5STEP(F2, b, c, d, a, in[12]+0x8d2a4c8a, 20);
   3173 
   3174         MD5STEP(F3, a, b, c, d, in[ 5]+0xfffa3942,  4);
   3175         MD5STEP(F3, d, a, b, c, in[ 8]+0x8771f681, 11);
   3176         MD5STEP(F3, c, d, a, b, in[11]+0x6d9d6122, 16);
   3177         MD5STEP(F3, b, c, d, a, in[14]+0xfde5380c, 23);
   3178         MD5STEP(F3, a, b, c, d, in[ 1]+0xa4beea44,  4);
   3179         MD5STEP(F3, d, a, b, c, in[ 4]+0x4bdecfa9, 11);
   3180         MD5STEP(F3, c, d, a, b, in[ 7]+0xf6bb4b60, 16);
   3181         MD5STEP(F3, b, c, d, a, in[10]+0xbebfbc70, 23);
   3182         MD5STEP(F3, a, b, c, d, in[13]+0x289b7ec6,  4);
   3183         MD5STEP(F3, d, a, b, c, in[ 0]+0xeaa127fa, 11);
   3184         MD5STEP(F3, c, d, a, b, in[ 3]+0xd4ef3085, 16);
   3185         MD5STEP(F3, b, c, d, a, in[ 6]+0x04881d05, 23);
   3186         MD5STEP(F3, a, b, c, d, in[ 9]+0xd9d4d039,  4);
   3187         MD5STEP(F3, d, a, b, c, in[12]+0xe6db99e5, 11);
   3188         MD5STEP(F3, c, d, a, b, in[15]+0x1fa27cf8, 16);
   3189         MD5STEP(F3, b, c, d, a, in[ 2]+0xc4ac5665, 23);
   3190 
   3191         MD5STEP(F4, a, b, c, d, in[ 0]+0xf4292244,  6);
   3192         MD5STEP(F4, d, a, b, c, in[ 7]+0x432aff97, 10);
   3193         MD5STEP(F4, c, d, a, b, in[14]+0xab9423a7, 15);
   3194         MD5STEP(F4, b, c, d, a, in[ 5]+0xfc93a039, 21);
   3195         MD5STEP(F4, a, b, c, d, in[12]+0x655b59c3,  6);
   3196         MD5STEP(F4, d, a, b, c, in[ 3]+0x8f0ccc92, 10);
   3197         MD5STEP(F4, c, d, a, b, in[10]+0xffeff47d, 15);
   3198         MD5STEP(F4, b, c, d, a, in[ 1]+0x85845dd1, 21);
   3199         MD5STEP(F4, a, b, c, d, in[ 8]+0x6fa87e4f,  6);
   3200         MD5STEP(F4, d, a, b, c, in[15]+0xfe2ce6e0, 10);
   3201         MD5STEP(F4, c, d, a, b, in[ 6]+0xa3014314, 15);
   3202         MD5STEP(F4, b, c, d, a, in[13]+0x4e0811a1, 21);
   3203         MD5STEP(F4, a, b, c, d, in[ 4]+0xf7537e82,  6);
   3204         MD5STEP(F4, d, a, b, c, in[11]+0xbd3af235, 10);
   3205         MD5STEP(F4, c, d, a, b, in[ 2]+0x2ad7d2bb, 15);
   3206         MD5STEP(F4, b, c, d, a, in[ 9]+0xeb86d391, 21);
   3207 
   3208         buf[0] += a;
   3209         buf[1] += b;
   3210         buf[2] += c;
   3211         buf[3] += d;
   3212 }
   3213 
   3214 /*
   3215  * Start MD5 accumulation.  Set bit count to 0 and buffer to mysterious
   3216  * initialization constants.
   3217  */
   3218 static void MD5Init(MD5Context *ctx){
   3219         ctx->isInit = 1;
   3220         ctx->buf[0] = 0x67452301;
   3221         ctx->buf[1] = 0xefcdab89;
   3222         ctx->buf[2] = 0x98badcfe;
   3223         ctx->buf[3] = 0x10325476;
   3224         ctx->bits[0] = 0;
   3225         ctx->bits[1] = 0;
   3226 }
   3227 
   3228 /*
   3229  * Update context to reflect the concatenation of another buffer full
   3230  * of bytes.
   3231  */
   3232 static
   3233 void MD5Update(MD5Context *ctx, const unsigned char *buf, unsigned int len){
   3234         uint32 t;
   3235 
   3236         /* Update bitcount */
   3237 
   3238         t = ctx->bits[0];
   3239         if ((ctx->bits[0] = t + ((uint32)len << 3)) < t)
   3240                 ctx->bits[1]++; /* Carry from low to high */
   3241         ctx->bits[1] += len >> 29;
   3242 
   3243         t = (t >> 3) & 0x3f;    /* Bytes already in shsInfo->data */
   3244 
   3245         /* Handle any leading odd-sized chunks */
   3246 
   3247         if ( t ) {
   3248                 unsigned char *p = (unsigned char *)ctx->in + t;
   3249 
   3250                 t = 64-t;
   3251                 if (len < t) {
   3252                         memcpy(p, buf, len);
   3253                         return;
   3254                 }
   3255                 memcpy(p, buf, t);
   3256                 byteReverse(ctx->in, 16);
   3257                 MD5Transform(ctx->buf, (uint32 *)ctx->in);
   3258                 buf += t;
   3259                 len -= t;
   3260         }
   3261 
   3262         /* Process data in 64-byte chunks */
   3263 
   3264         while (len >= 64) {
   3265                 memcpy(ctx->in, buf, 64);
   3266                 byteReverse(ctx->in, 16);
   3267                 MD5Transform(ctx->buf, (uint32 *)ctx->in);
   3268                 buf += 64;
   3269                 len -= 64;
   3270         }
   3271 
   3272         /* Handle any remaining bytes of data. */
   3273 
   3274         memcpy(ctx->in, buf, len);
   3275 }
   3276 
   3277 /*
   3278  * Final wrapup - pad to 64-byte boundary with the bit pattern
   3279  * 1 0* (64-bit count of bits processed, MSB-first)
   3280  */
   3281 static void MD5Final(unsigned char digest[16], MD5Context *ctx){
   3282         unsigned count;
   3283         unsigned char *p;
   3284 
   3285         /* Compute number of bytes mod 64 */
   3286         count = (ctx->bits[0] >> 3) & 0x3F;
   3287 
   3288         /* Set the first char of padding to 0x80.  This is safe since there is
   3289            always at least one byte free */
   3290         p = ctx->in + count;
   3291         *p++ = 0x80;
   3292 
   3293         /* Bytes of padding needed to make 64 bytes */
   3294         count = 64 - 1 - count;
   3295 
   3296         /* Pad out to 56 mod 64 */
   3297         if (count < 8) {
   3298                 /* Two lots of padding:  Pad the first block to 64 bytes */
   3299                 memset(p, 0, count);
   3300                 byteReverse(ctx->in, 16);
   3301                 MD5Transform(ctx->buf, (uint32 *)ctx->in);
   3302 
   3303                 /* Now fill the next block with 56 bytes */
   3304                 memset(ctx->in, 0, 56);
   3305         } else {
   3306                 /* Pad block to 56 bytes */
   3307                 memset(p, 0, count-8);
   3308         }
   3309         byteReverse(ctx->in, 14);
   3310 
   3311         /* Append length in bits and transform */
   3312         ((uint32 *)ctx->in)[ 14 ] = ctx->bits[0];
   3313         ((uint32 *)ctx->in)[ 15 ] = ctx->bits[1];
   3314 
   3315         MD5Transform(ctx->buf, (uint32 *)ctx->in);
   3316         byteReverse((unsigned char *)ctx->buf, 4);
   3317         memcpy(digest, ctx->buf, 16);
   3318         memset(ctx, 0, sizeof(ctx));    /* In case it is sensitive */
   3319 }
   3320 
   3321 /*
   3322 ** Convert a 128-bit MD5 digest into a 32-digit base-16 number.
   3323 */
   3324 static void MD5DigestToBase16(unsigned char *digest, char *zBuf){
   3325   static char const zEncode[] = "0123456789abcdef";
   3326   int i, j;
   3327 
   3328   for(j=i=0; i<16; i++){
   3329     int a = digest[i];
   3330     zBuf[j++] = zEncode[(a>>4)&0xf];
   3331     zBuf[j++] = zEncode[a & 0xf];
   3332   }
   3333   zBuf[j] = 0;
   3334 }
   3335 
   3336 
   3337 /*
   3338 ** Convert a 128-bit MD5 digest into sequency of eight 5-digit integers
   3339 ** each representing 16 bits of the digest and separated from each
   3340 ** other by a "-" character.
   3341 */
   3342 static void MD5DigestToBase10x8(unsigned char digest[16], char zDigest[50]){
   3343   int i, j;
   3344   unsigned int x;
   3345   for(i=j=0; i<16; i+=2){
   3346     x = digest[i]*256 + digest[i+1];
   3347     if( i>0 ) zDigest[j++] = '-';
   3348     sprintf(&zDigest[j], "%05u", x);
   3349     j += 5;
   3350   }
   3351   zDigest[j] = 0;
   3352 }
   3353 
   3354 /*
   3355 ** A TCL command for md5.  The argument is the text to be hashed.  The
   3356 ** Result is the hash in base64.
   3357 */
   3358 static int md5_cmd(void*cd, Tcl_Interp *interp, int argc, const char **argv){
   3359   MD5Context ctx;
   3360   unsigned char digest[16];
   3361   char zBuf[50];
   3362   void (*converter)(unsigned char*, char*);
   3363 
   3364   if( argc!=2 ){
   3365     Tcl_AppendResult(interp,"wrong # args: should be \"", argv[0],
   3366         " TEXT\"", 0);
   3367     return TCL_ERROR;
   3368   }
   3369   MD5Init(&ctx);
   3370   MD5Update(&ctx, (unsigned char*)argv[1], (unsigned)strlen(argv[1]));
   3371   MD5Final(digest, &ctx);
   3372   converter = (void(*)(unsigned char*,char*))cd;
   3373   converter(digest, zBuf);
   3374   Tcl_AppendResult(interp, zBuf, (char*)0);
   3375   return TCL_OK;
   3376 }
   3377 
   3378 /*
   3379 ** A TCL command to take the md5 hash of a file.  The argument is the
   3380 ** name of the file.
   3381 */
   3382 static int md5file_cmd(void*cd, Tcl_Interp*interp, int argc, const char **argv){
   3383   FILE *in;
   3384   MD5Context ctx;
   3385   void (*converter)(unsigned char*, char*);
   3386   unsigned char digest[16];
   3387   char zBuf[10240];
   3388 
   3389   if( argc!=2 ){
   3390     Tcl_AppendResult(interp,"wrong # args: should be \"", argv[0],
   3391         " FILENAME\"", 0);
   3392     return TCL_ERROR;
   3393   }
   3394   in = fopen(argv[1],"rb");
   3395   if( in==0 ){
   3396     Tcl_AppendResult(interp,"unable to open file \"", argv[1],
   3397          "\" for reading", 0);
   3398     return TCL_ERROR;
   3399   }
   3400   MD5Init(&ctx);
   3401   for(;;){
   3402     int n;
   3403     n = fread(zBuf, 1, sizeof(zBuf), in);
   3404     if( n<=0 ) break;
   3405     MD5Update(&ctx, (unsigned char*)zBuf, (unsigned)n);
   3406   }
   3407   fclose(in);
   3408   MD5Final(digest, &ctx);
   3409   converter = (void(*)(unsigned char*,char*))cd;
   3410   converter(digest, zBuf);
   3411   Tcl_AppendResult(interp, zBuf, (char*)0);
   3412   return TCL_OK;
   3413 }
   3414 
   3415 /*
   3416 ** Register the four new TCL commands for generating MD5 checksums
   3417 ** with the TCL interpreter.
   3418 */
   3419 int Md5_Init(Tcl_Interp *interp){
   3420   Tcl_CreateCommand(interp, "md5", (Tcl_CmdProc*)md5_cmd,
   3421                     MD5DigestToBase16, 0);
   3422   Tcl_CreateCommand(interp, "md5-10x8", (Tcl_CmdProc*)md5_cmd,
   3423                     MD5DigestToBase10x8, 0);
   3424   Tcl_CreateCommand(interp, "md5file", (Tcl_CmdProc*)md5file_cmd,
   3425                     MD5DigestToBase16, 0);
   3426   Tcl_CreateCommand(interp, "md5file-10x8", (Tcl_CmdProc*)md5file_cmd,
   3427                     MD5DigestToBase10x8, 0);
   3428   return TCL_OK;
   3429 }
   3430 #endif /* defined(SQLITE_TEST) || defined(SQLITE_TCLMD5) */
   3431 
   3432 #if defined(SQLITE_TEST)
   3433 /*
   3434 ** During testing, the special md5sum() aggregate function is available.
   3435 ** inside SQLite.  The following routines implement that function.
   3436 */
   3437 static void md5step(sqlite3_context *context, int argc, sqlite3_value **argv){
   3438   MD5Context *p;
   3439   int i;
   3440   if( argc<1 ) return;
   3441   p = sqlite3_aggregate_context(context, sizeof(*p));
   3442   if( p==0 ) return;
   3443   if( !p->isInit ){
   3444     MD5Init(p);
   3445   }
   3446   for(i=0; i<argc; i++){
   3447     const char *zData = (char*)sqlite3_value_text(argv[i]);
   3448     if( zData ){
   3449       MD5Update(p, (unsigned char*)zData, strlen(zData));
   3450     }
   3451   }
   3452 }
   3453 static void md5finalize(sqlite3_context *context){
   3454   MD5Context *p;
   3455   unsigned char digest[16];
   3456   char zBuf[33];
   3457   p = sqlite3_aggregate_context(context, sizeof(*p));
   3458   MD5Final(digest,p);
   3459   MD5DigestToBase16(digest, zBuf);
   3460   sqlite3_result_text(context, zBuf, -1, SQLITE_TRANSIENT);
   3461 }
   3462 int Md5_Register(sqlite3 *db){
   3463   int rc = sqlite3_create_function(db, "md5sum", -1, SQLITE_UTF8, 0, 0,
   3464                                  md5step, md5finalize);
   3465   sqlite3_overload_function(db, "md5sum", -1);  /* To exercise this API */
   3466   return rc;
   3467 }
   3468 #endif /* defined(SQLITE_TEST) */
   3469 
   3470 
   3471 /*
   3472 ** If the macro TCLSH is one, then put in code this for the
   3473 ** "main" routine that will initialize Tcl and take input from
   3474 ** standard input, or if a file is named on the command line
   3475 ** the TCL interpreter reads and evaluates that file.
   3476 */
   3477 #if TCLSH==1
   3478 static char zMainloop[] =
   3479   "set line {}\n"
   3480   "while {![eof stdin]} {\n"
   3481     "if {$line!=\"\"} {\n"
   3482       "puts -nonewline \"> \"\n"
   3483     "} else {\n"
   3484       "puts -nonewline \"% \"\n"
   3485     "}\n"
   3486     "flush stdout\n"
   3487     "append line [gets stdin]\n"
   3488     "if {[info complete $line]} {\n"
   3489       "if {[catch {uplevel #0 $line} result]} {\n"
   3490         "puts stderr \"Error: $result\"\n"
   3491       "} elseif {$result!=\"\"} {\n"
   3492         "puts $result\n"
   3493       "}\n"
   3494       "set line {}\n"
   3495     "} else {\n"
   3496       "append line \\n\n"
   3497     "}\n"
   3498   "}\n"
   3499 ;
   3500 #endif
   3501 #if TCLSH==2
   3502 static char zMainloop[] =
   3503 #include "spaceanal_tcl.h"
   3504 ;
   3505 #endif
   3506 
   3507 #ifdef SQLITE_TEST
   3508 static void init_all(Tcl_Interp *);
   3509 static int init_all_cmd(
   3510   ClientData cd,
   3511   Tcl_Interp *interp,
   3512   int objc,
   3513   Tcl_Obj *CONST objv[]
   3514 ){
   3515 
   3516   Tcl_Interp *slave;
   3517   if( objc!=2 ){
   3518     Tcl_WrongNumArgs(interp, 1, objv, "SLAVE");
   3519     return TCL_ERROR;
   3520   }
   3521 
   3522   slave = Tcl_GetSlave(interp, Tcl_GetString(objv[1]));
   3523   if( !slave ){
   3524     return TCL_ERROR;
   3525   }
   3526 
   3527   init_all(slave);
   3528   return TCL_OK;
   3529 }
   3530 #endif
   3531 
   3532 /*
   3533 ** Configure the interpreter passed as the first argument to have access
   3534 ** to the commands and linked variables that make up:
   3535 **
   3536 **   * the [sqlite3] extension itself,
   3537 **
   3538 **   * If SQLITE_TCLMD5 or SQLITE_TEST is defined, the Md5 commands, and
   3539 **
   3540 **   * If SQLITE_TEST is set, the various test interfaces used by the Tcl
   3541 **     test suite.
   3542 */
   3543 static void init_all(Tcl_Interp *interp){
   3544   Sqlite3_Init(interp);
   3545 
   3546 #if defined(SQLITE_TEST) || defined(SQLITE_TCLMD5)
   3547   Md5_Init(interp);
   3548 #endif
   3549 
   3550 #ifdef SQLITE_TEST
   3551   {
   3552     extern int Sqliteconfig_Init(Tcl_Interp*);
   3553     extern int Sqlitetest1_Init(Tcl_Interp*);
   3554     extern int Sqlitetest2_Init(Tcl_Interp*);
   3555     extern int Sqlitetest3_Init(Tcl_Interp*);
   3556     extern int Sqlitetest4_Init(Tcl_Interp*);
   3557     extern int Sqlitetest5_Init(Tcl_Interp*);
   3558     extern int Sqlitetest6_Init(Tcl_Interp*);
   3559     extern int Sqlitetest7_Init(Tcl_Interp*);
   3560     extern int Sqlitetest8_Init(Tcl_Interp*);
   3561     extern int Sqlitetest9_Init(Tcl_Interp*);
   3562     extern int Sqlitetestasync_Init(Tcl_Interp*);
   3563     extern int Sqlitetest_autoext_Init(Tcl_Interp*);
   3564     extern int Sqlitetest_demovfs_Init(Tcl_Interp *);
   3565     extern int Sqlitetest_func_Init(Tcl_Interp*);
   3566     extern int Sqlitetest_hexio_Init(Tcl_Interp*);
   3567     extern int Sqlitetest_init_Init(Tcl_Interp*);
   3568     extern int Sqlitetest_malloc_Init(Tcl_Interp*);
   3569     extern int Sqlitetest_mutex_Init(Tcl_Interp*);
   3570     extern int Sqlitetestschema_Init(Tcl_Interp*);
   3571     extern int Sqlitetestsse_Init(Tcl_Interp*);
   3572     extern int Sqlitetesttclvar_Init(Tcl_Interp*);
   3573     extern int SqlitetestThread_Init(Tcl_Interp*);
   3574     extern int SqlitetestOnefile_Init();
   3575     extern int SqlitetestOsinst_Init(Tcl_Interp*);
   3576     extern int Sqlitetestbackup_Init(Tcl_Interp*);
   3577     extern int Sqlitetestintarray_Init(Tcl_Interp*);
   3578     extern int Sqlitetestvfs_Init(Tcl_Interp *);
   3579     extern int SqlitetestStat_Init(Tcl_Interp*);
   3580     extern int Sqlitetestrtree_Init(Tcl_Interp*);
   3581     extern int Sqlitequota_Init(Tcl_Interp*);
   3582     extern int Sqlitemultiplex_Init(Tcl_Interp*);
   3583     extern int SqliteSuperlock_Init(Tcl_Interp*);
   3584     extern int SqlitetestSyscall_Init(Tcl_Interp*);
   3585     extern int Sqlitetestfuzzer_Init(Tcl_Interp*);
   3586     extern int Sqlitetestwholenumber_Init(Tcl_Interp*);
   3587 
   3588 #ifdef SQLITE_ENABLE_ZIPVFS
   3589     extern int Zipvfs_Init(Tcl_Interp*);
   3590     Zipvfs_Init(interp);
   3591 #endif
   3592 
   3593     Sqliteconfig_Init(interp);
   3594     Sqlitetest1_Init(interp);
   3595     Sqlitetest2_Init(interp);
   3596     Sqlitetest3_Init(interp);
   3597     Sqlitetest4_Init(interp);
   3598     Sqlitetest5_Init(interp);
   3599     Sqlitetest6_Init(interp);
   3600     Sqlitetest7_Init(interp);
   3601     Sqlitetest8_Init(interp);
   3602     Sqlitetest9_Init(interp);
   3603     Sqlitetestasync_Init(interp);
   3604     Sqlitetest_autoext_Init(interp);
   3605     Sqlitetest_demovfs_Init(interp);
   3606     Sqlitetest_func_Init(interp);
   3607     Sqlitetest_hexio_Init(interp);
   3608     Sqlitetest_init_Init(interp);
   3609     Sqlitetest_malloc_Init(interp);
   3610     Sqlitetest_mutex_Init(interp);
   3611     Sqlitetestschema_Init(interp);
   3612     Sqlitetesttclvar_Init(interp);
   3613     SqlitetestThread_Init(interp);
   3614     SqlitetestOnefile_Init(interp);
   3615     SqlitetestOsinst_Init(interp);
   3616     Sqlitetestbackup_Init(interp);
   3617     Sqlitetestintarray_Init(interp);
   3618     Sqlitetestvfs_Init(interp);
   3619     SqlitetestStat_Init(interp);
   3620     Sqlitetestrtree_Init(interp);
   3621     Sqlitequota_Init(interp);
   3622     Sqlitemultiplex_Init(interp);
   3623     SqliteSuperlock_Init(interp);
   3624     SqlitetestSyscall_Init(interp);
   3625     Sqlitetestfuzzer_Init(interp);
   3626     Sqlitetestwholenumber_Init(interp);
   3627 
   3628     Tcl_CreateObjCommand(interp,"load_testfixture_extensions",init_all_cmd,0,0);
   3629 
   3630 #ifdef SQLITE_SSE
   3631     Sqlitetestsse_Init(interp);
   3632 #endif
   3633   }
   3634 #endif
   3635 }
   3636 
   3637 #define TCLSH_MAIN main   /* Needed to fake out mktclapp */
   3638 int TCLSH_MAIN(int argc, char **argv){
   3639   Tcl_Interp *interp;
   3640 
   3641   /* Call sqlite3_shutdown() once before doing anything else. This is to
   3642   ** test that sqlite3_shutdown() can be safely called by a process before
   3643   ** sqlite3_initialize() is. */
   3644   sqlite3_shutdown();
   3645 
   3646 #if TCLSH==2
   3647   sqlite3_config(SQLITE_CONFIG_SINGLETHREAD);
   3648 #endif
   3649   Tcl_FindExecutable(argv[0]);
   3650 
   3651   interp = Tcl_CreateInterp();
   3652   init_all(interp);
   3653   if( argc>=2 ){
   3654     int i;
   3655     char zArgc[32];
   3656     sqlite3_snprintf(sizeof(zArgc), zArgc, "%d", argc-(3-TCLSH));
   3657     Tcl_SetVar(interp,"argc", zArgc, TCL_GLOBAL_ONLY);
   3658     Tcl_SetVar(interp,"argv0",argv[1],TCL_GLOBAL_ONLY);
   3659     Tcl_SetVar(interp,"argv", "", TCL_GLOBAL_ONLY);
   3660     for(i=3-TCLSH; i<argc; i++){
   3661       Tcl_SetVar(interp, "argv", argv[i],
   3662           TCL_GLOBAL_ONLY | TCL_LIST_ELEMENT | TCL_APPEND_VALUE);
   3663     }
   3664     if( TCLSH==1 && Tcl_EvalFile(interp, argv[1])!=TCL_OK ){
   3665       const char *zInfo = Tcl_GetVar(interp, "errorInfo", TCL_GLOBAL_ONLY);
   3666       if( zInfo==0 ) zInfo = Tcl_GetStringResult(interp);
   3667       fprintf(stderr,"%s: %s\n", *argv, zInfo);
   3668       return 1;
   3669     }
   3670   }
   3671   if( TCLSH==2 || argc<=1 ){
   3672     Tcl_GlobalEval(interp, zMainloop);
   3673   }
   3674   return 0;
   3675 }
   3676 #endif /* TCLSH */
   3677