u_messagehttp.pas

linux program to read packet data

(*
 * One Way Network Sniffer (OWNS)
 * Copyright (C) 2001-2002 OWNS
 *
 * http://owns.sourceforge.net/
 * http://www.owns.st
 *
 * This program is free software; you can redistribute it and/or
 * modify it under the terms of the GNU General Public License
 * as published by the Free Software Foundation; either version 2
 * of the License, or (at your option) any later version.
 *
 * This program is distributed in the hope that it will be useful,
 * but WITHOUT ANY WARRANTY; without even the implied warranty of
 * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
 * GNU General Public License for more details.
 *
 * You should have received a copy of the GNU General Public License
 * along with this program; if not, write to the Free Software
 * Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA  02111-1307, USA.
 *)

(*
 * $Id: u_messageHTTP.pas,v 1.6 2002/11/02 14:05:38 owns Exp $
 * A http connection contains several http messages
 * A http message has a header and a body
 *)

unit u_messageHTTP;

interface
uses classes,sysutils,
     u_MimeTypes,u_DataBuffer;

type
  THTTPMessage = class
  private
    FHTTPMessage : PChar;
    FHeader : TStrings;
    FCookies : TStrings;
    FContentUnChunked : TDataBuffer;
    FHeaderContentType : TMimeType;
    FHeaderContentRange : String;
    FHeaderContentLength : Integer;
    FHeaderLength : Integer;
    FHeaderTransferEnCoding : String;
    FHeaderContentEnCoding : String;
    FStatusCode : Integer;
    FSizeMax : LongInt;
    FSizeBody : Integer;
    FSizeContent : Integer;
    function readHTTPLine(p_Header : PChar;var r_Position : Integer) : String;
    procedure parseHeader;
    procedure readHTTPProperty(p_Line : String; var r_Property : String; var r_Value : String);
    function getBody : PChar;
    procedure getSizeBodyChunked(var r_BodyLength : Integer; var r_ContentLength : Integer);
    function getSizeBody : LongInt;
    procedure Unchunk;
    function getContent : PChar;
    function getCOntentLength : Integer;
  public
    constructor Create(p_HTTPMessage : PChar;p_SizeMax : LongInt);
    destructor destroy; override;
    procedure processMessage;
    function hasMessageBody : boolean;
    property StatusCode : Integer read FStatusCode;
    property Cookies : TStrings read FCookies;

    property Header : TStrings read FHeader;
    property Body: PChar read getBody;
    property COntent : PChar read getContent;

    // some header fields
    property HeaderContentType : TMimeType read FHeaderContentType;
    property HeaderContentLength : Integer read FHeaderContentLength;
    property HeaderTransferEncoding : String read FHeaderTransferEncoding;
    property HeaderContentEncoding : String read FHeaderContentEncoding;
    property HeaderContentRange : String read FHeaderContentRange;

    property HeaderLength : Integer read FHeaderLength;
    property BodyLength : Integer read getSizeBody;
    property ContentLength : Integer read getCOntentLength;
  end;

implementation


// give the status code : HTTP/1.0 200 OK => gives 200
function getStatusCode(p_HTTPLine : String) : Integer;
var
  l_StatusCOde : String;
  i : Integer;
  l_Length : Integer;
begin
  l_Length := Length(p_HTTPLine);
  i := 1;
  while (p_HTTPLine[i] <> ' ') do inc(i);
  inc(i);
  while ((i <= l_Length) and (p_HTTPLine[i] <> ' ')) do  // first part is necessary for things like HTTP/1.1 302
  begin
    l_StatusCode := l_StatusCode+p_HTTPLine[i];
    inc(i);
  end;
  result := StrToInt(l_StatusCode);
end;

// tells if the message has a body. The body can have a length of 0
// All 1xx (informational), 204 (no content), and 304 (not modified) responses
// MUST NOT include a message-body. All other responses do include a
// message-body, although it may be of zero length.
function THTTPMessage.hasMessageBody : boolean;
begin
  result := true;
  if ( ((FStatusCode >= 100) and (FStatusCode < 200)) or
     (FStatusCode = 204) or (FSTatusCode = 304) ) then
     result := false;
end;

// processHeader must be called after constructor
// p_SizeMax is the maximum length that the p_HTTPMessage can have
// Since we don't know the size of the message before reading the header,
// this is the size of the httpCOnnection (minus current position)
constructor THTTPMessage.Create(p_HTTPMessage : PChar;p_SizeMax : LongInt);
begin
  FHTTPMessage := p_HTTPMessage;
  FHeaderContentLength := -1; // undefined
  FSizeBody := -1; // undefined
  FSizeContent := -1; // undefined
  FHeaderContentType := TMimeType.create;
  FHeaderContentRange := '';
  FHeaderTransferEncoding := '';
  FHeaderContentEncoding := '';
  FStatusCode := 200;
  FHeaderLength := 0;
  FHeader := TSTringList.create;
  FCookies := TSTringList.create;
  FSizeMax := p_SizeMax;
  FContentUnChunked := nil;
end;

