restemplate/indy/Protocols/IdMessageCoderYenc.pas

418 lines
12 KiB
Plaintext

{
$Project$
$Workfile$
$Revision$
$DateUTC$
$Id$
This file is part of the Indy (Internet Direct) project, and is offered
under the dual-licensing agreement described on the Indy website.
(http://www.indyproject.org/)
Copyright:
(c) 1993-2005, Chad Z. Hower and the Indy Pit Crew. All rights reserved.
}
{
$Log$
}
{
Rev 1.7 27.08.2004 22:04:00 Andreas Hausladen
speed optimization ("const" for string parameters)
Rev 1.6 2004.05.20 1:39:16 PM czhower
Last of the IdStream updates
Rev 1.5 2004.05.20 11:37:00 AM czhower
IdStreamVCL
Rev 1.4 2004.05.20 11:13:06 AM czhower
More IdStream conversions
Rev 1.3 2004.05.19 3:06:44 PM czhower
IdStream / .NET fix
Rev 1.2 2004.02.03 5:44:06 PM czhower
Name changes
Rev 1.1 5/9/2003 2:14:42 PM BGooijen
Streams are now buffered, speed is now about 75 times as fast as before
Rev 1.0 11/13/2002 07:57:22 AM JPMugaas
}
{*===========================================================================*}
{* DESCRIPTION *}
{*****************************************************************************}
{* PROJECT : Indy 10 *}
{* AUTHOR : Bas Gooijen (bas_gooijen@yahoo.com) *}
{* MAINTAINER : Bas Gooijen *}
{*...........................................................................*}
{* DESCRIPTION *}
{* yEnc messagepart encoder/decoded *}
{* *}
{* QUICK NOTES: *}
{* MULTIPART-MESSAGES ARE _NOT_ SUPPORTED *}
{* THIS CODE IS ALPHA *}
{* *}
{* implemented according to version 1.3 *}
{* http://www.easynews.com/yenc/yenc-draft.1.3.txt *}
{* http://www.easynews.com/yenc/yEnc-Notes3.txt *}
{* http://www.yenc.org/develop.htm *}
{*...........................................................................*}
{* HISTORY *}
{* DATE VERSION AUTHOR REASONS *}
{* *}
{* 07/07/2002 1.0 Bas Gooijen Initial start *}
{*****************************************************************************}
unit IdMessageCoderYenc;
interface
{$i IdCompilerDefines.inc}
uses
Classes,
IdMessageCoder, IdMessage, IdExceptionCore, IdGlobal;
type
EIdMessageYencException = class(EIdMessageException);
EIdMessageYencInvalidSizeException = class(EIdMessageYencException);
EIdMessageYencInvalidCRCException = class(EIdMessageYencException);
EIdMessageYencCorruptionException = class(EIdMessageYencException);
TIdMessageDecoderYenc = class(TIdMessageDecoder)
protected
FPart: Integer;
FLine: Integer;
FSize: Integer;
public
function ReadBody(ADestStream: TStream; var AMsgEnd: Boolean): TIdMessageDecoder; override;
end;
TIdMessageDecoderInfoYenc = class(TIdMessageDecoderInfo)
public
function CheckForStart(ASender: TIdMessage; const ALine: string): TIdMessageDecoder; override;
end;
TIdMessageEncoderYenc = class(TIdMessageEncoder)
public
procedure Encode(ASrc: TStream; ADest: TStream); override;
end;
TIdMessageEncoderInfoYenc = class(TIdMessageEncoderInfo)
public
constructor Create; override;
procedure InitializeHeaders(AMsg: TIdMessage); override;
end;
const
BUFLEN = 4096;
//fixed chars in integer form for easy byte comparison
B_PERIOD = $2E;
B_EQUALS = $3D;
B_TAB = $09;
B_LF = $0A;
B_CR = $0D;
B_NUL = $00;
implementation
uses
{$IFDEF DOTNET}
IdStreamNET,
{$ELSE}
IdStreamVCL,
{$ENDIF}
IdHashCRC,
IdResourceStringsProtocols,
SysUtils;
function GetStrValue(const Line, Option: string; const AMaxCount: Integer = MaxInt) : string;
var
LStart, LEnd: Integer;
begin
LStart := IndyPos(LowerCase(Option) + '=', LowerCase(Line));
if LStart = 0 then
begin
Result := ''; {Do not Localize}
Exit;
end;
Inc(LStart, Length(Option) + 1);
Result := Copy(Line, LStart, AMaxCount);
LEnd := IndyPos(' ', Result) ; {Do not Localize}
if LEnd > 0 then begin
Result := Copy(Result, 1, LEnd - 1);
end;
end;
function GetIntValue(const Line, Option: string): Integer;
var
LValue: String;
begin
LValue := GetStrValue(Line, Option, $FFFF);
if LValue <> '' then begin
Result := IndyStrToInt(LValue);
end else begin
Result := 0;
end;
end;
{ TIdMessageDecoderInfoYenc }
function TIdMessageDecoderInfoYenc.CheckForStart(ASender: TIdMessage; const ALine: string): TIdMessageDecoder;
function GetName: string;
var
LStart: Integer;
begin
LStart := IndyPos('name=', LowerCase(ALine)); {Do not Localize}
if LStart > 0 then begin
Result := Copy(ALine, LStart+5, MaxInt);
end else begin
Result := '';
end;
end;
var
LYenc: TIdMessageDecoderYenc;
begin
if TextStartsWith(ALine, '=ybegin ') {Do not Localize} then
begin
LYenc := TIdMessageDecoderYenc.Create(ASender);
try
LYenc.FSize := GetIntValue(ALine, 'size'); {Do not Localize}
LYenc.FLine := GetIntValue(ALine, 'line'); {Do not Localize}
LYenc.FPart := GetIntValue(ALine, 'part'); {Do not Localize}
LYenc.FFilename := GetName;
LYenc.FPartType := mcptAttachment;
except
FreeAndNil(LYenc);
raise;
end;
Result := LYenc;
end else begin
Result := nil;
end;
end;
{ TIdMessageDecoderYenc }
function TIdMessageDecoderYenc.ReadBody(ADestStream: TStream; var AMsgEnd: Boolean): TIdMessageDecoder;
var
LLine: string;
LLinePos: Integer;
LChar: Byte;
LBytesDecoded: Integer;
LPartSize: Integer;
LCrc32: string;
LMsgEnd: Boolean;
LOutputBuffer: TIdBytes;
LOutputBufferUsed: Integer;
LHash: UInt32;
LH: TIdHashCRC32;
LEncoding: IIdTextEncoding;
procedure FlushOutputBuffer;
begin
//TODO: this uses Array of Characters. Unless its dealing in Unicode or MBCS it should
// be using TIdBuffer
if Assigned(ADestStream) then begin
WriteTIdBytesToStream(ADestStream, LOutputBuffer, LOutputBufferUsed);
end;
LOutputBufferUsed := 0;
end;
procedure AddByteToOutputBuffer(const AChar: Byte);
begin
LOutputBuffer[LOutputBufferUsed] := AChar;
Inc(LOutputBufferUsed);
if LOutputBufferUsed >= BUFLEN then begin
FlushOutputBuffer;
end;
end;
begin
SetLength(LOutputBuffer, BUFLEN);
AMsgEnd := False;
Result := nil;
LPartSize := FSize;
LOutputBufferUsed := 0;
LBytesDecoded := 0;
LH := TIdHashCRC32.Create;
try
LH.HashStart(LHash);
//note that we have to do hashing here because there's no seek
// in the TStream class, changing definitions in this API might
// break something, and storing in an extra buffer will just eat space
LEncoding := IndyTextEncoding_8Bit;
repeat
LLine := ReadLnRFC(LMsgEnd, LEncoding{$IFDEF STRING_IS_ANSI}, LEncoding{$ENDIF});
if (IndyPos('=yend', LowerCase(LLine)) <> 0) or LMsgEnd then {Do not Localize}
begin
Break;
end;
if TextStartsWith(LLine, '=ypart ') then begin {Do not Localize}
LPartSize := GetIntValue(LLine, 'end') - GetIntValue(LLine, 'begin') + 1; {Do not Localize}
end
else begin
LLinePos := 1;
while LLinePos <= Length(LLine) do
begin
LChar := Byte(LLine[LLinePos]);
if LChar = B_EQUALS then begin
// invalid file, escape character may not appear at end of line
if LLinePos = Length(LLine) then begin
raise EIdMessageYencCorruptionException.Create(RSYencFileCorrupted);
end;
Inc(LLinePos);
LChar := Byte(LLine[LLinePos]);
Dec(LChar, 64);
end;
Dec(LChar, 42);
AddByteToOutputBuffer(LChar);
LH.HashByte(LHash, LChar);
Inc(LLinePos);
Inc(LBytesDecoded);
end;
end;
until False;
LH.HashEnd(LHash);
FlushOutputBuffer;
if LPartSize <> LBytesDecoded then begin
raise EIdMessageYencInvalidSizeException.Create(RSYencInvalidSize);
end;
LCrc32 := LowerCase(GetStrValue(LLine, 'crc32', $FFFF)); {Do not Localize}
if LCrc32 <> '' then begin
//done this way because values can be computed faster than strings and we don't
//have to mess with charactor case.
if IndyStrToInt64('$' + LCrc32) <> LHash then begin
raise EIdMessageYencInvalidCRCException.Create(RSYencInvalidCRC);
end;
end;
finally
FreeAndNil(LH);
end;
end;
constructor TIdMessageEncoderInfoYenc.Create;
begin
inherited Create;
FMessageEncoderClass := TIdMessageEncoderYenc;
end;
procedure TIdMessageEncoderInfoYenc.InitializeHeaders(AMsg: TIdMessage);
begin
//
end;
{ TIdMessageEncoderYenc }
procedure TIdMessageEncoderYenc.Encode(ASrc: TStream; ADest: TStream);
const
LineSize = 128;
var
s: String;
i, LSSize: TIdStreamSize;
LInput: Byte;
LOutput: Byte;
LCurrentLineLength: Integer;
LOutputBuffer: TIdBytes;
LOutputBufferUsed: Integer;
LInputBuffer: TIdBytes;
LInputBufferPos: Integer;
LInputBufferSize: Integer;
LHash: UInt32;
LH: TIdHashCRC32;
procedure FlushOutputBuffer;
begin
WriteTIdBytesToStream(ADest, LOutputBuffer, LOutputBufferUsed);
LOutputBufferUsed := 0;
end;
procedure AddByteToOutputBuffer(const AChar: Byte);
begin
LOutputBuffer[LOutputBufferUsed] := AChar;
Inc(LOutputBufferUsed);
if LOutputBufferUsed >= BUFLEN then begin
FlushOutputBuffer;
end;
end;
function ReadByteFromInputBuffer: Byte;
begin
if LInputBufferPos >= LInputBufferSize then begin
LInputBufferSize := ReadTIdBytesFromStream(ASrc, LInputBuffer, BUFLEN);
LInputBufferPos := 0;
end;
Result := LInputBuffer[LInputBufferPos];
Inc(LInputBufferPos);
end;
begin
SetLength(LOutputBuffer, BUFLEN);
SetLength(LInputBuffer, BUFLEN);
LSSize := IndyLength(ASrc);
LCurrentLineLength := 0;
LOutputBufferUsed := 0;
LH := TIdHashCRC32.Create;
try
LH.HashStart(LHash);
s := '=ybegin line=' + IntToStr(LineSize) + ' size=' + IntToStr(LSSize) + ' name=' + FFilename + EOL; {do not localize}
WriteStringToStream(ADest, s);
i := 0;
while i < LSSize do
begin
LInput := ReadByteFromInputBuffer;
Inc(i);
LH.HashByte(LHash, LInput);
LOutput := LInput;
Inc(LOutput, 42);
if LOutput in [B_NUL, B_LF, B_CR, B_EQUALS, B_TAB, B_PERIOD] then begin {do not localize}
AddByteToOutputBuffer(B_EQUALS);
Inc(LCurrentLineLength);
Inc(LOutput, 64);
end;
AddByteToOutputBuffer(LOutput);
Inc(LCurrentLineLength);
if LCurrentLineLength = 1 then begin
if LOutput = B_PERIOD then begin
AddByteToOutputBuffer(LOutput);
Inc(LCurrentLineLength);
end;
end;
if LCurrentLineLength >= LineSize then
begin
AddByteToOutputBuffer(B_CR);
AddByteToOutputBuffer(B_LF);
LCurrentLineLength := 0;
end;
end;
FlushOutputBuffer;
s := EOL + '=yend size=' + IntToStr(LSSize) + ' crc32=' + {do not localize}
LowerCase(IntToHex(LHash, 8)) + EOL;
WriteStringToStream(ADest, s);
finally
FreeAndNil(LH);
end;
end;
initialization
TIdMessageDecoderList.RegisterDecoder('yEnc', TIdMessageDecoderInfoYenc.Create); {Do not Localize}
TIdMessageEncoderList.RegisterEncoder('yEnc', TIdMessageEncoderInfoYenc.Create); {Do not Localize}
end.