forwardingmain.pas

来自「著名的SecureBlackBox控件完整源码」· PAS 代码 · 共 593 行 · 第 1/2 页

// SSH Local port forwarding demo
// EldoS SecureBlackbox library 
// Copyright (C) 2002-2007 EldoS Corporation
unit ForwardingMain;

interface

uses
  Classes, SysUtils, SBSSHCommon, SBSSHClient, SBSSHKeyStorage,
  SBSharedResource, SBUtils, ScktComp, Windows, Winsock, SyncObjs;

type
  TSSHForwardingThread = class;

  TLogEvent = procedure(Sender: TObject; const S : string; Error : boolean) of object;
  TConnectionEvent = procedure(Sender: TObject; Conn: TSSHForwardingThread) of object;
  TSSHSession = class(TThread)
  private
    FClient : TElSSHClient;
    FSocket : TClientSocket;
    FServerSocket : TServerSocket;
    FTunnel : TElLocalPortForwardSSHTunnel;
    FTunnelList : TElSSHTunnelList;
    FHost : string;
    FPort : integer;
    FUsername : string;
    FPassword : string;
    FForwardedPort: integer;
    FDestHost : string;
    FDestPort : integer;
    FError : boolean;
    FOnLog : TLogEvent;
    FOnConnectionOpen : TConnectionEvent;
    FOnConnectionChange : TConnectionEvent;
    FOnConnectionRemove : TConnectionEvent;
    FGuiCS : TCriticalSection;
    FLastConn : TSSHForwardingThread;
    FLastS : string;
    FLastError : boolean;
    FChannelCount : integer;
    FCS : TCriticalSection;
    procedure OnClientKeyValidate(Sender : TObject; ServerKey : TElSSHKey; var Validate : boolean);
    procedure OnClientAuthSuccess(Sender : TObject);
    procedure OnClientAuthFailed(Sender : TObject; AuthType: integer);
    procedure OnClientSend(Sender : TObject; Buffer: pointer; Size : integer);
    procedure OnClientReceive(Sender : TObject; Buffer : pointer; MaxSize : longint;
      out Written : longint);
    procedure OnClientOpen(Sender : TObject);
    procedure OnClientClose(Sender : TObject);
    procedure OnClientError(Sender : TObject; ErrorCode : integer);
    procedure OnTunnelOpen(Sender : TObject; TunnelConnection : TElSSHTunnelConnection);
    procedure OnTunnelError(Sender : TObject; Error : integer; Data : pointer);
    procedure OnServerSocketGetThread(Sender: TObject; ClientSocket: TServerClientWinSocket;
      var SocketThread: TServerClientThread);
    procedure Log(const S : string; Error : boolean);
    procedure DoConnectionOpen(Conn: TSSHForwardingThread);
    procedure DoConnectionChange(Conn: TSSHForwardingThread);
    procedure DoConnectionRemove(Conn: TSSHForwardingThread);
    procedure DoConnectionOpenSync;
    procedure DoConnectionChangeSync;
    procedure DoConnectionRemoveSync;
    procedure DoLogSync;
  protected
    procedure Execute; override;
  public
    constructor Create;
    destructor Destroy; override;
    procedure Run;
    property Host : string read FHost write FHost;
    property Port : integer read FPort write FPort;
    property Username : string read FUsername write FUsername;
    property Password : string read FPassword write FPassword;
    property ForwardedPort: integer read FForwardedPort write FForwardedPort;
    property DestHost : string read FDestHost write FDestHost;
    property DestPort : integer read FDestPort write FDestPort;
    property OnLog : TLogEvent read FOnLog write FOnLog;
    property OnConnectionOpen : TConnectionEvent read FOnConnectionOpen write FOnConnectionOpen;
    property OnConnectionChange : TConnectionEvent read FOnConnectionChange write FOnConnectionChange;
    property OnConnectionRemove : TConnectionEvent read FOnConnectionRemove write FOnConnectionRemove;
  end;

  TSSHInForwardingState = (ifsActive, ifsClosing, ifsClosed);
  TSSHOutForwardingState = (ofsEstablishing, ofsActive, ofsClosing, ofsClosed);
  
  TSSHForwardingThread = class(TServerClientThread)
  private
    FSocket : TServerClientWinSocket;
    FConnection : TElSSHTunnelConnection;
    FSharedResource : TElSharedResource;
    FChannelBuffer : ByteArray;
    FSocketBuffer : ByteArray;
    FInState : TSSHInForwardingState;
    FOutState : TSSHOutForwardingState;
    FSent : integer;
    FReceived : integer;
    FHost : string;
    FOwner : TSSHSession;
    procedure OnConnectionData(Sender: TObject; Buffer: pointer; Size : integer);
    procedure OnConnectionClose(Sender: TObject; CloseType : TSSHCloseType);
    function ReadFromSocketBuffer(Buffer: pointer; MaxSize: integer): integer;
    function ReadFromChannelBuffer(Buffer: pointer; MaxSize: integer): integer;
    procedure WriteToSocketBuffer(Buffer: pointer; Size: integer);
    procedure WriteToChannelBuffer(Buffer: pointer; Size: integer);
    procedure SetConnection(Value: TElSSHTunnelConnection);
  protected
    procedure ClientExecute; override;
  public
    constructor Create(Owner: TSSHSession; Socket : TServerClientWinSocket);
    destructor Destroy; override;
    property Sent : integer read FSent;
    property Received : integer read FReceived;
    property InState : TSSHInForwardingState read FInState;
    property OutState : TSSHOutForwardingState read FOutState;
    property Host : string read FHost;
    property TunnelConnection : TElSSHTunnelConnection read FConnection
      write SetConnection;
  end;

