Contribution: MultipartFormDataEncode

EMartin · 2016-07-14 20:01:16

Hi @ab, I needed to implement a MultiFormDataEncode function and I needed change the MultiFromDataDecode function.

MultiFormDataDecode: I modified this function for add a new content type check for to decode multiple files in multipart array.

function MultiPartFormDataDecode(const MimeType,Body: RawUTF8;
  var MultiPart: TMultiPartDynArray): boolean;
var boundary,endBoundary: RawUTF8;
    i,j: integer;
    P: PUTF8Char;
    part: TMultiPart;
begin
  result := false;
  i := PosEx('boundary=',MimeType);
  if i=0 then
    exit;
  boundary := trim(copy(MimeType,i+9,200));
  if (boundary<>'') and (boundary[1]='"') then
    boundary := copy(boundary,2,length(boundary)-2); // "boundary" -> boundary
  boundary := '--'+boundary;
  endBoundary := boundary+'--'+#13#10;
  boundary := boundary+#13#10;
  i := PosEx(boundary,Body);
  if i<>0 then
  repeat
    inc(i,length(boundary));
    if i=length(body) then
      exit; // reached the end
    P := PUTF8Char(Pointer(Body))+i-1;
    Finalize(part);
    repeat
      if IdemPCharAndGetNextItem(P,
         'CONTENT-DISPOSITION: FORM-DATA; NAME="',part.Name,'"') then
        IdemPCharAndGetNextItem(P,'; FILENAME="',part.FileName,'"') else
      if IdemPCharAndGetNextItem(P,
         'CONTENT-DISPOSITION: FILE; FILENAME="',part.FileName,'"') then else // multipart/mixed files has it
      if not IdemPCharAndGetNextItem(P,'CONTENT-TYPE: ',part.ContentType) then
         IdemPCharAndGetNextItem(P,'CONTENT-TRANSFER-ENCODING: ',part.Encoding);
      GetNextLineBegin(P,P);
      if P=nil then
        exit;
    until PWord(P)^=13+10 shl 8;
    i := P-PUTF8Char(Pointer(Body))+3; // i = just after header
    j := PosEx(boundary,Body,i);
    if j=0 then begin
     j := PosEx(endboundary,Body,i); // try last boundary
     if j=0 then
      exit;
    end;
    part.Content := copy(Body,i,j-i-2); // -2 to ignore latest #13#10
    if (part.ContentType='') or (PosEx('-8',part.ContentType)>0) then begin
      part.ContentType := TEXT_CONTENT_TYPE;
      {$ifdef HASCODEPAGE}
      SetCodePage(part.Content,CP_UTF8,false); // ensure raw field value is UTF-8
      {$endif}
    end else
    if IdemPropNameU(part.Encoding,'base64') then
      part.Content := Base64ToBin(part.Content);
    // note: "quoted-printable" not yet handled here
    SetLength(MultiPart,length(MultiPart)+1);
    MultiPart[high(MultiPart)] := part;
    result := true;
    i := j;
  until false;
end;

MultiFormDataEncode:

/// encode multipart fields and files but only one of them can be used because MultiPartFormDataDecode must implement
// both decodings
// - MultiPart: parts to build the multipart content.
// - MultiPartContentType: variable returning Content-Type: multipart/form-data; boundary=xxx where xxx is the first generated boundary.
// - MultiPartContent: generated multipart content
function MultiPartFormDataEncode(const MultiPart: TMultiPartDynArray; var MultiPartContentType, MultiPartContent: RawUTF8): boolean;
var
  len: integer;
  i, j: integer;
  generator: TSynUniqueIdentifierGenerator;
  boundaries: array of RawUTF8;
  W: TTextWriter;
  countFiles: integer;
