mjn*_*mjn 5 delphi http multipartform-data indy
Indy 10.6修订版5128似乎包含一个更改,它会破坏HTTP表单上传的代码.
接收到的数据末尾包含两个附加字节,一个CR/LF对.
通过5127和5128之间的更改代码行读取并没有把我带到根本原因.
当我找到时间并在此处发布结果时,我将尝试调试它(但也许某人更快).
这是一个独立的演示应用程序,它显示了一个HTML上传表单 http://127.0.0.1:8080
program IndyMultipartUploadDemo;
{$APPTYPE CONSOLE}
uses
IdHTTPServer, IdCustomHTTPServer, IdContext, IdSocketHandle, IdGlobal,
IdMessageCoder, IdGlobalProtocols, IdMessageCoderMIME, IdMultiPartFormData,
SysUtils, Classes;
type
TMimeHandler = procedure(var VDecoder: TIdMessageDecoder;
var VMsgEnd: Boolean; const Response: TIdHTTPResponseInfo) of object;
TMyServer = class(TIdHTTPServer)
private
procedure ProcessMimePart(var VDecoder: TIdMessageDecoder;
var VMsgEnd: Boolean; const Response: TIdHTTPResponseInfo);
function IsHeaderMediaType(const AHeaderLine, AMediaType: String): Boolean;
function MediaTypeMatches(const AValue, AMediaType: String): Boolean;
function GetUploadFolder: string;
procedure HandleMultipartUpload(Request: TIdHTTPRequestInfo; Response:
TIdHTTPResponseInfo; MimeHandler: TMimeHandler);
public
procedure InitComponent; override;
procedure DoCommandGet(AContext: TIdContext;
ARequestInfo: TIdHTTPRequestInfo; AResponseInfo: TIdHTTPResponseInfo); override;
end;
procedure Demo;
var
Server: TMyServer;
begin
ReportMemoryLeaksOnShutdown := True;
Server := TMyServer.Create;
try
try
Server.Active := True;
except
on E: Exception do
begin
WriteLn(E.ClassName + ' ' + E.Message);
end;
end;
WriteLn('Hit any key to terminate.');
ReadLn;
finally
Server.Free;
end;
end;
procedure TMyServer.InitComponent;
var
Binding: TIdSocketHandle;
begin
inherited;
Bindings.Clear;
Binding := Bindings.Add;
Binding.IP := '127.0.0.1';
Binding.Port := 8080;
KeepAlive := True;
end;
procedure TMyServer.DoCommandGet(AContext: TIdContext;
ARequestInfo: TIdHTTPRequestInfo; AResponseInfo: TIdHTTPResponseInfo);
begin
AResponseInfo.ContentType := 'text/html';
AResponseInfo.CharSet := 'UTF-8';
if ARequestInfo.CommandType = hcGET then
begin
AResponseInfo.ContentText :=
'<!DOCTYPE HTML>' + #13#10
+ '<html>' + #13#10
+ ' <head>' + #13#10
+ ' <title>Multipart Upload Example</title>' + #13#10
+ ' </head>' + #13#10
+ ' <body> ' + #13#10
+ ' <form enctype="multipart/form-data" method="post">' + #13#10
+ ' <fieldset>' + #13#10
+ ' <legend>Standard file upload</legend>' + #13#10
+ ' <label>File input</label>' + #13#10
+ ' <input type="file" class="input-file" name="upload" />' + #13#10
+ ' <button type="submit" class="btn btn-default">Upload</button>' + #13#10
+ ' </fieldset>' + #13#10
+ ' </form>' + #13#10
+ ' </body>' + #13#10
+ '</html>' + #13#10;
end
else
begin
if ARequestInfo.CommandType = hcPOST then
begin
if IsHeaderMediaType(ARequestInfo.ContentType, 'multipart/form-data') then
begin
HandleMultipartUpload(ARequestInfo, AResponseInfo, ProcessMimePart);
end;
end;
end;
end;
// based on code on the Indy and Winsock Forum articles
// http://forums2.atozed.com/viewtopic.php?f=7&t=10924
// http://embarcadero.newsgroups.archived.at/public.delphi.internet.winsock/201107/1107276163.html
procedure TMyServer.ProcessMimePart(var VDecoder: TIdMessageDecoder;
var VMsgEnd: Boolean; const Response: TIdHTTPResponseInfo);
var
LMStream: TMemoryStream;
LNewDecoder: TIdMessageDecoder;
UploadFile: string;
begin
LMStream := TMemoryStream.Create;
try
LNewDecoder := VDecoder.ReadBody(LMStream, VMsgEnd);
if VDecoder.Filename <> '' then
begin
try
LMStream.Position := 0;
Response.ContentText := Response.ContentText
+ Format('<p>%s %d bytes</p>' + #13#10,
[VDecoder.Filename, LMStream.Size]);
// write stream to upload folder
UploadFile := GetUploadFolder + VDecoder.Filename;
LMStream.SaveToFile(UploadFile);
Response.ContentText := Response.ContentText
+ '<p>' + UploadFile + ' written</p>';
except
LNewDecoder.Free;
raise;
end;
end;
VDecoder.Free;
VDecoder := LNewDecoder;
finally
LMStream.Free;
end;
end;
function TMyServer.IsHeaderMediaType(const AHeaderLine, AMediaType: String): Boolean;
begin
Result := MediaTypeMatches(ExtractHeaderItem(AHeaderLine), AMediaType);
end;
function TMyServer.MediaTypeMatches(const AValue, AMediaType: String): Boolean;
begin
if Pos('/', AMediaType) > 0 then begin
Result := TextIsSame(AValue, AMediaType);
end else begin
Result := TextStartsWith(AValue, AMediaType + '/');
end;
end;
function TMyServer.GetUploadFolder: string;
begin
Result := ExtractFilePath(ParamStr(0)) + 'upload\';
ForceDirectories(Result);
end;
procedure TMyServer.HandleMultipartUpload(Request: TIdHTTPRequestInfo;
Response: TIdHTTPResponseInfo; MimeHandler: TMimeHandler);
var
LBoundary, LBoundaryStart, LBoundaryEnd: string;
LDecoder: TIdMessageDecoder;
LLine: string;
LBoundaryFound, LIsStartBoundary, LMsgEnd: Boolean;
begin
LBoundary := ExtractHeaderSubItem(Request.ContentType, 'boundary',
QuoteHTTP);
if LBoundary = '' then
begin
Response.ResponseNo := 400;
Response.CloseConnection := True;
Response.WriteHeader;
Exit;
end;
LBoundaryStart := '--' + LBoundary;
LBoundaryEnd := LBoundaryStart + '--';
LDecoder := TIdMessageDecoderMIME.Create(nil);
try
TIdMessageDecoderMIME(LDecoder).MIMEBoundary := LBoundary;
LDecoder.SourceStream := Request.PostStream;
LDecoder.FreeSourceStream := False;
LBoundaryFound := False;
LIsStartBoundary := False;
repeat
LLine := ReadLnFromStream(Request.PostStream, -1, True);
if LLine = LBoundaryStart then
begin
LBoundaryFound := True;
LIsStartBoundary := True;
end
else if LLine = LBoundaryEnd then
begin
LBoundaryFound := True;
end;
until LBoundaryFound;
if (not LBoundaryFound) or (not LIsStartBoundary) then
begin
Response.ResponseNo := 400;
Response.CloseConnection := True;
Response.WriteHeader;
Exit;
end;
LMsgEnd := False;
repeat
TIdMessageDecoderMIME(LDecoder).MIMEBoundary := LBoundary;
LDecoder.SourceStream := Request.PostStream;
LDecoder.FreeSourceStream := False;
LDecoder.ReadHeader;
case LDecoder.PartType of
mcptText, mcptAttachment:
begin
MimeHandler(LDecoder, LMsgEnd, Response);
end;
mcptIgnore:
begin
LDecoder.Free;
LDecoder := TIdMessageDecoderMIME.Create(nil);
end;
mcptEOF:
begin
LDecoder.Free;
LMsgEnd := True;
end;
end;
until (LDecoder = nil) or LMsgEnd;
finally
LDecoder.Free;
end;
end;
begin
Demo;
end.
Run Code Online (Sandbox Code Playgroud)
当前的SVN修订版为5203,因此您在更新方面略有落后.
我使用IE11在XE2中使用修订版5203测试了您的代码.
我上传了一个测试.pas
文件,它在upload
文件夹中大了53个字节.我可以确认PostStream
解码前的原始数据是正确的.
是的,我确实在文件的末尾看到了一个额外的CRLF,这与TIdMessageDecoderMIME
解码非二进制非base64/QP编码数据的方式有关(你的例子没有).它逐行读取数据,在每条线路上进行解码,在不使用二进制传输编码时,使用新的换行符将解码线写入目标流.该逻辑没有考虑到MIME边界前面的换行符属于边界,而不是边界之前的数据.MIME规范非常明确,但Indy还没有考虑到非base64数据.
文件大小的其余差异都与转换为$3F
字节序列的非ASCII字符有关,包括UTF-8 BOM.这是因为PostStream
数据被解码为7bit ASCII in,TIdMessageDecoderMIME.ReadBody()
因为没有Content-Transfer-Encoding
与文件数据一起发送的头,所以Indy因为RFC 2045第6.1节中的这个声明而默认为ASCII:
如果Content-Transfer-Encoding标头字段不存在,则假定"Content-Transfer-Encoding:7BIT".
但是,第6.4节规定了以下内容,这似乎与6.1相矛盾:
无论Content-Type标头字段实际上是什么,必须将具有无法识别的Content-Transfer-Encoding的任何实体视为具有Content-Type为"application/octet-stream"的实体.
ReadBody()
处理这两种情况,但首先检查6.1,因此Indy采用7bit
编码,然后使其处理6.4无效,因为7bit
它不是无法识别的编码.除非人们假设缺失Content-Transfer-Encoding
应被视为无法识别的编码,而Indy目前没有.
Content-Type
上传的实际情况是application/octet-stream
,这意味着8位编码.当我更新ReadBody()
处理application/octet-stream
的8bit
,而不是7bit
采用第6.1节的时候,所有的问题消失:
if LContentTransferEncoding = '' then begin
// RLebeau 04/08/2014: According to RFC 2045 Section 6.1:
// "Content-Transfer-Encoding: 7BIT" is assumed if the
// Content-Transfer-Encoding header field is not present."
if IsHeaderMediaType(LContentType, 'application/mac-binhex40') then begin {Do not Localize}
LContentTransferEncoding := 'binhex40'; {do not localize}
end
// START FIX!!
else if IsHeaderMediaType(LContentType, 'application/octet-stream') then begin {Do not Localize}
LContentTransferEncoding := '8bit'; {do not localize}
end
// END FIX!!
else begin
LContentTransferEncoding := '7bit'; {do not localize}
end;
end
Run Code Online (Sandbox Code Playgroud)
上传的文件是正确的文件大小,字节被正确解码和写入,而非ASCII序列不会转换为$3F
序列,并且文件末尾没有额外的CRLF.
我将不得不进一步调查这个问题,看看是否有更好的方法来处理这种不确定性.我已经在Indy的问题跟踪器中打开了门票.与此同时,如果您修补了Indy的副本,则可以找到解决方法.
归档时间: |
|
查看次数: |
6411 次 |
最近记录: |