xref: /sqlite-3.40.0/src/test_vfs.c (revision 5313f2e1)
1 /*
2 ** 2010 May 05
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 **
13 ** This file contains the implementation of the Tcl [testvfs] command,
14 ** used to create SQLite VFS implementations with various properties and
15 ** instrumentation to support testing SQLite.
16 **
17 **   testvfs VFSNAME ?OPTIONS?
18 **
19 ** Available options are:
20 **
21 **   -noshm      BOOLEAN        (True to omit shm methods. Default false)
22 **   -default    BOOLEAN        (True to make the vfs default. Default false)
23 **   -szosfile   INTEGER        (Value for sqlite3_vfs.szOsFile)
24 **   -mxpathname INTEGER        (Value for sqlite3_vfs.mxPathname)
25 **   -iversion   INTEGER        (Value for sqlite3_vfs.iVersion)
26 */
27 #if SQLITE_TEST          /* This file is used for testing only */
28 
29 #include "sqlite3.h"
30 #include "sqliteInt.h"
31 #include <tcl.h>
32 
33 typedef struct Testvfs Testvfs;
34 typedef struct TestvfsShm TestvfsShm;
35 typedef struct TestvfsBuffer TestvfsBuffer;
36 typedef struct TestvfsFile TestvfsFile;
37 typedef struct TestvfsFd TestvfsFd;
38 
39 /*
40 ** An open file handle.
41 */
42 struct TestvfsFile {
43   sqlite3_file base;              /* Base class.  Must be first */
44   TestvfsFd *pFd;                 /* File data */
45 };
46 #define tvfsGetFd(pFile) (((TestvfsFile *)pFile)->pFd)
47 
48 struct TestvfsFd {
49   sqlite3_vfs *pVfs;              /* The VFS */
50   const char *zFilename;          /* Filename as passed to xOpen() */
51   sqlite3_file *pReal;            /* The real, underlying file descriptor */
52   Tcl_Obj *pShmId;                /* Shared memory id for Tcl callbacks */
53 
54   TestvfsBuffer *pShm;            /* Shared memory buffer */
55   u32 excllock;                   /* Mask of exclusive locks */
56   u32 sharedlock;                 /* Mask of shared locks */
57   TestvfsFd *pNext;               /* Next handle opened on the same file */
58 };
59 
60 
61 #define FAULT_INJECT_NONE       0
62 #define FAULT_INJECT_TRANSIENT  1
63 #define FAULT_INJECT_PERSISTENT 2
64 
65 typedef struct TestFaultInject TestFaultInject;
66 struct TestFaultInject {
67   int iCnt;                       /* Remaining calls before fault injection */
68   int eFault;                     /* A FAULT_INJECT_* value */
69   int nFail;                      /* Number of faults injected */
70 };
71 
72 /*
73 ** An instance of this structure is allocated for each VFS created. The
74 ** sqlite3_vfs.pAppData field of the VFS structure registered with SQLite
75 ** is set to point to it.
76 */
77 struct Testvfs {
78   char *zName;                    /* Name of this VFS */
79   sqlite3_vfs *pParent;           /* The VFS to use for file IO */
80   sqlite3_vfs *pVfs;              /* The testvfs registered with SQLite */
81   Tcl_Interp *interp;             /* Interpreter to run script in */
82   Tcl_Obj *pScript;               /* Script to execute */
83   TestvfsBuffer *pBuffer;         /* List of shared buffers */
84   int isNoshm;
85   int isFullshm;
86 
87   int mask;                       /* Mask controlling [script] and [ioerr] */
88 
89   TestFaultInject ioerr_err;
90   TestFaultInject full_err;
91   TestFaultInject cantopen_err;
92 
93 #if 0
94   int iIoerrCnt;
95   int ioerr;
96   int nIoerrFail;
97   int iFullCnt;
98   int fullerr;
99   int nFullFail;
100 #endif
101 
102   int iDevchar;
103   int iSectorsize;
104 };
105 
106 /*
107 ** The Testvfs.mask variable is set to a combination of the following.
108 ** If a bit is clear in Testvfs.mask, then calls made by SQLite to the
109 ** corresponding VFS method is ignored for purposes of:
110 **
111 **   + Simulating IO errors, and
112 **   + Invoking the Tcl callback script.
113 */
114 #define TESTVFS_SHMOPEN_MASK      0x00000001
115 #define TESTVFS_SHMLOCK_MASK      0x00000010
116 #define TESTVFS_SHMMAP_MASK       0x00000020
117 #define TESTVFS_SHMBARRIER_MASK   0x00000040
118 #define TESTVFS_SHMCLOSE_MASK     0x00000080
119 
120 #define TESTVFS_OPEN_MASK         0x00000100
121 #define TESTVFS_SYNC_MASK         0x00000200
122 #define TESTVFS_DELETE_MASK       0x00000400
123 #define TESTVFS_CLOSE_MASK        0x00000800
124 #define TESTVFS_WRITE_MASK        0x00001000
125 #define TESTVFS_TRUNCATE_MASK     0x00002000
126 #define TESTVFS_ACCESS_MASK       0x00004000
127 #define TESTVFS_FULLPATHNAME_MASK 0x00008000
128 #define TESTVFS_READ_MASK         0x00010000
129 #define TESTVFS_UNLOCK_MASK       0x00020000
130 #define TESTVFS_LOCK_MASK         0x00040000
131 #define TESTVFS_CKLOCK_MASK       0x00080000
132 
133 #define TESTVFS_ALL_MASK          0x000FFFFF
134 
135 
136 #define TESTVFS_MAX_PAGES 1024
137 
138 /*
139 ** A shared-memory buffer. There is one of these objects for each shared
140 ** memory region opened by clients. If two clients open the same file,
141 ** there are two TestvfsFile structures but only one TestvfsBuffer structure.
142 */
143 struct TestvfsBuffer {
144   char *zFile;                    /* Associated file name */
145   int pgsz;                       /* Page size */
146   u8 *aPage[TESTVFS_MAX_PAGES];   /* Array of ckalloc'd pages */
147   TestvfsFd *pFile;               /* List of open handles */
148   TestvfsBuffer *pNext;           /* Next in linked list of all buffers */
149 };
150 
151 
152 #define PARENTVFS(x) (((Testvfs *)((x)->pAppData))->pParent)
153 
154 #define TESTVFS_MAX_ARGS 12
155 
156 
157 /*
158 ** Method declarations for TestvfsFile.
159 */
160 static int tvfsClose(sqlite3_file*);
161 static int tvfsRead(sqlite3_file*, void*, int iAmt, sqlite3_int64 iOfst);
162 static int tvfsWrite(sqlite3_file*,const void*,int iAmt, sqlite3_int64 iOfst);
163 static int tvfsTruncate(sqlite3_file*, sqlite3_int64 size);
164 static int tvfsSync(sqlite3_file*, int flags);
165 static int tvfsFileSize(sqlite3_file*, sqlite3_int64 *pSize);
166 static int tvfsLock(sqlite3_file*, int);
167 static int tvfsUnlock(sqlite3_file*, int);
168 static int tvfsCheckReservedLock(sqlite3_file*, int *);
169 static int tvfsFileControl(sqlite3_file*, int op, void *pArg);
170 static int tvfsSectorSize(sqlite3_file*);
171 static int tvfsDeviceCharacteristics(sqlite3_file*);
172 
173 /*
174 ** Method declarations for tvfs_vfs.
175 */
176 static int tvfsOpen(sqlite3_vfs*, const char *, sqlite3_file*, int , int *);
177 static int tvfsDelete(sqlite3_vfs*, const char *zName, int syncDir);
178 static int tvfsAccess(sqlite3_vfs*, const char *zName, int flags, int *);
179 static int tvfsFullPathname(sqlite3_vfs*, const char *zName, int, char *zOut);
180 #ifndef SQLITE_OMIT_LOAD_EXTENSION
181 static void *tvfsDlOpen(sqlite3_vfs*, const char *zFilename);
182 static void tvfsDlError(sqlite3_vfs*, int nByte, char *zErrMsg);
183 static void (*tvfsDlSym(sqlite3_vfs*,void*, const char *zSymbol))(void);
184 static void tvfsDlClose(sqlite3_vfs*, void*);
185 #endif /* SQLITE_OMIT_LOAD_EXTENSION */
186 static int tvfsRandomness(sqlite3_vfs*, int nByte, char *zOut);
187 static int tvfsSleep(sqlite3_vfs*, int microseconds);
188 static int tvfsCurrentTime(sqlite3_vfs*, double*);
189 
190 static int tvfsShmOpen(sqlite3_file*);
191 static int tvfsShmLock(sqlite3_file*, int , int, int);
192 static int tvfsShmMap(sqlite3_file*,int,int,int, void volatile **);
193 static void tvfsShmBarrier(sqlite3_file*);
194 static int tvfsShmUnmap(sqlite3_file*, int);
195 
196 static int tvfsFetch(sqlite3_file*, sqlite3_int64, int, void**);
197 static int tvfsUnfetch(sqlite3_file*, sqlite3_int64, void*);
198 
199 static sqlite3_io_methods tvfs_io_methods = {
200   3,                              /* iVersion */
201   tvfsClose,                      /* xClose */
202   tvfsRead,                       /* xRead */
203   tvfsWrite,                      /* xWrite */
204   tvfsTruncate,                   /* xTruncate */
205   tvfsSync,                       /* xSync */
206   tvfsFileSize,                   /* xFileSize */
207   tvfsLock,                       /* xLock */
208   tvfsUnlock,                     /* xUnlock */
209   tvfsCheckReservedLock,          /* xCheckReservedLock */
210   tvfsFileControl,                /* xFileControl */
211   tvfsSectorSize,                 /* xSectorSize */
212   tvfsDeviceCharacteristics,      /* xDeviceCharacteristics */
213   tvfsShmMap,                     /* xShmMap */
214   tvfsShmLock,                    /* xShmLock */
215   tvfsShmBarrier,                 /* xShmBarrier */
216   tvfsShmUnmap,                   /* xShmUnmap */
217   tvfsFetch,
218   tvfsUnfetch
219 };
220 
221 static int tvfsResultCode(Testvfs *p, int *pRc){
222   struct errcode {
223     int eCode;
224     const char *zCode;
225   } aCode[] = {
226     { SQLITE_OK,     "SQLITE_OK"     },
227     { SQLITE_ERROR,  "SQLITE_ERROR"  },
228     { SQLITE_IOERR,  "SQLITE_IOERR"  },
229     { SQLITE_LOCKED, "SQLITE_LOCKED" },
230     { SQLITE_BUSY,   "SQLITE_BUSY"   },
231   };
232 
233   const char *z;
234   int i;
235 
236   z = Tcl_GetStringResult(p->interp);
237   for(i=0; i<ArraySize(aCode); i++){
238     if( 0==strcmp(z, aCode[i].zCode) ){
239       *pRc = aCode[i].eCode;
240       return 1;
241     }
242   }
243 
244   return 0;
245 }
246 
247 static int tvfsInjectFault(TestFaultInject *p){
248   int ret = 0;
249   if( p->eFault ){
250     p->iCnt--;
251     if( p->iCnt==0 || (p->iCnt<0 && p->eFault==FAULT_INJECT_PERSISTENT ) ){
252       ret = 1;
253       p->nFail++;
254     }
255   }
256   return ret;
257 }
258 
259 
260 static int tvfsInjectIoerr(Testvfs *p){
261   return tvfsInjectFault(&p->ioerr_err);
262 }
263 
264 static int tvfsInjectFullerr(Testvfs *p){
265   return tvfsInjectFault(&p->full_err);
266 }
267 static int tvfsInjectCantopenerr(Testvfs *p){
268   return tvfsInjectFault(&p->cantopen_err);
269 }
270 
271 
272 static void tvfsExecTcl(
273   Testvfs *p,
274   const char *zMethod,
275   Tcl_Obj *arg1,
276   Tcl_Obj *arg2,
277   Tcl_Obj *arg3,
278   Tcl_Obj *arg4
279 ){
280   int rc;                         /* Return code from Tcl_EvalObj() */
281   Tcl_Obj *pEval;
282   assert( p->pScript );
283 
284   assert( zMethod );
285   assert( p );
286   assert( arg2==0 || arg1!=0 );
287   assert( arg3==0 || arg2!=0 );
288 
289   pEval = Tcl_DuplicateObj(p->pScript);
290   Tcl_IncrRefCount(p->pScript);
291   Tcl_ListObjAppendElement(p->interp, pEval, Tcl_NewStringObj(zMethod, -1));
292   if( arg1 ) Tcl_ListObjAppendElement(p->interp, pEval, arg1);
293   if( arg2 ) Tcl_ListObjAppendElement(p->interp, pEval, arg2);
294   if( arg3 ) Tcl_ListObjAppendElement(p->interp, pEval, arg3);
295   if( arg4 ) Tcl_ListObjAppendElement(p->interp, pEval, arg4);
296 
297   rc = Tcl_EvalObjEx(p->interp, pEval, TCL_EVAL_GLOBAL);
298   if( rc!=TCL_OK ){
299     Tcl_BackgroundError(p->interp);
300     Tcl_ResetResult(p->interp);
301   }
302 }
303 
304 
305 /*
306 ** Close an tvfs-file.
307 */
308 static int tvfsClose(sqlite3_file *pFile){
309   TestvfsFile *pTestfile = (TestvfsFile *)pFile;
310   TestvfsFd *pFd = pTestfile->pFd;
311   Testvfs *p = (Testvfs *)pFd->pVfs->pAppData;
312 
313   if( p->pScript && p->mask&TESTVFS_CLOSE_MASK ){
314     tvfsExecTcl(p, "xClose",
315         Tcl_NewStringObj(pFd->zFilename, -1), pFd->pShmId, 0, 0
316     );
317   }
318 
319   if( pFd->pShmId ){
320     Tcl_DecrRefCount(pFd->pShmId);
321     pFd->pShmId = 0;
322   }
323   if( pFile->pMethods ){
324     ckfree((char *)pFile->pMethods);
325   }
326   sqlite3OsClose(pFd->pReal);
327   ckfree((char *)pFd);
328   pTestfile->pFd = 0;
329   return SQLITE_OK;
330 }
331 
332 /*
333 ** Read data from an tvfs-file.
334 */
335 static int tvfsRead(
336   sqlite3_file *pFile,
337   void *zBuf,
338   int iAmt,
339   sqlite_int64 iOfst
340 ){
341   int rc = SQLITE_OK;
342   TestvfsFd *pFd = tvfsGetFd(pFile);
343   Testvfs *p = (Testvfs *)pFd->pVfs->pAppData;
344   if( p->pScript && p->mask&TESTVFS_READ_MASK ){
345     tvfsExecTcl(p, "xRead",
346         Tcl_NewStringObj(pFd->zFilename, -1), pFd->pShmId, 0, 0
347     );
348     tvfsResultCode(p, &rc);
349   }
350   if( rc==SQLITE_OK && p->mask&TESTVFS_READ_MASK && tvfsInjectIoerr(p) ){
351     rc = SQLITE_IOERR;
352   }
353   if( rc==SQLITE_OK ){
354     rc = sqlite3OsRead(pFd->pReal, zBuf, iAmt, iOfst);
355   }
356   return rc;
357 }
358 
359 /*
360 ** Write data to an tvfs-file.
361 */
362 static int tvfsWrite(
363   sqlite3_file *pFile,
364   const void *zBuf,
365   int iAmt,
366   sqlite_int64 iOfst
367 ){
368   int rc = SQLITE_OK;
369   TestvfsFd *pFd = tvfsGetFd(pFile);
370   Testvfs *p = (Testvfs *)pFd->pVfs->pAppData;
371 
372   if( p->pScript && p->mask&TESTVFS_WRITE_MASK ){
373     tvfsExecTcl(p, "xWrite",
374         Tcl_NewStringObj(pFd->zFilename, -1), pFd->pShmId,
375         Tcl_NewWideIntObj(iOfst), Tcl_NewIntObj(iAmt)
376     );
377     tvfsResultCode(p, &rc);
378   }
379 
380   if( rc==SQLITE_OK && tvfsInjectFullerr(p) ){
381     rc = SQLITE_FULL;
382   }
383   if( rc==SQLITE_OK && p->mask&TESTVFS_WRITE_MASK && tvfsInjectIoerr(p) ){
384     rc = SQLITE_IOERR;
385   }
386 
387   if( rc==SQLITE_OK ){
388     rc = sqlite3OsWrite(pFd->pReal, zBuf, iAmt, iOfst);
389   }
390   return rc;
391 }
392 
393 /*
394 ** Truncate an tvfs-file.
395 */
396 static int tvfsTruncate(sqlite3_file *pFile, sqlite_int64 size){
397   int rc = SQLITE_OK;
398   TestvfsFd *pFd = tvfsGetFd(pFile);
399   Testvfs *p = (Testvfs *)pFd->pVfs->pAppData;
400 
401   if( p->pScript && p->mask&TESTVFS_TRUNCATE_MASK ){
402     tvfsExecTcl(p, "xTruncate",
403         Tcl_NewStringObj(pFd->zFilename, -1), pFd->pShmId, 0, 0
404     );
405     tvfsResultCode(p, &rc);
406   }
407 
408   if( rc==SQLITE_OK ){
409     rc = sqlite3OsTruncate(pFd->pReal, size);
410   }
411   return rc;
412 }
413 
414 /*
415 ** Sync an tvfs-file.
416 */
417 static int tvfsSync(sqlite3_file *pFile, int flags){
418   int rc = SQLITE_OK;
419   TestvfsFd *pFd = tvfsGetFd(pFile);
420   Testvfs *p = (Testvfs *)pFd->pVfs->pAppData;
421 
422   if( p->pScript && p->mask&TESTVFS_SYNC_MASK ){
423     char *zFlags = 0;
424 
425     switch( flags ){
426       case SQLITE_SYNC_NORMAL:
427         zFlags = "normal";
428         break;
429       case SQLITE_SYNC_FULL:
430         zFlags = "full";
431         break;
432       case SQLITE_SYNC_NORMAL|SQLITE_SYNC_DATAONLY:
433         zFlags = "normal|dataonly";
434         break;
435       case SQLITE_SYNC_FULL|SQLITE_SYNC_DATAONLY:
436         zFlags = "full|dataonly";
437         break;
438       default:
439         assert(0);
440     }
441 
442     tvfsExecTcl(p, "xSync",
443         Tcl_NewStringObj(pFd->zFilename, -1), pFd->pShmId,
444         Tcl_NewStringObj(zFlags, -1), 0
445     );
446     tvfsResultCode(p, &rc);
447   }
448 
449   if( rc==SQLITE_OK && tvfsInjectFullerr(p) ) rc = SQLITE_FULL;
450 
451   if( rc==SQLITE_OK ){
452     rc = sqlite3OsSync(pFd->pReal, flags);
453   }
454 
455   return rc;
456 }
457 
458 /*
459 ** Return the current file-size of an tvfs-file.
460 */
461 static int tvfsFileSize(sqlite3_file *pFile, sqlite_int64 *pSize){
462   TestvfsFd *p = tvfsGetFd(pFile);
463   return sqlite3OsFileSize(p->pReal, pSize);
464 }
465 
466 /*
467 ** Lock an tvfs-file.
468 */
469 static int tvfsLock(sqlite3_file *pFile, int eLock){
470   TestvfsFd *pFd = tvfsGetFd(pFile);
471   Testvfs *p = (Testvfs *)pFd->pVfs->pAppData;
472   if( p->pScript && p->mask&TESTVFS_LOCK_MASK ){
473     char zLock[30];
474     sqlite3_snprintf(sizeof(zLock),zLock,"%d",eLock);
475     tvfsExecTcl(p, "xLock", Tcl_NewStringObj(pFd->zFilename, -1),
476                    Tcl_NewStringObj(zLock, -1), 0, 0);
477   }
478   return sqlite3OsLock(pFd->pReal, eLock);
479 }
480 
481 /*
482 ** Unlock an tvfs-file.
483 */
484 static int tvfsUnlock(sqlite3_file *pFile, int eLock){
485   TestvfsFd *pFd = tvfsGetFd(pFile);
486   Testvfs *p = (Testvfs *)pFd->pVfs->pAppData;
487   if( p->pScript && p->mask&TESTVFS_UNLOCK_MASK ){
488     char zLock[30];
489     sqlite3_snprintf(sizeof(zLock),zLock,"%d",eLock);
490     tvfsExecTcl(p, "xUnlock", Tcl_NewStringObj(pFd->zFilename, -1),
491                    Tcl_NewStringObj(zLock, -1), 0, 0);
492   }
493   if( p->mask&TESTVFS_WRITE_MASK && tvfsInjectIoerr(p) ){
494     return SQLITE_IOERR_UNLOCK;
495   }
496   return sqlite3OsUnlock(pFd->pReal, eLock);
497 }
498 
499 /*
500 ** Check if another file-handle holds a RESERVED lock on an tvfs-file.
501 */
502 static int tvfsCheckReservedLock(sqlite3_file *pFile, int *pResOut){
503   TestvfsFd *pFd = tvfsGetFd(pFile);
504   Testvfs *p = (Testvfs *)pFd->pVfs->pAppData;
505   if( p->pScript && p->mask&TESTVFS_CKLOCK_MASK ){
506     tvfsExecTcl(p, "xCheckReservedLock", Tcl_NewStringObj(pFd->zFilename, -1),
507                    0, 0, 0);
508   }
509   return sqlite3OsCheckReservedLock(pFd->pReal, pResOut);
510 }
511 
512 /*
513 ** File control method. For custom operations on an tvfs-file.
514 */
515 static int tvfsFileControl(sqlite3_file *pFile, int op, void *pArg){
516   TestvfsFd *p = tvfsGetFd(pFile);
517   if( op==SQLITE_FCNTL_PRAGMA ){
518     char **argv = (char**)pArg;
519     if( sqlite3_stricmp(argv[1],"error")==0 ){
520       int rc = SQLITE_ERROR;
521       if( argv[2] ){
522         const char *z = argv[2];
523         int x = atoi(z);
524         if( x ){
525           rc = x;
526           while( sqlite3Isdigit(z[0]) ){ z++; }
527           while( sqlite3Isspace(z[0]) ){ z++; }
528         }
529         if( z[0] ) argv[0] = sqlite3_mprintf("%s", z);
530       }
531       return rc;
532     }
533     if( sqlite3_stricmp(argv[1], "filename")==0 ){
534       argv[0] = sqlite3_mprintf("%s", p->zFilename);
535       return SQLITE_OK;
536     }
537   }
538   return sqlite3OsFileControl(p->pReal, op, pArg);
539 }
540 
541 /*
542 ** Return the sector-size in bytes for an tvfs-file.
543 */
544 static int tvfsSectorSize(sqlite3_file *pFile){
545   TestvfsFd *pFd = tvfsGetFd(pFile);
546   Testvfs *p = (Testvfs *)pFd->pVfs->pAppData;
547   if( p->iSectorsize>=0 ){
548     return p->iSectorsize;
549   }
550   return sqlite3OsSectorSize(pFd->pReal);
551 }
552 
553 /*
554 ** Return the device characteristic flags supported by an tvfs-file.
555 */
556 static int tvfsDeviceCharacteristics(sqlite3_file *pFile){
557   TestvfsFd *pFd = tvfsGetFd(pFile);
558   Testvfs *p = (Testvfs *)pFd->pVfs->pAppData;
559   if( p->iDevchar>=0 ){
560     return p->iDevchar;
561   }
562   return sqlite3OsDeviceCharacteristics(pFd->pReal);
563 }
564 
565 /*
566 ** Open an tvfs file handle.
567 */
568 static int tvfsOpen(
569   sqlite3_vfs *pVfs,
570   const char *zName,
571   sqlite3_file *pFile,
572   int flags,
573   int *pOutFlags
574 ){
575   int rc;
576   TestvfsFile *pTestfile = (TestvfsFile *)pFile;
577   TestvfsFd *pFd;
578   Tcl_Obj *pId = 0;
579   Testvfs *p = (Testvfs *)pVfs->pAppData;
580 
581   pFd = (TestvfsFd *)ckalloc(sizeof(TestvfsFd) + PARENTVFS(pVfs)->szOsFile);
582   memset(pFd, 0, sizeof(TestvfsFd) + PARENTVFS(pVfs)->szOsFile);
583   pFd->pShm = 0;
584   pFd->pShmId = 0;
585   pFd->zFilename = zName;
586   pFd->pVfs = pVfs;
587   pFd->pReal = (sqlite3_file *)&pFd[1];
588   memset(pTestfile, 0, sizeof(TestvfsFile));
589   pTestfile->pFd = pFd;
590 
591   /* Evaluate the Tcl script:
592   **
593   **   SCRIPT xOpen FILENAME KEY-VALUE-ARGS
594   **
595   ** If the script returns an SQLite error code other than SQLITE_OK, an
596   ** error is returned to the caller. If it returns SQLITE_OK, the new
597   ** connection is named "anon". Otherwise, the value returned by the
598   ** script is used as the connection name.
599   */
600   Tcl_ResetResult(p->interp);
601   if( p->pScript && p->mask&TESTVFS_OPEN_MASK ){
602     Tcl_Obj *pArg = Tcl_NewObj();
603     Tcl_IncrRefCount(pArg);
604     if( flags&SQLITE_OPEN_MAIN_DB ){
605       const char *z = &zName[strlen(zName)+1];
606       while( *z ){
607         Tcl_ListObjAppendElement(0, pArg, Tcl_NewStringObj(z, -1));
608         z += strlen(z) + 1;
609         Tcl_ListObjAppendElement(0, pArg, Tcl_NewStringObj(z, -1));
610         z += strlen(z) + 1;
611       }
612     }
613     tvfsExecTcl(p, "xOpen", Tcl_NewStringObj(pFd->zFilename, -1), pArg, 0, 0);
614     Tcl_DecrRefCount(pArg);
615     if( tvfsResultCode(p, &rc) ){
616       if( rc!=SQLITE_OK ) return rc;
617     }else{
618       pId = Tcl_GetObjResult(p->interp);
619     }
620   }
621 
622   if( (p->mask&TESTVFS_OPEN_MASK) &&  tvfsInjectIoerr(p) ) return SQLITE_IOERR;
623   if( tvfsInjectCantopenerr(p) ) return SQLITE_CANTOPEN;
624   if( tvfsInjectFullerr(p) ) return SQLITE_FULL;
625 
626   if( !pId ){
627     pId = Tcl_NewStringObj("anon", -1);
628   }
629   Tcl_IncrRefCount(pId);
630   pFd->pShmId = pId;
631   Tcl_ResetResult(p->interp);
632 
633   rc = sqlite3OsOpen(PARENTVFS(pVfs), zName, pFd->pReal, flags, pOutFlags);
634   if( pFd->pReal->pMethods ){
635     sqlite3_io_methods *pMethods;
636     int nByte;
637 
638     if( pVfs->iVersion>1 ){
639       nByte = sizeof(sqlite3_io_methods);
640     }else{
641       nByte = offsetof(sqlite3_io_methods, xShmMap);
642     }
643 
644     pMethods = (sqlite3_io_methods *)ckalloc(nByte);
645     memcpy(pMethods, &tvfs_io_methods, nByte);
646     pMethods->iVersion = pFd->pReal->pMethods->iVersion;
647     if( pMethods->iVersion>pVfs->iVersion ){
648       pMethods->iVersion = pVfs->iVersion;
649     }
650     if( pVfs->iVersion>1 && ((Testvfs *)pVfs->pAppData)->isNoshm ){
651       pMethods->xShmUnmap = 0;
652       pMethods->xShmLock = 0;
653       pMethods->xShmBarrier = 0;
654       pMethods->xShmMap = 0;
655     }
656     pFile->pMethods = pMethods;
657   }
658 
659   return rc;
660 }
661 
662 /*
663 ** Delete the file located at zPath. If the dirSync argument is true,
664 ** ensure the file-system modifications are synced to disk before
665 ** returning.
666 */
667 static int tvfsDelete(sqlite3_vfs *pVfs, const char *zPath, int dirSync){
668   int rc = SQLITE_OK;
669   Testvfs *p = (Testvfs *)pVfs->pAppData;
670 
671   if( p->pScript && p->mask&TESTVFS_DELETE_MASK ){
672     tvfsExecTcl(p, "xDelete",
673         Tcl_NewStringObj(zPath, -1), Tcl_NewIntObj(dirSync), 0, 0
674     );
675     tvfsResultCode(p, &rc);
676   }
677   if( rc==SQLITE_OK ){
678     rc = sqlite3OsDelete(PARENTVFS(pVfs), zPath, dirSync);
679   }
680   return rc;
681 }
682 
683 /*
684 ** Test for access permissions. Return true if the requested permission
685 ** is available, or false otherwise.
686 */
687 static int tvfsAccess(
688   sqlite3_vfs *pVfs,
689   const char *zPath,
690   int flags,
691   int *pResOut
692 ){
693   Testvfs *p = (Testvfs *)pVfs->pAppData;
694   if( p->pScript && p->mask&TESTVFS_ACCESS_MASK ){
695     int rc;
696     char *zArg = 0;
697     if( flags==SQLITE_ACCESS_EXISTS ) zArg = "SQLITE_ACCESS_EXISTS";
698     if( flags==SQLITE_ACCESS_READWRITE ) zArg = "SQLITE_ACCESS_READWRITE";
699     if( flags==SQLITE_ACCESS_READ ) zArg = "SQLITE_ACCESS_READ";
700     tvfsExecTcl(p, "xAccess",
701         Tcl_NewStringObj(zPath, -1), Tcl_NewStringObj(zArg, -1), 0, 0
702     );
703     if( tvfsResultCode(p, &rc) ){
704       if( rc!=SQLITE_OK ) return rc;
705     }else{
706       Tcl_Interp *interp = p->interp;
707       if( TCL_OK==Tcl_GetBooleanFromObj(0, Tcl_GetObjResult(interp), pResOut) ){
708         return SQLITE_OK;
709       }
710     }
711   }
712   return sqlite3OsAccess(PARENTVFS(pVfs), zPath, flags, pResOut);
713 }
714 
715 /*
716 ** Populate buffer zOut with the full canonical pathname corresponding
717 ** to the pathname in zPath. zOut is guaranteed to point to a buffer
718 ** of at least (DEVSYM_MAX_PATHNAME+1) bytes.
719 */
720 static int tvfsFullPathname(
721   sqlite3_vfs *pVfs,
722   const char *zPath,
723   int nOut,
724   char *zOut
725 ){
726   Testvfs *p = (Testvfs *)pVfs->pAppData;
727   if( p->pScript && p->mask&TESTVFS_FULLPATHNAME_MASK ){
728     int rc;
729     tvfsExecTcl(p, "xFullPathname", Tcl_NewStringObj(zPath, -1), 0, 0, 0);
730     if( tvfsResultCode(p, &rc) ){
731       if( rc!=SQLITE_OK ) return rc;
732     }
733   }
734   return sqlite3OsFullPathname(PARENTVFS(pVfs), zPath, nOut, zOut);
735 }
736 
737 #ifndef SQLITE_OMIT_LOAD_EXTENSION
738 /*
739 ** Open the dynamic library located at zPath and return a handle.
740 */
741 static void *tvfsDlOpen(sqlite3_vfs *pVfs, const char *zPath){
742   return sqlite3OsDlOpen(PARENTVFS(pVfs), zPath);
743 }
744 
745 /*
746 ** Populate the buffer zErrMsg (size nByte bytes) with a human readable
747 ** utf-8 string describing the most recent error encountered associated
748 ** with dynamic libraries.
749 */
750 static void tvfsDlError(sqlite3_vfs *pVfs, int nByte, char *zErrMsg){
751   sqlite3OsDlError(PARENTVFS(pVfs), nByte, zErrMsg);
752 }
753 
754 /*
755 ** Return a pointer to the symbol zSymbol in the dynamic library pHandle.
756 */
757 static void (*tvfsDlSym(sqlite3_vfs *pVfs, void *p, const char *zSym))(void){
758   return sqlite3OsDlSym(PARENTVFS(pVfs), p, zSym);
759 }
760 
761 /*
762 ** Close the dynamic library handle pHandle.
763 */
764 static void tvfsDlClose(sqlite3_vfs *pVfs, void *pHandle){
765   sqlite3OsDlClose(PARENTVFS(pVfs), pHandle);
766 }
767 #endif /* SQLITE_OMIT_LOAD_EXTENSION */
768 
769 /*
770 ** Populate the buffer pointed to by zBufOut with nByte bytes of
771 ** random data.
772 */
773 static int tvfsRandomness(sqlite3_vfs *pVfs, int nByte, char *zBufOut){
774   return sqlite3OsRandomness(PARENTVFS(pVfs), nByte, zBufOut);
775 }
776 
777 /*
778 ** Sleep for nMicro microseconds. Return the number of microseconds
779 ** actually slept.
780 */
781 static int tvfsSleep(sqlite3_vfs *pVfs, int nMicro){
782   return sqlite3OsSleep(PARENTVFS(pVfs), nMicro);
783 }
784 
785 /*
786 ** Return the current time as a Julian Day number in *pTimeOut.
787 */
788 static int tvfsCurrentTime(sqlite3_vfs *pVfs, double *pTimeOut){
789   return PARENTVFS(pVfs)->xCurrentTime(PARENTVFS(pVfs), pTimeOut);
790 }
791 
792 static int tvfsShmOpen(sqlite3_file *pFile){
793   Testvfs *p;
794   int rc = SQLITE_OK;             /* Return code */
795   TestvfsBuffer *pBuffer;         /* Buffer to open connection to */
796   TestvfsFd *pFd;                 /* The testvfs file structure */
797 
798   pFd = tvfsGetFd(pFile);
799   p = (Testvfs *)pFd->pVfs->pAppData;
800   assert( 0==p->isFullshm );
801   assert( pFd->pShmId && pFd->pShm==0 && pFd->pNext==0 );
802 
803   /* Evaluate the Tcl script:
804   **
805   **   SCRIPT xShmOpen FILENAME
806   */
807   Tcl_ResetResult(p->interp);
808   if( p->pScript && p->mask&TESTVFS_SHMOPEN_MASK ){
809     tvfsExecTcl(p, "xShmOpen", Tcl_NewStringObj(pFd->zFilename, -1), 0, 0, 0);
810     if( tvfsResultCode(p, &rc) ){
811       if( rc!=SQLITE_OK ) return rc;
812     }
813   }
814 
815   assert( rc==SQLITE_OK );
816   if( p->mask&TESTVFS_SHMOPEN_MASK && tvfsInjectIoerr(p) ){
817     return SQLITE_IOERR;
818   }
819 
820   /* Search for a TestvfsBuffer. Create a new one if required. */
821   for(pBuffer=p->pBuffer; pBuffer; pBuffer=pBuffer->pNext){
822     if( 0==strcmp(pFd->zFilename, pBuffer->zFile) ) break;
823   }
824   if( !pBuffer ){
825     int szName = (int)strlen(pFd->zFilename);
826     int nByte = sizeof(TestvfsBuffer) + szName + 1;
827     pBuffer = (TestvfsBuffer *)ckalloc(nByte);
828     memset(pBuffer, 0, nByte);
829     pBuffer->zFile = (char *)&pBuffer[1];
830     memcpy(pBuffer->zFile, pFd->zFilename, szName+1);
831     pBuffer->pNext = p->pBuffer;
832     p->pBuffer = pBuffer;
833   }
834 
835   /* Connect the TestvfsBuffer to the new TestvfsShm handle and return. */
836   pFd->pNext = pBuffer->pFile;
837   pBuffer->pFile = pFd;
838   pFd->pShm = pBuffer;
839   return SQLITE_OK;
840 }
841 
842 static void tvfsAllocPage(TestvfsBuffer *p, int iPage, int pgsz){
843   assert( iPage<TESTVFS_MAX_PAGES );
844   if( p->aPage[iPage]==0 ){
845     p->aPage[iPage] = (u8 *)ckalloc(pgsz);
846     memset(p->aPage[iPage], 0, pgsz);
847     p->pgsz = pgsz;
848   }
849 }
850 
851 static int tvfsShmMap(
852   sqlite3_file *pFile,            /* Handle open on database file */
853   int iPage,                      /* Page to retrieve */
854   int pgsz,                       /* Size of pages */
855   int isWrite,                    /* True to extend file if necessary */
856   void volatile **pp              /* OUT: Mapped memory */
857 ){
858   int rc = SQLITE_OK;
859   TestvfsFd *pFd = tvfsGetFd(pFile);
860   Testvfs *p = (Testvfs *)(pFd->pVfs->pAppData);
861 
862   if( p->isFullshm ){
863     return sqlite3OsShmMap(pFd->pReal, iPage, pgsz, isWrite, pp);
864   }
865 
866   if( 0==pFd->pShm ){
867     rc = tvfsShmOpen(pFile);
868     if( rc!=SQLITE_OK ){
869       return rc;
870     }
871   }
872 
873   if( p->pScript && p->mask&TESTVFS_SHMMAP_MASK ){
874     Tcl_Obj *pArg = Tcl_NewObj();
875     Tcl_IncrRefCount(pArg);
876     Tcl_ListObjAppendElement(p->interp, pArg, Tcl_NewIntObj(iPage));
877     Tcl_ListObjAppendElement(p->interp, pArg, Tcl_NewIntObj(pgsz));
878     Tcl_ListObjAppendElement(p->interp, pArg, Tcl_NewIntObj(isWrite));
879     tvfsExecTcl(p, "xShmMap",
880         Tcl_NewStringObj(pFd->pShm->zFile, -1), pFd->pShmId, pArg, 0
881     );
882     tvfsResultCode(p, &rc);
883     Tcl_DecrRefCount(pArg);
884   }
885   if( rc==SQLITE_OK && p->mask&TESTVFS_SHMMAP_MASK && tvfsInjectIoerr(p) ){
886     rc = SQLITE_IOERR;
887   }
888 
889   if( rc==SQLITE_OK && isWrite && !pFd->pShm->aPage[iPage] ){
890     tvfsAllocPage(pFd->pShm, iPage, pgsz);
891   }
892   *pp = (void volatile *)pFd->pShm->aPage[iPage];
893 
894   return rc;
895 }
896 
897 
898 static int tvfsShmLock(
899   sqlite3_file *pFile,
900   int ofst,
901   int n,
902   int flags
903 ){
904   int rc = SQLITE_OK;
905   TestvfsFd *pFd = tvfsGetFd(pFile);
906   Testvfs *p = (Testvfs *)(pFd->pVfs->pAppData);
907   int nLock;
908   char zLock[80];
909 
910   if( p->isFullshm ){
911     return sqlite3OsShmLock(pFd->pReal, ofst, n, flags);
912   }
913 
914   if( p->pScript && p->mask&TESTVFS_SHMLOCK_MASK ){
915     sqlite3_snprintf(sizeof(zLock), zLock, "%d %d", ofst, n);
916     nLock = (int)strlen(zLock);
917     if( flags & SQLITE_SHM_LOCK ){
918       strcpy(&zLock[nLock], " lock");
919     }else{
920       strcpy(&zLock[nLock], " unlock");
921     }
922     nLock += (int)strlen(&zLock[nLock]);
923     if( flags & SQLITE_SHM_SHARED ){
924       strcpy(&zLock[nLock], " shared");
925     }else{
926       strcpy(&zLock[nLock], " exclusive");
927     }
928     tvfsExecTcl(p, "xShmLock",
929         Tcl_NewStringObj(pFd->pShm->zFile, -1), pFd->pShmId,
930         Tcl_NewStringObj(zLock, -1), 0
931     );
932     tvfsResultCode(p, &rc);
933   }
934 
935   if( rc==SQLITE_OK && p->mask&TESTVFS_SHMLOCK_MASK && tvfsInjectIoerr(p) ){
936     rc = SQLITE_IOERR;
937   }
938 
939   if( rc==SQLITE_OK ){
940     int isLock = (flags & SQLITE_SHM_LOCK);
941     int isExcl = (flags & SQLITE_SHM_EXCLUSIVE);
942     u32 mask = (((1<<n)-1) << ofst);
943     if( isLock ){
944       TestvfsFd *p2;
945       for(p2=pFd->pShm->pFile; p2; p2=p2->pNext){
946         if( p2==pFd ) continue;
947         if( (p2->excllock&mask) || (isExcl && p2->sharedlock&mask) ){
948           rc = SQLITE_BUSY;
949           break;
950         }
951       }
952       if( rc==SQLITE_OK ){
953         if( isExcl )  pFd->excllock |= mask;
954         if( !isExcl ) pFd->sharedlock |= mask;
955       }
956     }else{
957       if( isExcl )  pFd->excllock &= (~mask);
958       if( !isExcl ) pFd->sharedlock &= (~mask);
959     }
960   }
961 
962   return rc;
963 }
964 
965 static void tvfsShmBarrier(sqlite3_file *pFile){
966   TestvfsFd *pFd = tvfsGetFd(pFile);
967   Testvfs *p = (Testvfs *)(pFd->pVfs->pAppData);
968 
969   if( p->pScript && p->mask&TESTVFS_SHMBARRIER_MASK ){
970     const char *z = pFd->pShm ? pFd->pShm->zFile : "";
971     tvfsExecTcl(p, "xShmBarrier", Tcl_NewStringObj(z, -1), pFd->pShmId, 0, 0);
972   }
973 
974   if( p->isFullshm ){
975     sqlite3OsShmBarrier(pFd->pReal);
976     return;
977   }
978 }
979 
980 static int tvfsShmUnmap(
981   sqlite3_file *pFile,
982   int deleteFlag
983 ){
984   int rc = SQLITE_OK;
985   TestvfsFd *pFd = tvfsGetFd(pFile);
986   Testvfs *p = (Testvfs *)(pFd->pVfs->pAppData);
987   TestvfsBuffer *pBuffer = pFd->pShm;
988   TestvfsFd **ppFd;
989 
990   if( p->isFullshm ){
991     return sqlite3OsShmUnmap(pFd->pReal, deleteFlag);
992   }
993 
994   if( !pBuffer ) return SQLITE_OK;
995   assert( pFd->pShmId && pFd->pShm );
996 
997   if( p->pScript && p->mask&TESTVFS_SHMCLOSE_MASK ){
998     tvfsExecTcl(p, "xShmUnmap",
999         Tcl_NewStringObj(pFd->pShm->zFile, -1), pFd->pShmId, 0, 0
1000     );
1001     tvfsResultCode(p, &rc);
1002   }
1003 
1004   for(ppFd=&pBuffer->pFile; *ppFd!=pFd; ppFd=&((*ppFd)->pNext));
1005   assert( (*ppFd)==pFd );
1006   *ppFd = pFd->pNext;
1007   pFd->pNext = 0;
1008 
1009   if( pBuffer->pFile==0 ){
1010     int i;
1011     TestvfsBuffer **pp;
1012     for(pp=&p->pBuffer; *pp!=pBuffer; pp=&((*pp)->pNext));
1013     *pp = (*pp)->pNext;
1014     for(i=0; pBuffer->aPage[i]; i++){
1015       ckfree((char *)pBuffer->aPage[i]);
1016     }
1017     ckfree((char *)pBuffer);
1018   }
1019   pFd->pShm = 0;
1020 
1021   return rc;
1022 }
1023 
1024 static int tvfsFetch(
1025     sqlite3_file *pFile,
1026     sqlite3_int64 iOfst,
1027     int iAmt,
1028     void **pp
1029 ){
1030   TestvfsFd *pFd = tvfsGetFd(pFile);
1031   return sqlite3OsFetch(pFd->pReal, iOfst, iAmt, pp);
1032 }
1033 
1034 static int tvfsUnfetch(sqlite3_file *pFile, sqlite3_int64 iOfst, void *p){
1035   TestvfsFd *pFd = tvfsGetFd(pFile);
1036   return sqlite3OsUnfetch(pFd->pReal, iOfst, p);
1037 }
1038 
1039 static int testvfs_obj_cmd(
1040   ClientData cd,
1041   Tcl_Interp *interp,
1042   int objc,
1043   Tcl_Obj *CONST objv[]
1044 ){
1045   Testvfs *p = (Testvfs *)cd;
1046 
1047   enum DB_enum {
1048     CMD_SHM, CMD_DELETE, CMD_FILTER, CMD_IOERR, CMD_SCRIPT,
1049     CMD_DEVCHAR, CMD_SECTORSIZE, CMD_FULLERR, CMD_CANTOPENERR
1050   };
1051   struct TestvfsSubcmd {
1052     char *zName;
1053     enum DB_enum eCmd;
1054   } aSubcmd[] = {
1055     { "shm",         CMD_SHM         },
1056     { "delete",      CMD_DELETE      },
1057     { "filter",      CMD_FILTER      },
1058     { "ioerr",       CMD_IOERR       },
1059     { "fullerr",     CMD_FULLERR     },
1060     { "cantopenerr", CMD_CANTOPENERR },
1061     { "script",      CMD_SCRIPT      },
1062     { "devchar",     CMD_DEVCHAR     },
1063     { "sectorsize",  CMD_SECTORSIZE  },
1064     { 0, 0 }
1065   };
1066   int i;
1067 
1068   if( objc<2 ){
1069     Tcl_WrongNumArgs(interp, 1, objv, "SUBCOMMAND ...");
1070     return TCL_ERROR;
1071   }
1072   if( Tcl_GetIndexFromObjStruct(
1073         interp, objv[1], aSubcmd, sizeof(aSubcmd[0]), "subcommand", 0, &i)
1074   ){
1075     return TCL_ERROR;
1076   }
1077   Tcl_ResetResult(interp);
1078 
1079   switch( aSubcmd[i].eCmd ){
1080     case CMD_SHM: {
1081       Tcl_Obj *pObj;
1082       int rc;
1083       TestvfsBuffer *pBuffer;
1084       char *zName;
1085       if( objc!=3 && objc!=4 ){
1086         Tcl_WrongNumArgs(interp, 2, objv, "FILE ?VALUE?");
1087         return TCL_ERROR;
1088       }
1089       zName = ckalloc(p->pParent->mxPathname);
1090       rc = p->pParent->xFullPathname(
1091           p->pParent, Tcl_GetString(objv[2]),
1092           p->pParent->mxPathname, zName
1093       );
1094       if( rc!=SQLITE_OK ){
1095         Tcl_AppendResult(interp, "failed to get full path: ",
1096                          Tcl_GetString(objv[2]), 0);
1097         ckfree(zName);
1098         return TCL_ERROR;
1099       }
1100       for(pBuffer=p->pBuffer; pBuffer; pBuffer=pBuffer->pNext){
1101         if( 0==strcmp(pBuffer->zFile, zName) ) break;
1102       }
1103       ckfree(zName);
1104       if( !pBuffer ){
1105         Tcl_AppendResult(interp, "no such file: ", Tcl_GetString(objv[2]), 0);
1106         return TCL_ERROR;
1107       }
1108       if( objc==4 ){
1109         int n;
1110         u8 *a = Tcl_GetByteArrayFromObj(objv[3], &n);
1111         int pgsz = pBuffer->pgsz;
1112         if( pgsz==0 ) pgsz = 65536;
1113         for(i=0; i*pgsz<n; i++){
1114           int nByte = pgsz;
1115           tvfsAllocPage(pBuffer, i, pgsz);
1116           if( n-i*pgsz<pgsz ){
1117             nByte = n;
1118           }
1119           memcpy(pBuffer->aPage[i], &a[i*pgsz], nByte);
1120         }
1121       }
1122 
1123       pObj = Tcl_NewObj();
1124       for(i=0; pBuffer->aPage[i]; i++){
1125         int pgsz = pBuffer->pgsz;
1126         if( pgsz==0 ) pgsz = 65536;
1127         Tcl_AppendObjToObj(pObj, Tcl_NewByteArrayObj(pBuffer->aPage[i], pgsz));
1128       }
1129       Tcl_SetObjResult(interp, pObj);
1130       break;
1131     }
1132 
1133     /*  TESTVFS filter METHOD-LIST
1134     **
1135     **     Activate special processing for those methods contained in the list
1136     */
1137     case CMD_FILTER: {
1138       static struct VfsMethod {
1139         char *zName;
1140         int mask;
1141       } vfsmethod [] = {
1142         { "xShmOpen",           TESTVFS_SHMOPEN_MASK },
1143         { "xShmLock",           TESTVFS_SHMLOCK_MASK },
1144         { "xShmBarrier",        TESTVFS_SHMBARRIER_MASK },
1145         { "xShmUnmap",          TESTVFS_SHMCLOSE_MASK },
1146         { "xShmMap",            TESTVFS_SHMMAP_MASK },
1147         { "xSync",              TESTVFS_SYNC_MASK },
1148         { "xDelete",            TESTVFS_DELETE_MASK },
1149         { "xWrite",             TESTVFS_WRITE_MASK },
1150         { "xRead",              TESTVFS_READ_MASK },
1151         { "xTruncate",          TESTVFS_TRUNCATE_MASK },
1152         { "xOpen",              TESTVFS_OPEN_MASK },
1153         { "xClose",             TESTVFS_CLOSE_MASK },
1154         { "xAccess",            TESTVFS_ACCESS_MASK },
1155         { "xFullPathname",      TESTVFS_FULLPATHNAME_MASK },
1156         { "xUnlock",            TESTVFS_UNLOCK_MASK },
1157         { "xLock",              TESTVFS_LOCK_MASK },
1158         { "xCheckReservedLock", TESTVFS_CKLOCK_MASK },
1159       };
1160       Tcl_Obj **apElem = 0;
1161       int nElem = 0;
1162       int mask = 0;
1163       if( objc!=3 ){
1164         Tcl_WrongNumArgs(interp, 2, objv, "LIST");
1165         return TCL_ERROR;
1166       }
1167       if( Tcl_ListObjGetElements(interp, objv[2], &nElem, &apElem) ){
1168         return TCL_ERROR;
1169       }
1170       Tcl_ResetResult(interp);
1171       for(i=0; i<nElem; i++){
1172         int iMethod;
1173         char *zElem = Tcl_GetString(apElem[i]);
1174         for(iMethod=0; iMethod<ArraySize(vfsmethod); iMethod++){
1175           if( strcmp(zElem, vfsmethod[iMethod].zName)==0 ){
1176             mask |= vfsmethod[iMethod].mask;
1177             break;
1178           }
1179         }
1180         if( iMethod==ArraySize(vfsmethod) ){
1181           Tcl_AppendResult(interp, "unknown method: ", zElem, 0);
1182           return TCL_ERROR;
1183         }
1184       }
1185       p->mask = mask;
1186       break;
1187     }
1188 
1189     /*
1190     **  TESTVFS script ?SCRIPT?
1191     **
1192     **  Query or set the script to be run when filtered VFS events
1193     **  occur.
1194     */
1195     case CMD_SCRIPT: {
1196       if( objc==3 ){
1197         int nByte;
1198         if( p->pScript ){
1199           Tcl_DecrRefCount(p->pScript);
1200           p->pScript = 0;
1201         }
1202         Tcl_GetStringFromObj(objv[2], &nByte);
1203         if( nByte>0 ){
1204           p->pScript = Tcl_DuplicateObj(objv[2]);
1205           Tcl_IncrRefCount(p->pScript);
1206         }
1207       }else if( objc!=2 ){
1208         Tcl_WrongNumArgs(interp, 2, objv, "?SCRIPT?");
1209         return TCL_ERROR;
1210       }
1211 
1212       Tcl_ResetResult(interp);
1213       if( p->pScript ) Tcl_SetObjResult(interp, p->pScript);
1214 
1215       break;
1216     }
1217 
1218     /*
1219     ** TESTVFS ioerr ?IFAIL PERSIST?
1220     **
1221     **   Where IFAIL is an integer and PERSIST is boolean.
1222     */
1223     case CMD_CANTOPENERR:
1224     case CMD_IOERR:
1225     case CMD_FULLERR: {
1226       TestFaultInject *pTest = 0;
1227       int iRet;
1228 
1229       switch( aSubcmd[i].eCmd ){
1230         case CMD_IOERR: pTest = &p->ioerr_err; break;
1231         case CMD_FULLERR: pTest = &p->full_err; break;
1232         case CMD_CANTOPENERR: pTest = &p->cantopen_err; break;
1233         default: assert(0);
1234       }
1235       iRet = pTest->nFail;
1236       pTest->nFail = 0;
1237       pTest->eFault = 0;
1238       pTest->iCnt = 0;
1239 
1240       if( objc==4 ){
1241         int iCnt, iPersist;
1242         if( TCL_OK!=Tcl_GetIntFromObj(interp, objv[2], &iCnt)
1243          || TCL_OK!=Tcl_GetBooleanFromObj(interp, objv[3], &iPersist)
1244         ){
1245           return TCL_ERROR;
1246         }
1247         pTest->eFault = iPersist?FAULT_INJECT_PERSISTENT:FAULT_INJECT_TRANSIENT;
1248         pTest->iCnt = iCnt;
1249       }else if( objc!=2 ){
1250         Tcl_WrongNumArgs(interp, 2, objv, "?CNT PERSIST?");
1251         return TCL_ERROR;
1252       }
1253       Tcl_SetObjResult(interp, Tcl_NewIntObj(iRet));
1254       break;
1255     }
1256 
1257     case CMD_DELETE: {
1258       Tcl_DeleteCommand(interp, Tcl_GetString(objv[0]));
1259       break;
1260     }
1261 
1262     case CMD_DEVCHAR: {
1263       struct DeviceFlag {
1264         char *zName;
1265         int iValue;
1266       } aFlag[] = {
1267         { "default",               -1 },
1268         { "atomic",                SQLITE_IOCAP_ATOMIC                },
1269         { "atomic512",             SQLITE_IOCAP_ATOMIC512             },
1270         { "atomic1k",              SQLITE_IOCAP_ATOMIC1K              },
1271         { "atomic2k",              SQLITE_IOCAP_ATOMIC2K              },
1272         { "atomic4k",              SQLITE_IOCAP_ATOMIC4K              },
1273         { "atomic8k",              SQLITE_IOCAP_ATOMIC8K              },
1274         { "atomic16k",             SQLITE_IOCAP_ATOMIC16K             },
1275         { "atomic32k",             SQLITE_IOCAP_ATOMIC32K             },
1276         { "atomic64k",             SQLITE_IOCAP_ATOMIC64K             },
1277         { "sequential",            SQLITE_IOCAP_SEQUENTIAL            },
1278         { "safe_append",           SQLITE_IOCAP_SAFE_APPEND           },
1279         { "undeletable_when_open", SQLITE_IOCAP_UNDELETABLE_WHEN_OPEN },
1280         { "powersafe_overwrite",   SQLITE_IOCAP_POWERSAFE_OVERWRITE   },
1281         { "immutable",             SQLITE_IOCAP_IMMUTABLE             },
1282         { 0, 0 }
1283       };
1284       Tcl_Obj *pRet;
1285       int iFlag;
1286 
1287       if( objc>3 ){
1288         Tcl_WrongNumArgs(interp, 2, objv, "?ATTR-LIST?");
1289         return TCL_ERROR;
1290       }
1291       if( objc==3 ){
1292         int j;
1293         int iNew = 0;
1294         Tcl_Obj **flags = 0;
1295         int nFlags = 0;
1296 
1297         if( Tcl_ListObjGetElements(interp, objv[2], &nFlags, &flags) ){
1298           return TCL_ERROR;
1299         }
1300 
1301         for(j=0; j<nFlags; j++){
1302           int idx = 0;
1303           if( Tcl_GetIndexFromObjStruct(interp, flags[j], aFlag,
1304                 sizeof(aFlag[0]), "flag", 0, &idx)
1305           ){
1306             return TCL_ERROR;
1307           }
1308           if( aFlag[idx].iValue<0 && nFlags>1 ){
1309             Tcl_AppendResult(interp, "bad flags: ", Tcl_GetString(objv[2]), 0);
1310             return TCL_ERROR;
1311           }
1312           iNew |= aFlag[idx].iValue;
1313         }
1314 
1315         p->iDevchar = iNew| 0x10000000;
1316       }
1317 
1318       pRet = Tcl_NewObj();
1319       for(iFlag=0; iFlag<sizeof(aFlag)/sizeof(aFlag[0]); iFlag++){
1320         if( p->iDevchar & aFlag[iFlag].iValue ){
1321           Tcl_ListObjAppendElement(
1322               interp, pRet, Tcl_NewStringObj(aFlag[iFlag].zName, -1)
1323           );
1324         }
1325       }
1326       Tcl_SetObjResult(interp, pRet);
1327 
1328       break;
1329     }
1330 
1331     case CMD_SECTORSIZE: {
1332       if( objc>3 ){
1333         Tcl_WrongNumArgs(interp, 2, objv, "?VALUE?");
1334         return TCL_ERROR;
1335       }
1336       if( objc==3 ){
1337         int iNew = 0;
1338         if( Tcl_GetIntFromObj(interp, objv[2], &iNew) ){
1339           return TCL_ERROR;
1340         }
1341         p->iSectorsize = iNew;
1342       }
1343       Tcl_SetObjResult(interp, Tcl_NewIntObj(p->iSectorsize));
1344       break;
1345     }
1346   }
1347 
1348   return TCL_OK;
1349 }
1350 
1351 static void testvfs_obj_del(ClientData cd){
1352   Testvfs *p = (Testvfs *)cd;
1353   if( p->pScript ) Tcl_DecrRefCount(p->pScript);
1354   sqlite3_vfs_unregister(p->pVfs);
1355   ckfree((char *)p->pVfs);
1356   ckfree((char *)p);
1357 }
1358 
1359 /*
1360 ** Usage:  testvfs VFSNAME ?SWITCHES?
1361 **
1362 ** Switches are:
1363 **
1364 **   -noshm   BOOLEAN             (True to omit shm methods. Default false)
1365 **   -default BOOLEAN             (True to make the vfs default. Default false)
1366 **
1367 ** This command creates two things when it is invoked: an SQLite VFS, and
1368 ** a Tcl command. Both are named VFSNAME. The VFS is installed. It is not
1369 ** installed as the default VFS.
1370 **
1371 ** The VFS passes all file I/O calls through to the underlying VFS.
1372 **
1373 ** Whenever the xShmMap method of the VFS
1374 ** is invoked, the SCRIPT is executed as follows:
1375 **
1376 **   SCRIPT xShmMap    FILENAME ID
1377 **
1378 ** The value returned by the invocation of SCRIPT above is interpreted as
1379 ** an SQLite error code and returned to SQLite. Either a symbolic
1380 ** "SQLITE_OK" or numeric "0" value may be returned.
1381 **
1382 ** The contents of the shared-memory buffer associated with a given file
1383 ** may be read and set using the following command:
1384 **
1385 **   VFSNAME shm FILENAME ?NEWVALUE?
1386 **
1387 ** When the xShmLock method is invoked by SQLite, the following script is
1388 ** run:
1389 **
1390 **   SCRIPT xShmLock    FILENAME ID LOCK
1391 **
1392 ** where LOCK is of the form "OFFSET NBYTE lock/unlock shared/exclusive"
1393 */
1394 static int testvfs_cmd(
1395   ClientData cd,
1396   Tcl_Interp *interp,
1397   int objc,
1398   Tcl_Obj *CONST objv[]
1399 ){
1400   static sqlite3_vfs tvfs_vfs = {
1401     3,                            /* iVersion */
1402     0,                            /* szOsFile */
1403     0,                            /* mxPathname */
1404     0,                            /* pNext */
1405     0,                            /* zName */
1406     0,                            /* pAppData */
1407     tvfsOpen,                     /* xOpen */
1408     tvfsDelete,                   /* xDelete */
1409     tvfsAccess,                   /* xAccess */
1410     tvfsFullPathname,             /* xFullPathname */
1411 #ifndef SQLITE_OMIT_LOAD_EXTENSION
1412     tvfsDlOpen,                   /* xDlOpen */
1413     tvfsDlError,                  /* xDlError */
1414     tvfsDlSym,                    /* xDlSym */
1415     tvfsDlClose,                  /* xDlClose */
1416 #else
1417     0,                            /* xDlOpen */
1418     0,                            /* xDlError */
1419     0,                            /* xDlSym */
1420     0,                            /* xDlClose */
1421 #endif /* SQLITE_OMIT_LOAD_EXTENSION */
1422     tvfsRandomness,               /* xRandomness */
1423     tvfsSleep,                    /* xSleep */
1424     tvfsCurrentTime,              /* xCurrentTime */
1425     0,                            /* xGetLastError */
1426     0,                            /* xCurrentTimeInt64 */
1427     0,                            /* xSetSystemCall */
1428     0,                            /* xGetSystemCall */
1429     0,                            /* xNextSystemCall */
1430   };
1431 
1432   Testvfs *p;                     /* New object */
1433   sqlite3_vfs *pVfs;              /* New VFS */
1434   char *zVfs;
1435   int nByte;                      /* Bytes of space to allocate at p */
1436 
1437   int i;
1438   int isNoshm = 0;                /* True if -noshm is passed */
1439   int isFullshm = 0;              /* True if -fullshm is passed */
1440   int isDefault = 0;              /* True if -default is passed */
1441   int szOsFile = 0;               /* Value passed to -szosfile */
1442   int mxPathname = -1;            /* Value passed to -mxpathname */
1443   int iVersion = 3;               /* Value passed to -iversion */
1444 
1445   if( objc<2 || 0!=(objc%2) ) goto bad_args;
1446   for(i=2; i<objc; i += 2){
1447     int nSwitch;
1448     char *zSwitch;
1449     zSwitch = Tcl_GetStringFromObj(objv[i], &nSwitch);
1450 
1451     if( nSwitch>2 && 0==strncmp("-noshm", zSwitch, nSwitch) ){
1452       if( Tcl_GetBooleanFromObj(interp, objv[i+1], &isNoshm) ){
1453         return TCL_ERROR;
1454       }
1455       if( isNoshm ) isFullshm = 0;
1456     }
1457     else if( nSwitch>2 && 0==strncmp("-default", zSwitch, nSwitch) ){
1458       if( Tcl_GetBooleanFromObj(interp, objv[i+1], &isDefault) ){
1459         return TCL_ERROR;
1460       }
1461     }
1462     else if( nSwitch>2 && 0==strncmp("-szosfile", zSwitch, nSwitch) ){
1463       if( Tcl_GetIntFromObj(interp, objv[i+1], &szOsFile) ){
1464         return TCL_ERROR;
1465       }
1466     }
1467     else if( nSwitch>2 && 0==strncmp("-mxpathname", zSwitch, nSwitch) ){
1468       if( Tcl_GetIntFromObj(interp, objv[i+1], &mxPathname) ){
1469         return TCL_ERROR;
1470       }
1471     }
1472     else if( nSwitch>2 && 0==strncmp("-iversion", zSwitch, nSwitch) ){
1473       if( Tcl_GetIntFromObj(interp, objv[i+1], &iVersion) ){
1474         return TCL_ERROR;
1475       }
1476     }
1477     else if( nSwitch>2 && 0==strncmp("-fullshm", zSwitch, nSwitch) ){
1478       if( Tcl_GetBooleanFromObj(interp, objv[i+1], &isFullshm) ){
1479         return TCL_ERROR;
1480       }
1481       if( isFullshm ) isNoshm = 0;
1482     }
1483     else{
1484       goto bad_args;
1485     }
1486   }
1487 
1488   if( szOsFile<sizeof(TestvfsFile) ){
1489     szOsFile = sizeof(TestvfsFile);
1490   }
1491 
1492   zVfs = Tcl_GetString(objv[1]);
1493   nByte = sizeof(Testvfs) + (int)strlen(zVfs)+1;
1494   p = (Testvfs *)ckalloc(nByte);
1495   memset(p, 0, nByte);
1496   p->iDevchar = -1;
1497   p->iSectorsize = -1;
1498 
1499   /* Create the new object command before querying SQLite for a default VFS
1500   ** to use for 'real' IO operations. This is because creating the new VFS
1501   ** may delete an existing [testvfs] VFS of the same name. If such a VFS
1502   ** is currently the default, the new [testvfs] may end up calling the
1503   ** methods of a deleted object.
1504   */
1505   Tcl_CreateObjCommand(interp, zVfs, testvfs_obj_cmd, p, testvfs_obj_del);
1506   p->pParent = sqlite3_vfs_find(0);
1507   p->interp = interp;
1508 
1509   p->zName = (char *)&p[1];
1510   memcpy(p->zName, zVfs, strlen(zVfs)+1);
1511 
1512   pVfs = (sqlite3_vfs *)ckalloc(sizeof(sqlite3_vfs));
1513   memcpy(pVfs, &tvfs_vfs, sizeof(sqlite3_vfs));
1514   pVfs->pAppData = (void *)p;
1515   pVfs->iVersion = iVersion;
1516   pVfs->zName = p->zName;
1517   pVfs->mxPathname = p->pParent->mxPathname;
1518   if( mxPathname>=0 && mxPathname<pVfs->mxPathname ){
1519     pVfs->mxPathname = mxPathname;
1520   }
1521   pVfs->szOsFile = szOsFile;
1522   p->pVfs = pVfs;
1523   p->isNoshm = isNoshm;
1524   p->isFullshm = isFullshm;
1525   p->mask = TESTVFS_ALL_MASK;
1526 
1527   sqlite3_vfs_register(pVfs, isDefault);
1528 
1529   return TCL_OK;
1530 
1531  bad_args:
1532   Tcl_WrongNumArgs(interp, 1, objv, "VFSNAME ?-noshm BOOL? ?-fullshm BOOL? ?-default BOOL? ?-mxpathname INT? ?-szosfile INT? ?-iversion INT?");
1533   return TCL_ERROR;
1534 }
1535 
1536 int Sqlitetestvfs_Init(Tcl_Interp *interp){
1537   Tcl_CreateObjCommand(interp, "testvfs", testvfs_cmd, 0, 0);
1538   return TCL_OK;
1539 }
1540 
1541 #endif
1542