serverthread.pas

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

  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);
var
  Thread: TElSSHSubsystemThread;
begin
  if (lowercase(Subsystem) = 'sftp') and (Settings.AllowSFTP) then
  begin
    Log('Subsystem (' + Subsystem + ') opened');
    Thread := TElSSHSubsystemThread.Create(TElSFTPSSHSubsystemHandler, Conn, true);
    TElSFTPSSHSubsystemHandler(Thread.Handler).Server.OnOpen := OnSftpOpen;
    TElSFTPSSHSubsystemHandler(Thread.Handler).Server.OnClose := OnSftpClose;
    TElSFTPSSHSubsystemHandler(Thread.Handler).Server.OnCloseHandle := OnSftpCloseHandle;
    TElSFTPSSHSubsystemHandler(Thread.Handler).Server.OnCreateDirectory := OnSftpCreateDirectory;
    TElSFTPSSHSubsystemHandler(Thread.Handler).Server.OnFindClose := OnSftpFindClose;
    TElSFTPSSHSubsystemHandler(Thread.Handler).Server.OnFindFirst := OnSftpFindFirst;
    TElSFTPSSHSubsystemHandler(Thread.Handler).Server.OnFindNext := OnSftpFindNext;
    TElSFTPSSHSubsystemHandler(Thread.Handler).Server.OnOpenFile := OnSftpOpenFile;
    TElSFTPSSHSubsystemHandler(Thread.Handler).Server.OnReadFile := OnSftpReadFile;
    TElSFTPSSHSubsystemHandler(Thread.Handler).Server.OnRemove := OnSftpRemove;
    TElSFTPSSHSubsystemHandler(Thread.Handler).Server.OnRenameFile := OnSftpRenameFile;
    TElSFTPSSHSubsystemHandler(Thread.Handler).Server.OnRequestAbsolutePath := OnSftpRequestAbsolutePath;
    TElSFTPSSHSubsystemHandler(Thread.Handler).Server.OnRequestAttributes := OnSftpRequestAttributes;
    TElSFTPSSHSubsystemHandler(Thread.Handler).Server.OnRequestAttributes2 := OnSftpRequestAttributes2;
    TElSFTPSSHSubsystemHandler(Thread.Handler).Server.OnSetAttributes := OnSftpSetAttributes;
    TElSFTPSSHSubsystemHandler(Thread.Handler).Server.OnWriteFile := OnSftpWriteFile;
    FSubsystemThreads.Add(Thread);
    Thread.Resume;
    ChangeState(ssActive);
  end
  else begin
    Log('Subsystem opened: ' + Subsystem);
    ChangeState(ssActive);
  end;
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;

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.ChangeState(NewState: TSSHServerState);
begin
  FState := NewState;
  Synchronize(DoRefreshInfo);
end;
// ----------------------------------------------------------------------------

function TSSHServerThread.FileInfoFromRec(r: TSearchRec): TElSftpFileInfo;
var
  inf: TElSftpFileInfo;
begin
  inf := TElSftpFileInfo.Create;
  if SftpVersion > 3 then
  begin
    inf.Name := ConvertToUTF8String(r.Name);
//    inf.LongName := Utf8Encode(r.Name);
  end
  else
  begin
    inf.Name := r.Name;
    inf.LongName := r.Name;
  end;
  inf.Attributes.Size := r.size;
  if (r.Attr and faDirectory) <> 0 then
  begin
    inf.Attributes.Directory := true;
    inf.Attributes.FileType := ftDirectory;
//    inf.Attributes.FileType := TSBSftpFileType(SSH_FILEXFER_TYPE_DIRECTORY);
  end
  else
  begin
    inf.Attributes.Directory := false;
    inf.Attributes.FileType := ftFile;
//    inf.Attributes.FileType := TSBSftpFileType(SSH_FILEXFER_TYPE_REGULAR);
  end;
  inf.Attributes.UserRead := true;
  inf.Attributes.GroupRead := true;
  inf.Attributes.OtherRead := true;
  if (r.Attr and faReadOnly) = 0 then
  begin
    inf.Attributes.UserWrite := true;
    inf.Attributes.GroupWrite := true;
    inf.Attributes.OtherWrite := true;
  end;
  inf.Attributes.MTime := FileDateToDateTime(r.Time);
  inf.Attributes.CTime := inf.Attributes.MTime;
  inf.Attributes.ATime := inf.Attributes.MTime;
  result := inf;
end;

function SizeOfFile(const n: string): int64;
var
  f: TFileStream;
