FreePascal helper unit to postprocess compressed response body

example.pas

program example;
{$mode OBJFPC}

{
  You'll need some SSL library if you want TFPHTTPClient to handle HTTPS.
  This also requires the OpenSSL shared libraries (.so/.dll/.dylib) to be
  installed, either system-wide or in your application directory.
  see: https://wiki.freepascal.org/fphttpclient#HTTPS_.28TLS.2FSSL.29
}
{$define USE_SSL}

// change this to DEBUG for diagnostics / more verbose output
{$define NO_DEBUG}

uses
{$ifdef USE_SSL}
  opensslsockets,
{$endif}
  Classes, fphttpclient, WebDecompression;

procedure TestRequest(const url: string; const AcceptEncoding: string = '');
var
  request: TFPHTTPClient;
  response: TStringStream;
  size: Cardinal;
begin
  request := TFPHTTPClient.Create(nil);
  try
    response := TStringStream.Create;

    if AcceptEncoding <> '' then
      request.AddHeader('Accept-Encoding', AcceptEncoding);

    writeln;
    writeln('Requesting ', url);
    request.Get(url, response);

{$ifdef DEBUG}
    writeln;
    writeln(request.ResponseHeaders.Text); // dump response headers
{$endif}

    size := response.Size;
    writeln('Got ', size, ' bytes response');

    DecompressResponse(response, 
      request.GetHeader(request.ResponseHeaders, 'Content-Encoding'));
    if response.Size <> size then
      writeln('Decompressed to ', response.Size, ' bytes');

{$ifdef DEBUG}
    writeln(Copy(response.DataString, 1, 70), '[...]');
{$endif}
  finally
    response.Free;
    request.Free;
  end;
end;

// MAIN
const
  URL = 'https://PUT-YOUR-URL-HERE';
begin
  TestRequest(URL); // (no compression)
  TestRequest(URL, 'gzip,deflate');
end.

WebDecompression.pas

unit WebDecompression;
{$mode OBJFPC}
{
  This is a FreePascal unit to help with postprocessing web server response
  streams that are possibly compressed.
  Note: Even if you want your program to work with the response in string form,
  it's very easy to achieve this: simply use a `TStringStream`.

  Standards-compliant web servers will indicate the compression used via the
  "Content-Encoding: " header field in their reply. You have several ways of
  passing this information to one of the DecompressResponse() procedures,
  which will then replace the response stream with its decompressed data (if
  applicable). The procedure is safe to call for uncompressed responses
  (and doesn't change anything in that case).
}

interface

uses
  Classes, httpdefs;

procedure DecompressResponse(Response: TMemoryStream;
                             ContentEncoding: string = '');
procedure DecompressResponse(Response: TMemoryStream;
                             ResponseHeader: THTTPHeader);
procedure DecompressResponse(Response: TMemoryStream;
                             ResponseHeader: TStrings; IncludeCommand: boolean = false);

implementation

uses
  SysUtils,
  zstream, // for exception types
  {
    FPC doesn't seem to come with an out-of-the-box solution for stream-based
    (= in-memory) decompression of gzip data.
    I've thus decided to use GZIPUtils.pas available from https://www.gocher.me/GZIP
  }
  GZIPUtils;

// pass ContentEncoding (string) directly
procedure DecompressResponse(Response: TMemoryStream;
                             ContentEncoding: string = '');
var
  temp: TMemoryStream;
  success: boolean;
begin
  ContentEncoding := LowerCase(ContentEncoding);
  if (ContentEncoding = '') or (ContentEncoding = 'identity') then
    Exit; // no compression, nothing to do

  // GZIPUtils' unzipStream() handles both gzip and "raw" zlib deflate
  if (ContentEncoding = 'gzip') or (ContentEncoding = 'deflate') then begin
    temp := TMemoryStream.Create;
    try
      success := unzipStream(Response, temp);
      if not success then
        raise EZlibError.Create('DecompressResponse failed to decode gzip stream');
      // unzipStream() will have reset stream positions to 0; so we can just copy
      Response.CopyFrom(temp, 0);
      // we normally expect the uncompressed data to be bigger than the input,
      // but for the sake of sanity we truncate the stream if it isn't
      with Response do if Size > Position then Size := Position;
    finally
      temp.Free;
    end;
    Exit; // done!
  end;

  // unknown encoding, give up
  raise ECompressionError.Create('Unable to handle content encoding "' + ContentEncoding + #34);
end;

// use Content-Encoding field from (response) header
procedure DecompressResponse(Response: TMemoryStream;
                             ResponseHeader: THTTPHeader);
begin
  // THTTPHeader doesn't seem to strip leading whitespace, use Trim() for extra safety
  DecompressResponse(Response, Trim(ResponseHeader.ContentEncoding));
end;

// use Content-Encoding field from (response) header stringlist
procedure DecompressResponse(Response: TMemoryStream;
                             ResponseHeader: TStrings; IncludeCommand: boolean = false);
var
  Header: THTTPHeader;
begin
  Header := THTTPHeader.Create;
  try
    Header.LoadFromStrings(ResponseHeader, IncludeCommand);
    DecompressResponse(Response, Header);
  finally
    Header.Free;
  end;
end;

end.