Windows Filtering Platform

[JHPJHP]

I'm getting: Incorrect archive headers or archive is broken! - using http://2zip.org/

Do you have a suggestion?

[Thunder93]

You did remove the response header messages? and removing the new line?

[Thunder93]

Your using 'Continue' to skip logging the response header messages? But it's having an undesirable side-effect.

[JHPJHP]

Your right, I was relying on the Continue to take care of the header (got rid of that). Now that I'm removing it manually, I get a different message: Wrong password! Please try again (input box)?

[Thunder93]

It might be the Windows Notepad or similar changing when saving. I use Notepad++ and it only saves those changes that I made.

[Thunder93]

Did you get it?

[Thunder93]

Just back up your BuildPayload() procedure and test using mine... No editing, simply rename the saved file, file extension.

Code: Select all

Procedure BuildPayload()
  pRange.b = #False
  SortStructuredArray(pPL(), #PB_Sort_Ascending, OffsetOf(PAYLOAD\Id), TypeOf(PAYLOAD\Id))

  For pCount = 0 To ArraySize(pPL()) - 1
    PacketData.s = PeekS(pPL(pCount)\ppData, pPL(pCount)\pDataLen, #PB_UTF8)
    
;;;;;;;;;;;;;;;;;;;;;;;;;;;;
    Header.s = Mid(PacketData, 0, FindString(PacketData,#CRLF$+#CRLF$))
    nL.l = Len(Header)
    
    cLen.l = FindString(PacketData, "Content-Length:")
    If cLen : 
      BodyLen = Val(StringField(Mid(PacketData,cLen+16), 1, #CR$))
    Else
      BodyLen = Val(StringField(Mid(PacketData, nL+4), 1, #CR$))
    EndIf
;;;;;;;;;;;;;;;;;;;;;;;
    
    If FindString(PacketData, "Content-Type: text/html") > 0 Or pRange
      If pPL(pCount)\pDataLen <> (pPL(pCount)\Length - pPL(pCount)\HdrLength) : Debug "ERROR: Length" : Break : EndIf

      If pRange
        If pPL(pCount)\Id > pId + 2 : Break : Else : pId = pPL(pCount)\Id : EndIf
        If pPL(pCount)\AckNum <> pPL(pCount - 1)\AckNum : Break : EndIf
      Else
        pRange = #True
        pId = pPL(pCount)\Id
;        Continue
      EndIf
      Debug Str(pPL(pCount)\Id) + " (" + Str(pPL(pCount)\pDataLen) + ")"
      Debug "---------------"

      If *Payload
        plSize = MemorySize(*Payload)
        *Payload = ReAllocateMemory(*Payload, plSize + pPL(pCount)\pDataLen)
      Else
        plSize = 0 : StartOffset.l = nL+3
        *Payload = AllocateMemory(pPL(pCount)\pDataLen - StartOffset)
      EndIf
      CopyMemory(pPL(pCount)\ppData + StartOffset, *Payload + plSize, pPL(pCount)\pDataLen - StartOffset)
      If StartOffset : StartOffset = 0 : EndIf 
    EndIf
  Next

  If CreateFile(0, "tPacket.txt")
    WriteData(0, *Payload, MemorySize(*Payload))
    CloseFile(0)
  EndIf
  FreeMemory(*Payload)
EndProcedure

[JHPJHP]

That did it - Thank you (very nice)... it's good to see the fruit!
- also great Website find
- http://i-tools.org/gzip/exec (now works with your latest change)
- http://2zip.org/ (I still prefer this one)

--------------------------------------------------------------------------------

Optimized BuildPayload() Procedure
- optional Parameter added (RemoveHeader: Boolean)
-- #True (default): Remove's the Header
--- saves file: tPacket.gz
--- opens browser (http://2zip.org/)
-- #False: Keeps the Header
--- saves file: tPacket.txt
--- opens notepad (tPacket.txt)
(this will all be removed once the Inflate / Deflate Procedures are finished)

Code: Select all

#DIVERT_LAYER_NETWORK = 0
#DIVERT_PRIORITY_DEFAULT = 0
#DIVERT_FLAG_SNIFF = 1
#MAXBUF = $FFFF

Structure DIVERT_ADDRESS
  IfIdx.l
  SubIfIdx.l
  Direction.a
EndStructure

Structure DIVERT_IPHDR
  StructureUnion
    HdrLength.a
    Version.a
  EndStructureUnion
  TOS.a
  Length.u
  Id.u
  FragOff0.u
  TTL.a
  Protocol.a
  Checksum.u
  SrcAddr.l
  DstAddr.l
EndStructure

Structure DIVERT_TCPHDR
  SrcPort.u
  DstPort.u
  SeqNum.l
  AckNum.l
  StructureUnion
    Reserved1.a
    HdrLength.a
  EndStructureUnion
  StructureUnion
    Fin.a
    Syn.a
    Rst.a
    Psh.a
    Ack.a
    Urg.a
    Reserved2.a
  EndStructureUnion
  Window.u
  Checksum.u
  UrgPtr.u
EndStructure

Structure PAYLOAD
  HdrLengthIP.a
  HdrLengthTCP.a
  Length.u
  Id.u
  AckNum.l
  *ppData
  pDataLen.l
EndStructure

Prototype protoDivertOpen(filter.s, layer, priority.u, flags.q)
Global DivertOpen.protoDivertOpen

Prototype.b protoDivertRecv(handle, *pPacket, packetLen, pAddr, recvLen)
Global DivertRecv.protoDivertRecv

Prototype.b protoDivertHelperParsePacket(*pPacket, packetLen, *ppIpHdr, *ppIpv6Hdr, *ppIcmpHdr, *ppIcmpv6Hdr, *ppTcpHdr, *ppUdpHdr, *ppData, pDataLen)
Global DivertHelperParsePacket.protoDivertHelperParsePacket

Prototype.b protoDivertClose(handle)
Global DivertClose.protoDivertClose

Global Dim pPL.PAYLOAD(0)

Procedure BuildPayload(RemoveHeader.b = #True)
  SortStructuredArray(pPL(), #PB_Sort_Ascending, OffsetOf(PAYLOAD\Id), TypeOf(PAYLOAD\Id))

  For pCount = 0 To ArraySize(pPL()) - 1
    PacketData.s = PeekS(pPL(pCount)\ppData, pPL(pCount)\pDataLen, #PB_UTF8)

    If FindString(PacketData, "Content-Type: text/html") > 0 Or pRange
      If pPL(pCount)\pDataLen <> pPL(pCount)\Length - (pPL(pCount)\HdrLengthIP + pPL(pCount)\HdrLengthTCP)
        Debug "ERROR: Data Packet length does not match calculated Structure values"
        End
      EndIf

      If pRange
        If pPL(pCount)\AckNum <> pPL(pCount - 1)\AckNum : Break : EndIf

        pId = pPL(pCount)\Id
        plSize = MemorySize(*Payload)
        *Payload = ReAllocateMemory(*Payload, plSize + pPL(pCount)\pDataLen)
        CopyMemory(pPL(pCount)\ppData, *Payload + plSize, pPL(pCount)\pDataLen)
      Else
        pRange = #True
        pId = pPL(pCount)\Id
        plSize = 0

        If RemoveHeader : pOffset = Len(Mid(PacketData, 0, FindString(PacketData, #CRLF$ + #CRLF$))) + 3 : EndIf

        *Payload = AllocateMemory(pPL(pCount)\pDataLen - pOffset)
        CopyMemory(pPL(pCount)\ppData + pOffset, *Payload + plSize, pPL(pCount)\pDataLen - pOffset)
      EndIf
    EndIf
  Next

  If RemoveHeader : pFilename.s = "tPacket.gz" : Else : pFilename.s = "tPacket.txt" : EndIf

  If CreateFile(0, pFilename)
    WriteData(0, *Payload, MemorySize(*Payload))
    CloseFile(0)
  EndIf

  If RemoveHeader : RunProgram("iexplore", "http://2zip.org/", "") : Else : RunProgram("notepad", "tPacket.txt", "") : EndIf

  FreeMemory(*Payload)
EndProcedure

WinDivert = OpenLibrary(#PB_Any, "WinDivert.dll")

If IsLibrary(WinDivert)
  DivertOpen = GetFunction(WinDivert, "DivertOpen")
  DivertSetParam = GetFunction(WinDivert, "DivertSetParam")
  DivertRecv = GetFunction(WinDivert, "DivertRecv")
  DivertHelperParsePacket = GetFunction(WinDivert, "DivertHelperParsePacket")
  DivertClose = GetFunction(WinDivert, "DivertClose")
  filter.s = "inbound && ip.SrcAddr == 88.191.144.148 && tcp.Ack"
  hWndDivert = DivertOpen(filter, #DIVERT_LAYER_NETWORK, #DIVERT_PRIORITY_DEFAULT, #DIVERT_FLAG_SNIFF)

  If hWndDivert <> #INVALID_HANDLE_VALUE
    pAddr.DIVERT_ADDRESS
    *ppIpHdr.DIVERT_IPHDR
    *ppTcpHdr.DIVERT_TCPHDR
    RunProgram("iexplore", "http://www.purebasic.com/", "")

    Repeat
      *pPacket = AllocateMemory(#MAXBUF)

      If DivertRecv(hWndDivert, *pPacket, #MAXBUF, @pAddr, @recvLen)
        DivertHelperParsePacket(*pPacket, recvLen, @*ppIpHdr, #Null, #Null, #Null, @*ppTcpHdr, #Null, @*ppData, @pDataLen)

        If *ppIpHdr And *ppTcpHdr
          If *ppData
            ReDim pPL(pCount)
            pPL(pCount)\HdrLengthIP = PeekA(@*ppIpHdr\Version) & %1111 * 32 / 8
            pPL(pCount)\HdrLengthTCP = PeekA(@*ppTcpHdr\HdrLength) >> 4 & %1111 * 4
            pPL(pCount)\Length = ntohs_(PeekU(@*ppIpHdr\Length))
            pPL(pCount)\Id = ntohs_(PeekU(@*ppIpHdr\Id))
            pPL(pCount)\AckNum = ntohl_(PeekL(@*ppTcpHdr\AckNum))
            pPL(pCount)\ppData = AllocateMemory(pDataLen)
            CopyMemory(*ppData, pPL(pCount)\ppData, pDataLen)
            pPL(pCount)\pDataLen = pDataLen
            pCount + 1
          EndIf

          If PeekA(@*ppTcpHdr\Reserved2) & %1 : Break : EndIf

        EndIf
      EndIf
      FreeMemory(*pPacket)
    ForEver
    DivertClose(hWndDivert)
  EndIf
  CloseLibrary(WinDivert)
  RunProgram("sc", "stop WinDivert1.0", "", #PB_Program_Hide)
  RunProgram("sc", "delete WinDivert1.0", "", #PB_Program_Hide)
  BuildPayload()
EndIf

[Thunder93]

Your welcome. It is good to see achievement.

Yep useful website.

I'm seeing a lot of nice enhancements that you've made, good job.

I had a go at that gzip decompression.... memory-based decompression isn't an easy one.

[JHPJHP]

You sparked something with one of your previous posts...

A couple years ago I started ... finished a Comic Book reader. Part of that project was memory decompression / compression, and I used unrar.lib.

I have WinRAR loaded. Manually using its extracting tool on tPacket.gz I was able to extract the intact webpage, I don't see why my existing script won't work with a little tweaking.

- failed on a quick test using ts-soft's Module: http://www.purebasic.fr/english/viewtop ... 40&t=56876

I'm still hopeful with my script; not sure when I will have something to show as I'm just about to step out for awhile. But if you want to give it a try see the above link.

------------------------------------------------------------------

Another temporary way to decompress
- save gzip.exe to your working directory
- update with this code:

Code: Select all

If RemoveHeader : pFilename.s = "gzPacket.gz" : Else : pFilename.s = "gzPacket.txt" : EndIf

If CreateFile(0, pFilename)
  WriteData(0, *Payload, MemorySize(*Payload))
  CloseFile(0)
EndIf

If RemoveHeader
  RunProgram("gzip", "-df gzPacket.gz", "")
  Delay(200)
  RenameFile("gzPacket", "gzPacket.html")
  RunProgram("gzPacket.html", "", "")
Else
  RunProgram("notepad", "gzPacket.txt", "")
EndIf

[Thunder93]

I already done it with calling a separate utility. It would be best to handle it via memory and even avoid creating a file first before dealing with the compression.

[jassing]

I've been following this thread on and off - it'd be nice if someone wrapped up all the finds into one post/example for the final solutions.

[JHPJHP]

I already done it with calling a separate utility. It would be best to handle it via memory and even avoid creating a file first before dealing with the compression.

Working on it now, I should have something in the near future.

[JHPJHP]

O ye, of little faith.

Code: Select all

#DIVERT_LAYER_NETWORK = 0
#DIVERT_PRIORITY_DEFAULT = 0
#DIVERT_FLAG_SNIFF = 1
#MAXBUF = $FFFF
#ZLIB_VERSION = "1.2.8"
#WANT_GZIP = 16
#Z_FINISH = 4

Structure DIVERT_ADDRESS
  IfIdx.l
  SubIfIdx.l
  Direction.a
EndStructure

Structure DIVERT_IPHDR
  StructureUnion
    HdrLength.a
    Version.a
  EndStructureUnion
  TOS.a
  Length.u
  Id.u
  FragOff0.u
  TTL.a
  Protocol.a
  Checksum.u
  SrcAddr.l
  DstAddr.l
EndStructure

Structure DIVERT_TCPHDR
  SrcPort.u
  DstPort.u
  SeqNum.l
  AckNum.l
  StructureUnion
    Reserved1.a
    HdrLength.a
  EndStructureUnion
  StructureUnion
    Fin.a
    Syn.a
    Rst.a
    Psh.a
    Ack.a
    Urg.a
    Reserved2.a
  EndStructureUnion
  Window.u
  Checksum.u
  UrgPtr.u
EndStructure

Structure PAYLOAD
  HdrLengthIP.a
  HdrLengthTCP.a
  Length.u
  Id.u
  AckNum.l
  *ppData
  pDataLen.l
EndStructure

Structure Z_STREAM Align #PB_Structure_AlignC
  *next_in.Byte
  avail_in.l
  total_in.l
  *next_out.Byte
  avail_out.l
  total_out.l
  *msg.Byte
  *state
  zalloc.l
  zfree.l
  opaque.l
  data_type.i
  adler.l
  reserved.l
  CompilerIf #PB_Compiler_Processor = #PB_Processor_x64
    alignment.l
  CompilerEndIf
EndStructure

Prototype protoDivertOpen(filter.s, layer, priority.u, flags.q)
Global DivertOpen.protoDivertOpen

Prototype.b protoDivertRecv(handle, *pPacket, packetLen, pAddr, recvLen)
Global DivertRecv.protoDivertRecv

Prototype.b protoDivertHelperParsePacket(*pPacket, packetLen, *ppIpHdr, *ppIpv6Hdr, *ppIcmpHdr, *ppIcmpv6Hdr, *ppTcpHdr, *ppUdpHdr, *ppData, pDataLen)
Global DivertHelperParsePacket.protoDivertHelperParsePacket

Prototype.b protoDivertClose(handle)
Global DivertClose.protoDivertClose

Global Dim pPL.PAYLOAD(0)

ImportC "zlib.lib"
  inflateInit2_(*strm, windowBits.i, version.s, strm_size)
  inflate(*strm, flush.i)
  inflateEnd(*strm)
EndImport

Procedure.s InflatePayload(*Payload)
  LengthToRead = MemorySize(*Payload)
  LengthToWrite = LengthToRead * 8
  *Output = AllocateMemory(LengthToWrite)
  strm.Z_STREAM
  strm\next_in = *Payload
  strm\avail_in = LengthToRead
  strm\next_out = *Output
  strm\avail_out = LengthToWrite
  inflateInit2_(@strm, #WANT_GZIP, #ZLIB_VERSION, SizeOf(Z_STREAM))
  inflate(@strm, #Z_FINISH)
  inflateEnd(@strm)
  sOutput.s = PeekS(*Output, -1, #PB_UTF8)
  FreeMemory(*Output)
  FreeMemory(*Payload)
  ProcedureReturn sOutput
EndProcedure

Procedure BuildPayload()
  SortStructuredArray(pPL(), #PB_Sort_Ascending, OffsetOf(PAYLOAD\Id), TypeOf(PAYLOAD\Id))

  For pCount = 0 To ArraySize(pPL()) - 1
    PacketData.s = PeekS(pPL(pCount)\ppData, pPL(pCount)\pDataLen, #PB_UTF8)

    If FindString(PacketData, "Content-Type: text/html") > 0 Or pRange
      If pPL(pCount)\pDataLen <> pPL(pCount)\Length - (pPL(pCount)\HdrLengthIP + pPL(pCount)\HdrLengthTCP)
        Debug "ERROR: Data Packet length does not match calculated Structure values"
        End
      EndIf

      If pRange
        If pPL(pCount)\AckNum <> pPL(pCount - 1)\AckNum : Break : EndIf

        pId = pPL(pCount)\Id
        plSize = MemorySize(*Payload)
        *Payload = ReAllocateMemory(*Payload, plSize + pPL(pCount)\pDataLen)
        CopyMemory(pPL(pCount)\ppData, *Payload + plSize, pPL(pCount)\pDataLen)
      Else
        pRange = #True
        pId = pPL(pCount)\Id
        plSize = 0
        pOffset = Len(Mid(PacketData, 0, FindString(PacketData, #CRLF$ + #CRLF$))) + 3
        *Payload = AllocateMemory(pPL(pCount)\pDataLen - pOffset)
        CopyMemory(pPL(pCount)\ppData + pOffset, *Payload + plSize, pPL(pCount)\pDataLen - pOffset)
      EndIf
    EndIf
  Next
  Debug InflatePayload(*Payload)
EndProcedure

WinDivert = OpenLibrary(#PB_Any, "WinDivert.dll")

If IsLibrary(WinDivert)
  DivertOpen = GetFunction(WinDivert, "DivertOpen")
  DivertSetParam = GetFunction(WinDivert, "DivertSetParam")
  DivertRecv = GetFunction(WinDivert, "DivertRecv")
  DivertHelperParsePacket = GetFunction(WinDivert, "DivertHelperParsePacket")
  DivertClose = GetFunction(WinDivert, "DivertClose")
  filter.s = "inbound && ip.SrcAddr == 88.191.144.148 && tcp.Ack"
  hWndDivert = DivertOpen(filter, #DIVERT_LAYER_NETWORK, #DIVERT_PRIORITY_DEFAULT, #DIVERT_FLAG_SNIFF)

  If hWndDivert <> #INVALID_HANDLE_VALUE
    pAddr.DIVERT_ADDRESS
    *ppIpHdr.DIVERT_IPHDR
    *ppTcpHdr.DIVERT_TCPHDR
    RunProgram("iexplore", "http://www.purebasic.com/", "")

    Repeat
      *pPacket = AllocateMemory(#MAXBUF)

      If DivertRecv(hWndDivert, *pPacket, #MAXBUF, @pAddr, @recvLen)
        DivertHelperParsePacket(*pPacket, recvLen, @*ppIpHdr, #Null, #Null, #Null, @*ppTcpHdr, #Null, @*ppData, @pDataLen)

        If *ppIpHdr And *ppTcpHdr
          If *ppData
            ReDim pPL(pCount)
            pPL(pCount)\HdrLengthIP = PeekA(@*ppIpHdr\Version) & %1111 * 32 / 8
            pPL(pCount)\HdrLengthTCP = PeekA(@*ppTcpHdr\HdrLength) >> 4 & %1111 * 4
            pPL(pCount)\Length = ntohs_(PeekU(@*ppIpHdr\Length))
            pPL(pCount)\Id = ntohs_(PeekU(@*ppIpHdr\Id))
            pPL(pCount)\AckNum = ntohl_(PeekL(@*ppTcpHdr\AckNum))
            pPL(pCount)\ppData = AllocateMemory(pDataLen)
            CopyMemory(*ppData, pPL(pCount)\ppData, pDataLen)
            pPL(pCount)\pDataLen = pDataLen
            pCount + 1
          EndIf

          If pCount = 1 : Debug "Please wait.... expecting TCP Fin Packet" : EndIf 

          If PeekA(@*ppTcpHdr\Fin) & %1
            FreeMemory(*pPacket)
            Break
          EndIf
        EndIf
      EndIf
      FreeMemory(*pPacket)
    ForEver
    DivertClose(hWndDivert)
  EndIf
  CloseLibrary(WinDivert)
  RunProgram("sc", "stop WinDivert1.0", "", #PB_Program_Hide)
  RunProgram("sc", "delete WinDivert1.0", "", #PB_Program_Hide)
  BuildPayload()
EndIf

[Thunder93]

Good job. Please put this line before the FIN check.

Code: Select all

If pCount = 1 : Debug "Please wait.... expecting TCP Fin Packet" : EndIf 

At least when it popups soon, I can hide it, move the window or whatever while I'm waiting.