keyfuncs.pas

来自「用DELPHI实现的 PGP 加密算法」· PAS 代码 · 共 1,570 行 · 第 1/4 页

      end;
    finally
      PGPFreeKeyList(KeyList);
    end;
  finally
    PGPFreeKeySet(KeySet);
  end;
end;

function GetGroupsList(Context: pPGPContext; KeySetMain: pPGPKeySet; var GroupsList: TGroupsList): Integer;
var
  GroupFileSpec	: pPGPFileSpec;
  GroupSet	: pPGPGroupSet;
  GroupCount	: PGPUInt32;
  GroupIndex	: PGPUInt32;
  GroupID	: PGPGroupID;
  GroupInfo	: TPGPGroupInfo;
  KeyCount	: PGPUInt32;
  ItemCount	: PGPUInt32;
  GroupItemIter	: pPGPGroupItemIter;
  GroupItem	: TPGPGroupItem;
  HexIDList	: String;
  Key		: pPGPKey;
  HexID		: String;
begin
  Result:=kPGPError_OutOfMemory;
  if GroupsList<>nil then begin
    try
      GroupsList.Clear;
      GroupFileSpec:=nil;
      GroupSet:=nil;
      Result:=PGPNewFileSpecFromFullPath(Context, PChar(KeyRings.GroupsFile), GroupFileSpec);
      if Result<>0 then Exit;
      try
	Result:=PGPNewGroupSetFromFile(Context, GroupFileSpec, GroupSet);
	if Result<>0 then Exit;
	try
	  Result:=PGPCountGroupsInSet(GroupSet, GroupCount);
	  if (Result<>0) or (GroupCount=0) then Exit;
	  for GroupIndex:=0 to pred(GroupCount) do begin
	    Result:=PGPGetIndGroupID(GroupSet, GroupIndex, GroupID);
	    if Result<>0 then Continue;
	    Result:=PGPGetGroupInfo(GroupSet, GroupID, GroupInfo);
	    if Result<>0 then Continue;
	    Result:=PGPCountGroupItems(GroupSet, GroupID, PGPTrue, KeyCount, ItemCount);
	    if (Result<>0) or (KeyCount=0) then Continue;
	    with GroupInfo do begin
	      if Description<>'' then
		GroupsList.Add(Description + ' <' + Name + '>' + #9)
	      else GroupsList.Add('<' + Name + '>' + #9);
	    end;
	    GroupItemIter:=nil;
	    Result:=PGPNewGroupItemIter(GroupSet, GroupID, kPGPGroupIterFlags_AllKeysRecursive, GroupItemIter);
	    if Result<>0 then Continue;
	    try
	      HexIDList:='';
	      while PGPGroupItemIterNext(GroupItemIter, GroupItem)=0 do begin
		with GroupItem.Item.Key do begin
		  if PGP7X then
		    Result:=PGPGetKeyByKeyID(KeySetMain, KeyStruct7.KeyID, kPGPPublicKeyAlgorithm_Invalid, Key)
		  else Result:=PGPGetKeyByKeyID(KeySetMain, KeyStruct6.KeyID, kPGPPublicKeyAlgorithm_Invalid, Key);
		end;
		if Result<>0 then Continue;
		HexID:=GetKeyPropKeyID(Key);
		if HexID<>'' then HexIDList:=HexIDList + ',' + HexID;
	      end;
	      Delete(HexIDList, 1, 1);
	      if HexIDList<>'' then with GroupsList do Strings[GroupIndex]:=Strings[GroupIndex] + HexIDList;
	    finally
	      PGPFreeGroupItemIter(GroupItemIter);
	    end;
	  end;
	  Result:=GroupsList.Count;
	finally
	  if GroupSet<>nil then PGPFreeGroupSet(GroupSet);
	end;
      finally
	PGPFreeFileSpec(GroupFileSpec);
      end;
    except
      Result:=0;
    end;
    if (Result<=0) and (GroupsList<>nil) then GroupsList.Clear;
  end;
end;

function GetKeyPropsData(KeySet: pPGPKeySet; KeyFound: pPGPKey; Flags: DWord;
			 KeyPropsList: TKeyPropsList; KeyIndex: Integer): Integer;
var
  KeyPropsRec	: pKeyPropsRec;
begin
  Result:=-1;
  if KeyPropsList.Objects[KeyIndex]<>nil then begin
    KeyPropsRec:=pKeyPropsRec(KeyPropsList.Objects[KeyIndex]);
    with KeyPropsRec^ do begin
      try
	// "string" properties
	KeyPropsList.Strings[KeyIndex]:=GetKeyPropKeyID(KeyFound);
	if Flags and spgpKeyPropFlag_KeyID<>0 then begin
	  kHexID:='0x' + Copy(KeyPropsList[KeyIndex], Length(KeyPropsList.Strings[KeyIndex])-7, 8);
	end;
	if Flags and spgpKeyPropFlag_UserID<>0 then kUserID:=GetKeyPropUserID(KeyFound);
	if Flags and spgpKeyPropFlag_Fingerprint<>0 then kFingerprint:=GetKeyPropFingerprint(KeyFound);
	if Flags and spgpKeyPropFlag_CreationTimeStr<>0 then kCreaTimeStr:=GetKeyPropKeyCreationTimeStr(KeyFound);
	if Flags and spgpKeyPropFlag_ExpirationTimeStr<>0 then kExpTimeStr:=GetKeyPropKeyExpirationTimeStr(KeyFound);
	// "number" properties
	if Flags and spgpKeyPropFlag_Keybits<>0 then kSize:=GetKeyPropKeyBits(KeyFound);
	if Flags and spgpKeyPropFlag_KeyAlg<>0 then kAlgorithm:=GetKeyPropAlg(KeyFound);
	if Flags and spgpKeyPropFlag_Trust<>0 then kTrust:=GetKeyPropTrust(KeyFound);
	if Flags and spgpKeyPropFlag_Validity<>0 then kValidity:=GetKeyPropValidity(KeyFound);
	if Flags and spgpKeyPropFlag_CreationTime<>0 then kCreaTimeNum:=GetKeyPropKeyCreationTime(KeyFound);
	if Flags and spgpKeyPropFlag_ExpirationTime<>0 then kExpTimeNum:=GetKeyPropKeyExpirationTime(KeyFound);
	// "boolean" properties
	if Flags and spgpKeyPropFlag_IsSecret<>0 then kPrivate:=GetKeyPropIsSecret(KeyFound);
	if Flags and spgpKeyPropFlag_IsAxiomatic<>0 then kImplicitTrust:=GetKeyPropIsAxiomatic(KeyFound);
	if Flags and spgpKeyPropFlag_IsRevoked<>0 then kRevoked:=GetKeyPropIsRevoked(KeyFound);
	if Flags and spgpKeyPropFlag_IsDisabled<>0 then kDisabled:=GetKeyPropIsDisabled(KeyFound);
	if Flags and spgpKeyPropFlag_IsExpired<>0 then kExpired:=GetKeyPropIsExpired(KeyFound);
	if Flags and spgpKeyPropFlag_IsSecretShared<>0 then kSecShared:=GetKeyPropIsSecretShared(KeyFound);
	if Flags and spgpKeyPropFlag_CanEncrypt<>0 then kCanEncrypt:=GetKeyPropCanEncrypt(KeyFound);
	if Flags and spgpKeyPropFlag_CanDecrypt<>0 then kCanDecrypt:=GetKeyPropCanDecrypt(KeyFound);
	if Flags and spgpKeyPropFlag_CanSign<>0 then kCanSign:=GetKeyPropCanSign(KeyFound);
	if Flags and spgpKeyPropFlag_CanVerify<>0 then kCanVerify:=GetKeyPropCanVerify(KeyFound);
	if Flags and spgpKeyPropFlag_HasRevoker<>0 then kHasRevoker:=GetKeyPropHasRevoker(KeySet, KeyFound, KeyPropsRec);
	if Flags and spgpKeyPropFlag_HasADK<>0 then kHasADK:=GetKeyPropHasARR(KeySet, KeyFound, KeyPropsRec);
	if Flags and spgpKeyPropFlag_HasSubKey<>0 then kHasSubKey:=GetKeyPropHasSubKey(KeySet, KeyFound);
	if Flags and spgpKeyPropFlag_LegacyKey<>0 then kLegacyKey:=GetKeyPropLegacy(KeyFound);
	// "list" properties
	if Flags and spgpKeyPropFlag_IncludeUserIDs<>0 then begin
	  GetKeyPropUserIDs(KeyFound, KeyPropsRec, (Flags and spgpKeyPropFlag_IncludeSignerIDs<>0));
	end;
	Result:=0;
      except
      end;
    end;
  end;
end;

function GetKeySetProps(Context: pPGPContext; KeySet: pPGPKeySet;
			var KeyPropsList: TKeyPropsList;
			PropertyFlags, FilterFlags: DWord;
			KeyOrder: TPGPKeyOrdering): Integer;
var
  KeyFilter	: pPGPFilter;
  KeySetFound	: pPGPKeySet;
  KeyCount	: PGPUInt32;
  KeyList	: pPGPKeyList;
  KeyIter	: pPGPKeyIter;
  KeyFound	: pPGPKey;
  KeyIndex	: Longint;
begin
  KeyFilter:=nil;
  KeySetFound:=nil;
  KeyList:=nil;
  KeyIter:=nil;
  if FilterFlags<>KeyFilterFlag_AllKeys then begin
    Result:=GetKeyFilter(Context, FilterFlags, KeyFilter);
    try
      if Result<>0 then Exit;
      Result:=PGPFilterKeySet(KeySet, KeyFilter, KeySetFound);
      if Result<>0 then Exit;
      KeySet:=KeySetFound;
    finally
      PGPFreeFilter(KeyFilter);
    end;
  end
  else Result:=0;
  try
    if Result<>0 then Exit;
    Result:=PGPCountKeys(KeySet, KeyCount);
    if Result<>0 then Exit;
    if PropertyFlags<>0 then begin
      if KeyPropsList=nil then begin
	KeyPropsList:=TKeyPropsList.Create(KeyCount, PropertyFlags);
	KeyIndex:=0;
      end
      else KeyIndex:=KeyPropsList.Append(KeyCount);
      if (KeyPropsList=nil) or (KeyIndex<0) then begin
	Result:=kPGPError_OutOfMemory;
	Exit;
      end;
      if (KeyIndex=0) and ((PropertyFlags and spgpKeyPropFlag_IncludeGroupsList)<>0) then begin
	GetGroupsList(Context, KeySet, KeyPropsList.GroupsList);
      end;
      Result:=PGPOrderKeySet(KeySet, PGPKeyOrdering(succ(ord(KeyOrder) shr 1)), PGPBoolean(odd(ord(KeyOrder))), KeyList);
      if Result<>0 then Exit;
      try
	Result:=PGPNewKeyIter(KeyList, KeyIter);
	try
	  if Result<>0 then Exit;
	  while PGPKeyIterNextKeyDBObj(KeyIter, kPGPKeyDBObjType_Key, KeyFound)=0 do begin
	    Result:=GetKeyPropsData(KeySet, KeyFound, PropertyFlags, KeyPropsList, KeyIndex);
	    if Result=0 then
	      inc(KeyIndex)
	    else Exit;
	  end;
	  Result:=KeyPropsList.Count;
	finally
	  PGPFreeKeyIter(KeyIter);
	end;
      finally
	PGPFreeKeyList(KeyList);
      end;
    end
    else Result:=KeyCount;
  finally
    PGPFreeKeySet(KeySetFound);
  end;
end;

function AddKeysToKeyRing(Context: pPGPContext; KeySetMain: pPGPKeySet;
			  KeysToImport: Pointer; var KeyPropsList: TKeyPropsList;
			  PropertyFlags: DWord): Integer; 
var
  KeySetToAdd	: pPGPKeySet;
begin
  if PGP7X then begin
    KeySetToAdd:=nil;
    Result:=PGPCopyKeys(PGPPeekKeyDBRootKeySet(pPGPKeyDB(KeysToImport)), PGPPeekKeySetKeyDB(KeySetMain), KeySetToAdd);
    if Result<>0 then Exit;
    try
      Result:=KeyRings.UpdateKeyRings;
      if Result<>0 then Exit;
      Result:=GetKeySetProps(Context, KeySetToAdd, KeyPropsList,
			     PropertyFlags, KeyFilterFlag_AllKeys, UserID_Ordering);
    finally
      PGPFreeKeySet(KeySetToAdd);
    end;
  end
  else begin
    Result:=PGPAddKeys(pPGPKeySet(KeysToImport), KeySetMain);
    if Result<>0 then Exit;
    Result:=KeyRings.UpdateKeyRings;
    if Result<>0 then Exit;
    Result:=GetKeySetProps(Context, pPGPKeySet(KeysToImport), KeyPropsList,
			   PropertyFlags, KeyFilterFlag_AllKeys, UserID_Ordering);
  end;
end;

function GetHexIDByAnyID(Context: pPGPContext; KeySetMain: pPGPKeySet;
			 const AnyID: String; var HexID: String): Integer;
var
  KeySetFound	: pPGPKeySet;
  KeyCount	: PGPUInt32;
  Key		: pPGPKey;
begin
  HexID:='';
  Result:=0;
  KeySetFound:=nil;
  if AnyID<>'' then begin
    try
      Result:=GetKeySetByAnyIDs(Context, KeySetMain, AnyID, KeySetFound);
      if Result<>0 then Exit;
      Result:=PGPCountKeys(KeySetFound, KeyCount);
      if Result<>0 then Exit;
      if KeyCount>0 then begin
	Result:=GetKeyFromKeySet(KeySetFound, Key);
	if Result<>0 then Exit;
	HexID:=GetKeyPropKeyID(Key);
      end;
      Result:=KeyCount;
    finally
      PGPFreeKeySet(KeySetFound);
    end;
  end;
end;

function PassphraseIsValid(Context: pPGPContext; KeySetMain: pPGPKeySet; AnyID, Passphrase: PChar): Longbool;
var
  KeySetFound	: pPGPKeySet;
  KeyCount	: PGPUInt32;
  Key		: pPGPKey;
begin
  Result:=false;
  KeySetFound:=nil;
  if GetKeySetByAnyIDs(Context, KeySetMain, AnyID, KeySetFound)=0 then begin
    try
      Result:=(PGPCountKeys(KeySetFound, KeyCount)=0) and (KeyCount=1) and (GetKeyFromKeySet(KeySetFound, Key)=0) and
	      (PGPPassphraseIsValid(Key, PGPOPassphrase(Context, Passphrase), PGPOLastOption(Context))<>PGPFalse);
    finally
      PGPFreeKeySet(KeySetFound);
    end;
  end;
end;

function TKeyRings.UpdateKeyRings: PGPError;
begin
  Result:=kPGPError_NoErr;
  if PGP7X then
    Result:=PGPFlushKeyDB(RingKeyDB)
  else if boolean(PGPKeySetNeedsCommit(RingKeySet)) then Result:=PGPCommitKeyringChanges(RingKeySet);
  if Result=0 then PGPclNotifyKeyringChanges(GetCurrentProcessID);
end;

function TKeyRings.SetKeyRings(const Pubring, Secring: String): Longbool;
begin
  PubringFile:=Pubring;
  SecringFile:=Secring;
  Result:=((PubringFile<>'') and (SecringFile<>''));
end;

function TKeyRings.InitKeyRings(var Context: pPGPContext; var KeySetMain: pPGPKeySet): PGPError;
var
  Prefs: TPreferenceRec;
  PubFileSpec: pPGPFileSpec;
  SecFileSpec: pPGPFileSpec;
begin
  Result:=kPGPError_ImproperInitialization;
  if PGPInitErrorCode=ieNone then begin
    if InitCount<=0 then begin
      InitCount:=0;
      RingKeyDB:=nil;
      RingKeySet:=nil;
      RingContext:=nil;
      PubFileSpec:=nil;
      SecFileSpec:=nil;
      Result:=PGPNewContext(kPGPsdkAPIVersion, RingContext);
      if Result<>0 then Exit;
      if (PubRingFile='') or (SecringFile='') then begin
	GetPreferences(Prefs, PrefsFlag_PublicKeyring or PrefsFlag_PrivateKeyring or PrefsFlag_GroupsFile);
	SetKeyRings(Prefs.PublicKeyring, Prefs.PrivateKeyring);
	if GroupsFile='' then GroupsFile:=Prefs.GroupsFile;
      end
      else if (GroupsFile='') and (GetPreferences(Prefs, PrefsFlag_GroupsFile)=0) then GroupsFile:=Prefs.GroupsFile;
      try
	Result:=PGPNewFileSpecFromFullPath(RingContext, PChar(PubringFile), PubFileSpec);
	if Result<>0 then Exit;
	Result:=PGPNewFileSpecFromFullPath(RingContext, PChar(SecringFile), SecFileSpec);
	if Result<>0 then Exit;
	if PGP7X then begin
	  Result:=PGPOpenKeyDBFile(RingContext, kPGPOpenKeyDBFileOptions_Mutable, PubFileSpec, SecFileSpec, RingKeyDB);
	  if Result=0 then RingKeySet:=PGPPeekKeyDBRootKeySet(RingKeyDB);
	end
	else Result:=PGPOpenKeyRingPair(RingContext, kPGPKeyRingOpenFlags_Mutable, PubFileSpec, SecFileSpec, RingKeySet);
      finally
	PGPFreeFileSpec(PubFileSpec);
	PGPFreeFileSpec(SecFileSpec);
      end;
      if Result<>0 then begin
	PGPFreeContext(RingContext);
	RingContext:=nil;
	if PGP7X then begin
	  PGPFreeKeyDB(RingKeyDB);
	  RingKeyDB:=nil;
	end
	else begin
	  PGPFreeKeySet(RingKeySet);
	  RingKeySet:=nil;
	end;
      end;
    end
    else Result:=0;
    if Result=0 then inc(InitCount);
    KeySetMain:=RingKeySet;
    Context:=RingContext;
  end;
end;

procedure TKeyRings.FreeKeyRings;
begin
  try
    if InitCount=1 then begin
      try
	if PGP7X then
	  PGPFreeKeyDB(RingKeyDB)
	else PGPFreeKeySet(RingKeySet);
      finally
	RingKeySet:=nil;
	RingKeyDB:=nil;
	try
	  PGPFreeContext(RingContext);
	finally
	  RingContext:=nil;
	end;
      end;
    end;
  finally
    if InitCount>0 then dec(InitCount);
  end;
end;

initialization
  KeyRings:=TKeyRings.Create;

finalization
  KeyRings.Free;
  KeyRings:=nil;

end.