forwardingmain.pas

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

  Log('Secure channel error ' + IntToStr(Error), true);
end;

procedure TSSHSession.OnServerSocketGetThread(Sender: TObject; ClientSocket: TServerClientWinSocket;
  var SocketThread: TServerClientThread);
var
  Fwd : TSSHForwardingThread;
begin
  Log('Connection accepted', false);
  Fwd := TSSHForwardingThread.Create(Self, ClientSocket);
  //Fwd.FreeOnTerminate := true;
  Fwd.Resume;
  DoConnectionOpen(Fwd);                  
  FTunnel.Open(Fwd);
  SocketThread := Fwd;
end;

procedure TSSHSession.Log(const S : string; Error : boolean);
begin
  if Assigned(FOnLog) then
  begin
    FGuiCS.Acquire;
    try
      FLastS := S;
      FLastError := Error;
      Synchronize(DoLogSync);
    finally
      FGuiCS.Release;
    end;
  end;
end;

procedure TSSHSession.DoConnectionOpen(Conn: TSSHForwardingThread);
begin
  InterlockedIncrement(FChannelCount);
  if Assigned(FOnConnectionOpen) then
  begin
    FGuiCS.Acquire;
    try
      FLastConn := Conn;
      Synchronize(DoConnectionOpenSync);
    finally
      FGuiCS.Release;
    end;
  end;
end;

procedure TSSHSession.DoConnectionChange(Conn: TSSHForwardingThread);
begin
  if Assigned(FOnConnectionChange) then
  begin
    FGuiCS.Acquire;
    try
      FLastConn := Conn;
      Synchronize(DoConnectionChangeSync);
    finally
      FGuiCS.Release;
    end;
  end;
end;

procedure TSSHSession.DoConnectionRemove(Conn: TSSHForwardingThread);
begin
  InterlockedDecrement(FChannelCount);
  if Assigned(FOnConnectionRemove) then
  begin
    FGuiCS.Acquire;
    try
      FLastConn := Conn;
      Synchronize(DoConnectionRemoveSync);
    finally
      FGuiCS.Release;
    end;
  end;
end;

procedure TSSHSession.DoConnectionOpenSync;
begin
  FOnConnectionOpen(Self, FLastConn);
end;

procedure TSSHSession.DoConnectionChangeSync;
begin
  FOnConnectionChange(Self, FLastConn);
end;

procedure TSSHSession.DoConnectionRemoveSync;
begin
  FOnConnectionRemove(Self, FLastConn);
end;

procedure TSSHSession.DoLogSync;
begin
  FOnLog(Self, FLastS, FLastError);
end;

////////////////////////////////////////////////////////////////////////////////
// TSSHForwardingThread class

constructor TSSHForwardingThread.Create(Owner: TSSHSession; Socket : TServerClientWinSocket);
begin
  inherited Create(true, Socket);
  FSharedResource := TElSharedResource.Create;
  FOwner := Owner;
  FInState := ifsActive;
  FOutState := ofsEstablishing;
  FSent := 0;
  FReceived := 0;
  FHost := FOwner.DestHost;
  FSocket := Socket;
  FConnection := nil;
end;

destructor TSSHForwardingThread.Destroy;
begin
  FreeAndNil(FSharedResource);
  inherited;
end;

procedure TSSHForwardingThread.ClientExecute;
var
  Buf : array[0..8191] of byte;
  Read, Sent, Left : integer;
  Ptr : ^byte;