function SocketReadable(Socket : TCustomWinSocket) : boolean;

implementation

////////////////////////////////////////////////////////////////////////////////
// TSSHSession class

constructor TSSHSession.Create;
begin
  inherited Create(true);
  FTunnelList := TElSSHTunnelList.Create(nil);
  FClient := TElSSHClient.Create(nil);
  FClient.TunnelList := FTunnelList;
  FClient.OnKeyValidate := OnClientKeyValidate;
  FClient.OnAuthenticationSuccess := OnClientAuthSuccess;
  FClient.OnAuthenticationFailed := OnClientAuthFailed;
  FClient.OnSend := OnClientSend;
  FClient.OnReceive := OnClientReceive;
  FClient.OnOpenConnection := OnClientOpen;
  FClient.OnCloseConnection := OnClientClose;
  FClient.OnError := OnClientError;
  FTunnel := TElLocalPortForwardSSHTunnel.Create(nil);
  FTunnel.TunnelList := FTunnelList;
  FTunnel.OnOpen := OnTunnelOpen;
  FTunnel.OnError := OnTunnelError;
  FSocket := TClientSocket.Create(nil);
  FSocket.ClientType := ctBlocking;
  FGuiCS := TCriticalSection.Create;
  FCS := TCriticalSection.Create;
  FServerSocket := TServerSocket.Create(nil);
  FServerSocket.ServerType := stThreadBlocking;
  FServerSocket.ThreadCacheSize := 0;
  FServerSocket.OnGetThread := OnServerSocketGetThread;
end;

destructor TSSHSession.Destroy;
begin
  FreeAndNil(FClient);
  FreeAndNil(FTunnel);
  FreeAndNil(FTunnelList);
  FreeAndNil(FSocket);
  FreeAndNil(FGuiCS);
  FreeAndNil(FCS);
  FreeAndNil(FServerSocket);
  inherited;
end;

procedure TSSHSession.Run;
begin
  FClient.UserName := FUsername;
  FClient.Password := FPassword;
  FSocket.Host := FHost;
  FSocket.Port := FPort;
  FTunnel.Port := FForwardedPort;
  FTunnel.ToHost := FDestHost;
  FTunnel.ToPort := FDestPort;
  FTunnel.AutoOpen := true;
  Resume;
end;

procedure TSSHSession.Execute;
begin
  FError := false;
  FChannelCount := 0;
  // establishing TCP session
  Log('Connecting to ' + FHost + '...', false);
  FSocket.Open;
  // establishing SSH session
  Log('Establishing SSH session...', false);
  FClient.Open;
  while (not FClient.Active) and (not FError) and (not Terminated) do
    FClient.DataAvailable;
  // starting listening
  FServerSocket.Port := FForwardedPort;
  FServerSocket.Open;
  // running client loop
  while (FClient.Active) and (FSocket.Active) and (not FError) and (not Terminated) do
  begin
    FCS.Acquire;
    try
      FClient.DataAvailable;
    finally
      FCS.Release;
    end;
  end;
  if (FServerSocket.Active) then
    FServerSocket.Close;
  // session closed, cleanup
  if FClient.Active then
    FClient.Close(true);
  if FSocket.Active then
    FSocket.Close();
  // waiting for all channel threads to terminate
  while FChannelCount > 0 do
    Sleep(150);
end;

procedure TSSHSession.OnClientKeyValidate(Sender : TObject; ServerKey : TElSSHKey;
  var Validate : boolean);
begin
  Validate := true;
end;

procedure TSSHSession.OnClientAuthSuccess(Sender : TObject);
begin
  Log('Authentication succeeded', false);
end;

procedure TSSHSession.OnClientAuthFailed(Sender : TObject; AuthType: integer);
begin
  Log('Authentication type ' + IntToStr(AuthType) + ' failed', true);
end;

procedure TSSHSession.OnClientSend(Sender : TObject; Buffer: pointer; Size : integer);
var
  Sent : integer;
  Ptr : ^byte;
begin
  try
    if FSocket.Active then
    begin
      Ptr := Buffer;
      while Size > 0 do
      begin
        Sent := FSocket.Socket.SendBuf(Ptr^, Size);
        Inc(Ptr, Sent);
        Dec(Size, Sent);
      end;
    end;
  except
    FError := true;
  end;
end;

procedure TSSHSession.OnClientReceive(Sender : TObject; Buffer : pointer; MaxSize : longint;
  out Written : longint);
begin
  try
    if SocketReadable(FSocket.Socket) then
    begin
      Written := FSocket.Socket.ReceiveBuf(Buffer^, MaxSize);
      if Written = 0 then
        FError := true;
    end
    else
      Written := 0;
  except
    FError := true;
  end;
end;

procedure TSSHSession.OnClientOpen(Sender : TObject);
begin
  Log('SSH session established', false);
end;

procedure TSSHSession.OnClientClose(Sender : TObject);
begin
  Log('SSH session closed', false);
  FError := true;
end;

procedure TSSHSession.OnClientError(Sender : TObject; ErrorCode : integer);
begin
  Log('SSH protocol error ' + IntToStr(ErrorCode), true);
  FError := true;
end;

procedure TSSHSession.OnTunnelOpen(Sender : TObject; TunnelConnection : TElSSHTunnelConnection);
var
  Fwd : TSSHForwardingThread;
begin
  Log('Secure channel opened', false);
  Fwd := TSSHForwardingThread(TunnelConnection.Data);
  Fwd.TunnelConnection := TunnelConnection;
end;

procedure TSSHSession.OnTunnelError(Sender : TObject; Error : integer; Data : pointer);
begin