
Pour répondre à des besoins de confidentialité, on peut crypter les champs de la base. Cela gonfle le code et alourdit les appels. Pour simplifier ces accès, crypter la base est plus naturel. Faute de solution libre et gratuite pour ce SGBD, j'ai cherché à exploiter la capacité de la version 3 de SQLite de gérer des systèmes de fichiers virtuels.
SQLite est multiplateformes alors que chaque OS (Operating System) implémente différemment l'accès aux fichiers. SQLite exploite donc en interne :
1) une couche d'abstraction vis-à-vis de l'OS, définissant un Système de Fichier Virtuel (VFS) aux méthodes communes ;
2) une couche d'appel spécifique dont l'implémentation de ces méthodes suffit à le rendre portable sur chaque OS.
Il y a ainsi des distributions Windows, Unix, os/2, etc.
Principes, détournements :

SQLite et systèmes de fichier :
Le VFS est décrit par une structure sqlite3_vfs de type enregistrement qui pointe sur des méthodes générales que l'OS sous-jacent doit implémenter : droits d'accès, ouverture, effacement de fichier, messages d'erreurs, etc. Cette structure est déclarée par SQLite et susceptible d'évoluer au fil des versions.
Le VFS doit assurer des méthodes d'accès aux fichiers ouverts : lecture, écriture, fermeture, etc. La structure sqlite3_io_methods pointe vers ces méthodes.
Une structure sqlite3_file, de type enregistrement, est retournée lors de l'ouverture d'un fichier. Elle maintient les informations nécessaires au VFS pour un fichier particulier (verrous, etc.). Le premier champ est un pointeur vers la structure sqlite3_io_methods (SQLite a besoin de savoir quelles méthodes utiliser pour un fichier), mais le VFS est libre d'ajouter les champs qu'il lui plaira : SQLite ne préjuge pas de ses besoins.
SQLite permet à l'exécution d'utiliser plusieurs VFS en les enregistrant par leur nom (qui doit donc être unique). Il offre ensuite le choix du VFS pour se connecter à une base. L'interface Open de base utilise le VFS par défaut (qui est sélectionnable), mais sa version Open_v2 permet de spécifier le VFS particulier à utiliser pour un fichier.
Interface VFS de SQLite :
Elle a nécessité des traductions à partir du C, en se basant sur la documentation SQLite (malheureusement non exhaustive), sur le wrapper d'IndaSoftware, et le code (non documenté) de l'implémentation du VFS Windows 32 Bits os_win.c dans le répertoire des sources SQLite. Seul ce dernier fichier décrit la déclinaison propre à Windows 32 Bits de la structure file.
Le code débute par les constantes qui définissent nos exigences de versions :
Code Pascal : | Sélectionner tout |
1 2 3 4 5 6 7 8 9 10 11 12 13 14 | unit lySQLite3OSIntf; interface uses SysUtils, lySQLite3Intf; const // informations de versions pour SQLite 3.7.17 MinVersion = 3007017; IO_Version = 3; VfsVersion = 3; Win32VFSName = 'win32'; WinFileStructLength = 72; |
Suivent les constantes définies par SQLite, sans intérêt pour notre propos. Certaines ne seraient utiles que pour redéfinir complètement un VFS, d'autres pour l'utilisation de Open_v2, par exemple.
Puis suivent les structures qui pointent sur les méthodes. Il fallait déclarer tous les types nécessaires pour une réécriture complète de VFS.
A tout seigneur, tout honneur : le VFS :
Code Pascal : | Sélectionner tout |
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 | type // pointeurs sur structures ou méthodes PSQLiteVFS = ^TSQLiteVFS; // système de fichier virtuel PSystemCall = Pointer; // adresse des méthodes systèmes internes à la VFS // caractéristiques d'un VFS (Système de Fichier Virtuel) TSQLiteVFS = record // champs de la version 1 (à partir 3.5.0) Version: integer; // VfsVersion = 3 pour la version 3.7.17 de SQLite szOsFile: integer; // taille de la structure SQLite3_File retournée (champs personnels additionnels possibles) mxPathname: integer; // Maximum file pathname length Next: PSQLiteVFS; // interne à SQLite : pas touche ! Name: PChar; // Name of this virtual file system : doit être unique AppData: Pointer; // Pointer to application-specific data // si Name = nil => utiliser nom temporaire propre au VFS // OutFlags doit refléter SQLITE_OPEN_READONLY si besoin Open: function(aVFS: PSQLiteVFS; aName: PAnsiChar; aFile: PSQLiteFile; aFlags: integer; var aOutFlags: integer): integer; cdecl; Delete: function(aVFS: PSQLiteVFS; aName: PAnsiChar; aSyncDir: LongBool): integer; cdecl; Access: function(aVFS: PSQLiteVFS; aName: PAnsiChar; aFlags: integer; var aOutFlags: integer): integer; cdecl; FullPathName: function(aVFS: PSQLiteVFS; aRelativePath: PChar; aFullPathSize: integer; aFullPath: PChar): integer; cdecl; // 4 fonctions liées aux librairies dynamiques DlOpen: function(aVFS: PSQLiteVFS; aFileName: PChar): Pointer; cdecl; DlError: procedure(aVFS: PSQLiteVFS; aBufferSize: integer; aBuffer: PChar); cdecl; DlSym: function(aVFS: PSQLiteVFS; aAddress: Pointer; aProcName: PChar): Pointer; cdecl; // pour Symbol = GetProcAddress DlClose: procedure(aVFS: PSQLiteVFS; aHandle: Pointer); cdecl; // pour initialisation générateur interne Randomness: function(aVFS: PSQLiteVFS; aBufferSize: integer; aBuffer: PChar): integer; cdecl; Sleep: function(aVFS: PSQLiteVFS; aMicroSeconds: integer): integer; cdecl; CurrentTime: function(aVFS: PSQLiteVFS; var aNow: Double): integer; cdecl; GetLastError: function(aVFS: PSQLiteVFS; aBufferSize: integer; aBuffer: PChar): integer; cdecl; // champs de la version 2 (à partir 3.x.x) CurrentTime64: function(aVFS: PSQLiteVFS; var aNow: int64): integer; cdecl; // SQLite utilisera CurrentTime si fonction non disponible // champs de la version 3 ; donnent accès pour débogage aux adresses des méthodes systèmes internes au VFS (à partir 3.7.6) // principe étendu à tous les appels à partir de la 3.7.10 SetSystemCall: function(aVFS: PSQLiteVFS; aName: PChar; aSystemCall: PSystemCall): integer; cdecl; GetSystemCall: function(aVFS: PSQLiteVFS; aName: PChar): PSystemCall; cdecl; NextSystemCall: function(aVFS: PSQLiteVFS; aName: PChar): PChar; cdecl; // Additional fields may be added in future releases (i.e. > 3.7.17 and Version > 3) end; |
Le VFS indique notamment :
1) la taille szOsFile du champ sqlite3_file que SQLite doit allouer pour que sa méthode Open puisse le renseigner ;
2) son nom (ici : 'win32') ;
3) plusieurs données ou méthodes dévolues à l'OS (MaxPathName, Sleep, GetLastError, CurrentTime, Randomness, gestion des bibliothèques à chargement dynamique utilisables grâce à l'interface sqlite3_load_extension) ;
4) les fonctions de redirection des appels système, qui seront traitées plus loin.
Suivent les autres structures qui nous permettront de bien appréhender le fonctionnement du VFS de SQLite, avec tout d'abord celle qui pointe sur les méthodes I/O :
Code Pascal : | Sélectionner tout |
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 | type // pointeurs sur structures de manipulation du fichier PSQLiteFile = ^TSQLiteFile; // fichier ouvert // méthodes d'accès aux fichiers ouverts décrits dans des objets SQLite3_File TSQLiteIO = record // méthodes de la version 1 (à partir 3.5.0) Version: integer; // IO_Version = 3 pour la version 3.7.17 de SQLite Close: function(aFile: PSQLiteFile): integer; cdecl; Read: function(aFile: PSQLiteFile; aData: PByteArray; aSize: integer; aOffset: int64): integer; cdecl; Write: function(aFile: PSQLiteFile; aData: PByteArray; aSize: integer; aOffset: int64): integer; cdecl; Truncate: function(aFile: PSQLiteFile; aSize: int64): integer; cdecl; Sync: function(aFile: PSQLiteFile; aFlags: integer): integer; cdecl; FileSize: function(aFile: PSQLiteFile; var aSize: int64): integer; cdecl; Lock: function(aFile: PSQLiteFile; aLocktype: integer): integer; cdecl; Unlock: function(aFile: PSQLiteFile; aLocktype: integer): integer; cdecl; CheckReservedLock: function(aFile: PSQLiteFile; var aResOut: LongBool): integer; cdecl; FileControl: function(aFile: PSQLiteFile; aOpCode: integer; aArg: Pointer): integer; cdecl; SectorSize: function(aFile: PSQLiteFile): integer; cdecl; DeviceCharacteristics: function(aFile: PSQLiteFile): integer; cdecl; // méthodes de la version 2 (gestion de la mémoire partagée, nécessaire au mode WAL = Write-Ahead Logging ; à partir 3.7.0 ?) ShmMap: function(aFile: PSQLiteFile; aPage, aPageSize: integer; aExtendFile: LongBool; var aPMapping: Pointer): integer; cdecl; ShmLock: function(aFile: PSQLiteFile; aOffset, aNb, aFlags: integer): integer; cdecl; ShmBarrier: procedure(aFile: PSQLiteFile); cdecl; ShmUnMap: function(aFile: PSQLiteFile; aDeleteFlag: integer): integer; cdecl; // méthodes de la version 3 (pour le mappage des fichiers en mémoire, à partir 3.7.17) Fetch: function(aFile: PSQLiteFile; aOffset: int64; aSize: integer; var aPMapping: Pointer): integer; cdecl; UnFetch: function(aFile: PSQLiteFile; aOffset: int64; aPMapping: Pointer): integer; cdecl; // Additional methods may be added in future releases (i.e. > 3.7.17 and Version > 3) end; |
Puis celle sur les informations fichier :
Code Pascal : | Sélectionner tout |
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 | type // pointeurs sur structures de manipulation du fichier PSQLiteIO = ^TSQLiteIO; // méthodes d'accès au fichier // structure des données pour la manipulation du fichier ouvert par la méthode Open de la VFS de Win32 // code traduit de l'unité os_win.c du source de la bibliothèque SQLite3 // le reste est documenté dans l'aide de SQLite3, mais pas cet aspect. // A l'exécution, la taille de cette structure est de 72 octets // du fait de l'alignement pair des données de type Byte. // Traduction en packed record avec des octets vides. TSQLiteFile = packed record IO_Methods: PSQLiteIO; // Methods for an opened file PVFS: PSQLiteVFS; // The VFS used to open this file HFile: THandle; // Handle for accessing the file LockType: Byte; // Type of lock currently held on this file __NotUsed1: Byte; // Padding SharedLockByte: Byte; // Randomly chosen byte used as a shared lock __NotUsed2: Byte; // Padding CtrlFlags: Byte; // WINFILE_PERSIST_WAL = $4 et/ou WINFILE_PSOW = $10 (POWERSAFE_OVERWRITE) __NotUsed3: Byte; // Padding __NotUsed4: Word; // Padding LastErrNo: Cardinal; // The Windows errno from the last I/O error PShm: Pointer; // Instance of shared memory on this file Path: PAnsiChar; // Full pathname of this file ChunkSize: integer; // Chunk size configured by FCNTL_CHUNK_SIZE // plus 36 octets de données ajoutés pour le mappage des fichiers en mémoire, à partir 3.7.17 nFetchOut: integer; // Number of outstanding xFetch references hMap: THandle; // Handle for accessing memory mapping pMapRegion: Pointer; // Area memory mapped mmapSize: int64; // Usable size of mapped region mmapSizeActual: int64; // Actual size of mapped region mmapSizeMax: int64; // Configured FCNTL_MMAP_SIZE value end; |
Il ne manque plus que la gestion des VFS à l'exécution, qui fait appel à trois fonctions pour les enregistrer, consulter, effacer. Et une fonction d'ouverture de base de données qui permette de spécifier le VFS à utiliser :
Code Pascal : | Sélectionner tout |
1 2 3 4 5 6 7 | // procédures relatives aux VFS function sqlite3_vfs_find(aVfsName: PChar): PSQLiteVFS; cdecl; external DllName; function sqlite3_vfs_register(aVFS: PSQLiteVFS; aMakeDefault: LongBool): integer; cdecl; external DllName; function sqlite3_vfs_unregister(aVFS: PSQLiteVFS): integer; cdecl; external DllName; // ouverture fichier en spécifiant le nom de la VFS à utiliser function sqlite3_open_v2(aFileName: PChar; var aDB: PSQLiteDB; aOpenMode: integer; aVfsName: PChar): integer; cdecl; external DllName; |
Et enfin, le code qui empêche d'utiliser une version précédente incompatible de la librairie :
Code Pascal : | Sélectionner tout |
1 2 3 4 5 6 7 8 9 10 | implementation initialization if MinVersion > sqlite3_libversion_number then raise Exception.Create('Cryptage prévu seulement pour SQLite 3.7.17 ou supérieur ; ici : ' + sqlite3_libversion); finalization // DoNone end. |
Ma première idée était de créer un VFS de novo implémentant toutes les fonctionnalités requises, basé sur un flux (TMemoryStream ?). L'ampleur de la tâche m'a vite découragé !
Ma seconde idée a été de créer un VFS qui profiterait de toutes les fonctionnalités de celui de Windows en ne modifiant que les appels de lecture/écriture pour intercaler le (dé)cryptage de façon transparente, exploitant l'interface open_V2 de SQLite qui permet de spécifier quel VFS utiliser pour ouvrir une base.
Tentative de surcharge de VFS :
Pour la mise en œuvre, il y avait plusieurs étapes à assurer :
- Récupérer le VFS de Windows grâce à sqlite3_vfs_find('win32') pour en peupler celui qui pointerait vers le nôtre ;
- Enregistrer notre VFS pour qu'il soit utilisable sur option en ouverture de fichier : sqlite3_vfs_register(@CryptoVfs, False) ;
- Renvoyer à SQLite lors de l'ouverture d'un fichier crypté l'enregistrement sqlite3_file retourné par les méthodes Windows, en ayant soin de rediriger les méthodes voulues de son champ sqlite3_io_methods vers les nôtres.
A l'époque sous Windows 95 avec Delphi 5 et une version 3.6.x de SQLite, je ne vous cacherai pas que tout n'a pas fonctionné comme ça semblait devoir...

