unit RFC2822;

// FIXME case-insensitive header blah.
// TODO RFC2822 from 'address' downwards.

{$MODE OBJFPC}

interface
uses contnrs, scanners, classes;

type
  TBody = TStringList;
  TAddress = ANSIString;
  TAddressList = TStringList;
  TMessageID = ANSIString;
  TMessageIDList = TStringList;
  THeader = class(TStringList)
  private // FIXME just use it from the stringlist.
    fSender : TAddress;
    fFrom : TAddressList;
    fTo : TAddressList; // one header entry!
    fCc : TAddressList;
    fBcc : TAddressList;
    fReplyTo : TAddress;
    fOriginationDate : TDateTime;
    fSubject : ANSIString;
    fMessageID : TMessageID;
    fInReplyTo : TMessageIDList;
    fReferences : TMessageIDList;
    fComments : TStringList;
    fKeywords : TStringList;
  published
    property OriginationDate : TDateTime read fOriginationDate write fOriginationDate; // required field.
    property ReplyTo : TAddress read fReplyTo write fReplyTo;
    property From : TAddressList read fFrom write fFrom; // required field.
    property To_ : TAddressList read fTo write fTo;
    property Cc : TAddressList read fCc write fCc;
    property Bcc : TAddressList read fBcc write fBcc;
    property Sender : TAddress read fSender write fSender;
    property MessageID : TMessageID read fMessageID write fMessageID; // SHOULD exist.
    property InReplyTo : TMessageIDList read fInReplyTo write fInReplyTo;
    property References : TMessageIDList read fReferences write fReferences;
    property Subject : ANSIString read fSubject write fSubject;
    property Comments : TStringList read fComments write fComments; // unlimited.
    property Keywords : TStringList read fKeywords write fKeywords; // unlimited.
    { TODO ResentDate, ResentFrom, ResentSender, ResentTo, ResentCc, ResentBcc, ResentMessageID }
    // FIXME #Add
  end; // TODO key-value?
  TMailboxList = TStringList;
  TTrace = class
  private
    fReturnPath : ANSIString;
    // FIXME received.
  published
    property ReturnPath : ANSIString read fReturnPath write fReturnPath;
  end;
  TDocument = class
  private
    fTraces : TObjectList; {TTrace;}
    fBody : TBody;
    fHeader : THeader;
  published
    property Body : TBody read fBody write fBody;
    property Header : THeader read fHeader write fHeader;
    // FIXME Trace, TraceCount
  end;
  TDayOfWeek = (dwMonday, dwTuesday, dwWednesday, dwThursday, dwFriday, dwSaturday, dwSunday);
  TUnstructuredData = ANSIString;
  TKeywords = TStringList;
  TParser = class(TScanner)
  private
    procedure WSP(); inline;
    function dtext() : Char; inline;
    function dcontent() : Char; inline;
    function qtext() : Char; inline;
    function qcontent() : Char; inline;
    function day_name() : TDayOfWeek;
    function hour() : Cardinal; inline;
    function minute() : Cardinal; inline;
    function second() : Cardinal; inline;
    function year() : Cardinal; inline;
    function month() : Cardinal; inline;
    function month_name() : Cardinal; inline;
    function day() : Cardinal; inline;
    function word() : ANSIString; // beware of CFWS.
    function traceBody() : TTrace;
    function field() : ANSIString;
    function mailboxBody(aFirstPart : TStringList) : ANSIString;
    function mailbox_list() : TMailboxList;
    function address_list() : TAddressList;
    function mailbox(out fFirstPart : TStringList) : ANSIString;
    function id_left() : ANSIString; inline;
    function id_right() : ANSIString; inline;
  protected
    function CRLF() : ANSIString;
    function utext() : Char; inline;
    procedure optional_FWS(); inline;
    procedure FWS(); inline;
    procedure optional_CFWS();
    procedure CFWS();
    function dot_atom() : ANSIString;
    function dot_atom_text() : ANSIString;
    function atom() : ANSIString;
    procedure comment();
    procedure ccontent(); inline;
    function ctext() : Char; inline;
    function quoted_pair() : Char; inline;
    function quoted_string() : ANSIString;
    function unstructured() : TUnstructuredData;
    function time_of_day() : Cardinal; // in seconds.
    function DIGIT() : Cardinal; inline;
    function zone() : Integer; // in minutes.
    function phrase() : ANSIString;
    function domain_literal() : ANSIString;
    function domain() : ANSIString;
    function local_part() : ANSIString;
    function addr_spec() : ANSIString;
    function angle_addr() : ANSIString;

    function body() : TBody;
    function message() : TDocument;
    function fields() : THeader;
    function trace() : TTrace;
    function traces() : TObjectList;
    function field_name() : ANSIString;
    function optional_field() : ANSIString;
    function path() : ANSIString;
    function display_name() : ANSIString;

    function subjectBody() : TUnstructuredData;
    function commentsBody() : TUnstructuredData;
    function keywordsBody() : TKeywords;
    function address() : ANSIString;

    function item_name() : ANSIString;
    function item_value() : ANSIString;
    function name_val_list() : TStringList {map};
    function no_fold_literal() : ANSIString;
    function no_fold_quote() : ANSIString;

  public
    function date_time() : TDateTime;
    function msg_id() : ANSIString;
  published
    function Parse() : TDocument;
  end;

