paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-04-20 11:29:27 +02:00
Code Issues Packages Projects Releases Wiki Activity

* update lnet in fppkg to 0.5.8

Browse Source 
git-svn-id: trunk@9012 -
This commit is contained in:
Almindor 2007-10-31 09:08:27 +00:00
parent 100dab3c33
commit 0dce152199
20 changed files with 309 additions and 196 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

6
utils/fppkg/lnet/lcommon.pp
View File

@ -1,6 +1,6 @@
{ lCommon
CopyRight (C) 2004-2006 Ales Katona
CopyRight (C) 2004-2007 Ales Katona
This library is Free software; you can rediStribute it and/or modify it
under the terms of the GNU Library General Public License as published by
@ -62,6 +62,10 @@ const
LMSG = 0;
{$ENDIF}
{$ENDIF}
{$IFDEF DARWIN}
SO_NOSIGPIPE = $1022; // for fpc 2.0.4
{$ENDIF}
{$ENDIF}
{ Default Values }
LDEFAULT_BACKLOG = 5;

2
utils/fppkg/lnet/lcontrolstack.pp
View File

@ -1,6 +1,6 @@
{ Control stack
CopyRight (C) 2004-2006 Ales Katona
CopyRight (C) 2004-2007 Ales Katona
This library is Free software; you can rediStribute it and/or modify it
under the terms of the GNU Library General Public License as published by

11
utils/fppkg/lnet/levents.pp
View File

@ -1,6 +1,6 @@
{ lNet Events abstration
CopyRight (C) 2006 Ales Katona
CopyRight (C) 2006-2007 Ales Katona
This library is Free software; you can rediStribute it and/or modify it
under the terms of the GNU Library General Public License as published by
@ -158,6 +158,7 @@ type
function CallAction: Boolean; virtual;
procedure RemoveHandle(aHandle: TLHandle); virtual;
procedure UnplugHandle(aHandle: TLHandle); virtual;
procedure UnregisterHandle(aHandle: TLHandle); virtual;
procedure LoadFromEventer(aEventer: TLEventer); virtual;
procedure Clear;
procedure AddRef;
@ -424,6 +425,11 @@ begin
end;
end;
procedure TLEventer.UnregisterHandle(aHandle: TLHandle);
begin
// do nothing, specific to win32 LCLEventer crap (windows is shit)
end;
procedure TLEventer.LoadFromEventer(aEventer: TLEventer);
begin
Clear;
@ -499,6 +505,9 @@ var
MaxHandle, n: Integer;
TempTime: TTimeVal;
begin
if FInLoop then
Exit;
if not Assigned(FRoot) then begin
Sleep(FTimeout.tv_sec * 1000 + FTimeout.tv_usec div 1000);
Exit;

2
utils/fppkg/lnet/lfastcgi.pp
View File

@ -1,6 +1,6 @@
{ FastCGI requester support for lNet
Copyright (C) 2006 Micha Nelissen
Copyright (C) 2006-2007 Micha Nelissen
This library is Free software; you can redistribute it and/or modify it
under the terms of the GNU Library General Public License as published by

12
utils/fppkg/lnet/lftp.pp
View File

@ -1,4 +1,4 @@
{ lFTP CopyRight (C) 2005-2006 Ales Katona
{ lFTP CopyRight (C) 2005-2007 Ales Katona
This library is Free software; you can rediStribute it and/or modify it
under the terms of the GNU Library General Public License as published by
@ -70,8 +70,8 @@ type
function GetConnected: Boolean; virtual;
function GetTimeout: DWord;
procedure SetTimeout(const Value: DWord);
function GetTimeout: Integer;
procedure SetTimeout(const Value: Integer);
function GetSocketClass: TLSocketClass;
procedure SetSocketClass(Value: TLSocketClass);
@ -87,7 +87,7 @@ type
public
property Connected: Boolean read GetConnected;
property Timeout: DWord read GetTimeout write SetTimeout;
property Timeout: Integer read GetTimeout write SetTimeout;
property SocketClass: TLSocketClass read GetSocketClass write SetSocketClass;
property ControlConnection: TLTelnetClient read FControl;
property DataConnection: TLTCP read FData;
@ -280,12 +280,12 @@ begin
Result := FControl.Connected;
end;
function TLFTP.GetTimeout: DWord;
function TLFTP.GetTimeout: Integer;
begin
Result := FControl.Timeout;
end;
procedure TLFTP.SetTimeout(const Value: DWord);
procedure TLFTP.SetTimeout(const Value: Integer);
begin
FControl.Timeout := Value;
FData.Timeout := Value;

2
utils/fppkg/lnet/lhttp.pp
View File

@ -1,6 +1,6 @@
{ HTTP server and client components
Copyright (C) 2006 Micha Nelissen
Copyright (C) 2006-2007 Micha Nelissen
This library is Free software; you can redistribute it and/or modify it
under the terms of the GNU Library General Public License as published by

5
utils/fppkg/lnet/lhttputil.pp
View File

@ -1,6 +1,6 @@
{ Utility routines for HTTP server component
Copyright (C) 2006 Micha Nelissen
Copyright (C) 2006-2007 Micha Nelissen
This library is Free software; you can redistribute it and/or modify it
under the terms of the GNU Library General Public License as published by
@ -244,9 +244,6 @@ begin
if index > 0 then begin
Port := StrToIntDef(Copy(Host, index+1, Length(Host)-index), -1);
if (Port < 0) or (Port > 65535) then
Port := 80;
SetLength(Host, index-1);
end else
Port := 80;

23
utils/fppkg/lnet/lmimestreams.pp
View File

@ -1,3 +1,26 @@
{ MIME Streams
CopyRight (C) 2006-2007 Micha Nelissen
This library is Free software; you can rediStribute it and/or modify it
under the terms of the GNU Library 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 Library General Public License
for more details.
You should have received a Copy of the GNU Library General Public License
along with This library; if not, Write to the Free Software Foundation,
Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
This license has been modified. See File LICENSE.ADDON for more inFormation.
Should you find these sources without a LICENSE File, please contact
me at ales@chello.sk
}
unit lMimeStreams;
{$mode objfpc}{$H+}

2
utils/fppkg/lnet/lmimetypes.pp
View File

@ -1,6 +1,6 @@
{ Mime types helper
Copyright (C) 2006 Micha Nelissen
Copyright (C) 2006-2007 Micha Nelissen
This library is Free software; you can redistribute it and/or modify it
under the terms of the GNU Library General Public License as published by

43
utils/fppkg/lnet/lmimewrapper.pp
View File

@ -1,3 +1,26 @@
{ lNet MIME Wrapper
CopyRight (C) 2007 Ales Katona
This library is Free software; you can rediStribute it and/or modify it
under the terms of the GNU Library 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 Library General Public License
for more details.
You should have received a Copy of the GNU Library General Public License
along with This library; if not, Write to the Free Software Foundation,
Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
This license has been modified. See File LICENSE.ADDON for more inFormation.
Should you find these sources without a LICENSE File, please contact
me at ales@chello.sk
}
unit lMimeWrapper;
{$mode objfpc}{$H+}
@ -115,9 +138,9 @@ type
function GetSize: Int64; override;
function GetCount: Integer;
function GetBoundary: string;
function GetSections(i: Integer): TMimeSection;
function GetSection(i: Integer): TMimeSection;
function GetMimeHeader: string;
procedure SetSections(i: Integer; const AValue: TMimeSection);
procedure SetSection(i: Integer; const AValue: TMimeSection);
procedure ActivateFirstSection;
procedure ActivateNextSection;
procedure DoRead(const aSize: Integer);
@ -135,7 +158,7 @@ type
procedure Remove(aSection: TMimeSection);
procedure Reset;
public
property Sections[i: Integer]: TMimeSection read GetSections write SetSections; default;
property Sections[i: Integer]: TMimeSection read GetSection write SetSection; default;
property Count: Integer read GetCount;
property Boundary: string read FBoundary;
end;
@ -529,7 +552,7 @@ begin
Result := Result + Char(Random(Ord('9') - Ord('0') + 1) + Ord('0'));
end;
function TMimeStream.GetSections(i: Integer): TMimeSection;
function TMimeStream.GetSection(i: Integer): TMimeSection;
begin
Result := nil;
@ -550,7 +573,7 @@ begin
'--' + FBoundary + CRLF;
end;
procedure TMimeStream.SetSections(i: Integer; const AValue: TMimeSection);
procedure TMimeStream.SetSection(i: Integer; const AValue: TMimeSection);
begin
if (i >= 0)
and (i < FSections.Count) then
@ -740,9 +763,17 @@ begin
or (s = 'cpp')
or (s = 'cc')
or (s = 'h')
or (s = 'hh')
or (s = 'rb')
or (s = 'pod')
or (s = 'php')
or (s = 'php3')
or (s = 'php4')
or (s = 'php5')
or (s = 'c++') then FContentType := 'text/plain';
if s = 'html' then FContentType := 'text/html';
if (s = 'html')
or (s = 'shtml') then FContentType := 'text/html';
if s = 'css' then FContentType := 'text/css';
if s = 'png' then FContentType := 'image/x-png';

80
utils/fppkg/lnet/lnet.pp
View File

@ -1,6 +1,6 @@
{ lNet v0.5.6
{ lNet v0.5.8
CopyRight (C) 2004-2006 Ales Katona
CopyRight (C) 2004-2007 Ales Katona
This library is Free software; you can rediStribute it and/or modify it
under the terms of the GNU Library General Public License as published by
@ -91,6 +91,7 @@ type
protected
FAddress: TInetSockAddr;
FPeerAddress: TInetSockAddr;
FReuseAddress: Boolean;
FConnected: Boolean;
FConnecting: Boolean;
FNextSock: TLSocket;
@ -117,9 +118,10 @@ type
function CanSend: Boolean; virtual;
function CanReceive: Boolean; virtual;
procedure SetBlocking(const aValue: Boolean);
procedure SetOptions; virtual;
procedure SetBlocking(const aValue: Boolean);
procedure SetReuseAddress(const aValue: Boolean);
function Bail(const msg: string; const ernum: Integer): Boolean;
procedure LogError(const msg: string; const ernum: Integer); virtual;
@ -150,6 +152,7 @@ type
property PeerPort: Word read GetPeerPort;
property LocalAddress: string read GetLocalAddress;
property LocalPort: Word read GetLocalPort;
property ReuseAddress: Boolean read FReuseAddress write SetReuseAddress;
property NextSock: TLSocket read FNextSock write FNextSock;
property PrevSock: TLSocket read FPrevSock write FPrevSock;
property Creator: TLComponent read FCreator;
@ -230,7 +233,7 @@ type
FID: Integer; // internal number for server
FEventer: TLEventer;
FEventerClass: TLEventerClass;
FTimeout: DWord;
FTimeout: Integer;
FListenBacklog: Integer;
protected
function InitSocket(aSocket: TLSocket): TLSocket; virtual;
@ -239,8 +242,8 @@ type
function GetCount: Integer; virtual;
function GetItem(const i: Integer): TLSocket;
function GetTimeout: DWord;
procedure SetTimeout(const AValue: DWord);
function GetTimeout: Integer;
procedure SetTimeout(const AValue: Integer);
procedure SetEventer(Value: TLEventer);
@ -289,7 +292,7 @@ type
property Connected: Boolean read GetConnected;
property ListenBacklog: Integer read FListenBacklog write FListenBacklog;
property Iterator: TLSocket read FIterator;
property Timeout: DWord read GetTimeout write SetTimeout;
property Timeout: Integer read GetTimeout write SetTimeout;
property Eventer: TLEventer read FEventer write SetEventer;
property EventerClass: TLEventerClass read FEventerClass write FEventerClass;
end;
@ -341,12 +344,15 @@ type
TLTcp = class(TLConnection)
protected
FCount: Integer;
FReuseAddress: Boolean;
function InitSocket(aSocket: TLSocket): TLSocket; override;
function GetConnected: Boolean; override;
function GetConnecting: Boolean;
function GetCount: Integer; override;
procedure SetReuseAddress(const aValue: Boolean);
procedure ConnectAction(aSocket: TLHandle); override;
procedure AcceptAction(aSocket: TLHandle); override;
procedure ReceiveAction(aSocket: TLHandle); override;
@ -378,6 +384,7 @@ type
property Connecting: Boolean read GetConnecting;
property OnAccept: TLSocketEvent read FOnAccept write FOnAccept;
property OnConnect: TLSocketEvent read FOnConnect write FOnConnect;
property ReuseAddress: Boolean read FReuseAddress write SetReuseAddress;
end;
implementation
@ -429,6 +436,10 @@ begin
if (FSocketType = SOCK_STREAM) and (not FIgnoreShutdown) and WasConnected then
if fpShutDown(FHandle, 2) <> 0 then
LogError('Shutdown error', LSocketError);
if Assigned(FEventer) then
FEventer.UnregisterHandle(Self);
if CloseSocket(FHandle) <> 0 then
LogError('Closesocket error', LSocketError);
FHandle := INVALID_SOCKET;
@ -482,6 +493,11 @@ begin
Result := FCanReceive and FConnected;
end;
procedure TLSocket.SetOptions;
begin
SetBlocking(FBlocking);
end;
procedure TLSocket.SetBlocking(const aValue: Boolean);
begin
FBlocking := aValue;
@ -490,9 +506,10 @@ begin
Bail('Error on SetBlocking', LSocketError);
end;
procedure TLSocket.SetOptions;
procedure TLSocket.SetReuseAddress(const aValue: Boolean);
begin
SetBlocking(FBlocking);
if not FConnected then
FReuseAddress := aValue;
end;
function TLSocket.GetMessage(out msg: string): Integer;
@ -514,8 +531,13 @@ begin
Result := sockets.fpRecv(FHandle, @aData, aSize, LMSG)
else
Result := sockets.fpRecvfrom(FHandle, @aData, aSize, LMSG, @FPeerAddress, @AddressLength);
if Result = 0 then
Disconnect;
if FSocketType = SOCK_STREAM then
Disconnect
else
Bail('Receive Error [0 on recvfrom with UDP]', 0);
if Result = SOCKET_ERROR then begin
LastError := LSocketError;
if IsBlockError(LastError) then begin
@ -542,7 +564,7 @@ end;
function TLSocket.SetupSocket(const APort: Word; const Address: string): Boolean;
var
Done: Boolean;
Arg: Integer;
Arg, Opt: Integer;
begin
Result := false;
if not FConnected and not FConnecting then begin
@ -551,12 +573,27 @@ begin
if FHandle = INVALID_SOCKET then
Exit(Bail('Socket error', LSocketError));
SetOptions;
Arg := 1;
if FSocketType = SOCK_DGRAM then begin
Arg := 1;
if fpsetsockopt(FHandle, SOL_SOCKET, SO_BROADCAST, @Arg, Sizeof(Arg)) = SOCKET_ERROR then
Exit(Bail('SetSockOpt error', LSocketError));
end else if FReuseAddress then begin
Opt := SO_REUSEADDR;
{$ifdef WIN32} // I expect 64 has it oddly, so screw them for now
if (Win32Platform = 2) and (Win32MajorVersion >= 5) then
Opt := Integer(not Opt);
{$endif}
if fpsetsockopt(FHandle, SOL_SOCKET, Opt, @Arg, Sizeof(Arg)) = SOCKET_ERROR then
Exit(Bail('SetSockOpt error', LSocketError));
end;
{$ifdef darwin}
Arg := 1;
if fpsetsockopt(FHandle, SOL_SOCKET, SO_NOSIGPIPE, @Arg, Sizeof(Arg)) = SOCKET_ERROR then
Exit(Bail('SetSockOpt error', LSocketError));
{$endif}
FillAddressInfo(FAddress, AF_INET, Address, aPort);
FillAddressInfo(FPeerAddress, AF_INET, LADDR_BR, aPort);
@ -730,7 +767,7 @@ begin
Result := Tmp;
end;
function TLConnection.GetTimeout: DWord;
function TLConnection.GetTimeout: Integer;
begin
if Assigned(FEventer) then
Result := FEventer.Timeout
@ -794,7 +831,7 @@ begin
FOnError(msg, TLSocket(aSocket));
end;
procedure TLConnection.SetTimeout(const AValue: DWord);
procedure TLConnection.SetTimeout(const AValue: Integer);
begin
if Assigned(FEventer) then
FEventer.Timeout := aValue;
@ -824,7 +861,7 @@ begin
if Assigned(FRootSock) then
FEventer.AddHandle(FRootSock);
if (FEventer.Timeout = 0) and (FTimeout > 0) then
if (FEventer.Timeout = 0) and (FTimeout <> 0) then
FEventer.Timeout := FTimeout
else
FTimeout := FEventer.Timeout;
@ -838,6 +875,7 @@ begin
while Assigned(Tmp) do begin
Tmp2 := Tmp;
Tmp := Tmp.NextSock;
Tmp2.Disconnect;
Tmp2.Free;
end;
end;
@ -1062,10 +1100,12 @@ begin
FRootSock := InitSocket(SocketClass.Create);
FRootSock.FIgnoreShutdown := True;
FRootSock.SetReuseAddress(FReuseAddress);
if FRootSock.Listen(APort, AIntf) then begin
FRootSock.FConnected := True;
FRootSock.FServerSocket := True;
FIterator := FRootSock;
Inc(FCount);
RegisterWithEventer;
Result := true;
end;
@ -1100,6 +1140,7 @@ begin
aSocket.PrevSock.NextSock := aSocket.NextSock;
if Assigned(aSocket.NextSock) then
aSocket.NextSock.PrevSock := aSocket.PrevSock;
Dec(FCount);
end;
@ -1240,6 +1281,13 @@ begin
Result := FCount;
end;
procedure TLTcp.SetReuseAddress(const aValue: Boolean);
begin
if not Assigned(FRootSock)
or not FRootSock.Connected then
FReuseAddress := aValue;
end;
function TLTcp.Get(var aData; const aSize: Integer; aSocket: TLSocket): Integer;
begin
Result := 0;

2
utils/fppkg/lnet/lprocess.pp
View File

@ -1,6 +1,6 @@
{ Asynchronous process support
Copyright (C) 2006 Micha Nelissen
Copyright (C) 2006-2007 Micha Nelissen
This library is Free software; you can redistribute it and/or modify it
under the terms of the GNU Library General Public License as published by

246
utils/fppkg/lnet/lsmtp.pp
View File

@ -1,6 +1,6 @@
{ lNet SMTP unit
CopyRight (C) 2005-2006 Ales Katona
CopyRight (C) 2005-2007 Ales Katona
This library is Free software; you can rediStribute it and/or modify it
under the terms of the GNU Library General Public License as published by
@ -29,7 +29,7 @@ unit lsmtp;
interface
uses
Classes, Contnrs, lNet, lEvents, lCommon;
Classes, SysUtils, Contnrs, lNet, lEvents, lCommon, lMimeWrapper, lMimeStreams;
type
TLSMTP = class;
@ -53,69 +53,41 @@ type
TLSMTPClientStatusEvent = procedure (aSocket: TLSocket;
const aStatus: TLSMTPStatus) of object;
{ TAttachment }
TAttachment = class
protected
FData: TStringList;
function GetAsText: string; virtual;
public
constructor Create;
destructor Destroy; override;
function LoadFromFile(const aFileName: string): Boolean;
public
property AsText: string read GetAsText;
end;
{ TAttachmentList }
TAttachmentList = class
protected
FItems: TFPObjectList;
function GetCount: Integer;
function GetItem(i: Integer): TAttachment;
procedure SetItem(i: Integer; const AValue: TAttachment);
public
constructor Create;
destructor Destroy; override;
function Add(anAttachment: TAttachment): Integer;
function AddFromFile(const aFileName: string): Integer;
function Remove(anAttachment: TAttachment): Integer;
procedure Delete(const i: Integer);
procedure Clear;
public
property Count: Integer read GetCount;
property Items[i: Integer]: TAttachment read GetItem write SetItem; default;
end;
{ TMail }
TMail = class
protected
FMailText: string;
FMailStream: TStream;
FMailStream: TMimeStream;
FRecipients: string;
FSender: string;
FSubject: string;
FAttachments: TAttachmentList;
function GetCount: Integer;
function GetSection(i: Integer): TMimeSection;
procedure SetSection(i: Integer; const AValue: TMimeSection);
public
constructor Create;
destructor Destroy; override;
procedure AddTextSection(const aText: string; const aCharSet: string = 'UTF-8');
procedure AddFileSection(const aFileName: string);
procedure AddStreamSection(aStream: TStream; const FreeStream: Boolean = False);
procedure DeleteSection(const i: Integer);
procedure RemoveSection(aSection: TMimeSection);
public
property Attachments: TAttachmentList read FAttachments;
property MailText: string read FMailText write FMailText;
property MailStream: TStream read FMailStream write FMailStream;
property MailText: string read FMailText write FMailText; deprecated; // use sections!
property Sender: string read FSender write FSender;
property Recipients: string read FRecipients write FRecipients;
property Subject: string read FSubject write FSubject;
property Sections[i: Integer]: TMimeSection read GetSection write SetSection; default;
property SectionCount: Integer read GetCount;
end;
TLSMTP = class(TLComponent)
protected
FConnection: TLTcp;
protected
function GetTimeout: DWord;
procedure SetTimeout(const AValue: DWord);
function GetTimeout: Integer;
procedure SetTimeout(const AValue: Integer);
function GetConnected: Boolean;
@ -133,7 +105,7 @@ type
property SocketClass: TLSocketClass read GetSocketClass write SetSocketClass;
property Eventer: TLEventer read GetEventer write SetEventer;
property Timeout: DWord read GetTimeout write SetTimeout;
property Timeout: Integer read GetTimeout write SetTimeout;
end;
{ TLSMTPClient }
@ -155,6 +127,8 @@ type
FSL: TStringList;
FStatusSet: TLSMTPStatusSet;
FBuffer: string;
FDataBuffer: string; // intermediate wait buffer on DATA command
FCharCount: Integer; // count of chars from last CRLF
FStream: TStream;
protected
procedure OnEr(const msg: string; aSocket: TLSocket);
@ -171,7 +145,7 @@ type
procedure ExecuteFrontCommand;
procedure InsertCRLFs;
procedure ClearCR_LF;
procedure SendData(const FromStream: Boolean = False);
public
constructor Create(aOwner: TComponent); override;
@ -212,9 +186,6 @@ type
implementation
uses
SysUtils, lMimeStreams;
const
EMPTY_REC: TLSMTPStatusRec = (Status: ssNone; Args: ('', ''));
@ -237,12 +208,12 @@ end;
{ TLSMTP }
function TLSMTP.GetTimeout: DWord;
function TLSMTP.GetTimeout: Integer;
begin
Result := FConnection.Timeout;
end;
procedure TLSMTP.SetTimeout(const AValue: DWord);
procedure TLSMTP.SetTimeout(const AValue: Integer);
begin
FConnection.Timeout := aValue;
end;
@ -431,8 +402,13 @@ begin
Eventize(FStatus.First.Status, True);
FStatus.Remove;
end;
300..399: SendData(True);
300..399: begin
FBuffer := FDataBuffer;
FDataBuffer := '';
SendData(True);
end;
else begin
FDataBuffer := '';
Eventize(FStatus.First.Status, False);
FStatus.Remove;
end;
@ -471,26 +447,39 @@ begin
FCommandFront.Remove;
end;
procedure TLSMTPClient.InsertCRLFs;
procedure TLSMTPClient.ClearCR_LF;
var
i, c: Integer;
i: Integer;
Skip: Boolean = False;
begin
c := 0;
i := 2;
while i <= Length(FBuffer) do begin
if (FBuffer[i - 1] = #13) and (FBuffer[i] = #10) then begin
c := 0;
Inc(i);
end else
Inc(c);
if c >= 74 then begin
Insert(CRLF, FBuffer, i);
c := 0;
Inc(i, 2);
for i := 1 to Length(FBuffer) do begin
if Skip then begin
Skip := False;
Continue;
end;
Inc(i);
if (FBuffer[i] = #13) or (FBuffer[i] = #10) then begin
if FBuffer[i] = #13 then
if (i < Length(FBuffer)) and (FBuffer[i + 1] = #10) then begin
FCharCount := 0;
Skip := True; // skip the crlf
end else begin // insert LF to a standalone CR
System.Insert(#10, FBuffer, i + 1);
FCharCount := 0;
Skip := True; // skip the new crlf
end;
if FBuffer[i] = #10 then begin
System.Insert(#13, FBuffer, i);
FCharCount := 0;
Skip := True; // skip the new crlf
end;
end else if FCharCount >= 1000 then begin // line too long
System.Insert(CRLF, FBuffer, i);
FCharCount := 0;
Skip := True;
end else
Inc(FCharCount);
end;
end;
@ -523,7 +512,7 @@ begin
n := 1;
Sent := 0;
while (Length(FBuffer) > 0) and (n > 0) do begin
InsertCRLFs;
ClearCR_LF;
n := FConnection.SendMessage(FBuffer);
Sent := Sent + n;
@ -615,10 +604,10 @@ end;
procedure TLSMTPClient.SendMail(aMail: TMail);
begin
if Length(aMail.MailText) > 0 then
SendMail(aMail.Sender, aMail.Recipients, aMail.Subject, aMail.MailText)
else if Assigned(aMail.MailStream) then
SendMail(aMail.Sender, aMail.Recipients, aMail.Subject, aMail.MailStream);
if Length(aMail.FMailText) > 0 then
SendMail(aMail.Sender, aMail.Recipients, aMail.Subject, aMail.FMailText)
else if Assigned(aMail.FMailStream) then
SendMail(aMail.Sender, aMail.Recipients, aMail.Subject, aMail.FMailStream);
end;
procedure TLSMTPClient.Helo(aHost: string = '');
@ -664,16 +653,17 @@ end;
procedure TLSMTPClient.Data(const Msg: string);
begin
if CanContinue(ssData, Msg, '') then begin
FBuffer := 'DATA ' + CRLF;
FDataBuffer := '';
if Assigned(FStream) then begin
if Length(Msg) > 0 then
FBuffer := 'DATA ' + Msg
else
FBuffer := 'DATA ';
FDataBuffer := Msg;
end else
FBuffer := 'DATA ' + Msg + CRLF + '.' + CRLF;
FDataBuffer := Msg + CRLF + '.' + CRLF;
FStatus.Insert(MakeStatusRec(ssData, '', ''));
SendData(True);
SendData(False);
end;
end;
@ -709,98 +699,56 @@ end;
{ TMail }
function TMail.GetCount: Integer;
begin
Result := FMailStream.Count;
end;
function TMail.GetSection(i: Integer): TMimeSection;
begin
Result := FMailStream.Sections[i];
end;
procedure TMail.SetSection(i: Integer; const AValue: TMimeSection);
begin
FMailStream.Sections[i] := aValue;
end;
constructor TMail.Create;
begin
FMailStream := TMimeStream.Create;
end;
destructor TMail.Destroy;
begin
FMailStream.Free;
end;
{ TAttachment }
function TAttachment.GetAsText: string;
procedure TMail.AddTextSection(const aText: string; const aCharSet: string);
begin
Result := '';
raise Exception.Create('Not yet implemented');
FMailStream.AddTextSection(aText, aCharSet);
end;
constructor TAttachment.Create;
procedure TMail.AddFileSection(const aFileName: string);
begin
FData := TStringList.Create;
FMailStream.AddFileSection(aFileName);
end;
destructor TAttachment.Destroy;
procedure TMail.AddStreamSection(aStream: TStream; const FreeStream: Boolean);
begin
FData.Free;
inherited Destroy;
FMailStream.AddStreamSection(aStream, FreeStream);
end;
function TAttachment.LoadFromFile(const aFileName: string): Boolean;
procedure TMail.DeleteSection(const i: Integer);
begin
Result := False;
raise Exception.Create('Not yet implemented');
FMailStream.Delete(i);
end;
{ TAttachmentList }
function TAttachmentList.GetCount: Integer;
procedure TMail.RemoveSection(aSection: TMimeSection);
begin
Result := FItems.Count;
FMailStream.Remove(aSection);
end;
function TAttachmentList.GetItem(i: Integer): TAttachment;
begin
Result := TAttachment(FItems[i]);
end;
procedure TAttachmentList.SetItem(i: Integer; const AValue: TAttachment);
begin
FItems[i] := aValue;
end;
constructor TAttachmentList.Create;
begin
FItems := TFPObjectList.Create(True);
end;
destructor TAttachmentList.Destroy;
begin
FItems.Free;
inherited Destroy;
end;
function TAttachmentList.Add(anAttachment: TAttachment): Integer;
begin
Result := FItems.Add(anAttachment);
end;
function TAttachmentList.AddFromFile(const aFileName: string): Integer;
var
Tmp: TAttachment;
begin
Tmp := TAttachment.Create;
if Tmp.LoadFromFile(aFileName) then
Result := FItems.Add(Tmp);
end;
function TAttachmentList.Remove(anAttachment: TAttachment): Integer;
begin
Result := FItems.Remove(anAttachment);
end;
procedure TAttachmentList.Delete(const i: Integer);
begin
FItems.Delete(i);
end;
procedure TAttachmentList.Clear;
begin
FItems.Clear;
end;
end.

23
utils/fppkg/lnet/lspawnfcgi.pp
View File

@ -1,3 +1,26 @@
{ lNet FastCGI Spawner
CopyRight (C) 2006-2007 Ales Katona
This library is Free software; you can rediStribute it and/or modify it
under the terms of the GNU Library 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 Library General Public License
for more details.
You should have received a Copy of the GNU Library General Public License
along with This library; if not, Write to the Free Software Foundation,
Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
This license has been modified. See File LICENSE.ADDON for more inFormation.
Should you find these sources without a LICENSE File, please contact
me at ales@chello.sk
}
unit lSpawnFCGI;
{$mode objfpc}{$H+}

2
utils/fppkg/lnet/lstrbuffer.pp
View File

@ -1,6 +1,6 @@
{ Efficient string buffer helper
Copyright (C) 2006 Micha Nelissen
Copyright (C) 2006-2007 Micha Nelissen
This library is Free software; you can redistribute it and/or modify it
under the terms of the GNU Library General Public License as published by

12
utils/fppkg/lnet/ltelnet.pp
View File

@ -1,4 +1,4 @@
{ lTelnet CopyRight (C) 2004-2006 Ales Katona
{ lTelnet CopyRight (C) 2004-2007 Ales Katona
This library is Free software; you can rediStribute it and/or modify it
under the terms of the GNU Library General Public License as published by
@ -91,8 +91,8 @@ type
function Question(const Command: Char; const Value: Boolean): Char;
function GetTimeout: DWord;
procedure SetTimeout(const Value: DWord);
function GetTimeout: Integer;
procedure SetTimeout(const Value: Integer);
function GetSocketClass: TLSocketClass;
procedure SetSocketClass(Value: TLSocketClass);
@ -129,7 +129,7 @@ type
public
property Output: TMemoryStream read FOutput;
property Connected: Boolean read FConnected;
property Timeout: DWord read GetTimeout write SetTimeout;
property Timeout: Integer read GetTimeout write SetTimeout;
property OnReceive: TLSocketEvent read FOnReceive write FOnReceive;
property OnDisconnect: TLSocketEvent read FOnDisconnect write FOnDisconnect;
property OnConnect: TLSocketEvent read FOnConnect write FOnConnect;
@ -222,7 +222,7 @@ begin
Result := FConnection.SocketClass;
end;
function TLTelnet.GetTimeout: DWord;
function TLTelnet.GetTimeout: Integer;
begin
Result := FConnection.Timeout;
end;
@ -232,7 +232,7 @@ begin
FConnection.SocketClass := Value;
end;
procedure TLTelnet.SetTimeout(const Value: DWord);
procedure TLTelnet.SetTimeout(const Value: Integer);
begin
FConnection.Timeout := Value;
end;

23
utils/fppkg/lnet/ltimer.pp
View File

@ -1,3 +1,26 @@
{ lNet Timer
CopyRight (C) 2006-2007 Micha Nelissen
This library is Free software; you can rediStribute it and/or modify it
under the terms of the GNU Library 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 Library General Public License
for more details.
You should have received a Copy of the GNU Library General Public License
along with This library; if not, Write to the Free Software Foundation,
Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
This license has been modified. See File LICENSE.ADDON for more inFormation.
Should you find these sources without a LICENSE File, please contact
me at ales@chello.sk
}
unit ltimer;
{$mode objfpc}{$H+}

2
utils/fppkg/lnet/lwebserver.pp
View File

@ -1,6 +1,6 @@
{ Web server component, built on the HTTP server component
Copyright (C) 2006 Micha Nelissen
Copyright (C) 2006-2007 Micha Nelissen
This library is Free software; you can redistribute it and/or modify it
under the terms of the GNU Library General Public License as published by

3
utils/fppkg/lnet/sys/lepolleventer.inc
View File

@ -126,6 +126,9 @@ var
MasterEvents: array[0..1] of TEpollEvent;
begin
Result := False;
if FInLoop then
Exit;
Changes := 0;
ReadChanges := 0;

4
utils/fppkg/lnet/sys/lkqueueeventer.inc
View File

@ -90,6 +90,10 @@ var
i, n: Integer;
Temp: TLHandle;
begin
Result := False;
if FInLoop then
Exit;
if FTimeout.tv_sec >= 0 then
n := KEvent(FQueue, @FChanges[0], FFreeSlot,
@FEvents[0], Length(FEvents), @FTimeout)