Ayant évolué vers Windows 7 et CodeTyphon (Lazarus), j'ai repris le problème alors que SQLite était parvenu en version 3.7.17 . Or l'interface des VFS s'était justement enrichie lors du passage en version 3.7.6 de fonctions permettant de rediriger les appels système.
Utilisation de l'interface SQLite de surcharge des appels système :
Ces appels système sont des fonctions fournies par l'API de l'OS. Cette fonctionnalité a été développée pour permettre des tests lors de la mise au point des VFS (pour simuler des erreurs ou des configurations rares ou difficiles à reproduire). Jusqu'à la version 3.7.10, tous les VFS n'implémentaient pas la possibilité de rediriger tous les appels système, à la différence de celui pour Windows 32 Bits.
Pour ce qui nous occupe, il suffit de rediriger les appels systèmes de lecture et écriture vers des routines propres chargées d'intercaler un cryptage. C'est donc une sorte de surcharge, comme en POO (anecdotiquement, la documentation SQLite parle d'ailleurs d'objets pour les structures vfs, io_methods et file, qui sont des enregistrements).
Comme on le voit dans cet extrait de l'unité os_win.c, SQLite définit un tableau d'adresses des fonctions de l'API à appeler, qu'il initialise avec celles de l'OS concerné :
Code C : | Sélectionner tout |
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 | /* ** Many system calls are accessed through pointer-to-functions so that ** they may be overridden at runtime to facilitate fault injection during ** testing and sandboxing. The following array holds the names and pointers ** to all overrideable system calls. */ static struct win_syscall { const char *zName; /* Name of the system call */ sqlite3_syscall_ptr pCurrent; /* Current value of the system call */ sqlite3_syscall_ptr pDefault; /* Default value */ } aSyscall[] = { // first calls here { "ReadFile", (SYSCALL)ReadFile, 0 }, #define osReadFile ((BOOL(WINAPI*)(HANDLE,LPVOID,DWORD,LPDWORD, \ LPOVERLAPPED))aSyscall[50].pCurrent) // some calls here { "WriteFile", (SYSCALL)WriteFile, 0 }, #define osWriteFile ((BOOL(WINAPI*)(HANDLE,LPCVOID,DWORD,LPDWORD, \ LPOVERLAPPED))aSyscall[59].pCurrent) // last calls here }; /* End of the overrideable system calls */ |
Il suffit donc d'utiliser SetSystemCall pour détourner les fonctions de lecture et écriture vers nos routines. On voit qu'elles ont le même prototype : function(aFile: THandle; var aBuffer: TByteArray; aSize: integer; var aDone: integer; var aOLapd: OverLapped ): Boolean; stdcall;
La position concernée dans le fichier est passée dans le paramètre aOlapd.
Il est immédiat que le cryptage ne doit dépendre que de la position absolue dans le fichier : un même octet à la même position doit être crypté par la même valeur. L'algorithme devra en tenir compte.

Objet encapsulant le cryptage à la volée
Le but est d'ajouter la capacité de cryptage à l'objet élaboré dans le billet précédent, en dérivant un objet de type TlySQLiteCryptDB à partir de la classe de base TlySQLiteDB.
Interface de l'objet :
Elle va exposer un nom de baptême pour le VFS «*maison*» qui doit être identifié par un nom unique, puis le prototype des fonctions CallBacks utilisateur devant assurer le cryptage/décryptage, et enfin l'objet lui-même :
Code Pascal : | Sélectionner tout |
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 | unit lySQLite3CryptDB; // Implémentation d'une BD SQLite3 cryptée à la volée, pour Windows 32 bits, utilisant // (détournant) les systèmes de fichiers virtuels (VFS) de SQLite version 3.7.13 // Yves Lemaire alias tourlourou 2011-2013 // Utilisation libre, mais sans garantie, // sous réserve de conserver cet en-tête {$mode objfpc}{$H+} interface uses Classes, SysUtils, Windows, lySQLite3DB, lySQLite3OSIntf; type // prototype des fonctions de cryptage/décryptage à passer en CallBack TCryptAlg = function(var Buffer: TByteArray; Size: integer; Position: int64; PassWord: string; Write: Boolean): Boolean; // classe qui encapsule une BDD SQLite3 (version 3.7.17) cryptée à la volée TlySQLiteCryptDB = class(TlySQLiteDB) private WinVfs: PSQLiteVFS; public constructor Create; overload; destructor Destroy; override; function Open(aDBName: TFileName): Boolean; override; function Open(aDBName: TFileName; aCryptAlg: TCryptAlg; aPassWord: string): Boolean; overload; // passer nil ou EmptyStr si pas de cryptage end; |
La déclaration de l'objet est sans difficulté particulière, avec la surcharge nécessaire pour gérer l'accès à la méthode ancêtre Open sans paramètres.
Implémentation de l'objet :
Elle est fort simple :
1) à la création de l'objet, il s'agit de détourner les méthodes du VFS en redirigeant les appels système de lecture et écriture vers des fonctions internes propres chargées d'appeler au besoin la fonction utilisateur de cryptage/décryptage ;
2) à l'ouverture d'une base, il faudra enregistrer si elle nécessite un cryptage, et dans ce cas, mémoriser le mot de passe et l'adresse de la CallBack ;
3) à la libération de l'objet, il faudra bien sûr réinitialiser les appels système.
Comme les fonctions système ne sont pas des méthodes d'objet, il a fallu déclarer des variables qui leur soient accessibles, dans la partie implémentation de l'unité.

