src/test_vfs.c

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