begin
  result := false;

  len := length(MultiPart);
  if (len=0) then
    exit;

  // generator for boundary hexa id
  generator := TSynUniqueIdentifierGenerator.Create(GetCurrentThreadId);
  W := TTextWriter.CreateOwnedStream;
  try
    j := 0;
    countFiles := 0; // files processed counter
    // header multipart
    SetLength(boundaries, j+1);
    boundaries[j] := Int64ToHex(generator.ComputeNew);
    MultiPartContentType := FormatUTF8('Content-Type: multipart/form-data; boundary=%', [boundaries[j]]);
    for i:=0 to len-1 do
    begin
      if (MultiPart[i].FileName='') then
      begin
        W.Add('--%', [boundaries[j]]);
        W.AddCR;
        W.Add('Content-Disposition: form-data; name="%"', [MultiPart[i].Name]);
        W.AddCR;
        W.Add('Content-Type: %', [MultiPart[i].ContentType]);
        W.AddCR;
        W.AddCR;
        W.AddString(MultiPart[i].Content);
        W.AddCR;
        W.Add('--%', [boundaries[j]]);
        W.AddCR;
      end
      else
      begin
        // if is the first file create the header for files
        if (countFiles=0) then
        begin
          if (i>0) then // a field has been processed
          begin
            Inc(J);
            SetLength(boundaries, j+1);
            boundaries[j] := Int64ToHex(generator.ComputeNew);
          end;
          W.AddString('Content-Disposition: form-data; name="files"');
          W.AddCR;
          W.Add('Content-Type: multipart/mixed; boundary=%', [boundaries[j]]);
          W.AddCR;
          W.AddCR;
        end;
        inc(countFiles);
        // add file
        W.Add('--%', [boundaries[j]]);
        W.AddCR;
        W.Add('Content-Disposition: file; filename="%"', [MultiPart[i].FileName]);
        W.AddCR;
        W.Add('Content-Type: %', [MultiPart[i].ContentType]);
        if (MultiPart[i].Encoding<>'') then
        begin
          W.AddCR;
          W.Add('Content-Transfer-Encoding: %', [MultiPart[i].Encoding]);
        end;
        W.AddCR;
        W.AddCR;
        W.AddString(MultiPart[i].Content);
        W.AddCR;
        W.Add('--%', [boundaries[j]]);
        W.AddCR;
      end;
    end;
    // footer multipart
    for i:=length(boundaries)-1 downto 0 do
    begin
      W.Add('--%--', [boundaries[i]]);
      W.AddCR;
    end;
    W.SetText(MultiPartContent);
    Result := True;
  finally
    W.Free;
    generator.Free;
  end;
end;

MultiPartFormDataEncodeFile:

/// Encode a file in a multipart
// - FileName: file to encode
// - Multipart: where the part is added
// - Name: name of the part, is empty the name 'FileN' is generated
function MultiPartFormDataEncodeFile(const FileName: TFileName; var MultiPart: TMultiPartDynArray; const Name: RawUTF8 = ''): boolean;
var
  part: TMultiPart;
  newlen: integer;
begin
  result := false;
  if (FileName='') or (FileAgeToDateTime(FileName)=0) then
    exit;

  newlen := length(MultiPart)+1;
  part.Name := Name;
  if (part.Name='') then
    part.Name := 'File'+IntToStr(newlen);
  part.FileName := ExtractFileName(FileName);
  part.ContentType := GetMimeContentType(nil, 0, FileName);
  part.Encoding := 'base64';
  part.Content := BinToBase64(StringFromFile(FileName));
  SetLength(MultiPart, newlen);
  MultiPart[newlen-1] := part;
  result := true;
end;

MultiPartFormDataEncodeField:

/// Encode a field in a multipart
// - FieldName: field name of the part
// - FieldValue: value of the field
// - Multipart: where the part is added
// - Name: name of the part, is empty the name 'FileN' is generated
function MultiPartFormDataEncodeField(const FieldName, FieldValue: RawUTF8; var MultiPart: TMultiPartDynArray): boolean;
var
  part: TMultiPart;
  newlen: integer;
begin
  result := false;
  if (FieldName='') then
    exit;

  newlen := length(MultiPart)+1;
  part.Name := FieldName;
  part.ContentType := GetMimeContentTypeFromBuffer(pointer(FieldValue), length(FieldValue), 'text/plain');
  part.Content := FieldValue;
  SetLength(MultiPart, newlen);
  MultiPart[newlen-1] := part;
  result := true;
end;

If you are agree, can you add the encoding functions to the SynCommons unit ?

Thanks.

ab · 2016-07-17 17:26:25

Please check and validate http://synopse.info/fossil/info/63ebaec176

Thanks for sharing!

EMartin · 2016-07-18 16:36:07