Code Pascal : | Sélectionner tout |
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 | implementation uses lySQLite3Intf; type // prototype des fonctions d'accès interne aux fichiers du VFS de Win32 TOSReadWrite = function(aFile: THandle; var aBuffer: TByteArray; aSize: integer; var aDone: integer; var aOLapd: OverLapped ): Boolean; stdcall; var // nécessaires car visibles des fonctions d'accès fichiers ci-dessous // attention : compatible exclusivement avec le pattern singleton WinRead, WinWrite: TOSReadWrite; lyCryptAlg: TCryptAlg; lyPassWord: String; MustCrypt: Boolean; |
Lors de la création de l'objet, il faut récupérer les appels système puis les détourner vers les nôtres :
Code Pascal : | Sélectionner tout |
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 | constructor TlySQLiteCryptDB.Create; begin inherited Create; // initialisations liées au cryptage MustCrypt:=False; // récupération du VFS par défaut = Win32 WinVfs:=sqlite3_vfs_find(nil); // nil => renvoie VFS par défaut if not Assigned(WinVfs) then raise Exception.Create('Erreur VFS par défaut renvoyé nil'); if WinVfs^.Name<>Win32VFSName then raise Exception.Create('Erreur de nom de VFS ; réservé aux systèmes Win32, sauf CE'); if WinVfs^.Version<VfsVersion then raise Exception.Create('Erreur de compatibilité de version de VFS'); // détournement des accès système de lecture et écriture WinRead:=TOSReadWrite(WinVfs^.GetSystemCall(WinVfs, 'ReadFile')); if not Assigned(WinRead) then raise Exception.Create('Erreur récupération ReadFile'); if WinVfs^.SetSystemCall(WinVfs, 'ReadFile', @lyCryptRead)<>SQLITE_OK then raise Exception.Create('Erreur d''enregistrement lyReadFile'); WinWrite:=TOSReadWrite(WinVfs^.GetSystemCall(WinVfs, 'WriteFile')); if not Assigned(WinWrite) then raise Exception.Create('Erreur récupération WriteFile'); if WinVfs^.SetSystemCall(WinVfs, 'WriteFile', @lyCryptWrite)<>SQLITE_OK then raise Exception.Create('Erreur d''enregistrement lyWriteFile'); end; |
A sa libération, il suffit de les réinitialiser :
Code Pascal : | Sélectionner tout |
1 2 3 4 5 6 | destructor TlySQLiteCryptDB.Destroy; begin inherited Destroy; // restauration des appels système if WinVfs^.SetSystemCall(WinVfs, nil, nil)<>SQLITE_OK then raise Exception.Create('Erreur de réenregistrement SysCalls'); end; |
L'ouverture d'une base peut se faire sans ou avec cryptage :
Code Pascal : | Sélectionner tout |
1 2 3 4 5 6 7 8 9 10 11 12 | function TlySQLiteCryptDB.Open(aDBName: TFileName): Boolean; begin Result := Open(aDBName, nil, EmptyStr); end; function TlySQLiteCryptDB.Open(aDBName: TFileName; aCryptAlg: TCryptAlg; aPassWord: string): Boolean; begin Result := inherited Open(aDBName); lyCryptAlg := aCryptAlg; lyPassWord := aPassWord; MustCrypt := Assigned(lyCryptAlg) and (lyPassWord>EmptyStr); end; |

