restemplate/indy/Security/IdIOHandlerTls.pas

{
  $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:18  MterWoord
  Second import, first time the filenames weren't prefixed with Id

  Rev 1.0    27-03-05 09:08:50  MterWoord
  Created
}

unit IdIOHandlerTls;

interface

uses
  System.Collections, System.ComponentModel, System.IO, System.Net.Sockets,
  System.Security.Cryptography.X509Certificates, Mono.Security.Protocol.Tls,
  IdSSL, IdCarrierStream, IdSocketStream, IdGlobal, IdTlsClientOptions;

{$AUTOBOX ON}
{$HINTS OFF}
{$WARNINGS OFF}

type
  TArrayOfInteger = array of Int32;
  TIdIOHandlerTls = class(TIdSSLIOHandlerSocketBase)
  protected
    FOptions: TIdTlsClientOptions;
    FTlsStream: SslClientStream;
    FCarrierStream: TIdCarrierStream;
    FSocketStream: TIdSocketStream;
    FActiveStream: Stream;
    FOnValidateCertificate: CertificateValidationCallback;
    procedure InitComponent; override;
    function RecvEnc(var ABuffer: TIdBytes): Integer; override;
    function SendEnc(const ABuffer: TIdBytes; const AOffset, ALength: Integer): Integer; override;
    procedure SetPassThrough(const AValue: Boolean); override;
    procedure SetOnValidateCertificate(const Value: CertificateValidationCallback);
    procedure SetOptions(const Value: TIdTlsClientOptions);
  public
    procedure Open; override;
    procedure Close; override;
    procedure CheckForDisconnect(ARaiseExceptionIfDisconnected: Boolean = True;
     AIgnoreBuffer: Boolean = False); override;
    procedure StartSSL; override;
    function Clone : TIdSSLIOHandlerSocketBase; override;
    function Connected: Boolean; override;
  published
    property Options: TIdTlsClientOptions read FOptions write SetOptions;
    property OnValidateCertificate: CertificateValidationCallback read FOnValidateCertificate write SetOnValidateCertificate;
  end;

implementation

uses IdIOHandler;

{ TIOHandlerTls }

procedure TIdIOHandlerTls.SetOnValidateCertificate(
  const Value: CertificateValidationCallback);
begin
  FOnValidateCertificate := Value;

  if FTlsStream <> nil then
  begin
    FTlsStream.ServerCertValidationDelegate := Value;
  end;
end;

procedure TIdIOHandlerTls.SetOptions(const Value: TIdTlsClientOptions);
begin
  FOptions := Value;
end;

function TIdIOHandlerTls.Connected: Boolean;
begin
  Result :=  (    (Binding <> nil)
              and (Binding.Handle <> nil)
              and (Binding.Handle.Connected)
              and (FSocketStream <> nil)
              and (FCarrierStream <> nil)
              and ((FTlsStream <> nil) or PassThrough)
              );
end;

function TIdIOHandlerTls.Clone: TIdSSLIOHandlerSocketBase;
var
  TempResult: TIdIOHandlerTls;
begin
  TempResult := TIdIOHandlerTls.Create;
  TempResult.Options.CertificateCollection.AddRange(Options.CertificateCollection);
  TempResult.Options.Protocol := Options.Protocol;
  Result := TempResult;
end;

procedure TIdIOHandlerTls.InitComponent;
begin
  inherited;
	FOptions := TIdTlsClientOptions.Create;
end;

procedure TIdIOHandlerTls.StartSSL;
begin
  inherited;
  PassThrough := False;
end;

procedure TIdIOHandlerTls.Open;
begin
  inherited;
  FSocketStream := TIdSocketStream.Create(Binding.Handle);
  FCarrierStream := TIdCarrierStream.Create(FSocketStream);
  FActiveStream := FCarrierStream;
  GC.SuppressFinalize(FSocketStream);
  GC.SuppressFinalize(FCarrierStream);
  GC.SuppressFinalize(Binding.Handle);
  if not PassThrough then
  begin
    PassThrough := True;
    PassThrough := False;
  end;
end;

function TIdIOHandlerTls.RecvEnc(var VBuffer: TIdBytes): Integer;
begin
  if FActiveStream <> nil then begin
    Result := FActiveStream.Read(VBuffer, 0, Length(VBuffer));
  end else begin
    Result := 0;
  end;
end;

procedure TIdIOHandlerTls.CheckForDisconnect(ARaiseExceptionIfDisconnected: Boolean = True;
  AIgnoreBuffer: Boolean = False);
begin
  inherited;
  try
    if FActiveStream = nil then
    begin
      if AIgnoreBuffer or (FInputBuffer.Size = 0) then begin
        CloseGracefully;
      end;
    end
    else if (not FActiveStream.CanRead) or (not FActiveStream.CanWrite) then
    begin
      if AIgnoreBuffer or (FInputBuffer.Size = 0) then begin
        CloseGracefully;
      end;
    end;
  except
    on E: Exception do begin
      CloseGracefully;
    end;
  end;
  if ARaiseExceptionIfDisconnected and ClosedGracefully then begin
    RaiseConnClosedGracefully;
  end;
end;

procedure TIdIOHandlerTls.Close;
begin
  if not PassThrough then
  begin
    FTlsStream.Close;
    FTlsStream := nil;
  end;
  FCarrierStream.Close;
  FCarrierStream := nil;
  FSocketStream.Close;
  FSocketStream := nil;
  inherited;
end;

function TIdIOHandlerTls.SendEnc(const ABuffer: TIdBytes; const AOffset, ALength: Integer): Integer;
begin
  if FActiveStream <> nil then
  begin
    FActiveStream.Write(ABuffer, AOffset, ALength);
    FActiveStream.Flush;
    Result := ALength;
  end else begin
    Result := 0;
  end;
end;

procedure TIdIOHandlerTls.SetPassThrough(const AValue: Boolean);
var
  TempBuff: array[0..0] of byte;
begin
  if PassThrough <> AValue then
  begin
    inherited;
    if FCarrierStream = nil then begin
      Exit;
    end;
    if AValue then
    begin
      FActiveStream := FSocketStream;
      if FTlsStream <> nil then
      begin
        FTlsStream.Close;
        FTlsStream := nil;
      end;
    end else
    begin
      FTlsStream := SslClientStream.Create(FCarrierStream, URIToCheck, True, FOptions.Protocol, FOptions.CertificateCollection);
      FTlsStream.ServerCertValidationDelegate := FOnValidateCertificate;
      GC.SuppressFinalize(FTlsStream);
      FActiveStream := FTlsStream;
      //FTlsStream.Read(TempBuff, 0, 0);
    end;
  end;
end;

end.