begin
  // running server loop
  while (not Terminated) and (FSocket.Connected) and
    (not ((FInState = ifsClosed) and (FOutState = ofsClosed))) do
  begin
    // processing socket endpoint
    if FInState = ifsActive then
    begin
      try
        // reading from socket connection
        if SocketReadable(FSocket) then
        begin
          Read := FSocket.ReceiveBuf(Buf[0], Length(Buf));
          if Read > 0 then
            WriteToChannelBuffer(@Buf[0], Read)
          else
            FInState := ifsClosed;
        end;
        // writing to socket connection
        repeat
          Read := ReadFromSocketBuffer(@Buf[0], Length(Buf));
          if Read > 0 then
          begin
            Left := Read;
            Ptr := @Buf[0];
            while Left > 0 do
            begin
              Sent := FSocket.SendBuf(Ptr^, Left);
              Inc(Ptr, Sent);
              Dec(Left, Sent);
            end;
          end;
        until Read = 0;
      except
        FInState := ifsClosed;
      end;
    end;
    // processing channel endpoint
    if FOutState = ofsActive then
    begin
      repeat
        Read := ReadFromChannelBuffer(@Buf[0], Length(Buf));
        if Read > 0 then
        begin
          FOwner.FCS.Acquire;
          try
            FConnection.SendData(@Buf[0], Read);
          finally
            FOwner.FCS.Release;
          end;
          Inc(FSent, Read);
        end;
      until Read = 0;
    end;
    // re-adjusting connection states
    if (FInState = ifsActive) and (FOutState in [ofsClosed, ofsClosing]) then
    begin
      FInState := ifsClosing;
      FSocket.Close;
    end
    else if (FOutState = ofsActive) and (FInState in [ifsClosing, ifsClosed]) then
    begin
      FOutState := ofsClosing;
      FOwner.FCS.Acquire;
      try
        FConnection.Close(true);
      finally
        FOwner.FCS.Release;
      end;
    end
    else if (FInState = ifsClosing) and (not FSocket.Connected) then
    begin
      FInState := ifsClosed;
    end;
    // throwing OnConnectionChange
    FOwner.DoConnectionChange(Self);
  end;
  FOwner.Log('Secure channel closed', false);
  FOwner.DoConnectionRemove(Self);
end;

procedure TSSHForwardingThread.SetConnection(Value: TElSSHTunnelConnection);
begin
  FConnection := Value;
  FConnection.OnData := OnConnectionData;
  FConnection.OnClose := OnConnectionClose;
  FOutState := ofsActive;
  FOwner.DoConnectionChange(Self);
end;

procedure TSSHForwardingThread.OnConnectionData(Sender: TObject; Buffer: pointer; Size : integer);
begin
  WriteToSocketBuffer(Buffer, Size);
  Inc(FReceived, Size);
end;

procedure TSSHForwardingThread.OnConnectionClose(Sender: TObject; CloseType : TSSHCloseType);
begin
  FOutState := ofsClosed;
end;

function TSSHForwardingThread.ReadFromSocketBuffer(Buffer: pointer; MaxSize: integer): integer;
begin
  FSharedResource.WaitToRead;
  try
    Result := Min(MaxSize, Length(FSocketBuffer));
    Move(FSocketBuffer[0], Buffer^, Result);
    Move(FSocketBuffer[Result], FSocketBuffer[0], Length(FSocketBuffer) - Result);
    SetLength(FSocketBuffer, Length(FSocketBuffer) - Result);
  finally
    FSharedResource.Done;
  end;
end;

function TSSHForwardingThread.ReadFromChannelBuffer(Buffer: pointer; MaxSize: integer): integer;
begin
  FSharedResource.WaitToRead;
  try
    Result := Min(MaxSize, Length(FChannelBuffer));
    Move(FChannelBuffer[0], Buffer^, Result);
    Move(FChannelBuffer[Result], FChannelBuffer[0], Length(FChannelBuffer) - Result);
    SetLength(FChannelBuffer, Length(FChannelBuffer) - Result);
  finally
    FSharedResource.Done;
  end;
end;

procedure TSSHForwardingThread.WriteToSocketBuffer(Buffer: pointer; Size: integer);
var
  OldLen : integer;
begin
  FSharedResource.WaitToWrite;
  try
    OldLen := Length(FSocketBuffer);
    SetLength(FSocketBuffer, OldLen + Size);
    Move(Buffer^, FSocketBuffer[OldLen], Size);
  finally
    FSharedResource.Done;
  end;
end;

procedure TSSHForwardingThread.WriteToChannelBuffer(Buffer: pointer; Size: integer);
var
  OldLen : integer;
begin
  FSharedResource.WaitToWrite;
  try
    OldLen := Length(FChannelBuffer);
    SetLength(FChannelBuffer, OldLen + Size);
    Move(Buffer^, FChannelBuffer[OldLen], Size);
  finally
    FSharedResource.Done;
  end;
end;

////////////////////////////////////////////////////////////////////////////////
// Auxiliary functions

function SocketReadable(Socket : TCustomWinSocket) : boolean;
var
  FD : TFDSet;
  TimeVal: TTimeVal;
begin
  FD_ZERO(FD);
  FD_SET(Socket.SocketHandle, FD);
  TimeVal.tv_sec := 0;
  TimeVal.tv_usec := 500;
  Result := select(-1, @FD, nil, nil, @TimeVal) > 0;
end;

end.