Vous êtes nouveau sur Developpez.com ? Créez votre compte ou connectez-vous afin de pouvoir participer !

Vous devez avoir un compte Developpez.com et être connecté pour pouvoir participer aux discussions.

Vous n'avez pas encore de compte Developpez.com ? Créez-en un en quelques instants, c'est entièrement gratuit !

Si vous disposez déjà d'un compte et qu'il est bien activé, connectez-vous à l'aide du formulaire ci-dessous.

Identifiez-vous
Identifiant
Mot de passe
Mot de passe oublié ?
Créer un compte

L'inscription est gratuite et ne vous prendra que quelques instants !

Je m'inscris !

Pascal : SQLite sous Windows, cryptage à la volée,
Un billet de Tourlourou

Le , par tourlourou

0PARTAGES

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

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

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

Une erreur dans cette actualité ? Signalez-le nous !