// This example is a primitive implementation designed as more of a guide than a library to be plugged into an application // The code that has all the TODO items completed required several major design changes and is available upon request. ' TLSclient.bas - SSPI Schannel gmail TLS connection example ' TODO: ' - Remove Global vars ' - Implement a structure pointer to pass session variables to functions ' - Replace GOTO statements ' - Break code into Open() and Close() functions ' - Handle long messages ' - Remove all Print statements ' - Implement library level error handling ' - Remove string concatenation in request/response handling ' - Processing of EXTRA data received during handshake (gmail welcome message for example) #COMPILE EXE #DIM ALL #INCLUDE "WIN32API.inc" #INCLUDE "WinTLS.inc" ' Corrected definitions from: WinCrypt.h, WinTrust.h, schannel.h, Security.h & Sspi.h GLOBAL hDbg AS LONG GLOBAL gpSSPI AS SecurityFunctionTableA PTR GLOBAL ghMyCertStore AS DWORD ' HCERTSTORE GLOBAL gSchannelCred AS SCHANNEL_CRED $DEBUG_FILE = "SSPI_dbg.txt" %fVerbose = 0 $MailHost = "smtp.gmail.com" ' SMTP Host - alias for gmail-smtp.l.google.com %TCP_PORT = 465 ' Gmail $sUser = "" ' if specified, a certificate in "MY" store is searched for %dwProtocol = %SP_PROT_TLS1 ' %SP_PROT_PCT1 %SP_PROT_SSL2 %SP_PROT_SSL3 0=default %aiKeyExch = 0 ' = default, %CALG_DH_EPHEM %CALG_RSA_KEYX %fUseProxy = 0 '%FALSE $pszProxyServer = "proxy" %iProxyPort = 80 '¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤ FUNCTION HexDump( nBytes AS DWORD, BYVAL pBytes AS BYTE PTR ) AS STRING ' For Debugging LOCAL i AS LONG LOCAL sRet AS STRING FOR i = 0 TO nBytes-1 sRet = sRet + HEX$(@pBytes[i], 2) + " " ' Seperate Hex codes with a space NEXT i ' FUNCTION = sRet END FUNCTION '¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤ FUNCTION TextDump( nBytes AS DWORD, BYVAL pBytes AS BYTE PTR ) AS STRING ' For Debugging LOCAL i AS LONG LOCAL sRet AS STRING FOR i = 0 TO nBytes-1 sRet = sRet + CHR$(@pBytes[i]) ' Seperate Hex codes with a space NEXT i ' FUNCTION = sRet END FUNCTION '**************************************************************************************** FUNCTION DisplayWinVerifyTrustError( Code AS DWORD ) AS STRING CASE %CERT_E_UNTRUSTEDROOT : FUNCTION = "CERT_E_UNTRUSTEDROOT - A certification chain processed correctly but terminated in a root certificate that is not trusted by the trust provider." CASE %CERT_E_UNTRUSTEDTESTROOT : FUNCTION = "CERT_E_UNTRUSTEDTESTROOT - The root certificate is a testing certificate, and policy settings disallow test certificates." CASE %CERT_E_CHAINING : FUNCTION = "CERT_E_CHAINING - A chain of certificates was not correctly created." CASE %CERT_E_WRONG_USAGE : FUNCTION = "CERT_E_WRONG_USAGE - The certificate is not valid for the requested usage." CASE %CERT_E_EXPIRED : FUNCTION = "CERT_E_EXPIRED - A required certificate is not within its validity period." CASE %CERT_E_INVALID_NAME : FUNCTION = "CERT_E_INVALID_NAME - The certificate has an invalid name. Either the name is not included in the permitted list, or it is explicitly excluded." CASE %CERT_E_INVALID_POLICY : FUNCTION = "CERT_E_INVALID_POLICY - The certificate has an invalid policy" CASE %CERT_E_CRITICAL : FUNCTION = "CERT_E_CRITICAL - The certificate is being used for a purpose other than the purpose specified by its CA." CASE %CERT_E_VALIDITYPERIODNESTING : FUNCTION = "CERT_E_VALIDITYPERIODNESTING - The validity periods of the certification chain do not nest correctly." CASE %CERT_E_PURPOSE : FUNCTION = "CERT_E_PURPOSE - The certificate is being used for a purpose other than one specified by the issuing CA." CASE %CERT_E_REVOKED : FUNCTION = "CERT_E_REVOKED - The certificate has been explicitly revoked by the issuer." CASE %CERT_E_REVOCATION_FAILURE : FUNCTION = "CERT_E_REVOCATION_FAILURE - The revocation process could not continue, and the certificate could not be checked." CASE %CERT_E_UNTRUSTEDROOT : FUNCTION = "CERT_E_UNTRUSTEDROOT - A certification chain processed correctly but terminated in a root certificate that is not trusted by the trust provider." CASE %CERT_E_CN_NO_MATCH : FUNCTION = "CERT_E_CN_NO_MATCH - The certificate's CN name does not match the passed value." CASE %CERT_E_PURPOSE : FUNCTION = "CERT_E_PURPOSE - The certificate is being used for a purpose other than the purposes specified by its CA." CASE %CERT_E_ROLE : FUNCTION = "CERT_E_ROLE - A certificate that can only be used as an end-entity is being used as a CA or vice versa." CASE %CERT_E_UNTRUSTEDROOT : FUNCTION = "CERT_E_UNTRUSTEDROOT - A certification chain processed correctly but terminated in a root certificate that is not trusted by the trust provider." CASE %CERT_E_CHAINING : FUNCTION = "CERT_E_CHAINING - The certificate chain to a trusted root authority could not be built." CASE %CERT_E_WRONG_USAGE : FUNCTION = "CERT_E_WRONG_USAGE - The certificate is not valid for the requested usage." CASE %CERT_E_PATHLENCONST : FUNCTION = "CERT_E_PATHLENCONST - A path length constraint in the certification chain has been violated." CASE %CERT_E_ISSUERCHAINING : FUNCTION = "CERT_E_ISSUERCHAINING - A parent of a given certificate in fact did not issue that child certificate." CASE %CERT_E_MALFORMED : FUNCTION = "CERT_E_MALFORMED - A certificate is missing or has an empty value for an important field, such as a subject or issuer name." CASE %CERT_E_UNTRUSTEDCA : FUNCTION = "CERT_E_UNTRUSTEDCA - A certification chain processed correctly, but one of the CA certificates is not trusted by the policy provider." CASE %CRYPT_E_REVOKED : FUNCTION = "CRYPT_E_REVOKED - The certificate or signature has been revoked." CASE %CRYPT_E_NO_REVOCATION_CHECK : FUNCTION = "CRYPT_E_NO_REVOCATION_CHECK - The revocation function was unable to check revocation for the certificate." CASE %CRYPT_E_REVOCATION_OFFLINE : FUNCTION = "CRYPT_E_REVOCATION_OFFLINE - The revocation function was unable to check revocation because the revocation server was offline." CASE %TRUST_E_BAD_DIGEST : FUNCTION = "TRUST_E_BAD_DIGEST - The digital signature of the object did not verify." CASE %TRUST_E_COUNTER_SIGNER : FUNCTION = "TRUST_E_COUNTER_SIGNER - One of the counter signatures was not valid." CASE %TRUST_E_EXPLICIT_DISTRUST : FUNCTION = "TRUST_E_EXPLICIT_DISTRUST - The certificate was explicitly marked as untrusted by the user." CASE %TRUST_E_FINANCIAL_CRITERIA : FUNCTION = "TRUST_E_FINANCIAL_CRITERIA - The certificate does not meet or contain the Authenticode financial extensions." CASE %TRUST_E_NO_SIGNER_CERT : FUNCTION = "TRUST_E_NO_SIGNER_CERT - The certificate for the signer of the message is not valid or not found." CASE %TRUST_E_SYSTEM_ERROR : FUNCTION = "TRUST_E_SYSTEM_ERROR - A system-level error occurred while verifying trust." CASE %TRUST_E_TIME_STAMP : FUNCTION = "TRUST_E_TIME_STAMP - The time stamp signature or certificate could not be verified or is malformed." CASE %TRUST_E_BASIC_CONSTRAINTS : FUNCTION = "TRUST_E_BASIC_CONSTRAINTS - The basic constraints of the certificate are not valid, or they are missing." CASE %TRUST_E_CERT_SIGNATURE : FUNCTION = "TRUST_E_CERT_SIGNATURE - The signature of the certificate cannot be verified. " CASE %TRUST_E_FAIL : FUNCTION = "TRUST_E_FAIL - Generic Trust Failure." CASE %TRUST_E_BASIC_CONSTRAINTS : FUNCTION = "TRUST_E_BASIC_CONSTRAINTS - The basic constraints of the certificate are not valid, or they are missing." CASE ELSE : FUNCTION = "Certificate verification failure code: 0x" + HEX$(Code) END SELECT END FUNCTION '**************************************************************************************** FUNCTION DisplayWinSockError( Code AS DWORD ) AS STRING CASE 00006 : FUNCTION = "WSA_INVALID_HANDLE" CASE 00008 : FUNCTION = "WSA_NOT_ENOUGH_MEMORY" CASE 00087 : FUNCTION = "WSA_INVALID_PARAMETER" CASE 00995 : FUNCTION = "WSA_OPERATION_ABORTED" CASE 00996 : FUNCTION = "WSA_IO_INCOMPLETE" CASE 00997 : FUNCTION = "WSA_IO_PENDING" CASE 10004 : FUNCTION = "WSAEINTR" CASE 10009 : FUNCTION = "WSAEBADF" CASE 10013 : FUNCTION = "WSAEACCES" CASE 10014 : FUNCTION = "WSAEFAULT" CASE 10022 : FUNCTION = "WSAEINVAL" CASE 10024 : FUNCTION = "WSAEMFILE" CASE 10035 : FUNCTION = "WSAEWOULDBLOCK" CASE 10036 : FUNCTION = "WSAEINPROGRESS" CASE 10037 : FUNCTION = "WSAEALREADY" CASE 10038 : FUNCTION = "WSAENOTSOCK" CASE 10039 : FUNCTION = "WSAEDESTADDRREQ" CASE 10040 : FUNCTION = "WSAEMSGSIZE" CASE 10041 : FUNCTION = "WSAEPROTOTYPE" CASE 10042 : FUNCTION = "WSAENOPROTOOPT" CASE 10043 : FUNCTION = "WSAEPROTONOSUPPORT" CASE 10044 : FUNCTION = "WSAESOCKTNOSUPPORT" CASE 10045 : FUNCTION = "WSAEOPNOTSUPP" CASE 10046 : FUNCTION = "WSAEPFNOSUPPORT" CASE 10047 : FUNCTION = "WSAEAFNOSUPPORT" CASE 10048 : FUNCTION = "WSAEADDRINUSE" CASE 10049 : FUNCTION = "WSAEADDRNOTAVAIL" CASE 10050 : FUNCTION = "WSAENETDOWN" CASE 10051 : FUNCTION = "WSAENETUNREACH" CASE 10052 : FUNCTION = "WSAENETRESET" CASE 10053 : FUNCTION = "WSAECONNABORTED" CASE 10054 : FUNCTION = "WSAECONNRESET" CASE 10055 : FUNCTION = "WSAENOBUFS" CASE 10056 : FUNCTION = "WSAEISCONN" CASE 10057 : FUNCTION = "WSAENOTCONN" CASE 10058 : FUNCTION = "WSAESHUTDOWN" CASE 10059 : FUNCTION = "WSAETOOMANYREFS" CASE 10060 : FUNCTION = "WSAETIMEDOUT" CASE 10061 : FUNCTION = "WSAECONNREFUSED" CASE 10062 : FUNCTION = "WSAELOOP" CASE 10063 : FUNCTION = "WSAENAMETOOLONG" CASE 10064 : FUNCTION = "WSAEHOSTDOWN" CASE 10065 : FUNCTION = "WSAEHOSTUNREACH" CASE 10066 : FUNCTION = "WSAENOTEMPTY" CASE 10067 : FUNCTION = "WSAEPROCLIM" CASE 10068 : FUNCTION = "WSAEUSERS" CASE 10069 : FUNCTION = "WSAEDQUOT" CASE 10070 : FUNCTION = "WSAESTALE" CASE 10071 : FUNCTION = "WSAEREMOTE" CASE 10091 : FUNCTION = "WSASYSNOTREADY" CASE 10092 : FUNCTION = "WSAVERNOTSUPPORTED" CASE 10093 : FUNCTION = "WSANOTINITIALISED" CASE 10101 : FUNCTION = "WSAEDISCON" CASE 10102 : FUNCTION = "WSAENOMORE" CASE 10103 : FUNCTION = "WSAECANCELLED" CASE 10104 : FUNCTION = "WSAEINVALIDPROCTABLE" CASE 10105 : FUNCTION = "WSAEINVALIDPROVIDER" CASE 10106 : FUNCTION = "WSAEPROVIDERFAILEDINIT" CASE 10107 : FUNCTION = "WSASYSCALLFAILURE" CASE 10108 : FUNCTION = "WSASERVICE_NOT_FOUND" CASE 10109 : FUNCTION = "WSATYPE_NOT_FOUND" CASE 10110 : FUNCTION = "WSA_E_NO_MORE" CASE 10111 : FUNCTION = "WSA_E_CANCELLED" CASE 10112 : FUNCTION = "WSAEREFUSED" CASE 11001 : FUNCTION = "WSAHOST_NOT_FOUND" CASE 11002 : FUNCTION = "WSATRY_AGAIN" CASE 11003 : FUNCTION = "WSANO_RECOVERY" CASE 11004 : FUNCTION = "WSANO_DATA" CASE 11005 : FUNCTION = "WSA_QOS_RECEIVERS" CASE 11006 : FUNCTION = "WSA_QOS_SENDERS" CASE 11007 : FUNCTION = "WSA_QOS_NO_SENDERS" CASE 11008 : FUNCTION = "WSA_QOS_NO_RECEIVERS" CASE 11009 : FUNCTION = "WSA_QOS_REQUEST_CONFIRMED" CASE 11010 : FUNCTION = "WSA_QOS_ADMISSION_FAILURE" CASE 11011 : FUNCTION = "WSA_QOS_POLICY_FAILURE" CASE 11012 : FUNCTION = "WSA_QOS_BAD_STYLE" CASE 11013 : FUNCTION = "WSA_QOS_BAD_OBJECT" CASE 11014 : FUNCTION = "WSA_QOS_TRAFFIC_CTRL_ERROR" CASE 11015 : FUNCTION = "WSA_QOS_GENERIC_ERROR" CASE 11016 : FUNCTION = "WSA_QOS_ESERVICETYPE" CASE 11017 : FUNCTION = "WSA_QOS_EFLOWSPEC" CASE 11018 : FUNCTION = "WSA_QOS_EPROVSPECBUF" CASE 11019 : FUNCTION = "WSA_QOS_EFILTERSTYLE" CASE 11020 : FUNCTION = "WSA_QOS_EFILTERTYPE" CASE 11021 : FUNCTION = "WSA_QOS_EFILTERCOUNT" CASE 11022 : FUNCTION = "WSA_QOS_EOBJLENGTH" CASE 11023 : FUNCTION = "WSA_QOS_EFLOWCOUNT" CASE 11024 : FUNCTION = "WSA_QOS_EUNKOWNPSOBJ" CASE 11025 : FUNCTION = "WSA_QOS_EPOLICYOBJ" CASE 11026 : FUNCTION = "WSA_QOS_EFLOWDESC" CASE 11027 : FUNCTION = "WSA_QOS_EPSFLOWSPEC" CASE 11028 : FUNCTION = "WSA_QOS_EPSFILTERSPEC" CASE 11029 : FUNCTION = "WSA_QOS_ESDMODEOBJ" CASE 11030 : FUNCTION = "WSA_QOS_ESHAPERATEOBJ" CASE 11031 : FUNCTION = "WSA_QOS_RESERVED_PETYPE" CASE ELSE : FUNCTION = "WinSock error code: 0x" + HEX$(Code) END SELECT END FUNCTION '**************************************************************************************** FUNCTION DisplaySECError( Code AS LONG ) AS STRING CASE %SEC_E_WRONG_PRINCIPAL : FUNCTION = "SEC_E_WRONG_PRINCIPAL - The target principal name is incorrect" CASE %SEC_E_INVALID_HANDLE : FUNCTION = "SEC_E_INVALID_HANDLE - The handle specified is invalid" CASE %SEC_E_BUFFER_TOO_SMALL : FUNCTION = "SEC_E_BUFFER_TOO_SMALL - The message buffer is too small. Used with the Digest SSP." CASE %SEC_E_CRYPTO_SYSTEM_INVALID : FUNCTION = "SEC_E_CRYPTO_SYSTEM_INVALID - The cipher chosen for the security context is not supported. Used with the Digest SSP." CASE %SEC_E_INCOMPLETE_MESSAGE : FUNCTION = "%SEC_E_INCOMPLETE_MESSAGE - The data in the input buffer is incomplete. The application needs to read more data from the server and call DecryptMessage (General) again." CASE %SEC_E_INVALID_HANDLE : FUNCTION = "SEC_E_INVALID_HANDLE - A context handle that is not valid was specified in the hContext Ptr parameter. Used with the Digest and Schannel SSPs." CASE %SEC_E_INVALID_TOKEN : FUNCTION = "SEC_E_INVALID_TOKEN - The buffers are of the wrong type or no buffer of type %SECBUFFER_DATA was found. Used with the Schannel SSP." CASE %SEC_E_MESSAGE_ALTERED : FUNCTION = "SEC_E_MESSAGE_ALTERED - The message has been altered. Used with the Digest and Schannel SSPs." CASE %SEC_E_OUT_OF_SEQUENCE : FUNCTION = "SEC_E_OUT_OF_SEQUENCE - The message was not received in the correct sequence." CASE %SEC_E_QOP_NOT_SUPPORTED : FUNCTION = "SEC_E_QOP_NOT_SUPPORTED - Neither confidentiality nor integrity are supported by the security context. Used with the Digest SSP." CASE %SEC_I_CONTEXT_EXPIRED : FUNCTION = "%SEC_I_CONTEXT_EXPIRED - The message sender has finished using the connection and has initiated a shutdown." CASE %SEC_I_RENEGOTIATE : FUNCTION = "%SEC_I_RENEGOTIATE - The remote party requires a new handshake sequence or the application has just initiated a shutdown." CASE %SEC_E_ENCRYPT_FAILURE : FUNCTION = "SEC_E_ENCRYPT_FAILURE - The specified data could not be encrypted." CASE %SEC_E_DECRYPT_FAILURE : FUNCTION = "SEC_E_DECRYPT_FAILURE - The specified data could not be decrypted." CASE %SEC_E_NO_SPM : FUNCTION = "SEC_E_INTERNAL_ERROR" CASE %SEC_E_NOT_SUPPORTED : FUNCTION = "SEC_E_UNSUPPORTED_FUNCTION" CASE %SEC_E_OK : FUNCTION = "SEC_E_OK" CASE %SEC_E_INSUFFICIENT_MEMORY : FUNCTION = "SEC_E_INSUFFICIENT_MEMORY" CASE %SEC_E_INVALID_HANDLE : FUNCTION = "SEC_E_INVALID_HANDLE" CASE %SEC_E_UNSUPPORTED_FUNCTION : FUNCTION = "SEC_E_UNSUPPORTED_FUNCTION" CASE %SEC_E_TARGET_UNKNOWN : FUNCTION = "SEC_E_TARGET_UNKNOWN " CASE %SEC_E_INTERNAL_ERROR : FUNCTION = "SEC_E_INTERNAL_ERROR " CASE %SEC_E_SECPKG_NOT_FOUND : FUNCTION = "SEC_E_SECPKG_NOT_FOUND " CASE %SEC_E_NOT_OWNER : FUNCTION = "SEC_E_NOT_OWNER " CASE %SEC_E_CANNOT_INSTALL : FUNCTION = "SEC_E_CANNOT_INSTALL " CASE %SEC_E_INVALID_TOKEN : FUNCTION = "SEC_E_INVALID_TOKEN " CASE %SEC_E_CANNOT_PACK : FUNCTION = "SEC_E_CANNOT_PACK " CASE %SEC_E_QOP_NOT_SUPPORTED : FUNCTION = "SEC_E_QOP_NOT_SUPPORTED " CASE %SEC_E_NO_IMPERSONATION : FUNCTION = "SEC_E_NO_IMPERSONATION " CASE %SEC_E_LOGON_DENIED : FUNCTION = "SEC_E_LOGON_DENIED " CASE %SEC_E_UNKNOWN_CREDENTIALS : FUNCTION = "SEC_E_UNKNOWN_CREDENTIALS " CASE %SEC_E_NO_CREDENTIALS : FUNCTION = "SEC_E_NO_CREDENTIALS " CASE %SEC_E_MESSAGE_ALTERED : FUNCTION = "SEC_E_MESSAGE_ALTERED " CASE %SEC_E_OUT_OF_SEQUENCE : FUNCTION = "SEC_E_OUT_OF_SEQUENCE " CASE %SEC_E_NO_AUTHENTICATING_AUTHORITY : FUNCTION = "SEC_E_NO_AUTHENTICATING_AUTHORITY" CASE %SEC_I_CONTINUE_NEEDED : FUNCTION = "SEC_I_CONTINUE_NEEDED " CASE %SEC_I_COMPLETE_NEEDED : FUNCTION = "SEC_I_COMPLETE_NEEDED " CASE %SEC_I_COMPLETE_AND_CONTINUE : FUNCTION = "SEC_I_COMPLETE_AND_CONTINUE " CASE %SEC_I_LOCAL_LOGON : FUNCTION = "SEC_I_LOCAL_LOGON " CASE %SEC_E_BAD_PKGID : FUNCTION = "SEC_E_BAD_PKGID " CASE %SEC_E_CONTEXT_EXPIRED : FUNCTION = "SEC_E_CONTEXT_EXPIRED " CASE %SEC_E_INCOMPLETE_CREDENTIALS : FUNCTION = "SEC_E_INCOMPLETE_CREDENTIALS" CASE %SEC_E_BUFFER_TOO_SMALL : FUNCTION = "SEC_E_BUFFER_TOO_SMALL " CASE %SEC_I_INCOMPLETE_CREDENTIALS : FUNCTION = "SEC_I_INCOMPLETE_CREDENTIALS" CASE %SEC_I_RENEGOTIATE : FUNCTION = "SEC_I_RENEGOTIATE " CASE %SEC_E_WRONG_PRINCIPAL : FUNCTION = "SEC_E_WRONG_PRINCIPAL " CASE %SEC_E_INSUFFICIENT_MEMORY : FUNCTION = "SEC_E_INSUFFICIENT_MEMORY " CASE %SEC_E_INVALID_HANDLE : FUNCTION = "SEC_E_INVALID_HANDLE " CASE %SEC_E_UNSUPPORTED_FUNCTION : FUNCTION = "SEC_E_UNSUPPORTED_FUNCTION" CASE %SEC_E_TARGET_UNKNOWN : FUNCTION = "SEC_E_TARGET_UNKNOWN " CASE %SEC_E_INTERNAL_ERROR : FUNCTION = "SEC_E_INTERNAL_ERROR " CASE %SEC_E_SECPKG_NOT_FOUND : FUNCTION = "SEC_E_SECPKG_NOT_FOUND " CASE %SEC_E_NOT_OWNER : FUNCTION = "SEC_E_NOT_OWNER " CASE %SEC_E_CANNOT_INSTALL : FUNCTION = "SEC_E_CANNOT_INSTALL " CASE %SEC_E_INVALID_TOKEN : FUNCTION = "SEC_E_INVALID_TOKEN " CASE %SEC_E_CANNOT_PACK : FUNCTION = "SEC_E_CANNOT_PACK " CASE %SEC_E_QOP_NOT_SUPPORTED : FUNCTION = "SEC_E_QOP_NOT_SUPPORTED " CASE %SEC_E_NO_IMPERSONATION : FUNCTION = "SEC_E_NO_IMPERSONATION " CASE %SEC_E_LOGON_DENIED : FUNCTION = "SEC_E_LOGON_DENIED " CASE %SEC_E_UNKNOWN_CREDENTIALS : FUNCTION = "SEC_E_UNKNOWN_CREDENTIALS " CASE %SEC_E_NO_CREDENTIALS : FUNCTION = "SEC_E_NO_CREDENTIALS " CASE %SEC_E_MESSAGE_ALTERED : FUNCTION = "SEC_E_MESSAGE_ALTERED " CASE %SEC_E_OUT_OF_SEQUENCE : FUNCTION = "SEC_E_OUT_OF_SEQUENCE " CASE %SEC_E_NO_AUTHENTICATING_AUTHORITY : FUNCTION = "SEC_E_NO_AUTHENTICATING_AUTHORITY" CASE %SEC_I_CONTINUE_NEEDED : FUNCTION = "SEC_I_CONTINUE_NEEDED " CASE %SEC_I_COMPLETE_NEEDED : FUNCTION = "SEC_I_COMPLETE_NEEDED " CASE %SEC_I_COMPLETE_AND_CONTINUE : FUNCTION = "SEC_I_COMPLETE_AND_CONTINUE " CASE %SEC_I_LOCAL_LOGON : FUNCTION = "SEC_I_LOCAL_LOGON " CASE %SEC_E_BAD_PKGID : FUNCTION = "SEC_E_BAD_PKGID " CASE %SEC_E_CONTEXT_EXPIRED : FUNCTION = "SEC_E_CONTEXT_EXPIRED " CASE %SEC_I_CONTEXT_EXPIRED : FUNCTION = "SEC_I_CONTEXT_EXPIRED " CASE %SEC_E_INCOMPLETE_CREDENTIALS : FUNCTION = "SEC_E_INCOMPLETE_CREDENTIALS" CASE %SEC_E_BUFFER_TOO_SMALL : FUNCTION = "SEC_E_BUFFER_TOO_SMALL " CASE %SEC_I_INCOMPLETE_CREDENTIALS : FUNCTION = "SEC_I_INCOMPLETE_CREDENTIALS" CASE %SEC_I_RENEGOTIATE : FUNCTION = "SEC_I_RENEGOTIATE " CASE %SEC_E_WRONG_PRINCIPAL : FUNCTION = "SEC_E_WRONG_PRINCIPAL " CASE %SEC_I_NO_LSA_CONTEXT : FUNCTION = "SEC_I_NO_LSA_CONTEXT " CASE %SEC_E_TIME_SKEW : FUNCTION = "SEC_E_TIME_SKEW " CASE %SEC_E_UNTRUSTED_ROOT : FUNCTION = "SEC_E_UNTRUSTED_ROOT " CASE %SEC_E_ILLEGAL_MESSAGE : FUNCTION = "SEC_E_ILLEGAL_MESSAGE " CASE %SEC_E_CERT_UNKNOWN : FUNCTION = "SEC_E_CERT_UNKNOWN " CASE %SEC_E_CERT_EXPIRED : FUNCTION = "SEC_E_CERT_EXPIRED " CASE %SEC_E_ENCRYPT_FAILURE : FUNCTION = "SEC_E_ENCRYPT_FAILURE " CASE %SEC_E_DECRYPT_FAILURE : FUNCTION = "SEC_E_DECRYPT_FAILURE " CASE %SEC_E_ALGORITHM_MISMATCH : FUNCTION = "SEC_E_ALGORITHM_MISMATCH " CASE %SEC_E_SECURITY_QOS_FAILED : FUNCTION = "SEC_E_SECURITY_QOS_FAILED " CASE %SEC_E_UNFINISHED_CONTEXT_DELETED : FUNCTION = "SEC_E_UNFINISHED_CONTEXT_DELETED" CASE %SEC_E_NO_TGT_REPLY : FUNCTION = "SEC_E_NO_TGT_REPLY " CASE %SEC_E_NO_IP_ADDRESSES : FUNCTION = "SEC_E_NO_IP_ADDRESSES " CASE %SEC_E_WRONG_CREDENTIAL_HANDLE : FUNCTION = "SEC_E_WRONG_CREDENTIAL_HANDLE" CASE %SEC_E_CRYPTO_SYSTEM_INVALID : FUNCTION = "SEC_E_CRYPTO_SYSTEM_INVALID " CASE %SEC_E_MAX_REFERRALS_EXCEEDED : FUNCTION = "SEC_E_MAX_REFERRALS_EXCEEDED " CASE %SEC_E_MUST_BE_KDC : FUNCTION = "SEC_E_MUST_BE_KDC " CASE %SEC_E_STRONG_CRYPTO_NOT_SUPPORTED : FUNCTION = "SEC_E_STRONG_CRYPTO_NOT_SUPPORTED" CASE %SEC_E_TOO_MANY_PRINCIPALS : FUNCTION = "SEC_E_TOO_MANY_PRINCIPALS " CASE %SEC_E_NO_PA_DATA : FUNCTION = "SEC_E_NO_PA_DATA " CASE %SEC_E_PKINIT_NAME_MISMATCH : FUNCTION = "SEC_E_PKINIT_NAME_MISMATCH " CASE %SEC_E_SMARTCARD_LOGON_REQUIRED : FUNCTION = "SEC_E_SMARTCARD_LOGON_REQUIRED" CASE %SEC_E_SHUTDOWN_IN_PROGRESS : FUNCTION = "SEC_E_SHUTDOWN_IN_PROGRESS" CASE %SEC_E_KDC_INVALID_REQUEST : FUNCTION = "SEC_E_KDC_INVALID_REQUEST " CASE %SEC_E_KDC_UNABLE_TO_REFER : FUNCTION = "SEC_E_KDC_UNABLE_TO_REFER " CASE %SEC_E_KDC_UNKNOWN_ETYPE : FUNCTION = "SEC_E_KDC_UNKNOWN_ETYPE " CASE %SEC_E_UNSUPPORTED_PREAUTH : FUNCTION = "SEC_E_UNSUPPORTED_PREAUTH " CASE %SEC_E_DELEGATION_REQUIRED : FUNCTION = "SEC_E_DELEGATION_REQUIRED " CASE %SEC_E_BAD_BINDINGS : FUNCTION = "SEC_E_BAD_BINDINGS " CASE %SEC_E_MULTIPLE_ACCOUNTS : FUNCTION = "SEC_E_MULTIPLE_ACCOUNTS " CASE %SEC_E_NO_KERB_KEY : FUNCTION = "SEC_E_NO_KERB_KEY " CASE %SEC_E_CERT_WRONG_USAGE : FUNCTION = "SEC_E_CERT_WRONG_USAGE " CASE %SEC_E_DOWNGRADE_DETECTED : FUNCTION = "SEC_E_DOWNGRADE_DETECTED " CASE %SEC_E_SMARTCARD_CERT_REVOKED : FUNCTION = "SEC_E_SMARTCARD_CERT_REVOKED" CASE %SEC_E_ISSUING_CA_UNTRUSTED : FUNCTION = "SEC_E_ISSUING_CA_UNTRUSTED " CASE %SEC_E_REVOCATION_OFFLINE_C : FUNCTION = "SEC_E_REVOCATION_OFFLINE_C " CASE %SEC_E_PKINIT_CLIENT_FAILURE : FUNCTION = "SEC_E_PKINIT_CLIENT_FAILURE " CASE %SEC_E_SMARTCARD_CERT_EXPIRED : FUNCTION = "SEC_E_SMARTCARD_CERT_EXPIRED" CASE %SEC_E_NO_S4U_PROT_SUPPORT : FUNCTION = "SEC_E_NO_S4U_PROT_SUPPORT " CASE %SEC_E_CROSSREALM_DELEGATION_FAILURE : FUNCTION = "SEC_E_CROSSREALM_DELEGATION_FAILURE" CASE %SEC_WINNT_AUTH_IDENTITY_ANSI : FUNCTION = "SEC_WINNT_AUTH_IDENTITY_ANSI" CASE %SEC_WINNT_AUTH_IDENTITY_UNICODE : FUNCTION = "SEC_WINNT_AUTH_IDENTITY_UNICODE" CASE %SECPKG_CRED_OUTBOUND : FUNCTION = "SECPKG_CRED_OUTBOUND" CASE %SECPKG_CRED_INBOUND : FUNCTION = "SECPKG_CRED_INBOUND " CASE ELSE : FUNCTION = "SEC error code:" + STR$(Code) + ", 0x" + HEX$(Code) END SELECT END FUNCTION '*****************************************************************************/ FUNCTION DisplayCertChain( BYVAL pServerCert AS CERT_CONTEXT PTR, fLocal AS LONG ) AS LONG ' pCERT_CONTEXT pServerCert, BOOL fLocal ) LOCAL dwVerificationFlags, dwRet AS DWORD ' LOCAL szName AS ASCIIZ * 1000 LOCAL pCurrentCert, pIssuerCert AS CERT_CONTEXT PTR ' pCERT_CONTEXT LOCAL PrevIssuerContext AS CERT_CONTEXT PRINT #hDbg, "" '- PRINT #hDbg, "Display leaf name" dwRet = CertNameToStr( @pServerCert.dwCertEncodingType, _ ' in DWORD dwCertEncodingType VARPTR(@pServerCert.@pCertInfo.Subject), _ ' in PCERT_NAME_BLOB pName %CERT_X500_NAME_STR OR %CERT_NAME_STR_NO_PLUS_FLAG, _ ' in DWORD dwStrType szName, _ ' out_opt LPSTR psz SIZEOF(szName) ) ' in DWORD csz IF dwRet = 0 THEN PRINT #hDbg, "**** Error: " + STR$(GetLastError()) + " building leaf subject name" END IF IF fLocal THEN PRINT #hDbg, "Client subject:" + TRIM$(szName) ELSE PRINT #hDbg, "Server subject:" + TRIM$(szName) END IF dwRet = CertNameToStr( @pServerCert.dwCertEncodingType, _ ' in DWORD dwCertEncodingType VARPTR(@pServerCert.@pCertInfo.Issuer), _ ' __in PCERT_NAME_BLOB pName %CERT_X500_NAME_STR OR %CERT_NAME_STR_NO_PLUS_FLAG, _ ' in DWORD dwStrType szName, _ ' out_opt LPSTR psz SIZEOF(szName) ) ' in DWORD csz IF dwRet = 0 THEN PRINT #hDbg, "**** Error: " + STR$(GetLastError()) + " building leaf issuer name" END IF IF fLocal THEN PRINT #hDbg, "Client issuer:" + TRIM$(szName) ELSE PRINT #hDbg, "Server issuer:" + TRIM$(szName) END IF '- PRINT #hDbg, "Display certificate chain" pCurrentCert = pServerCert WHILE( pCurrentCert <> %NULL ) dwVerificationFlags = 0 pIssuerCert = CertGetIssuerCertificateFromStore( @pServerCert.hCertStore, _ ' in HCERTSTORE hCertStore pCurrentCert, _ ' in pCERT_CONTEXT pSubjectContext %NULL, _ ' in_opt pCERT_CONTEXT pPrevIssuerContext dwVerificationFlags ) ' in_out DWORD *pdwFlags IF pIssuerCert = %NULL THEN ' No Certificates to display - jump out PRINT #hDbg, "No certificates to display" IF pCurrentCert <> pServerCert THEN CertFreeCertificateContext(@pCurrentCert) ' CERT_CONTEXT EXIT LOOP END IF ' dwRet = CertNameToStr( @pIssuerCert.dwCertEncodingType, _ ' in DWORD dwCertEncodingType VARPTR(@pIssuerCert.@pCertInfo.Subject), _ ' in PCERT_NAME_BLOB pName %CERT_X500_NAME_STR OR %CERT_NAME_STR_NO_PLUS_FLAG, _ ' in DWORD dwStrType szName, _ ' out_opt LPSTR psz SIZEOF(szName) ) ' in DWORD csz IF dwRet = 0 THEN PRINT #hDbg, "**** Error: " + STR$(GetLastError()) + " building cert subject name" END IF PRINT #hDbg, "CA subject: " + TRIM$(szName) dwRet = CertNameToStr( @pIssuerCert.dwCertEncodingType, _ ' in DWORD dwCertEncodingType VARPTR(@pIssuerCert.@pCertInfo.Issuer), _ ' in PCERT_NAME_BLOB pName %CERT_X500_NAME_STR OR %CERT_NAME_STR_NO_PLUS_FLAG, _ ' in DWORD dwStrType szName, _ ' out_opt LPSTR psz SIZEOF(szName) ) ' in DWORD csz IF dwRet = 0 THEN PRINT #hDbg, "**** Error: " + STR$(GetLastError()) + " building cert Issuer name" END IF PRINT #hDbg, "CA issuer: " + TRIM$(szName) IF pCurrentCert <> pServerCert THEN CertFreeCertificateContext(@pCurrentCert) ' CERT_CONTEXT pCurrentCert = pIssuerCert pIssuerCert = %NULL WEND END FUNCTION '*****************************************************************************/ FUNCTION DisplayConnectionInfo( BYVAL phContext AS CtxtHandle PTR ) AS LONG ' CtxtHandle *phContext LOCAL SecStatus AS LONG ' SECURITY_STATUS LOCAL ConnectionInfo AS SecPkgContext_ConnectionInfo PRINT #hDbg, "" CALL DWORD @gpSSPI.QueryContextAttributesA USING QueryContextAttributes( _ phContext, _ ' PCtxtHandle phContext // Context to query %SECPKG_ATTR_CONNECTION_INFO, _ ' unsigned long ulAttribute // Attribute to query VARPTR(ConnectionInfo) ) _ ' void SEC_FAR * pBuffer // Buffer for attributes TO SecStatus IF SecStatus <> %SEC_E_OK THEN PRINT #hDbg, "Error querying connection info" + STR$(SecStatus) EXIT FUNCTION END IF SELECT CASE ConnectionInfo.dwProtocol CASE %SP_PROT_TLS1_CLIENT: PRINT #hDbg, "Protocol: TLS1" CASE %SP_PROT_SSL3_CLIENT: PRINT #hDbg, "Protocol: SSL3" CASE %SP_PROT_PCT1_CLIENT: PRINT #hDbg, "Protocol: PCT" CASE %SP_PROT_SSL2_CLIENT: PRINT #hDbg, "Protocol: SSL2" CASE ELSE: PRINT #hDbg, "Protocol:" +STR$(ConnectionInfo.dwProtocol) END SELECT SELECT CASE ConnectionInfo.aiCipher CASE %CALG_RC4: PRINT #hDbg, "Cipher: RC4" CASE %CALG_3DES: PRINT #hDbg, "Cipher: Triple DES" CASE %CALG_RC2: PRINT #hDbg, "Cipher: RC2" CASE %CALG_DES, %CALG_CYLINK_MEK: PRINT #hDbg, "Cipher: DES" CASE %CALG_SKIPJACK: PRINT #hDbg, "Cipher: Skipjack" CASE ELSE: PRINT #hDbg, "Cipher:" + STR$(ConnectionInfo.aiCipher) END SELECT PRINT #hDbg, "Cipher strength:" + STR$(ConnectionInfo.dwCipherStrength) SELECT CASE ConnectionInfo.aiHash CASE %CALG_MD5: PRINT #hDbg, "Hash: MD5" CASE %CALG_SHA: PRINT #hDbg, "Hash: SHA" CASE ELSE: PRINT #hDbg, "Hash:" + STR$(ConnectionInfo.aiHash) END SELECT PRINT #hDbg, "Hash strength:" + STR$(ConnectionInfo.dwHashStrength) SELECT CASE ConnectionInfo.aiExch CASE %CALG_RSA_KEYX, %CALG_RSA_SIGN: PRINT #hDbg, "Key exchange: RSA" CASE %CALG_KEA_KEYX: PRINT #hDbg, "Key exchange: KEA" CASE %CALG_DH_EPHEM: PRINT #hDbg, "Key exchange: DH Ephemeral" CASE ELSE: PRINT #hDbg, "Key exchange:" + STR$(ConnectionInfo.aiExch) END SELECT PRINT #hDbg, "Key exchange strength:"+ STR$(ConnectionInfo.dwExchStrength) END FUNCTION '/*****************************************************************************/ FUNCTION UnloadSecurityLibrary( hSecurity AS DWORD ) AS LONG CALL FreeLibrary( hSecurity ) ' hLibModule AS DWORD hSecurity = 0 END FUNCTION '/*****************************************************************************/ FUNCTION VerifyServerCertificate( BYVAL pServerCert AS CERT_CONTEXT PTR, pszServerName AS ASCIIZ, dwCertFlags AS DWORD ) AS LONG LOCAL RetVal AS LONG LOCAL cUsages, SecStatus, dwID AS DWORD LOCAL sTemp AS STRING LOCAL rgszUsages() AS ASCIIZ * 64 LOCAL polHttps AS HTTPSPolicyCallbackData LOCAL PolicyPara AS CERT_CHAIN_POLICY_PARA LOCAL PolicyStatus AS CERT_CHAIN_POLICY_STATUS LOCAL ChainPara AS CERT_CHAIN_PARA LOCAL pChainContext AS CERT_CHAIN_CONTEXT PTR IF pServerCert = 0 THEN SecStatus = %SEC_E_WRONG_PRINCIPAL : GOTO cleanup IF LEN(pszServerName) = 0 THEN SecStatus = %SEC_E_WRONG_PRINCIPAL : GOTO cleanup cUsages = 3 ' SIZEOF(rgszUsages) / SIZEOF(LPSTR) DIM rgszUsages(cUsages-1) rgszUsages(0) = $szOID_PKIX_KP_SERVER_AUTH ' "1.3.6.1.5.5.7.3.1" rgszUsages(1) = $szOID_SERVER_GATED_CRYPTO ' "1.3.6.1.4.1.311.10.3.3" rgszUsages(2) = $szOID_SGC_NETSCAPE ' "2.16.840.1.113730.4.1" LOCAL OID() AS DWORD DIM OID(cUsages-1) OID(0) = VARPTR( rgszUsages(0) ) OID(1) = VARPTR( rgszUsages(1) ) OID(2) = VARPTR( rgszUsages(2) ) '- Build certificate chain. ChainPara.cbSize = SIZEOF(ChainPara) ChainPara.RequestedUsage.dwType = %USAGE_MATCH_TYPE_OR ChainPara.RequestedUsage.Usage.cUsageIdentifier = cUsages ChainPara.RequestedUsage.Usage.rgpszUsageIdentifier = VARPTR(OID(0)) ' Array of pointers ' http://msdn.microsoft.com/en-us/library/ms937660.aspx RetVal = CertGetCertificateChain( %NULL, _ ' in_opt hChainEngine pServerCert, _ ' in pCertContext %NULL, _ ' in_opt pTime @pServerCert.hCertStore, _ ' in_opt hAdditionalStore VARPTR(ChainPara), _ ' in pChainPara 0, _ ' in dwFlags %NULL, _ ' in pvReserved VARPTR(pChainContext) ) ' out ppChainContext IF RetVal = 0 THEN SecStatus = GetLastError() PRINT #hDbg, "**** Error:" + STR$(SecStatus) + " returned by CertGetCertificateChain" GOTO cleanup END IF '- Validate certificate chain. polHttps.cbStruct = SIZEOF(HTTPSPolicyCallbackData) polHttps.dwAuthType = %AUTHTYPE_SERVER polHttps.fdwChecks = dwCertFlags ' PRINT #hDbg, "pwszServerName>"+ pszServerName + "<" sTemp = UCODE$( TRIM$(pszServerName) ) ' Convert to Unicode Wide polHttps.pwszServerName = STRPTR(sTemp) ' PRINT #hDbg, "pwszServerName="+ sTemp ' Convert to Unicode Wide PolicyPara.cbSize = SIZEOF(PolicyPara) PolicyPara.pvExtraPolicyPara = VARPTR(polHttps) PolicyStatus.cbSize = SIZEOF(PolicyStatus) dwID = %CERT_CHAIN_POLICY_SSL ' cookie/handle/ID RetVal = CertVerifyCertificateChainPolicy( dwID, _ ' in DWORD ID value @pChainContext, _ ' in PCCERT_CHAIN_CONTEXT pChainContext PolicyPara, _ ' in PCERT_CHAIN_POLICY_PARA pPolicyPara PolicyStatus ) ' in_out PCERT_CHAIN_POLICY_STATUS pPolicyStatus IF RetVal = 0 THEN SecStatus = GetLastError() PRINT #hDbg, "**** Error:" + STR$(SecStatus) + " returned by CertVerifyCertificateChainPolicy" GOTO cleanup END IF ' PRINT #hDbg, "PolicyStatus.dwError="+ STR$(PolicyStatus.dwError) IF PolicyStatus.dwError THEN SecStatus = PolicyStatus.dwError PRINT #hDbg, "**** Error:" + STR$(SecStatus) + " returned by PolicyStatus" DisplayWinVerifyTrustError(SecStatus) GOTO cleanup END IF SecStatus = %SEC_E_OK ' cleanup: IF pChainContext THEN CertFreeCertificateChain(@pChainContext) FUNCTION = SecStatus ' PRINT #hDbg, "SecStatus="+ STR$(SecStatus) END FUNCTION '/*****************************************************************************/ FUNCTION CreateCredentials( sUser AS STRING, BYVAL phCreds AS CredHandle PTR ) AS LONG ' IN OUT LOCAL cSupportedAlgs AS DWORD LOCAL rgbSupportedAlgs() AS DWORD ' ALG_ID LOCAL tsExpiry AS QUAD ' TimeStamp LOCAL SecStatus AS LONG ' SECURITY_STATUS LOCAL pszPackage AS ASCIIZ * 64 ' "Microsoft Unified Security Protocol Provider" LOCAL pszPrincipal AS ASCIIZ * 16 ' LOCAL pszUser AS ASCIIZ * 255 LOCAL pCertContext AS CERT_CONTEXT PTR pszUser = sUser DIM rgbSupportedAlgs(16) '- OPEN the "MY" certificate store, where IE stores CLIENT certificates. IF ghMyCertStore = 0 THEN ghMyCertStore = CertOpenSystemStore(0, "MY") ' Windows maintains 4 stores -- MY, CA, ROOT, SPC. IF ghMyCertStore = 0 THEN PRINT #hDbg, "**** Error:" + STR$(GetLastError()) + " returned by CertOpenSystemStore" FUNCTION = %SEC_E_NO_CREDENTIALS EXIT FUNCTION END IF END IF ' PRINT #hDbg, "ghMyCertStore=" + STR$(ghMyCertStore) '- If user name is specified, attempt to find a CLIENT certificate. Otherwise, just create a NULL credential. IF LEN(pszUser) THEN ' Find CLIENT certificate. Note that this sample just searches for a certificate that contains ' the user name somewhere in the subject name. A real application should be a bit less casual. pCertContext = CertFindCertificateInStore( ghMyCertStore, _ ' hCertStore %X509_ASN_ENCODING, _ ' dwCertEncodingType 0, _ ' dwFindFlags %CERT_FIND_SUBJECT_STR_A, _ ' dwFindType pszUser, _ ' *pvFindPara BYVAL %NULL ) ' pPrevCertContext IF pCertContext = 0 THEN ' PRINT #hDbg, "**** Error:" + STR$(GetLastError()) + " returned by CertFindCertificateInStore" IF GetLastError() = %CRYPT_E_NOT_FOUND THEN PRINT #hDbg, "%CRYPT_E_NOT_FOUND - property doesn't exist" FUNCTION = %SEC_E_NO_CREDENTIALS EXIT FUNCTION END IF END IF '- Build Schannel credential structure. Currently, this sample only specifies the protocol to be used ' (and optionally the certificate). Real applications may wish to specify other parameters as well. gSchannelCred.dwVersion = %SCHANNEL_CRED_VERSION IF pCertContext THEN gSchannelCred.cCreds = 1 gSchannelCred.paCred = pCertContext END IF gSchannelCred.grbitEnabledProtocols = %dwProtocol IF %aiKeyExch THEN INCR cSupportedAlgs rgbSupportedAlgs(cSupportedAlgs) = %aiKeyExch END IF IF cSupportedAlgs THEN gSchannelCred.cSupportedAlgs = cSupportedAlgs gSchannelCred.palgSupportedAlgs = VARPTR(rgbSupportedAlgs(0)) ' May need to make this 1 END IF ' gSchannelCred.dwFlags = gSchannelCred.dwFlags OR %SCH_CRED_NO_DEFAULT_CREDS ' The SCH_CRED_MANUAL_CRED_VALIDATION flag is specified because ' this sample verifies the SERVER certificate manually. ' Applications that expect TO run ON WinNT, Win9x, OR WinME ' should specify this flag AND also manually VERIFY the SERVER ' certificate. Applications running ON newer versions OF Windows can ' leave OFF this flag, IN which CASE the Initialize Security Context ' FUNCTION will validate the SERVER certificate automatically. gSchannelCred.dwFlags = gSchannelCred.dwFlags OR %SCH_CRED_MANUAL_CRED_VALIDATION ' '- Create an SSPI credential. pszPackage = $UNISP_NAME_A + CHR$(0)' gpSSPI.AcquireCredentialsHandleA CALL DWORD @gpSSPI.AcquireCredentialsHandleA USING AcquireCredentialsHandle( _ %NULL, _ ' SEC_CHAR SEC_FAR * pszPrincipal // Name of principal VARPTR(pszPackage), _ ' SEC_CHAR SEC_FAR * pszPackage // Name of package %SECPKG_CRED_OUTBOUND, _ ' unsigned long fCredentialUse // Flags indicating use %NULL, _ ' void SEC_FAR * pvLogonId // Pointer to logon ID VARPTR(gSchannelCred), _ ' void SEC_FAR * pAuthData // Package specific data %NULL, _ ' SEC_GET_KEY_FN pGetKeyFn // Pointer to GetKey() func %NULL, _ ' void SEC_FAR * pvGetKeyArgument // Value to pass to GetKey() phCreds, _ ' PCredHandle phCredential // (out) Cred Handle VARPTR(tsExpiry) ) _ ' PTimeStamp ptsExpiry TO SecStatus ' IF SecStatus <> %SEC_E_OK THEN PRINT #hDbg, "**** Error:" + STR$(SecStatus) + " returned by AcquireCredentialsHandle" END IF '- cleanup: Free the certificate context. Schannel has already made its own copy. IF pCertContext THEN CertFreeCertificateContext(@pCertContext) FUNCTION = SecStatus ' PRINT #hDbg, "Returning SecStatus=" + STR$(SecStatus) END FUNCTION '/*****************************************************************************/ FUNCTION ConnectToServer( pszServerName AS ASCIIZ, iPortNumber AS LONG, SSLsocket AS DWORD ) AS LONG ' IN IN OUT LOCAL he_list AS LONG LOCAL cbMessage AS DWORD LOCAL sMessage AS STRING LOCAL zTemp AS ASCIIZ * 64 LOCAL SockInfo AS sockaddr_in ' struct LOCAL HostInfo AS hostent LOCAL pHostInfo AS hostent PTR ' struct SSLsocket = socket( %PF_INET, %SOCK_STREAM, 0 ) IF SSLsocket = %INVALID_SOCKET THEN PRINT #hDbg, "**** Error:" + STR$(WSAGetLastError()) + " creating socket" DisplayWinSockError( WSAGetLastError() ) FUNCTION = WSAGetLastError() EXIT FUNCTION END IF IF %fUseProxy THEN zTemp = $pszProxyServer pHostInfo = gethostbyname(zTemp) IF pHostInfo = 0 THEN PRINT #hDbg, "**** Error:" + STR$(WSAGetLastError()) + " returned by gethostbyname using Proxy" DisplayWinSockError( WSAGetLastError() ) FUNCTION = WSAGetLastError() EXIT FUNCTION END IF CopyMemory BYVAL VARPTR(hostinfo), BYVAL pHostinfo, LEN(hostinfo) ' Copy Structure locally he_list = hostinfo.h_list he_list = CVL(PEEK$(he_list,4)) SockInfo.sin_addr.s_addr = CVL(PEEK$(he_list,4)) ' SockInfo.sin_addr.s = CHR$(0, 0, 0, 0) '''''htonl(%INADDR_ANY) SockInfo.sin_family = %AF_INET SockInfo.sin_port = htons(%iProxyPort) ' Convert to network ordering sockinfo.sin_zero = STRING$(8, $NUL) ELSE ' No proxy used pHostInfo = gethostbyname(pszServerName) IF pHostInfo = 0 THEN PRINT #hDbg, "**** Error returned by gethostbyname" DisplayWinSockError( WSAGetLastError() ) FUNCTION = WSAGetLastError() EXIT FUNCTION END IF CopyMemory BYVAL VARPTR(hostinfo), BYVAL pHostinfo, LEN(hostinfo) ' Copy Structure locally he_list = hostinfo.h_list he_list = CVL(PEEK$(he_list,4)) SockInfo.sin_addr.s_addr = CVL(PEEK$(he_list,4)) ' SockInfo.sin_addr.s = CHR$(0, 0, 0, 0) '''''htonl(%INADDR_ANY) SockInfo.sin_family = %AF_INET SockInfo.sin_port = htons(iPortNumber) ' Convert to network ordering sockinfo.sin_zero = STRING$(8, $NUL) END IF ' LOCAL b AS BYTE PTR ' b = VARPTR(SockInfo.sin_addr.s_addr) 'return IP address of connection ' PRINT #hDbg, "ipAddress=" + USING$("#_.#_.#_.#", @b, @b[1], @b[2], @b[3]) IF cconnect( SSLsocket, SockInfo, SIZEOF(SockInfo) ) = %SOCKET_ERROR THEN PRINT #hDbg, "**** Error:" + STR$(WSAGetLastError()) + " connecting to" + TRIM$(pszServerName) CALL closesocket(SSLsocket) DisplayWinSockError( WSAGetLastError() ) FUNCTION = WSAGetLastError() EXIT FUNCTION END IF IF %fUseProxy THEN sMessage = "CONNECT " + TRIM$(pszServerName) + ":" + _ FORMAT$(iPortNumber) + " HTTP/1.0" + $CRLF + "User-Agent: webclient" +$CRLF+$CRLF + $NUL ' Send message to proxy server IF ssend( SSLsocket, STRPTR(sMessage), LEN(sMessage), 0 ) = %SOCKET_ERROR THEN PRINT #hDbg, "**** Error:" + STR$(WSAGetLastError()) + " sending message to proxy" DisplayWinSockError( WSAGetLastError() ) FUNCTION = WSAGetLastError() EXIT FUNCTION END IF ' Receive message from proxy server sMessage = NUL$(200) cbMessage = rrecv( SSLsocket, STRPTR(sMessage), LEN(sMessage), 0) IF cbMessage = %SOCKET_ERROR THEN PRINT #hDbg, "**** Error:" + STR$(WSAGetLastError()) + " receiving message from proxy" DisplayWinSockError( WSAGetLastError() ) FUNCTION = WSAGetLastError() EXIT FUNCTION END IF ' this code is limited. In normal use it should continue to receive until CRLF CRLF is received END IF FUNCTION = %SEC_E_OK ' PRINT #hDbg, "1 SSLsocket=" + STR$(SSLsocket) END FUNCTION '/*****************************************************************************/ FUNCTION DisconnectFromServer( SSLsocket AS DWORD, BYVAL phCreds AS CredHandle PTR, BYVAL phContext AS CtxtHandle PTR ) AS LONG LOCAL pbMessage AS BYTE PTR LOCAL cbData AS LONG LOCAL dwType, dwSSPIFlags, dwSSPIOutFlags, cbMessage, SecStatus AS DWORD LOCAL OutBuffer AS SecBufferDesc LOCAL OutBuffers() AS SecBuffer LOCAL tsExpiry AS QUAD ' TimeStamp DIM OutBuffers(0) dwType = %SCHANNEL_SHUTDOWN ' 1 - NOTIFY schannel that we are about TO CLOSE the connection. OutBuffers(0).pvBuffer = VARPTR(dwType) OutBuffers(0).BufferType = %SECBUFFER_TOKEN OutBuffers(0).cbBuffer = SIZEOF(dwType) OutBuffer.cBuffers = 1 OutBuffer.pBuffers = VARPTR(OutBuffers(0)) OutBuffer.ulVersion = %SECBUFFER_VERSION ' PRINT #hDbg, "OutBuffer.pBuffers=" + STR$(OutBuffer.pBuffers) CALL DWORD @gpSSPI.ApplyControlToken USING ApplyControlToken( phContext, VARPTR(OutBuffer) ) TO SecStatus IF SecStatus < 0 THEN PRINT #hDbg, "**** Error:" + STR$(SecStatus) + " returned by ApplyControlToken" GOTO cleanup END IF '- Build an SSL CLOSE NOTIFY message. dwSSPIFlags = %ISC_REQ_SEQUENCE_DETECT OR %ISC_REQ_REPLAY_DETECT OR %ISC_REQ_CONFIDENTIALITY OR _ %ISC_RET_EXTENDED_ERROR OR %ISC_REQ_ALLOCATE_MEMORY OR %ISC_REQ_STREAM OutBuffers(0).pvBuffer = %NULL OutBuffers(0).BufferType = %SECBUFFER_TOKEN OutBuffers(0).cbBuffer = 0 OutBuffer.cBuffers = 1 OutBuffer.pBuffers = VARPTR(OutBuffers(0)) OutBuffer.ulVersion = %SECBUFFER_VERSION CALL DWORD @gpSSPI.InitializeSecurityContextA USING InitializeSecurityContext( _ phCreds, _ ' PCredHandle phCredential ' Cred to base context phContext, _ ' PCtxtHandle phContext ' Existing context (OPT) %NULL, _ ' SEC_WCHAR SEC_FAR * pszTargetName ' Name of target dwSSPIFlags, _ ' unsigned long fContextReq ' Context Requirements 0, _ ' unsigned long Reserved1 ' Reserved, MBZ %SECURITY_NATIVE_DREP, _ ' unsigned long TargetDataRep ' Data rep of target %NULL, _ ' PSecBufferDesc pInput ' Input Buffers 0, _ ' unsigned long Reserved2 ' Reserved, MBZ phContext, _ ' PCtxtHandle phNewContext ' (out) New Context handle VARPTR(OutBuffer), _ ' PSecBufferDesc pOutput ' (inout) Output Buffers VARPTR(dwSSPIOutFlags), _' unsigned long SEC_FAR * pfContextAttr ' (out) Context attrs VARPTR(tsExpiry) ) _ ' PTimeStamp ptsExpiry ' (out) Life span (OPT) TO SecStatus IF SecStatus < 0 THEN PRINT #hDbg, "**** Error:" + STR$(SecStatus) + " returned by InitializeSecurityContext" GOTO cleanup END IF pbMessage = OutBuffers(0).pvBuffer cbMessage = OutBuffers(0).cbBuffer '- Send the close notify message to the server. IF pbMessage <> %NULL AND cbMessage <> 0 THEN cbData = ssend( SSLsocket, pbMessage, cbMessage, 0 ) IF cbData = %SOCKET_ERROR OR cbData = 0 THEN SecStatus = WSAGetLastError() PRINT #hDbg, "**** Error:" + STR$(SecStatus) + " sending close notify" DisplayWinSockError( WSAGetLastError() ) GOTO cleanup END IF PRINT #hDbg, "Sending Close Notify" PRINT #hDbg, STR$(cbData) + " bytes of handshake data sent" IF %fVerbose THEN PRINT #hDbg, HexDump(cbData, pbMessage) + $CRLF CALL DWORD @gpSSPI.FreeContextBuffer USING FreeContextBuffer(pbMessage) ' Free OUTPUT buffer. END IF cleanup: CALL DWORD @gpSSPI.DeleteSecurityContext USING DeleteSecurityContext(phContext) ' Free the security context. CALL closesocket(SSLsocket) ' Close the socket. FUNCTION = SecStatus ' PRINT #hDbg, "FUNCTION = SecStatus=" + STR$(SecStatus) END FUNCTION '/*****************************************************************************/ FUNCTION GetNewClientCredentials( BYVAL phCreds AS CredHandle PTR, BYVAL phContext AS CtxtHandle PTR ) AS LONG ' This sample code maintains a single credential handle, replacing it as necessary. This is a little ' unusual. Many applications maintain a global credential handle that's anonymous (ie it doesn't ' contain a CLIENT certificate), which is used to connect to all servers. If a particular server ' should require client authentication, then a new credential is created for use when connecting to that ' SERVER. The global anonymous credential is retained for future connections to other servers. ' maintaining a single anonymous credential that's used whenever possible is most efficient, since ' creating new credentials all the time is rather expensive. LOCAL hCreds AS CredHandle LOCAL IssuerListInfo AS SecPkgContext_IssuerListInfoEx LOCAL FindByIssuerPara AS CERT_CHAIN_FIND_BY_ISSUER_PARA LOCAL ChainContext AS CERT_CHAIN_CONTEXT LOCAL pChainContext AS CERT_CHAIN_CONTEXT PTR LOCAL CertContext AS CERT_CONTEXT LOCAL pCertContext AS CERT_CONTEXT PTR LOCAL SecStatus AS LONG ' SECURITY_STATUS LOCAL tsExpiry AS QUAD ' TimeStamp LOCAL zTemp AS ASCIIZ * 64 LOCAL pszPackage AS ASCIIZ * 64 ' "Microsoft Unified Security Protocol Provider" pChainContext = VARPTR(ChainContext) pCertContext = VARPTR(CertContext) '- Read list of trusted issuers from schannel. CALL DWORD @gpSSPI.QueryContextAttributesA USING QueryContextAttributes( _ phContext, _ ' PCtxtHandle phContext ' Context to query %SECPKG_ATTR_ISSUER_LIST_EX, _ ' unsigned long ulAttribute ' Attribute to query VARPTR(IssuerListInfo) ) _ ' void SEC_FAR * pBuffer ' Buffer for attributes TO SecStatus IF SecStatus <> %SEC_E_OK THEN PRINT #hDbg, "**** Error:" + STR$(SecStatus) + " querying issuer list info" EXIT FUNCTION END IF '- Enumerate the CLIENT certificates. zTemp = $szOID_PKIX_KP_CLIENT_AUTH ' "1.3.6.1.5.5.7.3.2" FindByIssuerPara.cbSize = SIZEOF(FindByIssuerPara) FindByIssuerPara.pszUsageIdentifier = VARPTR(zTemp) FindByIssuerPara.dwKeySpec = 0 FindByIssuerPara.cIssuer = IssuerListInfo.cIssuers FindByIssuerPara.rgIssuer = IssuerListInfo.aIssuers pChainContext = %NULL DO ' Find a certificate chain. pChainContext = CertFindChainInStore( ghMyCertStore, _ ' in HCERTSTORE hCertStore %X509_ASN_ENCODING, _ ' in DWORD dwCertEncodingType 0, _ ' in DWORD dwFindFlags %CERT_CHAIN_FIND_BY_ISSUER, _ ' in DWORD dwFindType FindByIssuerPara, _ ' in const void *pvFindPara ChainContext ) ' in PCCERT_CHAIN_CONTEXT pPrevChainContext IF pChainContext = 0 THEN PRINT #hDbg, "**** Error:" + STR$(GetLastError()) + " finding cert chain" EXIT DO END IF PRINT #hDbg, "ncertificate chain found" '- Get pointer to leaf certificate context. pCertContext = @pChainContext.@rgpChain.@rgpElement.pCertContext '- Create schannel credential. gSchannelCred.dwVersion = %SCHANNEL_CRED_VERSION gSchannelCred.cCreds = 1 gSchannelCred.paCred = VARPTR(pCertContext) pszPackage = $UNISP_NAME_A + CHR$(0) ' gpSSPI.AcquireCredentialsHandleA CALL DWORD @gpSSPI.AcquireCredentialsHandleA USING AcquireCredentialsHandle( _ %NULL, _ ' SEC_CHAR SEC_FAR * pszPrincipal // Name of principal VARPTR(pszPackage), _ ' SEC_CHAR SEC_FAR * pszPackage // Name of package %SECPKG_CRED_OUTBOUND, _ ' unsigned long fCredentialUse // Flags indicating use %NULL, _ ' void SEC_FAR * pvLogonId // Pointer to logon ID VARPTR(gSchannelCred), _ ' void SEC_FAR * pAuthData // Package specific data %NULL, _ ' SEC_GET_KEY_FN pGetKeyFn // Pointer to GetKey() func %NULL, _ ' void SEC_FAR * pvGetKeyArgument // Value to pass to GetKey() phCreds, _ ' PCredHandle phCredential // (out) Cred Handle VARPTR(tsExpiry) ) _ ' PTimeStamp ptsExpiry TO SecStatus ' IF SecStatus <> %SEC_E_OK THEN PRINT #hDbg, "**** Error:" + STR$(SecStatus) + " returned by AcquireCredentialsHandle" ITERATE ' try again END IF ' PRINT #hDbg, "new schannel credential created" CALL DWORD @gpSSPI.FreeCredentialHandle USING FreeCredentialsHandle(phCreds) ' Destroy the old credentials. EXIT DO LOOP END FUNCTION '/*****************************************************************************/ FUNCTION ClientHandshakeLoop( BYVAL SSLsocket AS DWORD, _ ' IN BYVAL phCreds AS CredHandle PTR, _ ' IN phContext AS DWORD, _ ' IN / OUT BYVAL fDoRead AS LONG, _ ' IN BYVAL pExtraData AS SecBuffer PTR ) AS LONG ' OUT SECURITY_STATUS LOCAL OutBuffer, InBuffer AS SecBufferDesc LOCAL InBuffers(), OutBuffers() AS SecBuffer LOCAL cbData AS LONG LOCAL dwSSPIFlags, dwSSPIOutFlags, cbIoBuffer AS DWORD LOCAL tsExpiry AS QUAD ' TimeStamp LOCAL scRet AS LONG ' SECURITY_STATUS LOCAL sIoBuffer AS STRING LOCAL pIoBuffer, pFrom AS BYTE PTR dwSSPIFlags = %ISC_REQ_SEQUENCE_DETECT OR %ISC_REQ_REPLAY_DETECT OR %ISC_REQ_CONFIDENTIALITY OR _ %ISC_RET_EXTENDED_ERROR OR %ISC_REQ_ALLOCATE_MEMORY OR %ISC_REQ_STREAM DIM InBuffers(2) DIM OutBuffers(1) '- Allocate DATA buffer. sIoBuffer = NUL$( %IO_BUFFER_SIZE ) ' application defined pIoBuffer = STRPTR(sIoBuffer) '- Loop until the handshake is finished or an error occurs. scRet = %SEC_I_CONTINUE_NEEDED WHILE( scRet = %SEC_I_CONTINUE_NEEDED OR _ scRet = %SEC_E_INCOMPLETE_MESSAGE OR _ scRet = %SEC_I_INCOMPLETE_CREDENTIALS ) ' PRINT #hDbg, "Handshake Loop:" IF cbIoBuffer = 0 OR scRet = %SEC_E_INCOMPLETE_MESSAGE THEN ' READ DATA FROM SERVER. IF fDoRead THEN cbData = rrecv(SSLsocket, pIoBuffer + cbIoBuffer, %IO_BUFFER_SIZE - cbIoBuffer, 0 ) IF cbData = %SOCKET_ERROR THEN PRINT #hDbg, "**** Error:" + STR$(WSAGetLastError()) + " reading data from server" scRet = %SEC_E_INTERNAL_ERROR EXIT LOOP ELSEIF cbData = 0 THEN PRINT #hDbg, "**** Server unexpectedly disconnected" scRet = %SEC_E_INTERNAL_ERROR EXIT LOOP END IF PRINT #hDbg, STR$(cbData) + " bytes of handshake data received" IF %fVerbose THEN PRINT #hDbg, HexDump(cbData, pIoBuffer + cbIoBuffer) + $CRLF cbIoBuffer = cbIoBuffer + cbData ELSE fDoRead = 1 ' %TRUE END IF END IF '- Set up the input buffers. buffer 0 is used to pass in data received from the server. ' schannel will consume some or all of this. leftover data (if any) will be placed in ' buffer 1 and given a buffer type OF %SECBUFFER_EXTRA. InBuffers(0).pvBuffer = pIoBuffer InBuffers(0).cbBuffer = cbIoBuffer InBuffers(0).BufferType = %SECBUFFER_TOKEN InBuffers(1).pvBuffer = %NULL InBuffers(1).cbBuffer = 0 InBuffers(1).BufferType = %SECBUFFER_EMPTY InBuffer.cBuffers = 2 InBuffer.pBuffers = VARPTR(InBuffers(0)) InBuffer.ulVersion = %SECBUFFER_VERSION '- Setup output buffers. initialized TO %NULL to reduce attempts to free random garbage later. OutBuffers(0).pvBuffer = %NULL OutBuffers(0).BufferType = %SECBUFFER_TOKEN OutBuffers(0).cbBuffer = 0 OutBuffer.cBuffers = 1 OutBuffer.pBuffers = VARPTR(OutBuffers(0)) OutBuffer.ulVersion = %SECBUFFER_VERSION '- PRINT #hDbg, "CALL InitializeSecurityContext." CALL DWORD @gpSSPI.InitializeSecurityContextA USING InitializeSecurityContext( _ phCreds, _ ' PCredHandle phCredential ' Cred to base context phContext, _ ' PCtxtHandle phContext ' Existing context (OPT) %NULL, _ ' SEC_WCHAR SEC_FAR * pszTargetName ' Name of target dwSSPIFlags, _ ' unsigned long fContextReq ' Context Requirements 0, _ ' unsigned long Reserved1 ' Reserved, MBZ %SECURITY_NATIVE_DREP, _ ' unsigned long TargetDataRep ' Data rep of target VARPTR(InBuffer), _ ' PSecBufferDesc pInput ' Input Buffers 0, _ ' unsigned long Reserved2 ' Reserved, MBZ %NULL, _ ' PCtxtHandle phNewContext ' (out) New Context handle VARPTR(OutBuffer), _ ' PSecBufferDesc pOutput ' (inout) Output Buffers VARPTR(dwSSPIOutFlags), _ ' unsigned long SEC_FAR * pfContextAttr ' (out) Context attrs VARPTR(tsExpiry) ) _ ' PTimeStamp ptsExpiry ' (out) Life span (OPT) TO scRet '- If InitializeSecurityContext was successful, or if the error was one of the special extended ones IF scRet = %SEC_E_OK OR scRet = %SEC_I_CONTINUE_NEEDED OR scRet < 0 AND _ (dwSSPIOutFlags AND %ISC_RET_EXTENDED_ERROR) THEN IF OutBuffers(0).cbBuffer <> 0 AND OutBuffers(0).pvBuffer <> %NULL THEN ' PRINT #hDbg, "Send output buffer to server" cbData = ssend( SSLsocket, OutBuffers(0).pvBuffer, OutBuffers(0).cbBuffer, 0 ) IF cbData = %SOCKET_ERROR OR cbData = 0 THEN PRINT #hDbg, "**** Error:" + STR$(WSAGetLastError()) + " sending data to server (2)" DisplayWinSockError( WSAGetLastError() ) CALL DWORD @gpSSPI.FreeContextBuffer USING FreeContextBuffer(OutBuffers(0).pvBuffer) CALL DWORD @gpSSPI.DeleteSecurityContext USING DeleteSecurityContext(phContext) FUNCTION = %SEC_E_INTERNAL_ERROR EXIT FUNCTION END IF PRINT #hDbg, STR$(cbData) + " bytes of handshake data sent" IF %fVerbose THEN PRINT #hDbg, HexDump(cbData, OutBuffers(0).pvBuffer) + $CRLF CALL DWORD @gpSSPI.FreeContextBuffer USING FreeContextBuffer(OutBuffers(0).pvBuffer) ' Free OUTPUT buffer. OutBuffers(0).pvBuffer = %NULL END IF END IF '- If InitializeSecurityContext returned %SEC_E_INCOMPLETE_MESSAGE - read more data, try again. IF scRet = %SEC_E_INCOMPLETE_MESSAGE THEN PRINT #hDbg, "InitializeSecurityContext returned %SEC_E_INCOMPLETE_MESSAGE - read more data, try again" ITERATE ' Go around again. END IF '- If InitializeSecurityContext returned %SEC_E_OK, then the handshake completed successfully. IF scRet = %SEC_E_OK THEN ' IF the "extra" buffer contains DATA, this is encrypted application protocol layer stuff. ' It needs TO be saved. The application layer will later decrypt it WITH DecryptMessage. PRINT #hDbg, "Handshake was successful" IF InBuffers(1).BufferType = %SECBUFFER_EXTRA THEN @pExtraData.pvBuffer = LocalAlloc( %LMEM_FIXED, InBuffers(1).cbBuffer ) IF @pExtraData.pvBuffer = 0 THEN PRINT #hDbg, "**** Out of memory (2)" FUNCTION = %SEC_E_INTERNAL_ERROR EXIT FUNCTION END IF pFrom = pIoBuffer + (cbIoBuffer-InBuffers(1).cbBuffer) MoveMemory( @pExtraData.pvBuffer, pFrom, InBuffers(1).cbBuffer ) @pExtraData.cbBuffer = InBuffers(1).cbBuffer @pExtraData.BufferType = %SECBUFFER_TOKEN PRINT #hDbg, STR$(@pExtraData.cbBuffer) + " bytes of app data was bundled with handshake data" ELSE @pExtraData.pvBuffer = %NULL @pExtraData.cbBuffer = 0 @pExtraData.BufferType = %SECBUFFER_EMPTY END IF EXIT LOOP ' Bail out to quit END IF '- Check for fatal error. IF scRet < 0 THEN PRINT #hDbg, "**** Error:" + STR$(scRet) + " returned by InitializeSecurityContext (2)" EXIT LOOP END IF '- If InitializeSecurityContext returned %SEC_I_INCOMPLETE_CREDENTIALS, server just requested client authentication. IF scRet = %SEC_I_INCOMPLETE_CREDENTIALS THEN ' PRINT #hDbg, "server just requested client authentication." ' Busted. The server has requested client authentication and the credential we supplied didn't ' contain a client certificate. This function will read the list of trusted certificate authorities ' ("issuers") that was received from the server and attempt to find a suitable client certificate ' that was issued by one of these. if this function is successful, then we will connect using the ' new certificate. otherwise, we will attempt to connect anonymously (using our current credentials). GetNewClientCredentials( phCreds, phContext ) fDoRead = 0 ' %FALSE scRet = %SEC_I_CONTINUE_NEEDED ITERATE ' Go around again. END IF '- Copy any leftover data from the "extra" buffer, and go around again. IF InBuffers(1).BufferType = %SECBUFFER_EXTRA THEN ' PRINT #hDbg, "Copy any leftover data from the 'extra' buffer, and go around again." pFrom = pIoBuffer + (cbIoBuffer-InBuffers(1).cbBuffer) MoveMemory( pIoBuffer, pFrom, InBuffers(1).cbBuffer ) cbIoBuffer = InBuffers(1).cbBuffer ELSE ' PRINT #hDbg, "cbIoBuffer = 0" cbIoBuffer = 0 END IF WEND '- Delete the security context in the case of a fatal error. IF scRet < 0 THEN ' PRINT #hDbg, "Delete the security context" CALL DWORD @gpSSPI.DeleteSecurityContext USING DeleteSecurityContext(phContext) CALL LocalFree(pIoBuffer) END IF FUNCTION = scRet ' END FUNCTION '/*****************************************************************************/ FUNCTION PerformClientHandshake( SSLsocket AS DWORD, _ ' IN BYVAL phCreds AS CredHandle PTR, _ ' IN pszServerName AS ASCIIZ, _ ' IN BYVAL phContext AS CtxtHandle PTR, _ ' IN BYVAL pExtraData AS SecBuffer PTR ) AS LONG ' OUT SECURITY_STATUS LOCAL cbData AS LONG LOCAL dwSSPIFlags, dwSSPIOutFlags AS DWORD LOCAL tsExpiry AS QUAD ' TimeStamp LOCAL scRet AS LONG ' SECURITY_STATUS LOCAL OutBuffer AS SecBufferDesc LOCAL OutBuffers() AS SecBuffer DIM OutBuffers(0) dwSSPIFlags = %ISC_REQ_SEQUENCE_DETECT OR %ISC_REQ_REPLAY_DETECT OR %ISC_REQ_CONFIDENTIALITY OR _ %ISC_RET_EXTENDED_ERROR OR %ISC_REQ_ALLOCATE_MEMORY OR %ISC_REQ_STREAM '- Initiate a ClientHello message AND generate a token. OutBuffers(0).pvBuffer = %NULL OutBuffers(0).BufferType = %SECBUFFER_TOKEN OutBuffers(0).cbBuffer = 0 OutBuffer.cBuffers = 1 OutBuffer.pBuffers = VARPTR(OutBuffers(0)) OutBuffer.ulVersion = %SECBUFFER_VERSION ' PRINT #hDbg, "phContext=" + STR$(phContext) CALL DWORD @gpSSPI.InitializeSecurityContextA USING InitializeSecurityContext( _ phCreds, _ ' PCredHandle phCredential ' Cred to base context %NULL, _ ' PCtxtHandle phContext ' Existing context (OPT) VARPTR(pszServerName), _ ' SEC_WCHAR SEC_FAR * pszTargetName ' Name of target dwSSPIFlags, _ ' unsigned long fContextReq ' Context Requirements 0, _ ' unsigned long Reserved1 ' Reserved, MBZ %SECURITY_NATIVE_DREP, _ ' unsigned long TargetDataRep ' Data rep of target %NULL, _ ' PSecBufferDesc pInput ' Input Buffers 0, _ ' unsigned long Reserved2 ' Reserved, MBZ phContext, _ ' PCtxtHandle phNewContext ' (out) New Context handle VARPTR(OutBuffer), _ ' PSecBufferDesc pOutput ' (inout) Output Buffers VARPTR(dwSSPIOutFlags), _ ' unsigned long SEC_FAR * pfContextAttr ' (out) Context attrs VARPTR(tsExpiry) ) _ ' PTimeStamp ptsExpiry ' (out) Life span (OPT) TO scRet IF scRet <> %SEC_I_CONTINUE_NEEDED THEN PRINT #hDbg, "**** Error:" + STR$(scRet) + " returned by InitializeSecurityContext (1)" FUNCTION = scRet EXIT FUNCTION END IF ' PRINT #hDbg, HexDump(OutBuffers(0).cbBuffer, OutBuffers(0).pvBuffer) '- Send response to server if there is one. IF OutBuffers(0).cbBuffer <> 0 AND OutBuffers(0).pvBuffer <> %NULL THEN ' cbData = ssend( SSLsocket, OutBuffers(0).pvBuffer, OutBuffers(0).cbBuffer, 0 ) ' IF cbData = %SOCKET_ERROR OR cbData = 0 THEN PRINT #hDbg, "**** Error:" + STR$(WSAGetLastError()) + " sending data to server (1)" CALL DWORD @gpSSPI.FreeContextBuffer USING FreeContextBuffer(OutBuffers(0).pvBuffer) CALL DWORD @gpSSPI.DeleteSecurityContext USING DeleteSecurityContext(phContext) FUNCTION = %SEC_E_INTERNAL_ERROR EXIT FUNCTION END IF PRINT #hDbg, STR$(cbData) + " bytes of handshake data sent" IF %fVerbose THEN PRINT #hDbg, HexDump(cbData, OutBuffers(0).pvBuffer) + $CRLF CALL DWORD @gpSSPI.FreeContextBuffer USING FreeContextBuffer(OutBuffers(0).pvBuffer) ' Free OUTPUT buffer. OutBuffers(0).pvBuffer = %NULL END IF FUNCTION = ClientHandshakeLoop( SSLsocket, phCreds, phContext, %TRUE, pExtraData ) END FUNCTION '/*****************************************************************************/ FUNCTION EncryptSend( BYVAL SSLsocket AS DWORD, _ ' IN BYVAL phContext AS CtxtHandle PTR, _ ' IN BYREF Sizes AS SecPkgContext_StreamSizes, _ ' IN BYVAL pbIoBuffer AS DWORD, _ ' IN BYVAL sBuffer AS STRING _ ' IN ) AS LONG ' OUT SECURITY_STATUS ' http://msdn.microsoft.com/en-us/library/aa375378(VS.85).aspx ' The encrypted message is encrypted IN place, overwriting the original contents OF its buffer. LOCAL cbData AS LONG LOCAL cbMessage AS DWORD LOCAL scRet AS LONG ' SECURITY_STATUS LOCAL Message AS SecBufferDesc ' unsigned LONG cbBuffer ' SIZE OF the buffer, IN bytes LOCAL Buffers() AS SecBuffer ' unsigned LONG BufferType ' TYPE OF the buffer (below) LOCAL pbMessage AS BYTE PTR ' void SEC_FAR * pvBuffer ' POINTER TO the buffer DIM Buffers(3) pbMessage = pbIoBuffer + Sizes.cbHeader ' message Offset by "header size" POKE$ pbMessage, sBuffer ' message begins after the header cbMessage = LEN(sBuffer) PRINT #hDbg, "Sending" + STR$(cbMessage) + " bytes of plaintext:" PRINT #hDbg, TextDump(cbMessage, pbMessage) IF %fVerbose THEN PRINT #hDbg, HexDump(cbMessage, pbMessage) + $CRLF '- Encrypt the HTTP request. Buffers(0).pvBuffer = pbIoBuffer ' Pointer to buffer 1 Buffers(0).cbBuffer = Sizes.cbHeader ' length of header Buffers(0).BufferType = %SECBUFFER_STREAM_HEADER ' Type of the buffer Buffers(1).pvBuffer = pbMessage ' Pointer to buffer 2 Buffers(1).cbBuffer = cbMessage ' length of the message Buffers(1).BufferType = %SECBUFFER_DATA ' Type of the buffer Buffers(2).pvBuffer = pbMessage + cbMessage ' Pointer to buffer 3 Buffers(2).cbBuffer = Sizes.cbTrailer ' length of the trailor Buffers(2).BufferType = %SECBUFFER_STREAM_TRAILER ' Type of the buffer Buffers(3).pvBuffer = %SECBUFFER_EMPTY ' Pointer to buffer 4 Buffers(3).cbBuffer = %SECBUFFER_EMPTY ' length of buffer 4 Buffers(3).BufferType = %SECBUFFER_EMPTY ' Type of the buffer 4 Message.ulVersion = %SECBUFFER_VERSION ' Version number Message.cBuffers = 4 ' Number of buffers - must contain four SecBuffer structures. Message.pBuffers = VARPTR(Buffers(0)) ' Pointer to array of buffers CALL DWORD @gpSSPI.EncryptMessage USING EncryptMessage( phContext, 0, Message, 0 ) TO scRet ' must contain four SecBuffer structures. IF scRet < 0 THEN PRINT #hDbg, "**** Error" + STR$(scRet) + " returned by EncryptMessage" FUNCTION = scRet EXIT FUNCTION END IF '- SEND the encrypted DATA TO the SERVER. LEN flags cbData = ssend( SSLsocket, pbIoBuffer, Buffers(0).cbBuffer + Buffers(1).cbBuffer + Buffers(2).cbBuffer, 0 ) IF cbData = %SOCKET_ERROR OR cbData = 0 THEN PRINT #hDbg, "**** Error" + STR$(WSAGetLastError()) + " sending data to server" FUNCTION = %SEC_E_INTERNAL_ERROR EXIT FUNCTION ELSE PRINT #hDbg, STR$(cbData) + " bytes of encrypted data sent" IF %fVerbose THEN PRINT #hDbg, HexDump(cbData, pbIoBuffer) + $CRLF END IF FUNCTION = cbData ' END FUNCTION '/*****************************************************************************/ FUNCTION ReadDecrypt( BYVAL SSLsocket AS DWORD, _ ' IN BYVAL phCreds AS CredHandle PTR, _ ' IN BYVAL phContext AS CtxtHandle PTR, _ ' IN BYVAL pbIoBuffer AS DWORD, _ ' IN BYREF cbIoBufferLength AS DWORD, _ ' IN BYREF sBuffer AS STRING _ ' OUT ) AS LONG ' OUT SECURITY_STATUS ' calls rrecv() - blocking socket READ ' http://msdn.microsoft.com/en-us/library/ms740121(VS.85).aspx ' The encrypted message is decrypted IN place, overwriting the original contents OF its buffer. ' http://msdn.microsoft.com/en-us/library/aa375211(VS.85).aspx LOCAL ExtraBuffer AS SecBuffer LOCAL pDataBuffer, pExtraBuffer AS SecBuffer PTR LOCAL scRet AS LONG ' SECURITY_STATUS LOCAL Message AS SecBufferDesc LOCAL Buffers() AS SecBuffer LOCAL cbData AS LONG LOCAL cbIoBuffer, length AS DWORD LOCAL pBuff AS BYTE PTR LOCAL i AS LONG DIM Buffers(3) sBuffer = "" ' Reset the buffer '- Read data from server until done. cbIoBuffer = 0 scRet = 0 DO '- READ some DATA. IF cbIoBuffer = 0 OR scRet = %SEC_E_INCOMPLETE_MESSAGE THEN ' GET the DATA cbData = rrecv( SSLsocket, pbIoBuffer+cbIoBuffer, cbIoBufferLength - cbIoBuffer, 0 ) IF cbData = %SOCKET_ERROR THEN PRINT #hDbg, "**** Error" + STR$(WSAGetLastError()) + " reading data from server" scRet = %SEC_E_INTERNAL_ERROR EXIT LOOP ELSEIF cbData = 0 THEN ' SERVER disconnected. IF cbIoBuffer THEN PRINT #hDbg, "**** Server unexpectedly disconnected" scRet = %SEC_E_INTERNAL_ERROR FUNCTION = scRet EXIT FUNCTION ELSE EXIT LOOP ' ALL Done END IF ELSE ' success PRINT #hDbg, STR$(cbData) + " bytes of (encrypted) application data received" IF %fVerbose THEN PRINT #hDbg, HexDump(cbData, pbIoBuffer+cbIoBuffer) + $CRLF cbIoBuffer = cbIoBuffer + cbData ' PRINT #hDbg, "cbIoBuffer=" + STR$(cbIoBuffer) END IF END IF '- Decrypt the received DATA. Buffers(0).pvBuffer = pbIoBuffer Buffers(0).cbBuffer = cbIoBuffer Buffers(0).BufferType = %SECBUFFER_DATA ' Initial TYPE OF the buffer 1 Buffers(1).BufferType = %SECBUFFER_EMPTY ' Initial TYPE OF the buffer 2 Buffers(2).BufferType = %SECBUFFER_EMPTY ' Initial TYPE OF the buffer 3 Buffers(3).BufferType = %SECBUFFER_EMPTY ' Initial TYPE OF the buffer 4 Message.ulVersion = %SECBUFFER_VERSION ' Version number Message.cBuffers = 4 ' Number of buffers - must contain four SecBuffer structures. Message.pBuffers = VARPTR(Buffers(0)) ' POINTER TO ARRAY OF buffers CALL DWORD @gpSSPI.DecryptMessage USING DecryptMessage( phContext, Message, 0, %NULL ) TO scRet IF scRet = %SEC_I_CONTEXT_EXPIRED THEN EXIT LOOP ' SERVER signalled END OF session ' IF scRet = %SEC_E_INCOMPLETE_MESSAGE - INPUT buffer has partial encrypted record, READ more IF scRet <> %SEC_E_OK AND scRet <> %SEC_I_RENEGOTIATE AND scRet <> %SEC_I_CONTEXT_EXPIRED THEN PRINT #hDbg, "**** DecryptMessage" DisplaySECError(scRet) FUNCTION = scRet EXIT FUNCTION END IF ' '- Locate DATA AND (OPTIONAL) extra buffers. pDataBuffer = 0 pExtraBuffer = 0 FOR i = 1 TO 4 IF pDataBuffer = 0 AND Buffers(i).BufferType = %SECBUFFER_DATA THEN pDataBuffer = VARPTR(Buffers(i)) IF pExtraBuffer = 0 AND Buffers(i).BufferType = %SECBUFFER_EXTRA THEN pExtraBuffer = VARPTR(Buffers(i)) NEXT '- Display the decrypted data. IF pDataBuffer THEN length = @pDataBuffer.cbBuffer IF length THEN ' Check if last two chars are CR LF pBuff = @pDataBuffer.pvBuffer ' PRINT #hDbg, "n-2= %d, n-1= %d \n", pBuff(length-2), pBuff(length-1) ) PRINT #hDbg, "Decrypted data: " + STR$(length) + " bytes" : PRINT #hDbg, TextDump( length, pBuff ) IF %fVerbose THEN PRINT #hDbg, HexDump(length, pBuff) + $CRLF sBuffer = sBuffer + PEEK$( pBuff, length ) ' Add reply IF @pBuff[length-2] = 13 AND @pBuff[length-1] = 10 THEN EXIT LOOP ' PRINT #hDbg, "Found CRLF" END IF END IF '- Move ANY "extra" DATA TO the INPUT buffer. IF pExtraBuffer THEN MoveMemory( pbIoBuffer, @pExtraBuffer.pvBuffer, @pExtraBuffer.cbBuffer ) cbIoBuffer = @pExtraBuffer.cbBuffer ' PRINT #hDbg, "cbIoBuffer= %d \n", cbIoBuffer) ELSE cbIoBuffer = 0 END IF '- The server wants to perform another handshake sequence. IF scRet = %SEC_I_RENEGOTIATE THEN PRINT #hDbg, "Server requested renegotiate!" scRet = ClientHandshakeLoop( SSLsocket, phCreds, phContext, %FALSE, VARPTR(ExtraBuffer) ) IF scRet <> %SEC_E_OK THEN FUNCTION = scRet : EXIT FUNCTION IF ExtraBuffer.pvBuffer THEN ' Move ANY "extra" DATA TO the INPUT buffer. MoveMemory( pbIoBuffer, ExtraBuffer.pvBuffer, ExtraBuffer.cbBuffer ) cbIoBuffer = ExtraBuffer.cbBuffer END IF END IF LOOP ' LOOP till CRLF is found at the end of the data FUNCTION = %SEC_E_OK END FUNCTION '/*****************************************************************************/ FUNCTION SMTPsession( BYVAL SSLsocket AS DWORD, _ ' IN BYVAL phCreds AS CredHandle PTR, _ ' IN BYVAL phContext AS CtxtHandle PTR _ ' IN ) AS LONG ' OUT SECURITY_STATUS LOCAL Sizes AS SecPkgContext_StreamSizes LOCAL scRet AS LONG ' SECURITY_STATUS LOCAL cbData AS LONG LOCAL cbIoBufferLength AS DWORD LOCAL sIoBuffer, sTemp, sRequest, sResponse AS STRING LOCAL pIoBuffer, pFrom AS BYTE PTR '- READ stream encryption properties. CALL DWORD @gpSSPI.QueryContextAttributesA USING QueryContextAttributes( phContext, %SECPKG_ATTR_STREAM_SIZES, VARPTR(Sizes) ) TO scRet IF scRet <> %SEC_E_OK THEN PRINT #hDbg, "**** Error" + STR$(scRet) + " reading SECPKG_ATTR_STREAM_SIZES" FUNCTION = scRet EXIT FUNCTION END IF ' PRINT #hDbg, "scRet=" + STR$(scRet) '- CREATE a buffer. cbIoBufferLength = Sizes.cbHeader + Sizes.cbMaximumMessage + Sizes.cbTrailer sIoBuffer = NUL$(cbIoBufferLength) pIoBuffer = STRPTR(sIoBuffer) '- Receive a Response scRet = ReadDecrypt( SSLsocket, phCreds, phContext, pIoBuffer, cbIoBufferLength, sTemp ) IF scRet <> %SEC_E_OK THEN FUNCTION = scRet : EXIT FUNCTION '- SEND a request, must be < maximum message SIZE sTemp = "EHLO " + $CRLF cbData = EncryptSend( SSLsocket, phContext, Sizes, pIoBuffer, sTemp ) IF cbData = %SEC_E_INTERNAL_ERROR THEN FUNCTION = cbData : EXIT FUNCTION '- Receive a Response scRet = ReadDecrypt( SSLsocket, phCreds, phContext, pIoBuffer, cbIoBufferLength, sTemp ) IF scRet <> %SEC_E_OK THEN FUNCTION = scRet : EXIT FUNCTION ' authentication and email send go here '- SEND a request, must be < maximum message SIZE sTemp = "QUIT " + $CRLF cbData = EncryptSend( SSLsocket, phContext, Sizes, pIoBuffer, sTemp ) IF cbData = %SEC_E_INTERNAL_ERROR THEN FUNCTION = cbData : EXIT FUNCTION '- Receive a Response scRet = ReadDecrypt( SSLsocket, phCreds, phContext, pIoBuffer, cbIoBufferLength, sTemp ) IF scRet <> %SEC_E_OK THEN FUNCTION = scRet FUNCTION = %SEC_E_OK END FUNCTION '**************************************************************************************** FUNCTION PBMAIN() ' powerbasic WINMAIN() LOCAL RetVal, fCredsInitialized, fContextInitialized AS LONG LOCAL hSecurity, SSLsocket, ghMyCertStore AS DWORD LOCAL sBody, sRet AS STRING LOCAL SecStatus AS LONG ' SECURITY_STATUS LOCAL pszServerName AS ASCIIZ * 255 LOCAL hClientCreds AS CredHandle LOCAL hContext AS CtxtHandle LOCAL wd AS WSADATA LOCAL ExtraData AS SecBuffer LOCAL RemoteCertContext AS CERT_CONTEXT LOCAL pRemoteCertContext AS CERT_CONTEXT PTR hDbg = FREEFILE : OPEN $DEBUG_FILE FOR OUTPUT LOCK SHARED AS hDbg ' PRINT #hDbg, "-------- "+DATE$+" "+TIME$+" ---------" '- Create dispatch table that contains pointers to the functions defined in SSPI.h gpSSPI = InitSecurityInterface() IF gpSSPI = 0 THEN PRINT #hDbg, "Error" + STR$(GetLastError()) = " reading security interface" : GOTO cleanup END IF PRINT #hDbg, "----- SSPI Initialized" '- Create credentials. RetVal = CreateCredentials( $sUser, VARPTR(hClientCreds) ) IF RetVal THEN PRINT #hDbg, "Error creating credentials" GOTO cleanup ' END IF fCredsInitialized = %TRUE ' PRINT #hDbg, "----- Credentials Initialized" '- Initialize the WinSock subsystem. RetVal = WSAStartup(&H101, wd) IF RetVal = %SOCKET_ERROR THEN PRINT #hDbg, "Error" +STR$(GetLastError())+ " returned by WSAStartup" : GOTO cleanup END IF ' PRINT #hDbg, "----- WinSock Initialized" '- Connect to the SERVER SSLsocket = %INVALID_SOCKET ' Default pszServerName = $MailHost IF ConnectToServer( pszServerName, %TCP_PORT, SSLsocket ) THEN PRINT #hDbg, "Error connecting to server" GOTO cleanup ' END IF PRINT #hDbg, "----- Connected To Server" '- Perform handshake IF PerformClientHandshake( SSLsocket, VARPTR(hClientCreds), pszServerName, VARPTR(hContext), VARPTR(ExtraData) ) THEN PRINT #hDbg, "Error performing handshake" GOTO cleanup ' END IF fContextInitialized = %TRUE ' PRINT #hDbg, "----- Client Handshake Performed" '- Authenticate server's credentials. Get server's certificate. pRemoteCertContext = VARPTR(RemoteCertContext) CALL DWORD @gpSSPI.QueryContextAttributesA USING QueryContextAttributes( VARPTR(hContext), _ ' handle to the security context to be queried. %SECPKG_ATTR_REMOTE_CERT_CONTEXT, _ ' attribute of the context to be returned. VARPTR(pRemoteCertContext) ) TO SecStatus ' pointer to a structure PTR that receives the attributes IF SecStatus <> %SEC_E_OK THEN PRINT #hDbg, "**** Error" + DisplaySECError(SecStatus) + " querying remote certificate" GOTO cleanup ' END IF PRINT #hDbg, "----- Server Credentials Authenticated " '- Display server certificate chain. DisplayCertChain( pRemoteCertContext, %FALSE ) ' PRINT #hDbg, "----- Certificate Chain Displayed " '- Validate the SERVER certificate. SecStatus = VerifyServerCertificate( pRemoteCertContext, pszServerName, 0 ) IF SecStatus THEN PRINT #hDbg, "**** Error" + DisplaySECError(SecStatus) + " authenticating server credentials!" GOTO cleanup ' END IF ' The server certificate did not validate correctly. at this point, we cannot tell ' if we are connecting to the correct server, or if we are connecting to a ' "man in the middle" attack SERVER - Best TO just abort the connection. PRINT #hDbg, "----- Server Certificate Verified" '- Free the SERVER certificate context. CALL CertFreeCertificateContext(@pRemoteCertContext) pRemoteCertContext = %NULL ' PRINT #hDbg, "----- Server certificate context released " '- Display connection info. DisplayConnectionInfo( VARPTR(hContext) ) ' PRINT #hDbg, "----- Secure Connection Info" '- SEND Request, recover response. LPSTR pszRequest = "EHLO" IF SMTPsession( SSLsocket, VARPTR(hClientCreds), VARPTR(hContext) ) <> %SEC_E_OK THEN PRINT #hDbg, "Error SMTP Session " GOTO cleanup ' END IF PRINT #hDbg, "----- SMTP session Complete " '- SEND a close_notify alert TO the SERVER AND CLOSE down the connection. IF DisconnectFromServer( SSLsocket, VARPTR(hClientCreds), VARPTR(hContext) ) THEN PRINT #hDbg, "Error disconnecting from server" GOTO cleanup END IF fContextInitialized = %FALSE SSLsocket = %INVALID_SOCKET ' PRINT #hDbg, "----- Disconnected From Server" cleanup: ' gpSSPI does not need to be freed PRINT #hDbg, "----- Begin Cleanup" '- Free the SERVER certificate context. IF pRemoteCertContext THEN CertFreeCertificateContext(@pRemoteCertContext) pRemoteCertContext = 0 END IF '- Free SSPI context HANDLE. IF fContextInitialized THEN CALL DWORD @gpSSPI.DeleteSecurityContext USING DeleteSecurityContext(VARPTR(hContext)) fContextInitialized = 0 END IF '- Free SSPI credentials HANDLE. IF fCredsInitialized THEN CALL DWORD @gpSSPI.FreeCredentialHandle USING FreeCredentialsHandle(VARPTR(hClientCreds)) fCredsInitialized = 0 END IF '- Close socket. IF SSLsocket <> %INVALID_SOCKET THEN closesocket(SSLsocket) '- Shutdown WinSock subsystem. WSACleanup() '- Close "MY" certificate store. IF ghMyCertStore THEN CertCloseStore(ghMyCertStore, 0) CALL UnloadSecurityLibrary(hSecurity) PRINT #hDbg, "----- All Done ----- " CLOSE #hDbg MSGBOX "DONE" END FUNCTION '**************************************************************************************** example in powerbasic |