Hi @ab, the funcion MultiPartFormDataEncode is not working because when using W.Add(...#13#10...) this function (TTextWriter.Add) when parse the #13 replace this with #13#10 then it's #13#10#10, later MultiPartFormDataDecode fail in function IdemPChar(...).

this is the corrected function:

function MultiPartFormDataEncode(const MultiPart: TMultiPartDynArray;
  var MultiPartContentType, MultiPartContent: RawUTF8): boolean;
var len, boundcount, filescount, i: integer;
    boundaries: array of RawUTF8;
    bound: RawUTF8;
    W: TTextWriter;
  procedure NewBound;
  var random: array[1..3] of cardinal;
  begin
    FillRandom(@random,3);
    bound := BinToBase64(@random,sizeof(Random));
    SetLength(boundaries,boundcount+1);
    boundaries[boundcount] := bound;
    inc(boundcount);
  end;
begin
  result := false;
  len := length(MultiPart);
  if len=0 then
    exit;
  boundcount := 0;
  filescount := 0;
  W := TTextWriter.CreateOwnedStream;
  try
    // header multipart
    NewBound;
    MultiPartContentType := 'Content-Type: multipart/form-data; boundary='+bound;
    for i := 0 to len-1 do
    with MultiPart[i] do begin
      if FileName='' then
        W.Add('--%'#13'Content-Disposition: form-data; name="%"'#13+
          'Content-Type: %'#13#13'%'#13'--%'#13,
          [bound,Name,ContentType,Content,bound]) else begin
        // if this is the first file, create the header for files
        if filescount=0 then begin
          if i>0 then
            NewBound;
          W.Add('Content-Disposition: form-data; name="files"'#13+
            'Content-Type: multipart/mixed; boundary=%'#13#13,[bound]);
        end;
        inc(filescount);
        W.Add('--%'#13'Content-Disposition: file; filename="%"'#13+
          'Content-Type: %'#13,[bound,FileName,ContentType]);
        if Encoding<>'' then
          W.Add('Content-Transfer-Encoding: %'#13,[Encoding]);
        W.AddCR;
        W.AddString(MultiPart[i].Content);
        W.Add(#13'--%'#13,[bound]);
      end;
    end;
    // footer multipart
    for i := boundcount-1 downto 0 do
      W.Add('--%--'#13, [boundaries[i]]);
    W.SetText(MultiPartContent);
    result := True;
  finally
    W.Free;
  end;
end;

In this code I removed the #10.

Thanks.

Last edited by EMartin (2016-07-18 16:38:09)

ab · 2016-07-19 09:13:54

I've fixed MultiPartFormDataEncode implementation.

See http://synopse.info/fossil/info/73271568b4

EMartin · 2016-07-19 18:40:01

Works fine !!!

Thanks @ab

EMartin · 2017-01-12 16:02:49

Hi @ab, I found a problem in function MultiPartFormDataDecode, if a text file is uploaded as base64 this is not converted to original text.

The section code to fix:

The fix:

    part.Content := copy(Body,i,j-i-2); // -2 to ignore latest #13#10
    if (part.ContentType='') or (PosEx('-8',part.ContentType)>0) then begin
      part.ContentType := TEXT_CONTENT_TYPE;
      {$ifdef HASCODEPAGE}
      SetCodePage(part.Content,CP_UTF8,false); // ensure raw field value is UTF-8
      {$endif}
    end; // --> FIX: CHANGE THE else BY ; then conversion to original is OK
    if IdemPropNameU(part.Encoding,'base64') then
      part.Content := Base64ToBin(part.Content);

Can you fix this ?

Thanks.

Esteban

EMartin · 2017-01-13 14:02:46

Any news ?

ab · 2017-01-13 15:58:46

Please check http://synopse.info/fossil/info/3f0abd16f0

(I had family issues this week, so re-activity was low)

EMartin · 2017-01-13 17:03:57

I apologize, and thanks for the fix.

Esteban.

mORMot Open Source

#1 2016-07-14 20:01:16

Contribution: MultipartFormDataEncode

#2 2016-07-17 17:26:25

Re: Contribution: MultipartFormDataEncode

#3 2016-07-18 16:36:07

Re: Contribution: MultipartFormDataEncode

#4 2016-07-19 09:13:54

Re: Contribution: MultipartFormDataEncode

#5 2016-07-19 18:40:01

Re: Contribution: MultipartFormDataEncode

#6 2017-01-12 16:02:49

Re: Contribution: MultipartFormDataEncode

#7 2017-01-13 14:02:46

Re: Contribution: MultipartFormDataEncode

#8 2017-01-13 15:58:46

Re: Contribution: MultipartFormDataEncode

#9 2017-01-13 17:03:57

Re: Contribution: MultipartFormDataEncode

Board footer