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 */
strlen30(const char * z)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 */
closeIncrblobChannels(SqliteDb * pDb)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 */
incrblobClose(ClientData instanceData,Tcl_Interp * interp)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 */
incrblobInput(ClientData instanceData,char * buf,int bufSize,int * errorCodePtr)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 */
incrblobOutput(ClientData instanceData,CONST char * buf,int toWrite,int * errorCodePtr)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 */
incrblobSeek(ClientData instanceData,long offset,int seekMode,int * errorCodePtr)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
incrblobWatch(ClientData instanceData,int mode)303 static void incrblobWatch(ClientData instanceData, int mode){
304 /* NO-OP */
305 }
incrblobHandle(ClientData instanceData,int dir,ClientData * hPtr)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 */
createIncrblobChannel(Tcl_Interp * interp,SqliteDb * pDb,const char * zDb,const char * zTable,const char * zColumn,sqlite_int64 iRow,int isReadonly)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 */
safeToUseEvalObjv(Tcl_Interp * interp,Tcl_Obj * pCmd)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 */
findSqlFunc(SqliteDb * pDb,const char * zName)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 */
flushStmtCache(SqliteDb * pDb)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 */
DbDeleteCmd(void * db)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 */
DbBusyHandler(void * cd,int nTries)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 */
DbProgressHandler(void * cd)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 */
DbTraceHandler(void * cd,const char * zSql)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 */
DbProfileHandler(void * cd,const char * zSql,sqlite_uint64 tm)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 */
DbCommitHandler(void * cd)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
DbRollbackHandler(void * clientData)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 */
DbWalHandler(void * clientData,sqlite3 * db,const char * zDb,int nEntry)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)
setTestUnlockNotifyVars(Tcl_Interp * interp,int iArg,int nArg)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
DbUnlockNotify(void ** apArg,int nArg)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
DbUpdateHandler(void * p,int op,const char * zDb,const char * zTbl,sqlite_int64 rowid)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
tclCollateNeeded(void * pCtx,sqlite3 * db,int enc,const char * zName)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 */
tclSqlCollate(void * pCtx,int nA,const void * zA,int nB,const void * zB)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 */
tclSqlFunc(sqlite3_context * context,int argc,sqlite3_value ** argv)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 */
auth_callback(void * pArg,int code,const char * zArg1,const char * zArg2,const char * zArg3,const char * zArg4)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 */
dbTextToObj(char const * zText)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 */
local_getline(char * zPrompt,FILE * in)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 */
DbTransPostCmd(ClientData data[],Tcl_Interp * interp,int result)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 */
dbPrepareAndBind(SqliteDb * pDb,char const * zIn,char const ** pzOut,SqlPreparedStmt ** ppPreStmt)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 */
dbReleaseStmt(SqliteDb * pDb,SqlPreparedStmt * pPreStmt,int discard)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 */
dbReleaseColumnNames(DbEvalContext * p)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 */
dbEvalInit(DbEvalContext * p,SqliteDb * pDb,Tcl_Obj * pSql,Tcl_Obj * pArray)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 */
dbEvalRowInfo(DbEvalContext * p,int * pnCol,Tcl_Obj *** papColName)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 */
dbEvalStep(DbEvalContext * p)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 */
dbEvalFinalize(DbEvalContext * p)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 */
dbEvalColumnValue(DbEvalContext * p,int iCol)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
DbUseNre(void)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 */
DbEvalNextCmd(ClientData data[],Tcl_Interp * interp,int result)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 */
DbObjCmd(void * cd,Tcl_Interp * interp,int objc,Tcl_Obj * const * objv)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 */
DbObjCmdAdaptor(void * cd,Tcl_Interp * interp,int objc,Tcl_Obj * const * objv)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 */
DbMain(void * cd,Tcl_Interp * interp,int objc,Tcl_Obj * const * objv)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 */
Sqlite3_Init(Tcl_Interp * interp)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 }
Tclsqlite3_Init(Tcl_Interp * interp)3036 EXTERN int Tclsqlite3_Init(Tcl_Interp *interp){ return Sqlite3_Init(interp); }
Sqlite3_SafeInit(Tcl_Interp * interp)3037 EXTERN int Sqlite3_SafeInit(Tcl_Interp *interp){ return TCL_OK; }
Tclsqlite3_SafeInit(Tcl_Interp * interp)3038 EXTERN int Tclsqlite3_SafeInit(Tcl_Interp *interp){ return TCL_OK; }
Sqlite3_Unload(Tcl_Interp * interp,int flags)3039 EXTERN int Sqlite3_Unload(Tcl_Interp *interp, int flags){ return TCL_OK; }
Tclsqlite3_Unload(Tcl_Interp * interp,int flags)3040 EXTERN int Tclsqlite3_Unload(Tcl_Interp *interp, int flags){ return TCL_OK; }
Sqlite3_SafeUnload(Tcl_Interp * interp,int flags)3041 EXTERN int Sqlite3_SafeUnload(Tcl_Interp *interp, int flags){ return TCL_OK; }
Tclsqlite3_SafeUnload(Tcl_Interp * interp,int flags)3042 EXTERN int Tclsqlite3_SafeUnload(Tcl_Interp *interp, int flags){ return TCL_OK;}
3043
3044
3045 #ifndef SQLITE_3_SUFFIX_ONLY
Sqlite_Init(Tcl_Interp * interp)3046 int Sqlite_Init(Tcl_Interp *interp){ return Sqlite3_Init(interp); }
Tclsqlite_Init(Tcl_Interp * interp)3047 int Tclsqlite_Init(Tcl_Interp *interp){ return Sqlite3_Init(interp); }
Sqlite_SafeInit(Tcl_Interp * interp)3048 int Sqlite_SafeInit(Tcl_Interp *interp){ return TCL_OK; }
Tclsqlite_SafeInit(Tcl_Interp * interp)3049 int Tclsqlite_SafeInit(Tcl_Interp *interp){ return TCL_OK; }
Sqlite_Unload(Tcl_Interp * interp,int flags)3050 int Sqlite_Unload(Tcl_Interp *interp, int flags){ return TCL_OK; }
Tclsqlite_Unload(Tcl_Interp * interp,int flags)3051 int Tclsqlite_Unload(Tcl_Interp *interp, int flags){ return TCL_OK; }
Sqlite_SafeUnload(Tcl_Interp * interp,int flags)3052 int Sqlite_SafeUnload(Tcl_Interp *interp, int flags){ return TCL_OK; }
Tclsqlite_SafeUnload(Tcl_Interp * interp,int flags)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 */
byteReverse(unsigned char * buf,unsigned longs)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 */
MD5Transform(uint32 buf[4],const uint32 in[16])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 */
MD5Init(MD5Context * ctx)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
MD5Update(MD5Context * ctx,const unsigned char * buf,unsigned int len)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 */
MD5Final(unsigned char digest[16],MD5Context * ctx)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 */
MD5DigestToBase16(unsigned char * digest,char * zBuf)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 */
MD5DigestToBase10x8(unsigned char digest[16],char zDigest[50])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 */
md5_cmd(void * cd,Tcl_Interp * interp,int argc,const char ** argv)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 */
md5file_cmd(void * cd,Tcl_Interp * interp,int argc,const char ** argv)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 */
Md5_Init(Tcl_Interp * interp)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 */
md5step(sqlite3_context * context,int argc,sqlite3_value ** argv)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 }
md5finalize(sqlite3_context * context)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 }
Md5_Register(sqlite3 * db)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 *);
init_all_cmd(ClientData cd,Tcl_Interp * interp,int objc,Tcl_Obj * CONST objv[])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 */
init_all(Tcl_Interp * interp)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 */
TCLSH_MAIN(int argc,char ** argv)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