demosettings.pas

来自「著名的SecureBlackBox控件完整源码」· PAS 代码 · 共 529 行

unit DemoSettings;

interface

uses
  Classes,
  SBSSHKeyStorage;

type
  TSSHServerDemoSettings = class;

  TSSHServerUser = class
  private
    FName: string;
    FAuthTypes: integer;
    FPasswordSalt: string;
    FPasswordHash: string;
    FPublicKey: string;
    FParent: TSSHServerDemoSettings;
    function CalcPasswordHash(const Salt, Password: string): string;
  protected
    FAuthAll: Boolean;
  public
    constructor Create;
    function KeyValid(Key: TElSSHKey): Boolean;
    procedure SetPassword(const Password: string);
    function SetPublicKey(const Key: string): boolean;
    function PasswordValid(const Password: string): boolean;
    property AuthAll: Boolean read FAuthAll write FAuthAll;
    property Name: string read FName write FName;
    property AuthTypes: integer read FAuthTypes write FAuthTypes;
    property PasswordSalt: string read FPasswordSalt write FPasswordSalt;
    property PasswordHash: string read FPasswordHash write FPasswordHash;
    property PublicKey: string read FPublicKey write FPublicKey;
  end;
  
  TSSHServerDemoSettings = class
  private
    FUsers: TList;
    FHostKey: string;
    FSettingsFound: boolean;
    function GetUsers(Index: integer): TSSHServerUser;
    function GetUserCount: integer;
    procedure LoadDefaults;
    procedure ClearUsers;
    procedure DoChange;
    function GetSettingsFilenames(var UsersFile: string; var KeyFile: string):
    boolean;
  protected
  public
    constructor Create;
    destructor Destroy; override;
    function AddUser: integer;
    procedure RemoveUser(Index: integer); overload;
    procedure RemoveUser(User: TSSHServerUser); overload;
    function FindUser(const Username: string): integer;
    procedure Load;
    procedure Save;
    function SetHostKey(const Key: string): boolean;
    property Users[Index: integer]: TSSHServerUser read GetUsers;
    property UserCount: integer read GetUserCount;
    property HostKey: string read FHostKey;
    property SettingsFound: boolean read FSettingsFound;
  end;
  
var
  Settings: TSSHServerDemoSettings;

implementation

uses
  SBSSHConstants,
  SBMD,
  SBUtils,
  SysUtils,
  Windows,
  FileCtrl;

////////////////////////////////////////////////////////////////////////////////
// TSSHServerUser class

constructor TSSHServerUser.Create;
begin
  inherited;
  FParent := nil;
end;

procedure TSSHServerUser.SetPassword(const Password: string);
var
  Salt: array[0..3] of byte;
  I: integer;
begin
  SBRndGenerate(@Salt[0], SizeOf(Salt));
  FPasswordSalt := '';
  for I := 0 to SizeOf(Salt) - 1 do
    FPasswordSalt := FPasswordSalt + IntToHex(Salt[I], 2);
  FPasswordHash := CalcPasswordHash(FPasswordSalt, Password);
end;

function TSSHServerUser.PasswordValid(const Password: string): boolean;
var
  CurrHash: string;
begin
  CurrHash := CalcPasswordHash(FPasswordSalt, Password);
  Result := CurrHash = FPasswordHash;
end;

function TSSHServerUser.SetPublicKey(const Key: string): boolean;
var
  K: TElSSHKey;
begin
  K := TElSSHKey.Create;
  if K.LoadPublicKey(@Key[1], Length(Key)) = 0 then
  begin
    FPublicKey := Key;
    Result := true;
  end
  else
    Result := false;
  K.Free;
end;

function TSSHServerUser.CalcPasswordHash(const Salt, Password: string): string;
begin
  Result := DigestToStr(SBMD.HashMD5(Salt + Password));
end;

function TSSHServerUser.KeyValid(Key: TElSSHKey): Boolean;
var
  K: TElSSHKey;
  F1, F2: TMessageDigest160;
begin
  if FPublicKey = '' then
    Result := false
  else
  begin
    K := TElSSHKey.Create;
    try
      K.LoadPublicKey(@FPublicKey[1], Length(FPublicKey));
      F1 := Key.FingerprintSHA1;
      F2 := K.FingerprintSHA1;
      result := CompareMem(@F1, @F2, sizeof(TMessageDigest160));
    finally
      K.Free;
    end;
  end;
end;

////////////////////////////////////////////////////////////////////////////////
// TSSHServerDemoSettings class