Il nous reste à voir le cœur des opérations, à savoir les fonctions « surchargées » de lecture/écriture :
Code Pascal : | Sélectionner tout |
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 | function lyCryptRead(aFile: Handle; var aBuffer: TByteArray; aSize: integer; var aDone: integer; var aOLapd: OverLapped ): Boolean; stdcall; var Offset: int64; begin Result:=WinRead(aFile, aBuffer, aSize, aDone, aOLapd); // on laisse faire WinVFS... if Result and MustCrypt then begin // on décrypte le Buffer Offset := aOLapd.Offset + aOLapd.OffsetHigh shl 32 ; if not lyCryptAlg(aBuffer, aDone, Offset, lyPassWord, False) then aDone:=0; // SQLite renverra le Buffer vide et ShortRead alors que c'est un problème de décryptage... end; end; function lyCryptWrite(aFile: integer; var aBuffer: TByteArray; aSize: integer; var aDone: integer; var aOLapd: OverLapped ): Boolean; stdcall; var Offset: int64; PCryptBuffer: PByteArray; begin if not MustCrypt then Result:=WinWrite(aFile, aBuffer, aSize, aDone, aOLapd) // on laisse faire WinVFS... else begin // on crypte le Buffer PCryptBuffer:=GetMem(aSize); Move(aBuffer, PCryptBuffer^, aSize); Offset := aOLapd.Offset + aOLapd.OffsetHigh shl 32 ; if not lyCryptAlg(PCryptBuffer^, aSize, Offset, lyPassWord, True) then aDone:=-1 // indiquera une erreur d'écriture alors que c'est un problème de cryptage... else Result:=WinWrite(aFile, PCryptBuffer^, aSize, aDone, aOLapd); FreeMem(PCryptBuffer); end; end; |
Elles orchestrent seulement les appels à la CallBack utilisateur et au système.
Exemple d'utilisation :
Restons fidèles au modèle de fiche avec un bouton, une StringGrid et un Memo :
Code Pascal : | Sélectionner tout |
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 | unit Unit1; {$mode objfpc}{$H+} interface uses Classes, SysUtils, FileUtil, Forms, Controls, Graphics, Dialogs, StdCtrls, Grids, lySqlite3Intf, lySQLite3Param, lySqlite3DB, lySQLite3OSIntf, lySQLite3CryptDB; type { TForm1 } TForm1 = class(TForm) Button1: Tbutton; StringGrid1: TStringGrid; Memo1: Tmemo; procedure MemoLog(aSender: TObject; aText: string); procedure Button1Click(Sender: TObject); private { private declarations } public { public declarations } end; var Form1: TForm1; implementation |
On fournit une fonction chargée du cryptage/décryptage ; ici, un simple cryptage de type XOR, réversible. La fonction ne tient donc pas compte du paramètre aWrite :
Code Pascal : | Sélectionner tout |
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 | function TestCrypt(var aBuffer: TByteArray; aSize: integer; aPosition: int64; aPassWord: string; aWrite: Boolean): Boolean; var i, j, l: integer; srce, pass: Byte; begin l:=Length(aPassWord); for i:=1 to aSize do begin srce:=aBuffer[i-1]; j := (aPosition + i) mod l ; if j=0 then j:=l; pass:=Ord(aPassWord[j]); if (srce>0) and (srce<>pass) then aBuffer[i-1] := srce xor pass ; end; Result:=True; end; |
Pour avoir le retour des événements log, on fournit une CallBack, MemoLog, qui les affichera dans le Memo.
Code Pascal : | Sélectionner tout |
1 2 3 4 5 6 | { TForm1 } procedure TForm1.MemoLog(aSender: TObject; aText: string); begin Memo1.Lines.Add(' >'+aText); end; |
On va loger dans le code du bouton plusieurs types d'utilisations des objets, et un test de vitesse. Le code devrait être suffisamment parlant à l'écriture et à l'exécution pour se passer d'autres commentaires.
Pour les besoins de la démonstration, vous remplacerez dans le code du bouton la valeur de la constante Path_Bdd par un chemin vers un fichier existant (attention : selon son nom, il pourra être recréé). La démonstration créera successivement 3 fichiers d'après ce modèle, avec les extensions '.cry' pour crypté, '.clr' pour clair, et '.bdd' pour l'objet ne gérant pas le cryptage.

