415 lines
12 KiB
ObjectPascal
415 lines
12 KiB
ObjectPascal
{******************************************************************************}
|
|
{ }
|
|
{ Library: Fundamentals TLS }
|
|
{ File name: flcTLSBuffer.pas }
|
|
{ File version: 5.02 }
|
|
{ Description: TLS buffer }
|
|
{ }
|
|
{ Copyright: Copyright (c) 2008-2020, David J Butler }
|
|
{ All rights reserved. }
|
|
{ Redistribution and use in source and binary forms, with }
|
|
{ or without modification, are permitted provided that }
|
|
{ the following conditions are met: }
|
|
{ Redistributions of source code must retain the above }
|
|
{ copyright notice, this list of conditions and the }
|
|
{ following disclaimer. }
|
|
{ THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND }
|
|
{ CONTRIBUTORS "AS IS" AND ANY EXPRESS OR IMPLIED }
|
|
{ WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED }
|
|
{ WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A }
|
|
{ PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL }
|
|
{ THE REGENTS OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, }
|
|
{ INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR }
|
|
{ CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, }
|
|
{ PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF }
|
|
{ USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) }
|
|
{ HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER }
|
|
{ IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING }
|
|
{ NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE }
|
|
{ USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE }
|
|
{ POSSIBILITY OF SUCH DAMAGE. }
|
|
{ }
|
|
{ Github: https://github.com/fundamentalslib }
|
|
{ E-mail: fundamentals.library at gmail.com }
|
|
{ }
|
|
{ Revision history: }
|
|
{ }
|
|
{ 2010/11/26 0.01 Initial development. }
|
|
{ 2018/07/17 5.02 Revised for Fundamentals 5. }
|
|
{ }
|
|
{******************************************************************************}
|
|
|
|
{$INCLUDE flcTLS.inc}
|
|
|
|
unit flcTLSBuffer;
|
|
|
|
interface
|
|
|
|
|
|
|
|
{ }
|
|
{ TLS Buffer }
|
|
{ }
|
|
type
|
|
TTLSBuffer = record
|
|
Ptr : Pointer;
|
|
Size : Integer;
|
|
Head : Integer;
|
|
Used : Integer;
|
|
end;
|
|
|
|
procedure TLSBufferInitialise(
|
|
var TLSBuf: TTLSBuffer;
|
|
const TLSBufSize: Integer = -1);
|
|
procedure TLSBufferFinalise(var TLSBuf: TTLSBuffer);
|
|
procedure TLSBufferPack(var TLSBuf: TTLSBuffer);
|
|
procedure TLSBufferResize(
|
|
var TLSBuf: TTLSBuffer;
|
|
const TLSBufSize: Integer);
|
|
procedure TLSBufferExpand(
|
|
var TLSBuf: TTLSBuffer;
|
|
const Size: Integer);
|
|
function TLSBufferAddPtr(
|
|
var TLSBuf: TTLSBuffer;
|
|
const Size: Integer): Pointer;
|
|
procedure TLSBufferAddBuf(
|
|
var TLSBuf: TTLSBuffer;
|
|
const Buf; const Size: Integer);
|
|
procedure TLSBufferShrink(var TLSBuf: TTLSBuffer);
|
|
function TLSBufferPeekPtr(
|
|
const TLSBuf: TTLSBuffer;
|
|
var BufPtr: Pointer; const Size: Integer): Integer;
|
|
function TLSBufferPeek(
|
|
var TLSBuf: TTLSBuffer;
|
|
var Buf; const Size: Integer): Integer;
|
|
function TLSBufferRemove(
|
|
var TLSBuf: TTLSBuffer;
|
|
var Buf; const Size: Integer): Integer;
|
|
function TLSBufferUsed(const TLSBuf: TTLSBuffer): Integer;
|
|
function TLSBufferPtr(const TLSBuf: TTLSBuffer): Pointer;
|
|
procedure TLSBufferClear(var TLSBuf: TTLSBuffer);
|
|
function TLSBufferDiscard(
|
|
var TLSBuf: TTLSBuffer;
|
|
const Size: Integer): Integer;
|
|
|
|
|
|
|
|
implementation
|
|
|
|
uses
|
|
{ TLS }
|
|
|
|
flcTLSErrors;
|
|
|
|
|
|
|
|
{ }
|
|
{ TLS Buffer }
|
|
{ }
|
|
const
|
|
TLS_CLIENT_DEFAULTBUFFERSIZE = 16384;
|
|
|
|
// Initialise a TLS buffer
|
|
procedure TLSBufferInitialise(
|
|
var TLSBuf: TTLSBuffer;
|
|
const TLSBufSize: Integer = -1);
|
|
var L : Integer;
|
|
begin
|
|
TLSBuf.Ptr := nil;
|
|
TLSBuf.Size := 0;
|
|
TLSBuf.Head := 0;
|
|
TLSBuf.Used := 0;
|
|
L := TLSBufSize;
|
|
if L < 0 then
|
|
L := TLS_CLIENT_DEFAULTBUFFERSIZE;
|
|
if L > 0 then
|
|
GetMem(TLSBuf.Ptr, L);
|
|
TLSBuf.Size := L;
|
|
end;
|
|
|
|
// Finalise a TLS buffer
|
|
procedure TLSBufferFinalise(var TLSBuf: TTLSBuffer);
|
|
var P : Pointer;
|
|
begin
|
|
P := TLSBuf.Ptr;
|
|
if Assigned(P) then
|
|
begin
|
|
TLSBuf.Ptr := nil;
|
|
FreeMem(P);
|
|
end;
|
|
TLSBuf.Size := 0;
|
|
end;
|
|
|
|
// Pack a TLS buffer
|
|
// Moves data to front of buffer
|
|
// Post: TLSBuf.Head = 0
|
|
procedure TLSBufferPack(var TLSBuf: TTLSBuffer);
|
|
var P, Q : PByte;
|
|
U, H : Integer;
|
|
begin
|
|
H := TLSBuf.Head;
|
|
if H <= 0 then
|
|
exit;
|
|
U := TLSBuf.Used;
|
|
if U <= 0 then
|
|
begin
|
|
TLSBuf.Head := 0;
|
|
exit;
|
|
end;
|
|
Assert(Assigned(TLSBuf.Ptr));
|
|
P := TLSBuf.Ptr;
|
|
Q := P;
|
|
Inc(P, H);
|
|
Move(P^, Q^, U);
|
|
TLSBuf.Head := 0;
|
|
end;
|
|
|
|
// Resize a TLS buffer
|
|
// New buffer size must be large enough to hold existing data
|
|
// Post: TLSBuf.Size = TLSBufSize
|
|
procedure TLSBufferResize(
|
|
var TLSBuf: TTLSBuffer;
|
|
const TLSBufSize: Integer);
|
|
var U, L : Integer;
|
|
begin
|
|
L := TLSBufSize;
|
|
U := TLSBuf.Used;
|
|
// treat negative TLSBufSize parameter as zero
|
|
if L < 0 then
|
|
L := 0;
|
|
// check if shrinking buffer to less than used size
|
|
if U > L then
|
|
raise ETLSError.Create(TLSError_InvalidParameter);
|
|
// check if packing required to fit buffer
|
|
if U + TLSBuf.Head > L then
|
|
TLSBufferPack(TLSBuf);
|
|
Assert(U + TLSBuf.Head <= L);
|
|
// resize
|
|
ReallocMem(TLSBuf.Ptr, L);
|
|
TLSBuf.Size := L;
|
|
end;
|
|
|
|
// Expand a TLS buffer
|
|
// Expands the size of the buffer to at least Size
|
|
procedure TLSBufferExpand(
|
|
var TLSBuf: TTLSBuffer;
|
|
const Size: Integer);
|
|
var S, N, I : Integer;
|
|
begin
|
|
S := TLSBuf.Size;
|
|
N := Size;
|
|
// check if expansion not required
|
|
if N <= S then
|
|
exit;
|
|
// scale up new size proportional to current size
|
|
// increase by at least quarter of current size
|
|
// this reduces the number of resizes in growing buffers
|
|
I := S + (S div 4);
|
|
if N < I then
|
|
N := I;
|
|
// resize buffer
|
|
Assert(N >= Size);
|
|
TLSBufferResize(TLSBuf, N);
|
|
end;
|
|
|
|
// Returns a pointer to position in buffer to add new data of Size
|
|
// Handles resizing and packing of buffer to fit new data
|
|
function TLSBufferAddPtr(
|
|
var TLSBuf: TTLSBuffer;
|
|
const Size: Integer): Pointer; {$IFDEF UseInline}inline;{$ENDIF}
|
|
var P : PByte;
|
|
U, L : Integer;
|
|
begin
|
|
// return nil if nothing to add
|
|
if Size <= 0 then
|
|
begin
|
|
Result := nil;
|
|
exit;
|
|
end;
|
|
U := TLSBuf.Used;
|
|
L := U + Size;
|
|
// resize if necessary
|
|
if L > TLSBuf.Size then
|
|
TLSBufferExpand(TLSBuf, L);
|
|
// pack if necessary
|
|
if TLSBuf.Head + L > TLSBuf.Size then
|
|
TLSBufferPack(TLSBuf);
|
|
// buffer should now be large enough for new data
|
|
Assert(TLSBuf.Size > 0);
|
|
Assert(TLSBuf.Head + TLSBuf.Used + Size <= TLSBuf.Size);
|
|
// get buffer pointer
|
|
Assert(Assigned(TLSBuf.Ptr));
|
|
P := TLSBuf.Ptr;
|
|
Inc(P, TLSBuf.Head + U);
|
|
Result := P;
|
|
end;
|
|
|
|
// Adds new data from a buffer to a TLS buffer
|
|
procedure TLSBufferAddBuf(
|
|
var TLSBuf: TTLSBuffer;
|
|
const Buf; const Size: Integer); {$IFDEF UseInline}inline;{$ENDIF}
|
|
var P : PByte;
|
|
begin
|
|
if Size <= 0 then
|
|
exit;
|
|
// get buffer pointer
|
|
P := TLSBufferAddPtr(TLSBuf, Size);
|
|
// move user buffer to buffer
|
|
Assert(Assigned(P));
|
|
Move(Buf, P^, Size);
|
|
Inc(TLSBuf.Used, Size);
|
|
Assert(TLSBuf.Head + TLSBuf.Used <= TLSBuf.Size);
|
|
end;
|
|
|
|
// Shrink the size of a TLS buffer to release all unused memory
|
|
// Post: TLSBuf.Used = TLSBuf.Size and TLSBuf.Head = 0
|
|
procedure TLSBufferShrink(var TLSBuf: TTLSBuffer);
|
|
var S, U : Integer;
|
|
begin
|
|
S := TLSBuf.Size;
|
|
if S <= 0 then
|
|
exit;
|
|
U := TLSBuf.Used;
|
|
if U = 0 then
|
|
begin
|
|
TLSBufferResize(TLSBuf, 0);
|
|
TLSBuf.Head := 0;
|
|
exit;
|
|
end;
|
|
if U = S then
|
|
exit;
|
|
TLSBufferPack(TLSBuf); // move data to front of buffer
|
|
TLSBufferResize(TLSBuf, U); // set size equal to used bytes
|
|
Assert(TLSBuf.Used = TLSBuf.Size);
|
|
end;
|
|
|
|
// Peek TLS buffer
|
|
// Returns the number of bytes actually available to peek (up to requested size)
|
|
function TLSBufferPeekPtr(
|
|
const TLSBuf: TTLSBuffer;
|
|
var BufPtr: Pointer; const Size: Integer): Integer; {$IFDEF UseInline}inline;{$ENDIF}
|
|
var P : PByte;
|
|
L : Integer;
|
|
begin
|
|
// handle peeking zero bytes
|
|
if Size <= 0 then
|
|
begin
|
|
BufPtr := nil;
|
|
Result := 0;
|
|
exit;
|
|
end;
|
|
// handle empty buffer
|
|
L := TLSBuf.Used;
|
|
if L <= 0 then
|
|
begin
|
|
BufPtr := nil;
|
|
Result := 0;
|
|
exit;
|
|
end;
|
|
// peek from buffer
|
|
if L > Size then
|
|
L := Size;
|
|
Assert(TLSBuf.Head + L <= TLSBuf.Size);
|
|
Assert(Assigned(TLSBuf.Ptr));
|
|
P := TLSBuf.Ptr;
|
|
Inc(P, TLSBuf.Head);
|
|
BufPtr := P;
|
|
Result := L;
|
|
end;
|
|
|
|
// Peek data from a TLS buffer
|
|
// Returns the number of bytes actually available and copied into the buffer
|
|
function TLSBufferPeek(
|
|
var TLSBuf: TTLSBuffer;
|
|
var Buf; const Size: Integer): Integer; {$IFDEF UseInline}inline;{$ENDIF}
|
|
var P : Pointer;
|
|
L : Integer;
|
|
begin
|
|
L := TLSBufferPeekPtr(TLSBuf, P, Size);
|
|
Move(P^, Buf, L);
|
|
Result := L;
|
|
end;
|
|
|
|
// Remove data from a TLS buffer
|
|
// Returns the number of bytes actually available and copied into the user buffer
|
|
function TLSBufferRemove(
|
|
var TLSBuf: TTLSBuffer;
|
|
var Buf; const Size: Integer): Integer; {$IFDEF UseInline}inline;{$ENDIF}
|
|
var L, H, U : Integer;
|
|
begin
|
|
// peek data from buffer
|
|
L := TLSBufferPeek(TLSBuf, Buf, Size);
|
|
if L = 0 then
|
|
begin
|
|
Result := 0;
|
|
exit;
|
|
end;
|
|
// remove from buffer
|
|
H := TLSBuf.Head;
|
|
U := TLSBuf.Used;
|
|
Inc(H, L);
|
|
Dec(U, L);
|
|
if U = 0 then
|
|
H := 0;
|
|
TLSBuf.Head := H;
|
|
TLSBuf.Used := U;
|
|
Result := L;
|
|
end;
|
|
|
|
// Returns number of bytes used in TLS buffer
|
|
function TLSBufferUsed(const TLSBuf: TTLSBuffer): Integer; {$IFDEF UseInline}inline;{$ENDIF}
|
|
begin
|
|
Result := TLSBuf.Used;
|
|
end;
|
|
|
|
// Returns pointer to TLS buffer head
|
|
function TLSBufferPtr(const TLSBuf: TTLSBuffer): Pointer; {$IFDEF UseInline}inline;{$ENDIF}
|
|
var P : PByte;
|
|
begin
|
|
P := PByte(TLSBuf.Ptr);
|
|
Inc(P, TLSBuf.Head);
|
|
Result := P;
|
|
end;
|
|
|
|
// Clear the data from a TLS buffer
|
|
procedure TLSBufferClear(var TLSBuf: TTLSBuffer);
|
|
begin
|
|
TLSBuf.Used := 0;
|
|
TLSBuf.Head := 0;
|
|
end;
|
|
|
|
// Discard a number of bytes from the TLS buffer
|
|
// Returns the number of bytes actually discarded from buffer
|
|
function TLSBufferDiscard(
|
|
var TLSBuf: TTLSBuffer;
|
|
const Size: Integer): Integer; {$IFDEF UseInline}inline;{$ENDIF}
|
|
var L, U : Integer;
|
|
begin
|
|
// handle discarding zero bytes from buffer
|
|
L := Size;
|
|
if L <= 0 then
|
|
begin
|
|
Result := 0;
|
|
exit;
|
|
end;
|
|
// handle discarding the complete buffer
|
|
U := TLSBuf.Used;
|
|
if L >= U then
|
|
begin
|
|
TLSBuf.Used := 0;
|
|
TLSBuf.Head := 0;
|
|
Result := U;
|
|
exit;
|
|
end;
|
|
// discard partial buffer
|
|
Inc(TLSBuf.Head, L);
|
|
Dec(U, L);
|
|
TLSBuf.Used := U;
|
|
Result := L;
|
|
end;
|
|
|
|
|
|
|
|
end.
|
|
|