390 lines
10 KiB
Plaintext
390 lines
10 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.0 27-03-05 10:04:20 MterWoord
|
|
Second import, first time the filenames weren't prefixed with Id
|
|
|
|
Rev 1.0 27-03-05 09:08:54 MterWoord
|
|
Created
|
|
}
|
|
|
|
unit IdServerIOHandlerTls;
|
|
|
|
interface
|
|
|
|
uses
|
|
IdSSL, IdTlsServerOptions, Mono.Security.Protocol.Tls, IdCarrierStream,
|
|
IdSocketStream, System.IO, System.Security.Cryptography, IdGlobal, IdYarn,
|
|
System.Security.Cryptography.X509Certificates, Mono.Security.Authenticode,
|
|
IdIOHandler, IdSocketHandle, IdThread;
|
|
|
|
type
|
|
TIdServerIOHandlerTls = class(TIdServerIOHandlerSSLBase)
|
|
protected
|
|
FOptions: TIdTlsServerOptions;
|
|
function NewServerSideIOHandlerTls: TIdSSLIOHandlerSocketBase;
|
|
procedure InitComponent; override;
|
|
public
|
|
function MakeFTPSvrPasv: TIdSSLIOHandlerSocketBase; override;
|
|
function MakeFTPSvrPort: TIdSSLIOHandlerSocketBase; override;
|
|
function MakeClientIOHandler(AYarn: TIdYarn) : TIdIOHandler; override;
|
|
function MakeClientIOHandler: TIdSSLIOHandlerSocketBase; override;
|
|
function Accept(ASocket: TIdSocketHandle; AListenerThread: TIdThread; AYarn: TIdYarn): TIdIOHandler; override;
|
|
published
|
|
property Options: TIdTlsServerOptions read FOptions write FOptions;
|
|
end;
|
|
|
|
|
|
implementation
|
|
|
|
type
|
|
TIdServerSideIOHandlerTls = class(TIdSSLIOHandlerSocketBase)
|
|
protected
|
|
FOptions: TIdTlsServerOptions;
|
|
FTlsServerStream: SslServerStream;
|
|
FTlsClientStream: SslClientStream;
|
|
FCarrierStream: TIdCarrierStream;
|
|
FSocketStream: TIdSocketStream;
|
|
FActiveStream: Stream;
|
|
FPassThrough: Boolean;
|
|
function PrivateKeySelection(certificate: X509Certificate; TargetHost: string): AsymmetricAlgorithm;
|
|
function ReadFromSource(ARaiseExceptionIfDisconnected: Boolean; ATimeout: Integer; ARaiseExceptionOnTimeOut: Boolean): Integer; override;
|
|
procedure SetPassThrough(const AValue: Boolean); override;
|
|
public
|
|
procedure CheckForDataOnSource(ATimeOut: Integer); override;
|
|
procedure StartSSL; override;
|
|
procedure AfterAccept; override;
|
|
procedure CheckForDisconnect(ARaiseExceptionIfDisconnected: Boolean; AIgnoreBuffer: Boolean); override;
|
|
function Clone: TIdSSLIOHandlerSocketBase; override;
|
|
procedure WriteDirect(var ABuffer: TIdBytes); override;
|
|
procedure Close; override;
|
|
published
|
|
property Options: TIdTlsServerOptions read FOptions write FOptions;
|
|
end;
|
|
|
|
{ TServerSideIOHandlerTls }
|
|
|
|
function TIdServerSideIOHandlerTls.Clone: TIdSSLIOHandlerSocketBase;
|
|
var
|
|
TEmpResult : TIdServerSideIOHandlerTls;
|
|
begin
|
|
TempResult := TIdServerSideIOHandlerTls.Create;
|
|
TempResult.Options.ClientNeedsCertificate := Options.ClientNeedsCertificate;
|
|
TempResult.Options.PrivateKey := Options.PrivateKey;
|
|
TempResult.Options.Protocol := Options.Protocol;
|
|
TempResult.Options.PublicCertificate := Options.PublicCertificate;
|
|
TempResult.IsPeer := IsPeer;
|
|
TempResult.PassThrough := PassThrough;
|
|
Result := TempResult;
|
|
end;
|
|
|
|
procedure TIdServerSideIOHandlerTls.StartSSL;
|
|
begin
|
|
inherited;
|
|
PassThrough := False;
|
|
end;
|
|
|
|
function TIdServerSideIOHandlerTls.PrivateKeySelection(
|
|
certificate: X509Certificate; TargetHost: string): AsymmetricAlgorithm;
|
|
begin
|
|
Result := FOptions.PrivateKey.RSA;
|
|
end;
|
|
|
|
function TIdServerSideIOHandlerTls.ReadFromSource(
|
|
ARaiseExceptionIfDisconnected: Boolean; ATimeout: Integer;
|
|
ARaiseExceptionOnTimeOut: Boolean): Integer;
|
|
var
|
|
TempBuff: array of byte;
|
|
TotalBytesRead: Integer;
|
|
StartTime: Cardinal;
|
|
BytesRead: Integer;
|
|
TempBytes: array of byte;
|
|
begin
|
|
Result := 0;
|
|
if FInputBuffer = nil then
|
|
Exit;
|
|
if FActiveStream <> nil then
|
|
begin
|
|
SetLength(TempBuff, 512);
|
|
TotalBytesRead := 0;
|
|
StartTime := Ticks;
|
|
repeat
|
|
BytesRead := FActiveStream.Read(TempBuff, 0, 512);
|
|
if BytesRead <> 0 then
|
|
begin
|
|
TempBytes := ToBytes(TempBuff, BytesRead);
|
|
FInputBuffer.Write(TempBytes);
|
|
TotalBytesRead := TotalBytesRead + BytesRead;
|
|
end;
|
|
if BytesRead <> 512 then
|
|
begin
|
|
Result := TotalBytesRead;
|
|
Exit;
|
|
end;
|
|
IndySleep(2);
|
|
until ( (Abs(GetTickDiff(StartTime, Ticks)) > ATimeOut)
|
|
and (not ((ATimeOut = IdTimeoutDefault) or (ATimeOut = IdTimeoutInfinite)))
|
|
);
|
|
Result := TotalBytesRead;
|
|
end;
|
|
end;
|
|
|
|
procedure TIdServerSideIOHandlerTls.CheckForDisconnect(
|
|
ARaiseExceptionIfDisconnected, AIgnoreBuffer: Boolean);
|
|
begin
|
|
try
|
|
if FActiveStream = nil then
|
|
begin
|
|
if AIgnoreBuffer then
|
|
begin
|
|
CloseGracefully;
|
|
end
|
|
else
|
|
begin
|
|
if FInputBuffer.Size = 0 then
|
|
begin
|
|
CloseGracefully;
|
|
end;
|
|
end;
|
|
end
|
|
else
|
|
begin
|
|
if ( (not FActiveStream.CanRead)
|
|
or (not FActiveStream.CanWrite)
|
|
) then
|
|
begin
|
|
if AIgnoreBuffer then
|
|
begin
|
|
CloseGracefully;
|
|
end
|
|
else
|
|
begin
|
|
if FInputBuffer.Size = 0 then
|
|
begin
|
|
CloseGracefully;
|
|
end;
|
|
end;
|
|
end;
|
|
end;
|
|
except
|
|
on E: Exception do
|
|
begin
|
|
CloseGracefully;
|
|
end;
|
|
end;
|
|
if ( (ARaiseExceptionIfDisconnected)
|
|
and (ClosedGracefully)
|
|
) then
|
|
RaiseConnClosedGracefully;
|
|
end;
|
|
|
|
procedure TIdServerSideIOHandlerTls.CheckForDataOnSource(ATimeOut: Integer);
|
|
begin
|
|
if Connected then
|
|
begin
|
|
ReadFromSource(false, ATimeOut, false);
|
|
end;
|
|
end;
|
|
|
|
procedure TIdServerSideIOHandlerTls.AfterAccept;
|
|
begin
|
|
inherited;
|
|
FSocketStream := TIdSocketStream.Create(Binding.Handle);
|
|
FCarrierStream := TIdCarrierStream.Create(FSocketStream);
|
|
FTlsServerStream := SslServerStream.Create(FCarrierStream, FOptions.PublicCertificate, FOptions.ClientNeedsCertificate, true, FOptions.Protocol);
|
|
GC.SuppressFinalize(FSocketStream);
|
|
GC.SuppressFinalize(FCarrierStream);
|
|
GC.SuppressFinalize(FTlsServerStream);
|
|
FActiveStream := FCarrierStream;
|
|
FTlsServerStream.PrivateKeyCertSelectionDelegate := PrivateKeySelection;
|
|
IsPeer := true;
|
|
PassThrough := true;
|
|
end;
|
|
|
|
procedure TIdServerSideIOHandlerTls.Close;
|
|
begin
|
|
if not PassThrough then
|
|
begin
|
|
if IsPeer then
|
|
begin
|
|
if FTlsServerStream <> nil then
|
|
begin
|
|
FTlsServerStream.Close;
|
|
FTlsServerStream := nil;
|
|
end;
|
|
end
|
|
else
|
|
begin
|
|
if FTlsClientStream <> nil then
|
|
begin
|
|
FTlsClientStream.Close;
|
|
FTlsClientStream := nil;
|
|
end;
|
|
end;
|
|
end;
|
|
if FCarrierStream <> nil then
|
|
begin
|
|
FCarrierStream.Close;
|
|
FCarrierStream := nil;
|
|
end;
|
|
if FSocketStream <> nil then
|
|
begin
|
|
FSocketStream.Close;
|
|
FSocketStream := nil;
|
|
end;
|
|
inherited;
|
|
end;
|
|
|
|
procedure TIdServerSideIOHandlerTls.WriteDirect(var ABuffer: TIdBytes);
|
|
begin
|
|
if Intercept <> nil then
|
|
Intercept.Send(ABuffer);
|
|
|
|
if FActiveStream <> nil then
|
|
begin
|
|
FActiveStream.Write(ABuffer, 0, Length(ABuffer));
|
|
FActiveStream.Flush;
|
|
end
|
|
else
|
|
raise Exception.Create('No active stream!');
|
|
end;
|
|
|
|
procedure TIdServerSideIOHandlerTls.SetPassThrough(const AValue: Boolean);
|
|
var
|
|
TempBuff: array[0..0] of byte;
|
|
begin
|
|
inherited;
|
|
if AValue then
|
|
begin
|
|
if FActiveStream <> nil then
|
|
begin
|
|
FActiveStream.Close;
|
|
FActiveStream := nil;
|
|
end;
|
|
FActiveStream := FSocketStream;
|
|
if IsPeer then
|
|
begin
|
|
if FTlsServerStream <> nil then
|
|
begin
|
|
FTlsServerStream.Close;
|
|
FTlsServerStream := nil;
|
|
end;
|
|
FTlsServerStream := SslServerStream.Create(FCarrierStream, FOptions.PublicCertificate, FOptions.ClientNeedsCertificate, true, FOptions.Protocol);
|
|
GC.SuppressFinalize(FTlsServerStream);
|
|
FTlsServerStream.PrivateKeyCertSelectionDelegate := PrivateKeySelection;
|
|
end
|
|
else
|
|
begin
|
|
if FTlsClientStream <> nil then
|
|
begin
|
|
FTlsClientStream.Close;
|
|
FTlsClientStream := nil;
|
|
end;
|
|
FTlsClientStream := SslClientStream.Create(FCarrierStream, Destination, true, FOptions.Protocol);
|
|
GC.SuppressFinalize(FTlsClientStream);
|
|
end;
|
|
end
|
|
else
|
|
begin
|
|
if IsPeer then
|
|
begin
|
|
FActiveStream := FTlsServerStream;
|
|
end
|
|
else
|
|
begin
|
|
FActiveStream := FTlsClientStream;
|
|
end;
|
|
FActiveStream.Read(TempBuff, 0, 0);
|
|
end;
|
|
end;
|
|
|
|
{ TServerIOHandlerTls }
|
|
|
|
procedure TIdServerIOHandlerTls.InitComponent;
|
|
begin
|
|
inherited;
|
|
FOptions := TIdTlsServerOptions.Create;
|
|
end;
|
|
|
|
function TIdServerIOHandlerTls.NewServerSideIOHandlerTls: TIdSSLIOHandlerSocketBase;
|
|
var
|
|
TempResult: TIdServerSideIOHandlerTls;
|
|
begin
|
|
TempResult := TIdServerSideIOHandlerTls.Create;
|
|
TempResult.Options := FOptions;
|
|
Result := TempResult;
|
|
end;
|
|
|
|
function TIdServerIOHandlerTls.MakeClientIOHandler: TIdSSLIOHandlerSocketBase;
|
|
begin
|
|
Result := NewServerSideIOHandlerTls;
|
|
end;
|
|
|
|
function TIdServerIOHandlerTls.MakeClientIOHandler(AYarn: TIdYarn): TIdIOHandler;
|
|
begin
|
|
Result := NewServerSideIOHandlerTls;
|
|
end;
|
|
|
|
function TIdServerIOHandlerTls.MakeFTPSvrPort: TIdSSLIOHandlerSocketBase;
|
|
begin
|
|
Result := NewServerSideIOHandlerTls;
|
|
end;
|
|
|
|
function TIdServerIOHandlerTls.Accept(ASocket: TIdSocketHandle;
|
|
AListenerThread: TIdThread; AYarn: TIdYarn): TIdIOHandler;
|
|
var
|
|
LIOHandler: TIdServerSideIOHandlerTls;
|
|
begin
|
|
LIOHandler := TIdServerSideIOHandlerTls.Create;
|
|
LIOHandler.Options := FOptions;
|
|
LIOHandler.Open;
|
|
while not AListenerThread.Stopped do
|
|
begin
|
|
try
|
|
if ASocket.Select(250) then
|
|
begin
|
|
if LIOHandler.Binding.Accept(ASocket.Handle) then
|
|
begin
|
|
LIOHandler.AfterAccept;
|
|
Result := LIOHandler;
|
|
Exit;
|
|
end
|
|
else
|
|
begin
|
|
LIOHandler.Close;
|
|
Result := nil;
|
|
Exit;
|
|
end;
|
|
end;
|
|
finally
|
|
if AListenerThread.Stopped then
|
|
begin
|
|
LIOHandler.Close;
|
|
end;
|
|
end;
|
|
end;
|
|
Result := nil;
|
|
end;
|
|
|
|
function TIdServerIOHandlerTls.MakeFTPSvrPasv: TIdSSLIOHandlerSocketBase;
|
|
begin
|
|
Result := NewServerSideIOHandlerTls;
|
|
end;
|
|
|
|
end.
|