implementation
uses sysutils;

function DIGIT_P(aInput : Char) : Boolean; inline;
begin
  Result := aInput in ['0', '1', '2', '3', '4', '5', '6', '7', '8', '9'];
end;

function ALPHA_P(aInput : Char) : Boolean; inline;
begin
  Result := ((aInput >= 'A') and (aInput <= 'Z')) or ((aInput >= 'a') and (aInput <= 'z'));
end;

function atext_P(aInput : Char) : Boolean; inline;
begin
  // especially not ':' nor '@':
  Result := ALPHA_P(aInput) or DIGIT_P(aInput) or (aInput in ['!', '#', '$', '%', '&', '''', '*', '+', '-', '/', '=', '?', '^', '_', '`', '{', '|', '}', '~']);
end;

function ftext_P(aInput : Char) : Boolean; inline;
begin
  Result := ((aInput >= #33) and (aInput <= #57)) or ((aInput >= #59) and (aInput <= #126));
end;

// NOTE non-standard:
function CRLF_P(aInput : Char) : Boolean; inline;
begin
  Result := aInput in [#13, #10];
end;

function WSP_P(aInput : Char) : Boolean; inline;
begin
  Result := aInput in [#32, #9];
end;

function dot_atext_P(aInput : Char) : Boolean; inline;
begin
  Result := atext_P(aInput) or (aInput = '.');
end;

function dot_atom_P(aInput : Char) : Boolean; inline;
begin
  Result := dot_atext_P(aInput);
end;

function comment_start_P(aInput : Char) : Boolean; inline;
begin
  Result := aInput = '(';
end;

function quoted_pair_P(aInput : Char) : Boolean; inline;
begin
  Result := aInput = '\'; // FIXME or ops-qp
end;

function NO_WS_CTL_P(aInput : Char) : Boolean; inline;
begin
  Result := ((aInput > #0) and (aInput < #32) and not (aInput in [#9, #10, #13])) or (aInput = #127);
end;

function ctext_P(aInput : Char) : Boolean; inline;
begin
  Result := NO_WS_CTL_P(aInput) or ((aInput >= #33) and (aInput <= #39)) or ((aInput >= #42) and (aInput <= #91)) or ((aInput >= #93) and (aInput <= #126)); 
end;

function text_P(aInput : Char) : Boolean; inline;
begin
  Result := (aInput > #0) and (aInput <= #127) and not (aInput in [#10, #13]);
end;

function qtext_P(aInput : Char) : Boolean; inline;
begin
  Result := NO_WS_CTL_P(aInput) or (aInput = #33) or ((aInput >= #35) and (aInput <= #91)) or ((aInput >= #93) and (aInput <= #126));
end;

function FWS_P(aInput : Char) : Boolean; inline;
begin
  Result := WSP_P(aInput); // FIXME verify
end;

function ccontent_P(aInput : Char) : Boolean; inline;
begin
  Result := ctext_P(aInput) or quoted_pair_P(aInput) or comment_start_P(aInput);
end;

function qcontent_P(aInput : Char) : Boolean; inline;
begin
  Result := qtext_P(aInput) or quoted_pair_P(aInput);
end;

function utext_P(aInput : Char) : Boolean; inline;
begin
  Result := NO_WS_CTL_P(aInput) or ((aInput >= #33) and (aInput <= #126));
  // FIXME or obs-utext
end;

function dtext_P(aInput : Char) : Boolean; inline;
begin
  Result := NO_WS_CTL_P(aInput) or ((aInput >= #33) and (aInput <= #126) and not (aInput in ['[', '\', ']']));
end;

function day_name_P(aInput : Char) : Boolean; inline;
begin
  Result := (aInput in ['M', 'T', 'W', 'F', 'S']);
end;

function quoted_string_P(aInput : Char) : Boolean; inline;
begin
  Result := aInput = '"';
end;

// note: beware of CFWS.
function word_P(aInput : Char) : Boolean; inline;
begin
  Result := atext_P(aInput) or quoted_string_P(aInput);
end;

// note: beware of CFWS.
function domain_literal_P(aInput : Char) : Boolean; inline;
begin
  Result := aInput = '[';
end;

procedure TParser.optional_FWS(); inline;
begin
  // FIXME
  FWS();
end;

procedure TParser.FWS(); inline;
begin
  // ([*WSP CRLF] 1*WSP)
  while WSP_P(Input) do begin
    Consume();
  end;
  if Input = #13 then begin
    Consume();

    // NOTE: non-standard behaviour:
    if Input = #10 then
      Consume(#10);

    WSP();
    while WSP_P(Input) do 
      WSP();
  end;

  // FIXME obs-FWS
end;

function TParser.ctext() : Char; inline;
begin
  if not ctext_P(Input) then
    Error('<ctext>');
  Result := Consume();
end;

function TParser.quoted_pair() : Char; inline;
begin
  if not quoted_pair_P(Input) then
    Error('<quoted-pair>');
  Consume('\');
  if not text_P(Input) then
    Error('<text>');
  Result := Consume(); // FIXME or obs-qp
end;

procedure TParser.ccontent(); inline;
begin
  if ctext_P(Input) then
    ctext()
  else if quoted_pair_P(Input) then
    quoted_pair()
  else if comment_start_P(Input) then
    comment()
  else 
    Error('<ctext>|<quoted-pair>|<comment-start>');
end;

procedure TParser.comment();
begin
  Consume('(');
  while True do begin
    if FWS_P(Input) then
      FWS()
    else if ccontent_P(Input) then
      ccontent()
    else
      Break;
  end;

  FWS();
  Consume(')');  
end;

procedure TParser.optional_CFWS();
begin
  // FIXME
  CFWS();
end;

procedure TParser.CFWS();
begin
  // FIXME at least one FWS and comment.
  while True do begin
    if comment_start_P(Input) then begin
      comment();
    end else if FWS_P(Input) then begin
      FWS();
    end else 
      Break;
  end;
end;

function TParser.atom() : ANSIString;
begin
  Result := '';
  CFWS();
  if not atext_P(Input) then
    Error('<atext>');

  while atext_P(Input) do begin
    Result := Result + Consume(); // TODO optimize.
  end;

  CFWS();
end;

function TParser.dot_atom_text() : ANSIString;
begin
  Result := '';
  if not dot_atext_P(Input) then
    Error('<dot-atext>');

  while dot_atext_P(Input) do begin
    Result := Result + Consume(); // TODO optimize.
  end;
end;

function TParser.dot_atom() : ANSIString;
begin
  CFWS();
  Result := dot_atom_text();
  CFWS();
end;


function TParser.hour() : Cardinal; inline;
begin
  Result := DIGIT() * 10;
  Result := Result + DIGIT();
  // FIXME obs- (not in THIS function!)
end;

function TParser.minute() : Cardinal; inline;
begin
  Result := DIGIT() * 10;
  Result := Result + DIGIT();
  // FIXME obs- (not in THIS function!)
end;

function TParser.second() : Cardinal; inline;
begin
  Result := DIGIT() * 10;
  Result := Result + DIGIT();
  // FIXME obs-
end;

function TParser.year() : Cardinal; inline;
begin
  Result := DIGIT() * 10;
  Result := Result + DIGIT();
  // FIXME obs-
end;

function TParser.month_name() : Cardinal; inline;
begin
  case Input of 
    'J': begin
           Consume();
           if Input = 'a' then begin
             Consume('an');
             Result := 1;
           end else begin
             Consume('u');
             if Input = 'n' then begin
               Consume();
               Result := 6;
             end else if Input = 'l' then begin
               Consume();
               Result := 7;
             end else
               Error('<month-name>');
           end;
         end;
    'F': begin
           Consume('Feb');
           Result := 2;
         end;
    'M': begin
           Consume('Ma');
           if Input = 'r' then begin
             Consume();
             Result := 3;
           end else if Input = 'y' then begin
             Consume();
             Result := 4;
           end else
             Error('<month-name>');
         end;
    'A': begin
           Consume();
           if Input = 'p' then begin
             Consume('pr');
             Result := 4;
           end else if Input = 'u' then begin
             Consume('ug');
             Result := 8;
           end else
             Error('<month-name>');
         end;
    'S': begin
           Consume('Sep');
           Result := 9;
         end;
    'O': begin
           Consume('Oct');
           Result := 10;
         end;
    'N': begin
           Consume('Nov');
           Result := 11;
         end;
    'D': begin
           Consume('Dec'); 
           Result := 12;
         end;
    else
      Error('<month-name>');
  end;
  // FIXME obs-month
end;

function TParser.month() : Cardinal; inline;
begin
  FWS();
  Result := month_name();
  FWS();
  // FIXME obs-month.
end;

function TParser.day() : Cardinal; inline;
begin
  optional_FWS();
  // FIXME [FWS] 1*2DIGIT
  Result := DIGIT() * 10;
  Result := Result + DIGIT();
  // FIXME obs-day.
end;

function TParser.time_of_day() : Cardinal; // in seconds.
begin
  Result := hour();
  Consume(':');
  Result := Result * 60 + minute();
  Result := Result * 60;
  if Input = ':' then begin
    Consume(':');
    Result := Result + second();
  end;
end;

function TParser.date_time() : TDateTime;
var
  vYear : Cardinal;
  vMonth : Cardinal;
  vDay : Cardinal;
begin
  optional_FWS();
  day_name();
  // FIXME obs-day-of-week
  //date();

  vDay := day();
  vMonth := month();
  vYear := year();
  Result := EncodeDate(vYear, vMonth, vDay);

  FWS();
  //time();

  Result := Result + time_of_day() / 86400;
  FWS();
  zone(); // FIXME.

  optional_CFWS();
end;

function TParser.day_name() : TDayOfWeek; // non-standard.
begin
  //if day_of_week_P(Input)
  case Input of
    'M': begin
           Consume('Mon');
           Result := dwMonday;
         end;
    'T': begin
           Consume();
           if Input = 'u' then begin
             Consume('ue');
             Result := dwTuesday;
           end else if Input = 'h' then begin
             Consume('hu');
             Result := dwThursday;
           end else 
             Error('<day-name>');
         end;
    'W': begin
           Consume('Wed');
           Result := dwWednesday;
         end;
    'F': begin
           Consume('Fri');
           Result := dwFriday;
         end;
    'S': begin
           Consume();
           if Input = 'a' then begin
             Consume('at');
             Result := dwSaturday;
           end else if Input = 'u' then begin
             Consume('un');
             Result := dwSunday;
           end else
             Error('<day-name>');
         end;
    else
      Error('<day-name>');
  end;
end;

function TParser.qtext() : Char; inline;
begin
  Result := Consume();
end;

function TParser.qcontent() : Char; inline;
begin
  if quoted_pair_P(Input) then
    Result := quoted_pair()
  else
    Result := qtext();
end;

function TParser.utext() : Char; inline;
begin
  if not utext_P(Input) then
    Error('<utext>');
  Result := Consume();
end;

function TParser.no_fold_quote() : ANSIString;
begin
  Consume('"'); // FIXME DQUOTE
  Result := '';

  while True do begin
    if qtext_P(Input) then
      Result := Result + qtext()
    else if quoted_pair_P(Input) then
      Result := Result + quoted_pair()
    else
      Break;
  end;
  Consume('"');
  //no-fold-quote   =       DQUOTE *(qtext / quoted-pair) DQUOTE
end;

function TParser.no_fold_literal() : ANSIString;
begin
  Consume('[');
  Result := '';
  while True do begin
    if dtext_P(Input) then
      Result := Result + dtext()
    else if quoted_pair_P(Input) then
      Result := Result + quoted_pair()
    else
      Break;
  end;
  Consume(']');
end;

function TParser.quoted_string() : ANSIString;
begin
  optional_CFWS();
  Consume('"'); // FIXME DQUOTE
  Result := '';
  while True do begin
    if qcontent_P(Input) then
      Result := Result + qcontent()
    else if FWS_P(Input) then
      FWS()
    else
      Break;
  end;
  optional_FWS();
  Consume('"');
  optional_CFWS();
end;

function TParser.unstructured() : TUnstructuredData;
begin
  Result := '';
  while True do begin
    optional_FWS();
    Result := Result + utext();
  end;
  optional_FWS();
end;

function TParser.DIGIT() : Cardinal; inline;
begin
  if DIGIT_P(Input) then
    Result := Ord(Consume()) - Ord('0')
  else
    Error('<DIGIT>');
end;

function TParser.path() : ANSIString;
begin
  optional_CFWS();
  Consume('<');
  optional_CFWS();
  Result := '<' + addr_spec() + '>'; // FIXME spec says this is optional. What the heck?
  Consume('>');
  optional_CFWS();
  // FIXME obs-path
end;

function TParser.zone() : Integer; // in minutes.
var
  fSign : Char;
begin
  { obs-zone }
  if Input = 'U' then begin
    Consume('UT');
    Result := 0;
    Exit;
  end else if Input = 'G' then begin
    Consume('GMT');
    Result := 0;
    Exit;
  end else if Input = 'E' then begin
    Consume();
    if Input = 'S' then begin
      Consume();
      Result := -5 * 60
    end else if Input = 'D' then begin
      Consume();
      Result := -4 * 60
    end else
      Error('<zone>');
    Consume('T');
    Exit;
  end else if Input = 'C' then begin
    Consume();
    if Input = 'S' then begin
      Consume();
      Result := -6 * 60
    end else if Input = 'D' then begin
      Consume();
      Result := -5 * 60
    end else
      Error('<zone>');
    Consume('T');
    Exit;
  end else if Input = 'M' then begin
    Consume();
    if Input = 'S' then begin
      Consume();
      Result := -7 * 60
    end else if Input = 'D' then begin
      Consume();
      Result := -6 * 60
    end else
      Error('<zone>');
    Consume('T');
    Exit;
  end else if Input = 'P' then begin
    Consume();
    if Input = 'S' then begin
      Consume();
      Result := -8 * 60
    end else if Input = 'D' then begin
      Consume();
      Result := -7 * 60
    end else
      Error('<zone>');
    Consume('T');
    Exit;
  end else begin
    { FIXME obs-zone:
                        %d65-73 /               ; Military zones - "A"
                        %d75-90 /               ; through "I" and "K"
                        %d97-105 /              ; through "Z", both
                        %d107-122               ; upper and lower case }
    { end of obs-zone }
    if Input = '+' then
      fSign := Consume()
    else if Input = '-' then
      fSign := Consume()
    else 
      Error('<zone>');

    Result := hour() * 60;
    Result := Result + minute();
    if fSign = '-' then
      Result := -Result;
  end;
end;

function TParser.word() : ANSIString;
begin
  if atext_P(Input) then
    Result := atom()
  else if quoted_string_P(Input) then
    Result := quoted_string()
  else
    Error('<atom>|<quoted_string>');
end;

function TParser.phrase() : ANSIString;
begin
  Result := '';
  Result := word();
  CFWS();
  while word_P(Input) do begin
    Result := Result + word();
    CFWS();
  end;
  // FIXME obs-phrase.
end;

procedure TParser.WSP(); inline;
begin 
// FIXME if debugging, check.
  Consume();
end;

function TParser.domain_literal() : ANSIString;
begin
  optional_CFWS();
  Consume('[');
  Result := '';
  while True do begin
    if FWS_P(Input) then
      FWS()
    else if quoted_pair_P(Input) then
      Result := Result + quoted_pair()
    else if dtext_P(Input) then
      Result := Result + dcontent()
    else
      Break;
  end;

  optional_FWS();
  Consume(']');
  optional_FWS();
end;

function TParser.domain() : ANSIString;
begin
  // NOTE non-standard.
  optional_CFWS();
  if dot_atom_P(Input) then
    Result := dot_atom()
  else if domain_literal_P(Input) then
    Result := domain_literal()
  else
    Error('<domain>');
  // FIXME obs-domain.
end;

function TParser.dtext() : Char; inline;
begin
  Result := Consume();
end;

function TParser.dcontent() : Char; inline;
begin
  if quoted_pair_P(Input) then
    Result := quoted_pair()
  else
    Result := dtext();
end;

function TParser.local_part() : ANSIString;
begin
  if dot_atom_P(Input) then
    Result := dot_atom()
  else if quoted_string_P(Input) then
    Result := quoted_string()
  else
    Error('<local-part>');
  // FIXME obs-local-part.
end;

function TParser.addr_spec() : ANSIString;
begin
  Result := local_part();
  Consume('@');
  Result := domain();
end;

function TParser.body() : TBody;
var
  fLine : ANSIString;
begin
  Result := TBody.Create();
  fLine := '';

  while True do begin
    if (Input <> #13) and (Input <> #10) then
      fLine := fLine + Consume()
    else begin
      fLine := fLine + CRLF();
      Result.Add(fLine);
      fLine := '';
    end;
  end;
  if fLine <> '' then
    Result.Add(fLine);
  // FIXME         =       *(*998text CRLF) *998text
end;

function trace_P(aInput : Char) : Boolean; inline;
begin
  Result := (aInput = 't') or (aInput = 'c'); // Return-Path|Received.
end;

function TParser.item_name() : ANSIString;
begin
  if not ALPHA_P(Input) then
    Error('<item-name>');
  Result := Consume();
  while True do begin
    if Input = '-' then
      Result := Result + Consume();
    if ALPHA_P(Input) or DIGIT_P(Input) then
      Result := Result + Consume()
    else
      Break;
  end;
  //item-name       =       ALPHA *(["-"] (ALPHA / DIGIT))
end;

function TParser.id_left() : ANSIString; inline;
begin
  if quoted_string_P(Input) then
    Result := no_fold_quote()
  else if dot_atom_P(Input) then
    Result := dot_atom_text()
  else
    Error('<id-left>');
  // FIXME obs-id-left
  // id-left         =       dot-atom-text / no-fold-quote / obs-id-left
end;

function TParser.id_right() : ANSIString; inline;
begin
  if dot_atom_P(Input) then
    Result := dot_atom_text()
  else if domain_literal_P(Input) then
    Result := no_fold_literal()
  else
    Error('<id-right>');
  // FIXME obs-id-right. 
  // id-right        =       dot-atom-text / no-fold-literal / obs-id-right
end;

function TParser.msg_id() : ANSIString;
begin
  optional_CFWS();
  Consume('<');
  Result := '<' + id_left() + '@';
  Consume('@');
  Result := Result + id_right() + '>';
  Consume('>');
  optional_CFWS();
end;

function TParser.item_value() : ANSIString;
begin
  if Input = '<' then begin // TODO CFWS?
    Result := angle_addr();
    // FIXME ≥ 1
  end else begin
{
  local_part of addr_spec:
    dot_atom_P(Input) then
    Result := dot_atom()   
  else if quoted_string_P(Input) then
    Result := quoted_string();
}
    if Input = ? then
      Result := addr_spec() // can start with dot_atom
    else if atom_P(Input) then
      Result := atom()
    else if domain_P(Input) then
      Result := domain() // can also start with dot_atom
    else if Input = '<' then // FIXME CFWS before it.
      Result := msg_id()
    else
      Error('<angle-addr>|<addr-spec>|<atom>|<domain>|<msg-id>');
  end;
end;

function TParser.name_val_list() : TStringList {map};
var
  fItemName : ANSIString;
  fItemValue : ANSIString;
begin
  Result := TStringList.Create();
  optional_CFWS();
  repeat
    fItemName := item_name();
    CFWS();
    fItemValue := item_value();

    // FIXME are "fItemName"s unique?
    Result.Values[fItemName] := fItemValue;

    // FIXME abort condition.
    CFWS();
  until False;
  //name-val-list   =       [CFWS] [name-val-pair *(CFWS name-val-pair)]
  //name-val-pair   =       item-name CFWS item-value
end;

function TParser.ceivedBody() : ;
begin
  name-val-list
  Consume(';');
  date_time();
  CRLF();
end;

function TParser.traceBody() : TTrace;
begin
  Result := TTrace.Create();
  if Input = 't' then begin
    Consume('turn-Path:');
    Result.ReturnPath := path();
    CRLF();
  end;

  while Input = 'c' do begin
    Consume('ceived:');
    ceivedBody();
    if Input <> 'R' then
      Break;
    Consume('Re');
  end;
end;

function TParser.traces() : TObjectList;
begin
  Result := TObjectList.Create();
  while True do begin
    if Input = 'R' then begin
      Consume('Re');
      if not trace_P(Input) then // FIXME. whoops.
        Break;
      traceBody(); // FIXME Result.Add
    end else
      Break; // => <field>
  end;    
end;

// TODO case-insensitive?
function orig_date_P(aInput : Char) : Boolean; inline;
begin
  Result := aInput = 'D'; //  Date:
end;
function from_P(aInput : Char) : Boolean; inline; begin
  Result := aInput = 'F'; // From:
end;
{function sender_P(aInput : Char) : Boolean; inline; begin
  Result := aInput = 'S'; // Sender:
end;}
{function reply_to_P(aInput : Char) : Boolean; inline; begin
  Result := aInput = 'R'; // Reply-To:
end;
function references_P(aInput : Char) : Boolean; inline; begin
  References
end;}
function to_P(aInput : Char) : Boolean; inline; begin
  Result := aInput = 'T'; // To:
end;
{function cc_P(aInput : Char) : Boolean; inline; begin
  Result := aInput = 'C';  // Cc:
end;}
function bcc_P(aInput : Char) : Boolean; inline; begin
  Result := aInput = 'B'; // Bcc:
end;
function message_ID_P(aInput : Char) : Boolean; inline; begin
  Result := aInput = 'M'; // Message-ID:
end;
function in_reply_to_P(aInput : Char) : Boolean; inline; begin
  Result := aInput = 'I'; // In-Reply-To:
end;
function keywords_P(aInput : Char) : Boolean; inline; begin
  Result := aInput = 'K'; // Keywords:
end;

function TParser.field() : ANSIString;
begin
  // FIXME:
    if orig_date_P(Input) then begin
      Consume('Date:');
      Result := (Format('Date: %s', [orig_dateBody()]))
    end else if from_P(Input) then begin
      Consume('From:');
      Result := (Format('From: %s', [fromBody()]))
    end else if Input = 'S' then begin
      if Input = 'e' then begin
        Consume('ender:');
        Result := (Format('Sender: %s', [senderBody()]))
      end else if Input = 'u' then begin
        Consume('ubject:');
        Result := (Format('Subject: %s', [subjectBody()]))
      end else
        Error('<field>');
    end else if Input = 'R' then begin
      Consume('Re');
      if Input = 'p' then begin // FIXME
        Consume('ply-To');
        Result := (Format('Reply-To: %s', [reply_toBody()]))
      end else if Input = 'f' then begin
        Consume('ferences');
        Result := (Format('References: %s', [referencesBody()]))
      end else if Input = 's' then begin
        Consume('Resent-');
        // TODO Resent-: Date, From, Sender, To, Cc, Bcc, Message-ID.
        Result := (Format('Resent-%s', [resentBody()]))
      end else
        Error('References|Reply-To|Resent-');
    end else if to_P(Input) then begin
      Consume('To:');
      Result := (Format('To: %s', [toBody()]))
    end else if Input = 'C' then begin
      Consume();
      if Input = 'c' then begin
        Consume('c:');
        Result := (Format('Cc: %s', [ccBody()]))
      end else if Input = 'o' then begin
        Consume('omments:');
        Result := (Format('Comments: %s', [commentsBody()]))
      end else
        Error('<field>');
    end else if bcc_P(Input) then begin 
      Consume('Bcc:');
      Result := (Format('Bcc: %s', [bccBody()]))
    end else if message_id_P(Input) then begin
      Consume('Message-ID:');
      Result := (Format('Message-ID: %s', [message_IDBody()]))
    end else if in_reply_to_P(Input) then begin
      Consume('In-Reply-To:');
      Result := (Format('In-Reply-To: %s', [in_reply_toBody()]))
    end else if keywords_P(Input) then begin
      Consume('Keywords:');
      Result := (Format('Keywords: %s', [keywordsBody()]))
    end else if optional_field_P(Input) then
      Result := (optional_field()) // Format('Keywords: %s', [keywords()]))
    else
      Error('<field>');
end;

function TParser.field_name() : ANSIString;
begin
  if not ftext_P(Input) then
    Error('<field-name>');

  Result := Consume();
  while ftext_P(Input) do begin
    Result := Result + Consume();
  end;
end;

function TParser.optional_field() : ANSIString;
begin
  Result := field_name();
  Consume(':');
  Result := Result + ';' + unstructured();
end;

function TParser.fields() : THeader;
begin
  Result := THeader.Create();
  // non-trace:
  while (Input <> #13) and (Input <> #10) do begin // FIXME EOF.
    Result.Add(field());
  end;    
end;

function TParser.message() : TDocument;
begin
  Result := TDocument.Create();
  Result.fTraces := traces();
  Result.Header := fields();
  if CRLF_P(Input) then begin
    CRLF();
    Result.Body := body();
  end;
end;

function TParser.Parse() : TDocument;
begin
  Result := message();
end;

function TParser.CRLF() : ANSIString;
begin
  Result := Consume(#13);

  // NOTE non-standard behaviour:
  if Input = #10 then
    Result := Result + Consume(#10);
end;

function TParser.commentsBody() : TUnstructuredData;
begin
  Result := unstructured();
  CRLF();
end;

function TParser.subjectBody() : TUnstructuredData;
begin
  Result := unstructured();
  CRLF();
end;

function TParser.keywordsBody() : TKeywords;
begin
  Result := TKeywords.Create();
  Result.Add(phrase());
  while Input = ',' do begin
    Consume();
    Result.Add(phrase());
  end;
  CRLF();
end;

function TParser.address_list() : TAddressList;
begin
  Result := TAddressList.Create();
  Result.Add(address());
  while Input = ',' do begin
    Consume();
    Result.Add(address());
  end;
  // FIXME obs-addr-list
end;

function TParser.mailbox_list() : TMailboxList;
begin
  Result := TMailboxList.Create();
  Result.Add(mailbox());
  while Input = ',' do begin
    Consume();
    Result.Add(mailbox());
  end;
  // FIXME obs-mbox-list
end;

function TParser.display_name() : ANSIString;
begin
  Result := phrase();
end;

function TParser.mailboxBody(aFirstPart : TStringList) : ANSIString;
begin
  // FIXME aFirstPart
  if Input = '<' then begin
    Consume();
    Result := aFirstPart.Items + '<' + addr_spec() + '>'; // displayname.
    optional_CFWS();
    // FIXME obs-angle-addr
  end else if Input = '@' then begin
    Consume();

  end else
    Error('<mailbox>');
end;

function TParser.groupBody(aFirstPart : TStringList);
begin
  aFirstPart = display-name
  Consume(':');
  mailbox_list();
end;

function TParser.mailbox(out fFirstPart : TStringList) : ANSIString;
begin
  // this isn't exactly standard since I can't figure out a way to actually map this:
{
  (([1*(atom|quoted-string)] optional_CFWS "<" ...angle-addr)
  | ((dot-atom | quoted-string | obs-local-part) "@" domain)) 
  | (1*(atom|quoted-string) ":" [mailbox-list / CFWS] ";" [CFWS] )
}
  fFirstPart := TStringList.Create();
  while True do begin
    if dot_atom_P(Input) then
      fFirstPart.Add(dot_atom())
    else if quoted_string_P(Input) then
      fFirstPart.Add(quoted_string())
    else
      Break;
  end;
  optional_CFWS();
  if Input = '<' then
    Result := mailboxBody(fFirstPart)
  else if Input = '@' then
    Result := mailboxBody(fFirstPart)
  else
    Result := '';
end;

function TParser.address() : ANSIString;
var
  fFirstPart : TStringList;
begin
  Result := mailbox(fFirstPart);
  if Result = '' then if Input = ':' then
    Result := groupBody(fFirstPart)
  else
    Error('<address>');
  // FIXME obs-local-part
end;

function TParser.angle_addr() : ANSIString;
begin
  optional_CFWS();
  Consume('<');
  Result := '<' + addr_spec() + '>';
  Consume('>');
  optional_CFWS();
end;

{ THeader }


end.