FsMinifilter - twinBASIC Minifilter Driver Proof of Concept

[fafalone]

File access block by a filter driver

My demo of using tB to make kernel mode minifilter drivers is now out! This type of driver is useful for antimalware, system monitoring, access control, and other tasks, and unlike hardware drivers or others, is actually practical to make and use in twinBASIC, being only roughly as complicated as regular API-heavy projects. My HelloWorldDriver project demonstrated tB could make a driver, now this project serves as a proof of concept that tB can make useful drivers: This project blocks execution of certain programs or access to certain files by name.

The code for this is simple and straightforward. Head on over to the project repository and check it out! Do read through the whole post there though, there's some important caveats around bugs and different/additional techniques compared to my first driver.
twinBASIC has huge potential for bridging the gap between the power of low level- even down to the kernel- and RAD simplicity. ?

Project repository: https://github.com/fafalone/FsMinifilter


Code preview:

    Private Type BinaryString
        aCH(255) As Integer
    End Type
    Private fileNoOpen As BinaryString
    Private fileNoExec As BinaryString
    Private ucNoOpen As UNICODE_STRING
    Private ucNoExecute As UNICODE_STRING
    Private Declare PtrSafe Sub RtlInitUnicodeString Lib "ntoskrnl.exe" (DestinationString As UNICODE_STRING, SourceString As Any)
    

    Private Callbacks(1) As FLT_OPERATION_REGISTRATION
    ' Private ContextRegistration(1) As FLT_CONTEXT_REGISTRATION 
    Private Type FltCallbackStruct
        Callback(1) As FLT_OPERATION_REGISTRATION
    End Type
    Private CallbacksDbg As FltCallbackStruct
    
    Private FilterRegistration As FLT_REGISTRATION
    Private FilterHandle As LongPtr
    
    Private dbgsEntry As String
    Private dbgsRegOk As String
    Private dbgsBadFile As String
    Private dbgsBadProgram As String

    Private Const g_systemProcessId As LongPtr = 4

    [IgnoreWarnings(TB0026)]
    Public Function DriverEntry(ByRef DriverObject As DRIVER_OBJECT, ByRef RegistryPath As UNICODE_STRING) As NTSTATUS
        UNREFERENCED_PARAMETER(RegistryPath)
        InitDefs
        InitUnicodeStrings
        CallbacksDbg.Callback(0).MajorFunction = IRP_MJ_CREATE
        CallbacksDbg.Callback(0).PreOperation = AddressOf FsPreCreate
        CallbacksDbg.Callback(1).MajorFunction = IRP_MJ_OPERATION_END
        With FilterRegistration
            .Size = LenB(FilterRegistration)
            .Version = FLT_REGISTRATION_VERSION
            .OperationRegistration = VarPtr(CallbacksDbg.Callback(0).MajorFunction)
            .FilterUnloadCallback = AddressOf InstanceFilterUnloadCallback
            .InstanceQueryTeardownCallback = AddressOf InstanceQueryTeardownCallback
        End With
        Dim status As NTSTATUS

        status = FltRegisterFilter(DriverObject, FilterRegistration, FilterHandle)
        DbgPrint1 StrPtr(dbgsRegOk), ByVal status
        If NT_SUCCESS(status) Then
            status = FltStartFiltering(FilterHandle)
            DbgPrint1 StrPtr(dbgsRegOk), ByVal status
            If NT_SUCCESS(status) Then
                Return STATUS_SUCCESS
            End If
        Else
            Return status
        End If
        FltUnregisterFilter FilterHandle
        Return status
    End Function
    
    
    Private Function InstanceFilterUnloadCallback(ByVal Flags As FLT_FILTER_UNLOAD_FLAGS) As NTSTATUS
        UNREFERENCED_PARAMETER(Flags)
        If FilterHandle Then
            FltUnregisterFilter(FilterHandle)
        End If
        Return STATUS_SUCCESS
    End Function
    
    Private Function InstanceSetupCallback(FltObjects As FLT_RELATED_OBJECTS, ByVal Flags As FLT_INSTANCE_SETUP_FLAGS, _
                            ByVal VolumeDeviceType As DEVICE_TYPE, ByVal VolumeFilesystemType As FLT_FILESYSTEM_TYPE) As NTSTATUS
        
        UNREFERENCED_PARAMETER(FltObjects)
        UNREFERENCED_PARAMETER(Flags)
        UNREFERENCED_PARAMETER(VolumeDeviceType)
        UNREFERENCED_PARAMETER(VolumeFilesystemType)
        
        Return STATUS_SUCCESS
    End Function
    
    Public Function InstanceQueryTeardownCallback(FltObjects As FLT_RELATED_OBJECTS, ByVal Flags As FLT_INSTANCE_QUERY_TEARDOWN_FLAGS) As NTSTATUS
        UNREFERENCED_PARAMETER(FltObjects)
        UNREFERENCED_PARAMETER(Flags)
        Return STATUS_SUCCESS
    End Function
    
    Public Function FsPreCreate(Data As FLT_CALLBACK_DATA, FltObjects As FLT_RELATED_OBJECTS, CompletionContext As LongPtr) As FLT_PREOP_CALLBACK_STATUS
        
        UNREFERENCED_PARAMETER(CompletionContext)
        
        If (VarPtr(Data) = 0) Or (VarPtr(FltObjects) = 0) Then
            Return FLT_PREOP_SUCCESS_NO_CALLBACK
        End If
        
        If PsGetCurrentProcessId() = g_systemProcessId Then
            Return FLT_PREOP_SUCCESS_NO_CALLBACK
        End If
        
        'Skip named pipes, mailslots, and volumes
        Dim dwFlags As FILE_OBJECT_FLAGS
        dwFlags = CType(Of FILE_OBJECT)(FltObjects.FileObject).Flags
        If (dwFlags And (FO_NAMED_PIPE Or FO_MAILSLOT Or FO_VOLUME_OPEN)) Then
                   Return FLT_PREOP_SUCCESS_NO_CALLBACK
        End If
        
        Dim Iopb As FLT_IO_PARAMETER_BLOCK
        Iopb = CType(Of FLT_IO_PARAMETER_BLOCK)(Data.Iopb)
        Dim createParams As FLT_PARAMETERS_Create
        CopyMemory createParams, Iopb.Parameters(0), LenB(Of FLT_PARAMETERS_Create)
        
        'Skip folders, files opened by id (needs separate handling), or paging files.
        If ((createParams.Options And FILE_DIRECTORY_FILE) <> 0) Or _
            (FsRtlIsPagingFile(FltObjects.FileObject) <> 0) Or _
            ((createParams.Options And FILE_OPEN_BY_FILE_ID) <> 0) Then
            Return FLT_PREOP_SUCCESS_NO_CALLBACK
        End If
        
        Dim fileNameInfo As LongPtr ' PFLT_FILE_NAME_INFORMATION
        Dim status As NTSTATUS = FltGetFileNameInformation(Data, FLT_FILE_NAME_NORMALIZED Or FLT_FILE_NAME_QUERY_DEFAULT, fileNameInfo)
        
        If (NT_SUCCESS(status) = False) Or (fileNameInfo = 0) Then
            Return FLT_PREOP_SUCCESS_NO_CALLBACK
        End If
        
        status = FltParseFileNameInformation(fileNameInfo)
        If (NT_SUCCESS(status) = False) Then
            Return FLT_PREOP_SUCCESS_NO_CALLBACK
        End If
        
        Dim usInfo As UNICODE_STRING
        usInfo = CType(Of FLT_FILE_NAME_INFORMATION)(fileNameInfo).FinalComponent
        
        If usInfo.Length = 0 Then
            Return FLT_PREOP_SUCCESS_NO_CALLBACK
        End If
        
  
        If RtlCompareUnicodeString(usInfo, ucNoOpen, 1) = 0 Then
            DbgPrint1 StrPtr(dbgsBadFile), ucNoOpen
            Data.IoStatus.Status = STATUS_ACCESS_DENIED
            Data.IoStatus.Information = IO_REPARSE
            Return FLT_PREOP_COMPLETE
        End If
        
         If (RtlCompareUnicodeString(usInfo, ucNoExecute, 1) = 0&) And _
                ((CType(Of IO_SECURITY_CONTEXT)(createParams.SecurityContext).DesiredAccess And FILE_EXECUTE) <> 0&) Then
            DbgPrint1 StrPtr(dbgsBadProgram), ucNoExecute
            Data.IoStatus.Status = STATUS_ACCESS_DENIED
            Data.IoStatus.Information = IO_REPARSE
            Return FLT_PREOP_COMPLETE
        End If
        
        Return FLT_PREOP_SUCCESS_NO_CALLBACK
    End Function
    
    
    [IgnoreWarnings(TB0018)]
    [ConstantFoldable]
    Public Function ToANSI(sIn As String) As String
        Return StrConv(sIn, vbFromUnicode)
    End Function
    Private Sub InitDefs()
    SOURCE_FILE = ToANSI("MainModule.twin")
    dbgsEntry = ToANSI("FsMinifilter: Entry point success")
    dbgsRegOk = ToANSI("FsMinifilter: Registration status 0x%X")
    dbgsBadFile = ToANSI("FsMinifilter - Blocked access to unauthorized file: %wZ")
    dbgsBadProgram = ToANSI("FsMinifilter - Blocked execution of unauthorized program: %wZ")

    End Sub
    
    'This won't be needed for long, just a bug with constant strings.
    Private Sub InitUnicodeStrings()
        fileNoOpen.aCH(0) = &H65: fileNoOpen.aCH(1) = &H76: fileNoOpen.aCH(2) = &H69: fileNoOpen.aCH(3) = &H6C
        fileNoOpen.aCH(4) = &H66: fileNoOpen.aCH(5) = &H69: fileNoOpen.aCH(6) = &H6C: fileNoOpen.aCH(7) = &H65
        fileNoOpen.aCH(8) = &H2E: fileNoOpen.aCH(9) = &H74: fileNoOpen.aCH(10) = &H78: fileNoOpen.aCH(11) = &H74
        RtlInitUnicodeString ucNoOpen, fileNoOpen
        fileNoExec.aCH(0) = &H65: fileNoExec.aCH(1) = &H76: fileNoExec.aCH(2) = &H69: fileNoExec.aCH(3) = &H6C
        fileNoExec.aCH(4) = &H70: fileNoExec.aCH(5) = &H72: fileNoExec.aCH(6) = &H6F: fileNoExec.aCH(7) = &H67
        fileNoExec.aCH(8) = &H72: fileNoExec.aCH(9) = &H61: fileNoExec.aCH(10) = &H6D: fileNoExec.aCH(11) = &H2E
        fileNoExec.aCH(12) = &H65: fileNoExec.aCH(13) = &H78: fileNoExec.aCH(14) = &H65
        RtlInitUnicodeString ucNoExecute, fileNoExec
    End Sub