destructor THTTPMessage.destroy;
begin
  FHeader.free;
  FCookies.free;
  FHeaderContentType.free;
  FContentUnChunked.free; // if necessary
  inherited;
end;


// read the header of the message
// must be called before calling other functions
procedure THTTPMessage.processMessage;
var
  l_Position : Integer;
  l_Line : String;
begin
  // on lit la premi鑢e ligne. On en d閐uit le status code
  l_Position := 0;

  if ((FHTTPMessage[0] <> 'H') or
      (FHTTPMessage[1] <> 'T') or
      (FHTTPMessage[2] <> 'T') or
      (FHTTPMessage[3] <> 'P')) then
    raise exception.create('invalid http message');

  l_Line := readHTTPLine(FHTTPMessage,l_Position); // HTTP/1.1 200 OK par ex
  FStatusCode := getStatusCode(l_Line);

  // on met toutes les lignes du header dans un TStringList
  FHeader.add(l_Line);
  while (l_Line <> '') do
  begin
    l_Line := readHTTPLine(FHTTPMessage,l_Position);
    if (l_Line <> '') then FHeader.add(l_Line);
  end;
  FHeaderLength := l_Position;

  // puis on parse le header pour avoir taille, content-type ...
  parseHeader;
end;


// read a line
// From RFC 2068 :
// "The line terminator for message-header fields is the sequence CRLF.
// However, we recommend that applications, when parsing such headers,
// recognize a single LF as a line terminator and ignore the leading CR"
function THTTPMessage.readHTTPLine(p_Header : PChar;var r_Position : Integer) : String;
begin
  result := '';
  while ((p_Header[r_Position] <> #10)) do // LF
  begin
    if (r_Position >= FSizeMax) then
      exit;

    if (p_Header[r_Position] <> #13) then // CR
      result := result + p_Header[r_Position];
    Inc(r_Position);

    // Il peut y avoir une ligne de longueur importante dans l'entete (pour les cookies)
    // par contre si on rencontre un 0, il y a un probl鑝e ...
//    if (p_Header[r_Position] = #0) then raise exception.create('error in http header');
  end;

  Inc(r_Position,1); // pour le #10 (LF)
end;

// parse the header
procedure THTTPMessage.parseHeader;
var
  i : Integer;
  l_Property : String;
  l_Value : String;
begin
  for i := 0 to FHeader.Count-1 do
  begin
    readHTTPProperty(FHeader[i], l_Property, l_Value);
    l_Property := UpperCase(l_Property);
    if (l_Property = 'CONTENT-TYPE') then  FHeaderContentType.ContentType := l_Value;

    if (l_Property = 'CONTENT-LENGTH') then FHeaderContentLength := StrToInt(l_Value);

    if (l_Property = 'CONTENT-RANGE') then FHeaderContentRange := l_Value;
    if (l_Property = 'TRANSFER-ENCODING') then FHeaderTransferEnCoding := UpperCase(l_Value); // "all transfer-coding values are case-insensitive"
    if (l_Property = 'SET-COOKIE') then FCookies.Add(l_Value);
    if (l_Property = 'CONTENT-ENCODING') then FHeaderContentEnCoding := UpperCase(l_Value);
  end;
end;

// parse the given http line of the http header
// returns the field name and the field value
// message-header = field-name ":" [ field-value ] CRLF
procedure THTTPMessage.readHTTPProperty(p_Line : String; var r_Property : String; var r_Value : String);
var
  i  : Integer;
begin
  r_Property := ''; r_Value := '';
  i := 1;
  while ((i <= length(p_Line)) and (p_Line[i] <> ':')) do
  begin
    r_Property := r_Property+p_Line[i];
    Inc(i);
  end;
  Inc(i,2); // ' '
  while (i <= Length(p_Line)) do
  begin
    r_Value := r_Value+p_Line[i];
    inc(i);
  end;

  // En principe c'est inutile mais parfois on a un trailing space apr鑣
  // par exemple "Content-Length: 3089 "
  // ce qui fait une exception lors de la convertion (StrToInt)
  r_Value := TrimRight(r_Value);
end;


// get size of a chunked body and the size of the content !)
// see RFC2068, Page 25
procedure THTTPMessage.getSizeBodyChunked(var r_BodyLength : Integer; var r_ContentLength : Integer);
var
  l_Position     : Integer; // position dans le body
  l_Line         : String;
  l_ChunkSizeHex : String;
  l_ChunkSize    : Integer;
  i              : Integer;
  l_Body         : PChar;
begin
  try
  l_Body := Body;
  l_Position := 0;
  r_BodyLength := 0; r_ContentLength := 0;

  while true do
  begin
    // read chunk line
    l_Line := '';
    while (l_Body[l_Position] <> #13) do
    begin
      l_Line := l_Line + l_Body[l_Position];
      Inc(l_Position);
    end;
    Inc(l_Position,2); // CRLF

    // calculate next chunk size
    l_ChunkSizeHex := '';
    // le 'or l_Line[i] = ' ' est n閏essaire car assez souvent il y a un ' ' entre le nombre hexa et le CRLF !
    // (ce qui n'est d'ailleur pas conforme