serverthread.pas

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

  if Accept then
    Log('Password authentication succeeded for user ' + Username);
end;

procedure TSSHServerThread.OnSrvAuthKeyboard(Sender: TObject; const Username : string;
  Submethods : TStringList; var Name: string; var Instruction: string;
  Requests : TStringList; Echoes : TBits);
begin
  Log('User ' + Username + ' tries Keyboard-interactive authentication');
  Name := '';
  Instruction := 'Please enter your username and password';
  Requests.Clear;
  Requests.Add('Username: ');
  Requests.Add('Password: ');
  Echoes.Size := 2;
  Echoes[0] := true;
  Echoes[1] := false;
end;

procedure TSSHServerThread.OnSrvAuthKeyboardResponse(Sender: TObject; Requests : TStringList;
  Responses: TStringList; var Name: string; var Instruction: string;
  NewRequests : TStringList; Echoes : TBits; var Accept : boolean);
begin
  if (Assigned(FOnAuthKeyboard)) and (Responses.Count = 2) then
  begin
    FCurrUsername := Responses[0];
    FCurrPassword := Responses[1];
    Synchronize(DoAuthKeyboard);
    Accept := FCurrBool;
  end
  else
    Accept := false;
  if Accept then
    Log('Keyboard-interactive authentication succeeded for user ' + Username);
end;

procedure TSSHServerThread.OnSrvSend(Sender : TObject; Buffer : pointer; Size : longint);
var
  Sent: integer;
  Ptr: ^byte;
begin
  Ptr := Buffer;
  if ClientSocket <> nil then
    while (Size > 0) and ClientSocket.Connected do
    begin
      Sent := ClientSocket.SendBuf(Ptr^, Size);
      Inc(Ptr, Sent);
      Dec(Size, Sent);
    end;
end;

procedure TSSHServerThread.OnSrvReceive(Sender : TObject; Buffer : pointer; MaxSize : longint; out Written : longint);
begin
  Written := ClientSocket.ReceiveBuf(Buffer^, MaxSize);
  if Written < 0 then
    Written := 0;
  if Written = 0 then
    Terminate;
end;

procedure TSSHServerThread.OnSrvOpen(Sender : TObject);
begin
  Log('SSH connection established');
  ChangeState(ssActive);
end;

procedure TSSHServerThread.OnSrvClose(Sender : TObject);
begin
  if not Terminated then
  begin
    Log('SSH connection closed');
    ChangeState(ssDisconnected);
  end;
  if (ClientSocket <> nil) and ClientSocket.Connected then
    ClientSocket.Close;
end;

procedure TSSHServerThread.OnSrvError(Sender : TObject; ErrorCode : integer);
begin
  Log('Error ' + IntToStr(ErrorCode));
end;

procedure TSSHServerThread.OnSrvOpenShell(Sender: TObject; Conn: TElSSHTunnelConnection);
var
  Thread : TElSSHSubsystemThread;
begin
  Log('Shell opened');
  Thread := TElSSHSubsystemThread.Create(TElShellSSHSubsystemHandler, Conn, true);
  Thread.OnTerminate := OnThreadTerminate;
  Thread.FreeOnTerminate := true;
  FSubsystemThreads.Add(Thread);
  Thread.Resume;
  ChangeState(ssActive);
end;

procedure TSSHServerThread.OnSrvOpenCommand(Sender: TObject; Conn: TElSSHTunnelConnection;
  const Command: string);
var
  Thread : TElSSHSubsystemThread;
begin
  Log('Command opened: ' + Command);
  Thread := TElSSHSubsystemThread.Create(TElShellSSHSubsystemHandler, Conn, true);
  TElShellSSHSubsystemHandler(Thread.Handler).Command := Command;
  Thread.OnTerminate := OnThreadTerminate;
  Thread.FreeOnTerminate := true;
  FSubsystemThreads.Add(Thread);
  Thread.Resume;
  ChangeState(ssActive);
end;

procedure TSSHServerThread.OnSrvOpenSubsystem(Sender: TObject; Conn: TElSSHTunnelConnection;
  const Subsystem: string);
begin
  Log('Subsystem opened: ' + Subsystem);
  ChangeState(ssActive);
end;

procedure TSSHServerThread.OnSrvBeforeOpenClientForwarding(Sender: TObject;
  const DestHost: string; DestPort: integer; const SrcHost: string; SrcPort: integer;
  var Accept: boolean);
begin
  // checking whether user is allowed to forward connections
  // ...
  Accept := true;
end;

procedure TSSHServerThread.OnSrvOpenClientForwarding(Sender: TObject;
  Connection: TElSSHTunnelConnection; const DestHost: string; DestPort: integer;
  const SrcHost : string; SrcPort: integer);
var
  Thread : TElSSHSubsystemThread;
begin
  Log('Establishing client TCP forwarding to ' + DestHost + ':' + IntToStr(DestPort));
  Thread := TElSSHSubsystemThread.Create(TElClientTCPForwardingSSHSubsystemHandler,
    Connection, true);
  TElClientTCPForwardingSSHSubsystemHandler(Thread.Handler).Host := DestHost;
  TElClientTCPForwardingSSHSubsystemHandler(Thread.Handler).Port := DestPort;
  Thread.OnTerminate := OnThreadTerminate;
  Thread.FreeOnTerminate := true;
  FSubsystemThreads.Add(Thread);
  Thread.Resume;
  ChangeState(ssActive);
