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