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