constructor TSSHServerDemoSettings.Create;
begin
  inherited;
  FUsers := TList.Create;
end;

destructor TSSHServerDemoSettings.Destroy;
begin
  ClearUsers;
  FUsers.Free;
  inherited;
end;

procedure TSSHServerDemoSettings.LoadDefaults;
begin
  FHostKey := '-----BEGIN RSA PRIVATE KEY-----'#13#10 +
    'MIICWgIBAAKBgQCytkFlDL5lUd243uEo4jNpOS8cUDf7GiAzf6xu7FDhdavA7K28'#13#10 +
    'ZWZn+yGuVSPX49LtrTHBEAWW/L/wKqofTaFwuCBRhk9ZjC99pGFH0L/J7UuCmdGj'#13#10 +
    'jlGB24Dko9+fdrVaMeI5pLiDA8GUa16BCdMgItmDaQ5NPsm3Tbw+2rY88QIBIwKB'#13#10 +
    'gA9Rc1HN5G8VpUpcPy9j2IVcrERBY+JSsk2OmcBdZgSyUIzhFjS4O/pIub58U4eI'#13#10 +
    'jmwkycAXUO+vQ6bfFeVtDdZRXZ6TBYQktpO4SKThb0mLoszT1RJMlGYqckoqD/zU'#13#10 +
    'fwtijFBVgxYr1QrCzteyBAOJUefbj15cXzNW1yYX1XXLAkEA6hNn2wtk7pwC7FGV'#13#10 +
    'vdDM3Y8hCDY6+FA/A6NXLEVgt5vC458Ykz4JjUyO/fusUpfH88iJjTQ2Eyf0HROm'#13#10 +
    'aL6BGQJBAMNzWk1Y7vFBafzALneHTbKmYT+QPcM98D39gYzfuQ/6Enszd9aBIXcU'#13#10 +
    '3TdLAEUMhEJVaNpRdPX1wZDahrE9XZkCQQCgglXYB9Ault1u2Nu1W/oxhreQmjcQ'#13#10 +
    'rA3z3bgeW3WFN5uUxN2my3RDojYqgLCtqegyIxx+FSxk6DJdFMnhbLBLAkBImI9B'#13#10 +
    'TOsJJuzaOMDNT4NCWw4tjVjE3H3N4dEIcFquKa8X0UnEs563M6KfgkHtwtIKAndn'#13#10 +
    'CFADlcuNkv7UHhtzAkAwsWyRTvxRykESFuqRQMyQKJeR2mjlf34LtlQYU2yuHuz0'#13#10 +
    'gTBqUy7sYASwHHHjMRyTmQFnwpviB3UiDOAcnWKR'#13#10 +
    '-----END RSA PRIVATE KEY-----';
  Save;
end;

function GetEnvironmentVariable(const Name: string): string;
var
  Needed: integer;
begin
  Needed := Windows.GetEnvironmentVariable(PChar(Name), nil, 0);
  if Needed > 0 then
  begin
    SetLength(Result, Needed);
    Needed := Windows.GetEnvironmentVariable(PChar(Name), @Result[1], Needed);
    SetLength(Result, Needed);
  end
  else
    SetLength(Result, 0);
end;

function TSSHServerDemoSettings.GetSettingsFilenames(var UsersFile: string;
  var KeyFile: string): boolean;
var
  AppData: string;
  DirName: string;
const
  SBB_DIR_NAME = 'SecureBlackbox';
  SBB_USERS_FILE_NAME = 'SSHSrvUsers';
  SBB_KEY_FILE_NAME = 'SSHSrvHostkey';
begin
  AppData := GetEnvironmentVariable('APPDATA');
  if Length(AppData) = 0 then
    AppData := GetEnvironmentVariable('USERPROFILE');
  if Length(AppData) <> 0 then
    DirName := AppData + '\' + SBB_DIR_NAME
  else
    DirName := SBB_DIR_NAME;
  if not DirectoryExists(DirName) then
    if not CreateDir(DirName) then
    begin
      Result := false;
      Exit;
    end;
  UsersFile := DirName + '\' + SBB_USERS_FILE_NAME;
  KeyFile := DirName + '\' + SBB_KEY_FILE_NAME;
  Result := true;
end;

