tourlourou

Introduction :

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 :

Nous ne nous int�resserons ici qu'au syst�me Windows 32 Bits, en excluant Windows CE, dont les appels syst�me sont un peu diff�rents.

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 - Visualiser dans une fen�tre � part

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 - Visualiser dans une fen�tre � part

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 - Visualiser dans une fen�tre � part

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 - Visualiser dans une fen�tre � part

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 - Visualiser dans une fen�tre � part

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 - Visualiser dans une fen�tre � part

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 :

1. R�cup�rer le VFS de Windows gr�ce � sqlite3_vfs_find('win32') pour en peupler celui qui pointerait vers le n�tre ;
2. Enregistrer notre VFS pour qu'il soit utilisable sur option en ouverture de fichier : sqlite3_vfs_register(@CryptoVfs, False) ;
3. 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... J'ai atteint mes limites ou celles de l'id�e et laiss� le projet en plan un bon moment.

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 - Visualiser dans une fen�tre � part

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.

En outre, le d�tournement se fera pour tous les acc�s fichiers, donc pour toutes les bases ouvertes gr�ce � la commande SQL ATTACH en m�me temps que celle principale. On ne pourra donc avoir simultan�ment que des bases soit en clair, soit crypt�es avec le m�me algorithme.

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 - Visualiser dans une fen�tre � part

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�.

Du fait de ces variables li�es � l'unit�, il est indispensable de respecter le patron singleton pour l'objet anc�tre TlySQLiteDB (il est ais� de le rendre multi-instances).

Code Pascal :

S�lectionner tout - Visualiser dans une fen�tre � part

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 - Visualiser dans une fen�tre � part

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 - Visualiser dans une fen�tre � part

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 - Visualiser dans une fen�tre � part

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;

Quelle que soit la signature de la fonction Open, il n'y aura pas de cryptage en l'absence de mot de passe ou de CallBack.

Il nous reste � voir le c�ur des op�rations, � savoir les fonctions � surcharg�es � de lecture/�criture :

Code Pascal :

S�lectionner tout - Visualiser dans une fen�tre � part

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 - Visualiser dans une fen�tre � part

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 - Visualiser dans une fen�tre � part

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 - Visualiser dans une fen�tre � part

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.

Sous Lazarus, mieux vaut �viter les caract�res accentu�s dans les chemins et respecter sous Windows les contraintes que Linux impose.

Code Pascal :

S�lectionner tout - Visualiser dans une fen�tre � part

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� :



Il n'est pas conseill� (je parle d'exp�rience ) de faire un xor du mot de passe sur une s�rie de #0, sous peine de le voir en clair !

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