end;

procedure TSSHServerThread.OnSrvOpenServerForwarding(Sender: TObject;
  Connection: TElSSHTunnelConnection);
begin
  TSSHServerForwardingThread(Connection.Data).Run(Connection);
  ChangeState(ssActive);
end;

procedure TSSHServerThread.OnSrvServerForwardingFailed(Sender: TObject; Data: pointer);
begin
  TSSHServerForwardingThread(Data).Handler.Terminate;
end;

procedure TSSHServerThread.OnSrvServerForwardingRequest(Sender: TObject;
  const Address: string; Port : integer; var Accept : boolean; var RealPort: integer);
var
  ListeningSocket : TServerSocket;
begin
  ListeningSocket := TServerSocket.Create(nil);
  try
    ListeningSocket.ServerType := stThreadBlocking;
    ListeningSocket.OnGetThread := OnForwardingSocketGetThread;
    ListeningSocket.Port := Port;
    ListeningSocket.Open;
    FServerForwardings.Add(ListeningSocket);
    Accept := true;
  except
    ListeningSocket.Free;
    Accept := false;
  end;
end;

procedure TSSHServerThread.OnSrvServerForwardingCancel(Sender: TObject;
  const Address: string; Port : integer);
var
  I : integer;
begin
  for I := 0 to FServerForwardings.Count - 1 do
  begin
    if (TServerSocket(FServerForwardings[I]).Socket.LocalAddress = Address) and
      (TServerSocket(FServerForwardings[I]).Socket.LocalPort = Port) then
    begin
      TServerSocket(FServerForwardings[I]).Close;
      TServerSocket(FServerForwardings[I]).Free;
      FServerForwardings.Delete(I);
    end;
  end;
end;

procedure TSSHServerThread.OnForwardingSocketGetThread(Sender: TObject;
  ClientSocket: TServerClientWinSocket; var SocketThread: TServerClientThread);
begin
  SocketThread := TSSHServerForwardingThread.Create(ClientSocket);
  FSSHServer.OpenServerForwarding(ClientSocket.ServerWinSocket.LocalAddress,
    ClientSocket.ServerWinSocket.LocalPort,
    ClientSocket.RemoteAddress, ClientSocket.RemotePort, SocketThread);
end;

procedure TSSHServerThread.OnThreadTerminate(Sender: TObject);
begin
  FSubsystemThreads.Remove(Sender);
  ChangeState(ssActive);
end;

procedure TSSHServerThread.DoLog;
begin
  FOnLog(Self, FCurrLogLine);
end;

procedure TSSHServerThread.DoAuthAttempt;
begin
  FCurrBool := false;
  FOnAuthAttempt(Self, FCurrUsername, FCurrAuthType, FCurrBool);
end;

procedure TSSHServerThread.DoAuthPassword;
var
  FCP : boolean;
begin
  FCurrBool := false;
  FOnAuthPassword(Self, FCurrUsername, FCurrPassword, FCurrBool, FCP);
end;

procedure TSSHServerThread.DoAuthPublicKey;
begin
  FCurrBool := false;
  FOnAuthPublicKey(Self, FCurrUsername, FCurrKey, FCurrBool);
end;

procedure TSSHServerThread.DoConnClosed;
begin
  if Assigned(FOnConnClosed) then
    FOnConnClosed(Self);
end;

procedure TSSHServerThread.DoRefreshInfo;
begin
  if Assigned(FOnRefreshInfo) then
    FOnRefreshInfo(Self);
end;

procedure TSSHServerThread.Log(const S : string);
begin
  if Assigned(FOnLog) then
  begin
    FCurrLogLine := S;
    Synchronize(DoLog);
  end;
end;

procedure TSSHServerThread.ChangeState(NewState: TSSHServerState);
begin
  FState := NewState;
  Synchronize(DoRefreshInfo);
end;

function TSSHServerThread.GetTunnelCount: integer;
var
  I : integer;
begin
  Result := FSubsystemThreads.Count;
  for I := 0 to FServerForwardings.Count - 1 do
    Result := Result + TServerSocket(FServerForwardings[I]).Socket.ActiveConnections;
end;


procedure TSSHServerThread.DoFurtherAuthNeeded;
begin
  FCurrBool := false;
  FOnFurtherAuthNeeded(Self, FCurrUsername, FCurrBool);
  FSSHServer.AuthenticationTypes := FSSHServer.AuthenticationTypes and not AuthAllTypes;
end;


procedure TSSHServerThread.OnSrvFurtherAuthNeeded(Sender: TObject; const
    Username: string; var Needed: boolean);
begin
  if Assigned(FOnFurtherAuthNeeded) then
  begin
    FCurrUsername := Username;
    FUsername := Username;
    Synchronize(DoFurtherAuthNeeded);
    Needed := FCurrBool;
  end
  else
    Needed := false;
end;


procedure TSSHServerThread.DoAuthKeyboard;
var
  FCP: boolean;
begin
  FCurrBool := false;
  FOnAuthKeyboard(Self, FCurrUsername, FCurrPassword, FCurrBool, FCP);
end;


end.