Code Pascal : | Sélectionner tout |
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 | procedure TForm1.Button1Click(Sender: Tobject); const Path_Bdd = 'c:\userfiles\test.txt' ; // à personnaliser Flush = 'OFF' ; // 'ON' pour activer le Flush à chaque écriture NbTests = 5000 ; // nombre d'itérations pour le test de vitesse var MyBd: TlySQLiteCryptDB; MyDb: TlySQLiteDB; SQList: TStringList; MyDbName, S: string; i, intervalle: integer; dtBegin, dtEnd, dtElapsed: TDateTime; begin Memo1.Clear; intervalle := NbTests div 10; MyBd:=TlySQLiteCryptDB.Create; MyBd.AutoLog:=False; MyBd.OnLog:=@MemoLog; MyBd.LogRequests:=True; Memo1.Lines.Add('***** connexion de TlySQLiteCryptDB à une base cryptée *****'); MyDbName:=ChangeFileExt(Path_Bdd, '.cry'); DeleteFile(MyDbName); // on devrait tester les valeurs de retour de toutes les fonctions, // mais comme on a le log, on va alléger le code pour la lisibilité if not MyBd.Open(MyDbName, @TestCrypt, 'test_password') then Memo1.Lines.Add(MyBD.LastErrorMsg); Memo1.Lines.Add('***** création de la table, utilisation de Execute(TStrings) *****'); SQList:=TStringList.Create; SQList.Add('CREATE TABLE employes ( id INTEGER PRIMARY KEY , nom TEXT , age INTEGER )'); SQList.Add('INSERT INTO employes ( nom , age ) VALUES ( "toto" , 50 )'); SQList.Add('INSERT INTO employes ( nom , age ) VALUES ( "tata" , 25 )'); MyBd.Execute(SQList); SQList.Free; Memo1.Lines.Add('***** appel de ToStringGrid *****'); MyBd.ToStringGrid(StringGrid1, 'SELECT * FROM employes'); StringGrid1.Refresh; // tests de vitesse Memo1.Lines.Add('***** test de célérité de TlySQLiteCryptDB avec une base cryptée *****'); MyBd.Execute('DELETE FROM employes'); MyBd.Execute('PRAGMA synchronous = '+Flush); MyBd.OnLog:=nil; dtBegin:=Now; for i:=1 to NbTests do begin S:=IntToStr(i); MyBd.Execute('INSERT INTO employes ( nom , age ) VALUES ( "tutu" , '+S+' )'); if i mod intervalle = 0 then Memo1.Lines.Add('écriture '+S+'/'+IntToStr(NbTests)); end; Memo1.Lines.Add(TimeToStr(Now-dtBegin)); for i:=1 to NbTests do begin MyBd.ToString(S, 'SELECT rowid FROM employes WHERE age = '+IntToStr(i)); if i mod intervalle = 0 then Memo1.Lines.Add('lecture '+S+'/'+IntToStr(NbTests)); end; dtEnd:=Now; dtElapsed:=dtEnd-dtBegin; Memo1.Lines.Add('Total : '+TimeToStr(dtElapsed)); Memo1.Lines.Add('***** test de célérité de TlySQLiteCryptDB avec une base non cryptée *****'); MyBd.OnLog:=@MemoLog; MyBd.LogRequests:=True; MyDbName:=ChangeFileExt(Path_Bdd, '.clr'); DeleteFile(MyDbName); MyBd.Open(MyDbName); MyBd.Execute('PRAGMA synchronous = '+Flush); MyBd.Execute('CREATE TABLE employes ( id INTEGER PRIMARY KEY , nom TEXT , age INTEGER )'); MyBd.OnLog:=nil; dtBegin:=Now; for i:=1 to NbTests do begin S:=IntToStr(i); MyBd.Execute('INSERT INTO employes ( nom , age ) VALUES ( "tutu" , '+S+' )'); if i mod intervalle = 0 then Memo1.Lines.Add('écriture '+S+'/'+IntToStr(NbTests)); end; Memo1.Lines.Add(TimeToStr(Now-dtBegin)); for i:=1 to NbTests do begin MyBd.ToString(S, 'SELECT rowid FROM employes WHERE age = '+IntToStr(i)); if i mod intervalle = 0 then Memo1.Lines.Add('lecture '+S+'/'+IntToStr(NbTests)); end; dtEnd:=Now; dtElapsed:=dtEnd-dtBegin; Memo1.Lines.Add('Total : '+TimeToStr(dtElapsed)); MyBd.Free; Memo1.Lines.Add('***** test de célérité de TlySQLiteDB avec une base en clair *****'); MyDb:=TlySQLiteDB.Create; MyDb.OnLog:=@MemoLog; MyDb.LogRequests:=True; MyDbName:=ChangeFileExt(Path_Bdd, '.bdd'); DeleteFile(MyDbName); MyDb.Open(MyDbName); MyDb.Execute('PRAGMA synchronous = '+Flush); MyDb.Execute('CREATE TABLE employes ( id INTEGER PRIMARY KEY , nom TEXT , age INTEGER )'); MyDb.OnLog:=nil; dtBegin:=Now; for i:=1 to NbTests do begin S:=IntToStr(i); MyDb.Execute('INSERT INTO employes ( nom , age ) VALUES ( "tutu" , '+S+' )'); if i mod intervalle = 0 then Memo1.Lines.Add('écriture '+S+'/'+IntToStr(NbTests)); end; Memo1.Lines.Add(TimeToStr(Now-dtBegin)); for i:=1 to NbTests do begin MyDb.ToString(S, 'SELECT rowid FROM employes WHERE age = '+IntToStr(i)); if i mod intervalle = 0 then Memo1.Lines.Add('lecture '+S+'/'+IntToStr(NbTests)); end; dtEnd:=Now; dtElapsed:=dtEnd-dtBegin; Memo1.Lines.Add('Total : '+TimeToStr(dtElapsed)); MyDb.OnLog:=@MemoLog; MyDb.LogRequests:=True; MyDb.Free; end; end. |
Observations :
Les tests ne montrent pas de réduction sensible de la vitesse par le cryptage à la volée. C'est le recours à l'OS pour les opérations physiques d'entrées/sorties qui est le facteur limitant, surtout en écriture, comme on peut le voir en adoptant la synchronisation const Flush = 'ON' qui entraîne l'écriture physique à chaque opération.
Ci-dessous un exemple avec et sans cryptage de la portion de fichier qui décrit la table dans la base. Les exemples sont tirés des fichiers créés par la démonstration :
fichier en clair :

qui donne une fois crypté :




Chacun aura à cœur d'utiliser un cryptage avec un algorithme personnel efficace tout en gardant à l'esprit qu'il existe des solutions sûres pour ceux dont les besoins excèdent la simple résistance à des débutants.
Conclusion :
Après plusieurs essais infructueux, l'implémentation de cette fonctionnalité n'a été permise aussi facilement que grâce à l'évolution de SQLite.
Il est finalement plutôt aisé et peu pénalisant de crypter à la volée. Et si la qualité du cryptage ne résistera sûrement pas à des experts, cela peut suffire à de nombreux besoins...
Un futur billet ajoutera à la panoplie un objet de type Table ou DataSet et exploitera d'autres fonctionnalités de l'API pour l'alimenter par les requêtes.
Vous trouverez les unités ici : Billet_numero_4.zip
Vous avez lu gratuitement 2 847 articles depuis plus d'un an.
Soutenez le club developpez.com en souscrivant un abonnement pour que nous puissions continuer à vous proposer des publications.
Soutenez le club developpez.com en souscrivant un abonnement pour que nous puissions continuer à vous proposer des publications.