begin
  try
    f := TFileStream.Create(n, fmOpenRead);
    try
      Result := f.Size;
    finally
      f.Free;
    end;
  except
    result := -1;
  end;
end;

function replace(var Str: string; const SourceString, DestString: string): boolean;
var
  i: integer;
begin
  i := pos(SourceString, Str);
  if i = 0 then
  begin
    Result := false;
    exit;
  end;
  Delete(Str, i, Length(SourceString));
  if Length(DestString)>0 then
    Insert(DestString, Str, i);
  Result := true;
end;

function TSSHServerThread.StatFile(name: string): TElSftpFileInfo;
var
  inf: TElSftpFileInfo;
  a: integer;

begin
  result := nil;
  inf := TElSftpFileInfo.Create;
  if SftpVersion > 3 then
    name := ConvertFromUTF8String(name);
  while replace(name, '/', '\') do ;
  inf.Name := ExtractFileName(name);
  inf.LongName := inf.Name;
  a := FileGetAttr(name);
  if (a = -1) then
    Exit;
  if (a and faDirectory) <> 0 then
  begin
    inf.Attributes.Directory := true;
//    inf.Attributes.FileType := TSBSftpFileType(SSH_FILEXFER_TYPE_DIRECTORY);
  end
  else
  begin
    inf.Attributes.Directory := false;
//    inf.Attributes.FileType := TSBSftpFileType(SSH_FILEXFER_TYPE_REGULAR);
    inf.Attributes.Size := SizeOfFile(name);
    if inf.Attributes.Size < 0 then
    begin
      inf.Free;
      exit;
    end;
  end;
  inf.Attributes.UserRead := true;
  inf.Attributes.GroupRead := true;
  inf.Attributes.OtherRead := true;
  if (a and faReadOnly) = 0 then
  begin
    inf.Attributes.UserWrite := true;
    inf.Attributes.GroupWrite := true;
    inf.Attributes.OtherWrite := true;
  end;
  inf.Attributes.MTimeCardinal := FileAge(name);
  inf.Attributes.ATimeCardinal := inf.Attributes.MTimeCardinal;
  result := inf;
end;


function TSSHServerThread.StatOpenFile(Data : pointer): TElSftpFileInfo;
{var
  inf: TElSftpFileInfo;
  a: integer;
  hs: string;}
begin
(*
  inf := TElSftpFileInfo.Create;
  hs := h.path;
  if SftpVersion > 3 then
    hs := ConvertFromUTF8String(hs);

  while replace(hs, '/', '\') do ;
  inf.Name := ExtractFileName(ConvertToUTF8String(hs));
  inf.LongName := inf.Name;
  a := FileGetAttr(hs);
  if (a and faDirectory) <> 0 then
  begin
    inf.Attributes.Directory := true;
//    inf.Attributes.FileType := TSBSftpFileType(SSH_FILEXFER_TYPE_DIRECTORY);
  end
  else
  begin
    inf.Attributes.Directory := false;
//    inf.Attributes.FileType := TSBSftpFileType(SSH_FILEXFER_TYPE_REGULAR);
    inf.Attributes.Size := h.fil.Size;
  end;
  inf.Attributes.UserRead := true;
  inf.Attributes.GroupRead := true;
  inf.Attributes.OtherRead := true;
  if (a and faReadOnly) = 0 then
  begin
    inf.Attributes.UserWrite := true;
    inf.Attributes.GroupWrite := true;
    inf.Attributes.OtherWrite := true;
  end;
  inf.Attributes.MTimeCardinal := FileGetDate(h.fil.Handle);
  inf.Attributes.ATimeCardinal := inf.Attributes.MTimeCardinal;
  result := inf;
  *)
end;

function rpos(c: widechar; s: widestring): integer;
var
  i: integer;
begin
  result := -1;
  i := Length(s);
  while i > 0 do
    if s[i] = c then
    begin
      result := i;
      break;
    end
    else
      dec(i);
end;

function UpDir(p: widestring): widestring;
var
  i: integer;
begin
  i := rpos('/', p);
  if i < Length(p) then
    result := copy(p, 1, i - 1)
  else
    result := p;
end;

function ResolveDots(p: widestring): widestring;
var
  d, us, hu: widestring;
  i: integer;
begin
  d := '';
  if (Length(p) > 1) and (p[2] = ':') then
  begin
    d := copy(p, 1, 2);
    delete(p, 1, 2);
  end;
  i := pos('/', p);
  us := '';
  while true do
  begin