procedure TSSHServerDemoSettings.Load;
var
  UsersFile, KeyFile: string;
  F: TFileStream;
  SettingsStr: string;
  Key: TElSSHKey;

  function GetLex(var Line: string): string;
  var
    Index: integer;
  begin
    Index := Pos(':', Line);
    if Index > 0 then
    begin
      Result := Copy(Line, 1, Index - 1);
      Line := Copy(Line, Index + 1, Length(Line));
    end
    else
    begin
      Result := Line;
      Line := '';
    end;
  end;

  procedure ProcessUsers(const S: string);
  var
    SingleUser, Tmp, Name, Salt, Pass, Auths, PubKey: string;
    Index: integer;
    UserIndex: integer;
    K: TElSSHKey;
    AT: integer;
  begin
    Tmp := S;
    K := TElSSHKey.Create;
    try
      repeat
        Index := Pos(#13#10, Tmp);
        if (Index > 0) then
        begin
          SingleUser := Copy(Tmp, 1, Index - 1);
          Tmp := Copy(Tmp, Index + 2, Length(Tmp));
        end
        else
        begin
          SingleUser := Tmp;
          Tmp := '';
        end;
        if Length(SingleUser) > 0 then
        begin
          Name := GetLex(SingleUser);
          Salt := GetLex(SingleUser);
          Pass := GetLex(SingleUser);
          Auths := GetLex(SingleUser);
          PubKey := SingleUser;
          UserIndex := AddUser();
          Users[UserIndex].FName := Name;
          Users[UserIndex].FPasswordSalt := Salt;
          Users[UserIndex].FPasswordHash := Pass;
          AT := 0;
          if Pos('password', Auths) > 0 then
            AT := AT or SSH_AUTH_TYPE_PASSWORD;
          if Pos('publickey', Auths) > 0 then
            AT := AT or SSH_AUTH_TYPE_PUBLICKEY;
          if Pos('keyboard', Auths) > 0 then
            AT := AT or SSH_AUTH_TYPE_KEYBOARD;

          Users[UserIndex].FAuthTypes := AT;

          Users[UserIndex].FAuthAll := Pos(' all', Auths) > 0;

          if K.LoadPublicKey(@PubKey[1], Length(PubKey)) = 0 then
            Users[UserIndex].FPublicKey := PubKey;
        end;
      until Tmp = '';
    finally
      K.Free;
    end;
  end;
begin
  FSettingsFound := false;
  if GetSettingsFilenames(UsersFile, KeyFile) then
  begin
    if (FileExists(UsersFile)) and (FileExists(KeyFile)) then
    begin
      try
        F := TFileStream.Create(UsersFile, fmOpenRead);
        try
          SetLength(SettingsStr, F.Size);
          F.Read(SettingsStr[1], Length(SettingsStr));
        finally
          F.Free;
        end;
        { Users file contains a sequence of lines, each line corresponds to
          a single user:
          username:salt:password:auth-types:public-key,
          e.g.
          user:0ffe321a:3201f08abc44e1908efc1c2000eff032:password,public-key,keyboard:<base64 key data>
        }
        ProcessUsers(SettingsStr);
        F := TFileStream.Create(KeyFile, fmOpenRead);
        try
          SetLength(SettingsStr, F.Size);
          F.Read(SettingsStr[1], Length(SettingsStr));
        finally
          F.Free;
        end;
        Key := TElSSHKey.Create;
        try
          if Key.LoadPrivateKey(@SettingsStr[1], Length(SettingsStr)) = 0 then
            FHostKey := SettingsStr
          else
            FHostKey := '';
        finally
          Key.Free;
        end;
        FSettingsFound := true;
      except
        ;
      end;
    end;
  end;
  if not FSettingsFound then
    LoadDefaults;
end;

procedure TSSHServerDemoSettings.Save;
var
  UsersFile, KeyFile: string;
  F: TFileStream;
  I: integer;
  AllUsers, S, AT, KeyData: string;
  Key: TElSSHKey;
  Size: integer;
  Success: boolean;
begin
  if GetSettingsFilenames(UsersFile, KeyFile) then
  begin
    Key := TElSSHKey.Create;
    try
      AllUsers := '';
      for I := 0 to UserCount - 1 do
      begin
        S := Users[I].FName + ':' + Users[I].FPasswordSalt + ':' +
          Users[I].FPasswordHash + ':';
        AT := '';
        if Users[I].FAuthTypes and SSH_AUTH_TYPE_PASSWORD =
          SSH_AUTH_TYPE_PASSWORD then
          AT := AT + 'password,';
        if Users[I].FAuthTypes and SSH_AUTH_TYPE_PUBLICKEY =
          SSH_AUTH_TYPE_PUBLICKEY then
          AT := AT + 'publickey,';
        if Users[I].FAuthTypes and SSH_AUTH_TYPE_KEYBOARD =
          SSH_AUTH_TYPE_KEYBOARD then
          AT := AT + 'keyboard,';
        if Users[I].AuthAll then
          AT := AT + ' all'
        else
          AT := AT + ' any';

        S := S + AT + ':';
        if (Length(Users[I].FPublicKey) > 0) and
          (Key.LoadPublicKey(@Users[I].FPublicKey[1],
            Length(Users[I].FPublicKey))
          = 0) then
        begin
          Key.KeyFormat := kfOpenSSH;
          Size := 0;
          Key.SavePublicKey(nil, Size);
          SetLength(KeyData, Size);
          Key.SavePublicKey(@KeyData[1], Size);
          SetLength(KeyData, Size);
        end;
        S := S + KeyData;
        AllUsers := AllUsers + S + #13#10;
      end;
      Success := true;
      try
        F := TFileStream.Create(UsersFile + '.tmp', fmCreate);
        try
          F.Write(AllUsers[1], Length(AllUsers));
        finally
          F.Free;
        end;
      except
        Success := false;
      end;
      if Success then
      begin
        SysUtils.DeleteFile(UsersFile);
        RenameFile(UsersFile + '.tmp', UsersFile);
      end;
      Success := true;
      try
        F := TFileStream.Create(KeyFile + '.tmp', fmCreate);
        try
          F.Write(FHostKey[1], Length(FHostKey));
        finally
          F.Free;
        end;
      except
        Success := false;
      end;
      if Success then
      begin
        SysUtils.DeleteFile(KeyFile);
        RenameFile(KeyFile + '.tmp', KeyFile);
      end;
    finally
      Key.Free;
    end;
  end;
end;

function TSSHServerDemoSettings.AddUser: integer;
begin
  Result := FUsers.Add(TSSHServerUser.Create);
  TSSHServerUser(FUsers[Result]).FParent := Self;
end;

procedure TSSHServerDemoSettings.RemoveUser(Index: integer);
begin
  TSSHServerUser(FUsers[Index]).Free;
  FUsers.Delete(Index);
end;

procedure TSSHServerDemoSettings.RemoveUser(User: TSSHServerUser);
begin
  FUsers.Remove(User);
  User.Free;
end;

function TSSHServerDemoSettings.FindUser(const Username: string): integer;
var
  I: integer;
begin
  Result := -1;
  for I := 0 to UserCount - 1 do
    if Users[I].FName = Username then
    begin
      Result := I;
      Break;
    end;
end;

procedure TSSHServerDemoSettings.ClearUsers;
var
  I: integer;
begin
  for I := 0 to FUsers.Count - 1 do
    TSSHServerUser(FUsers[I]).Free;
  FUsers.Clear;
end;

function TSSHServerDemoSettings.GetUsers(Index: integer): TSSHServerUser;
begin
  Result := FUsers[Index];
end;

function TSSHServerDemoSettings.GetUserCount: integer;
begin
  Result := FUsers.Count;
end;

function TSSHServerDemoSettings.SetHostKey(const Key: string): boolean;
var
  K: TElSSHKey;
begin
  K := TElSSHKey.Create;
  if K.LoadPrivateKey(@Key[1], Length(Key)) = 0 then
  begin
    FHostKey := Key;
    Result := true;
  end
  else
    Result := false;
  K.Free;
end;

procedure TSSHServerDemoSettings.DoChange;
begin
  Save;
end;

initialization
  SetLicenseKey('ADDCD14AD06709806817E0B3D7BFD0A2222D536FE156466C5D5FE65DB5DEAE76' + 
  'FFDEBC07E915A5751C12C01C783958872A38E4A5EDA140E7247E0F2E56442A3C' +
  'F3E9347AD8FDE52083A0DFC86BC00ECB0FD0CF1B51159A2BCB84F6EA6349EF47' +
  '5C15A59AFCC55F7C3AAD26C279628B5D91B1DC94BD2385354A70CCA3B76101D9' +
  'F41C84A639FC3CCE4BA8F0CC4A66DCD150114A3F58C1AD46B7B94643741BC20A' +
  '8DCA83AB921480951B423CAA19EF1863A47CA2C3422E7E5634BED98939A5AE43' +
  'DE1E4BAD79E66D8A5C973B3455656C8C9B6FF024FADD6CDA02D0F506D98493C8' +
  'BD1ED7B237DB75FA31F2C82654490CDDDEE24E19939137B9E1DB05508733B22F');

  Settings := TSSHServerDemoSettings.Create;
  Settings.Load;

finalization
  FreeAndNil(Settings);

end.