Im stucked with SSL connection... Help?

[Paul Franks]

COM class, .NET class... They look the same in the COm browser.
how can i tell the difference?

If it shows up in PB's COM browser, it's definitely COM. Can't find any docs for it on MSDN, though, but M$ is making if difficult to find anything that's not .NET.

You'll need to produce the .INC file using the COM browser, then see what the actual object name is. That doesn't look right, should be something like Microsoft.xxxxx or MSCrypto.xxxxx or something similar.

[Paul Franks]

Did some searching, looks like M$ has a COM interface to the Win32 CryptoAPI called CAPICOM, which is very old, difficult to use, and being replaced by CNG, which is .NET only.

Also found a COM crypto object for Google Checkout which appears to be much easier to use:

http://code.google.com/apis/checkout/samples/Google_Checkout_Sample_Code_ASP.html

Might help, I don't know for sure...

[Elias Montoya]

No, it doesnt show there. it shows some of the interfaces of mscorlib.dll,
but some of them are "restricted".

Ill see what i can do.

[David Roberts]

With regard to SHA1 I use the MS Crypto APIs directly.

The following is a quick and dirty code rip from a working application which hashes files as opposed to text.

It was thrown together very quickly but it does correctly calculate the Control samples indicated.

With regard to HMAC I had read that there was a leak in the MS HMAC hash object so have reverted to first principles in my own code. I have since read that the bug is in NT4 and Win95.

#COMPILE  EXE
#Register None
#DIM      ALL
#TOOLS    OFF

%NOMMIDS = 1
%NOGDI = 1

#Include "WIN32API.INC"

' ***************************************************************
' Credit to Don Dickinson for the following equates & delarations
 
%HP_HASHSIZE = &h0004
%HP_HASHVAL  = &h0002
%ALG_SID_MD5 = 3
%ALG_SID_SHA1 = 4
%ALG_CLASS_HASH = 32768
%ALG_TYPE_ANY = 0
%CALG_MD5 = %ALG_CLASS_HASH Or %ALG_TYPE_ANY Or %ALG_SID_MD5
%CALG_SHA1 = %ALG_CLASS_HASH Or %ALG_TYPE_ANY Or %ALG_SID_SHA1
%PROV_RSA_FULL = 1
$MS_DEF_PROV = "Microsoft Base Cryptographic Provider v1.0"
%CRYPT_NEWKEYSET = &h00000008

Declare Function crGetDefaultRSAHandle As Long
Declare Function CryptCreateHash Lib "advapi32.dll" Alias "CryptCreateHash" _
      (  ByVal hProv As Long, ByVal iAlgID As Long, ByVal hKey As Long, _
         ByVal dwFlags As Dword, hHash As Long ) As Long
Declare Function CryptDestroyHash Lib "advapi32.dll" Alias "CryptDestroyHash" _
      (  ByVal hHash As Long ) As Long
Declare Function CryptHashData Lib "advapi32.dll" Alias "CryptHashData" _
      (  ByVal hHash As Long, pbData As Any, ByVal dwDatalen As Dword, _
         ByVal dwFlags As Long ) As Long
Declare Function CryptReleaseContext Lib "advapi32.dll" Alias "CryptReleaseContext" _
      (  ByVal hCryptProv As Long, ByVal dwFlags As Dword ) As Long
      
Declare Function CryptAcquireContext Lib "advapi32.dll" Alias "CryptAcquireContextA" _
      (  hCryptProv As Long, zContainer As Asciiz, zProvider As Asciiz, _
         ByVal dwProvType As Dword, ByVal dwFlags As Dword ) As Long

' End of credits
' ******************************************************************************************         

Declare Function CryptGetHashParam Lib "advapi32.dll" Alias "CryptGetHashParam" _
      (  ByVal hHash As Long, ByVal dwParam As Dword, pbData As Any, _
         pdwDataLen As Long, ByVal dwFlags As Long ) As Long         
Declare Function FormatErrMsg( ByVal Long, String) As String

Declare Function CreateHash( Long, Long, Long ) As Long
Declare Function HashText( sText As String) As String

' *********************************
Function PBMain( ) As Long

Local sText As String

MsgBox HashText("abcdbcdecdefdefgefghfghighijhijkijkljklmklmnlmnomnopnopq")

End Function
' *********************************

Function FormatErrMsg( ByVal WinErr As Long, Comment As String ) As String ' Windows Error message
Local Buff  As Asciiz * 64

	Call FormatMessage( %FORMAT_MESSAGE_FROM_SYSTEM, ByVal %Null, WinErr, %Null, Buff, SizeOf( Buff ), ByVal %Null )
	If Len( Buff ) Then
   	Function = "Error" + Str$( WinErr ) + Comment + " : " + Buff
	Else
  	Function = "Unknown error code: " + Str$( WinErr )
	End If

End Function

' Credit to Don Dickinson
' ***********************
Function crGetDefaultRSAHandle As Long

Local hProv                         As Long

  If CryptAcquireContext( hProv, ByVal %Null, ByVal %Null, %PROV_RSA_FULL, 0 ) = %False Then

  '- Create a new key container
  '
  '  This will only be called the first time you
  '  run this program.
  '
    If CryptAcquireContext( hProv, ByVal %Null, $MS_DEF_PROV, %PROV_RSA_FULL, _
    %CRYPT_NEWKEYSET ) = %False Then
      Function = %False
    Else
      Function = hProv
    End If
  Else
    Function = hProv
  End If
End Function
' ***************

Function CreateHash( hProv As Long, Which As Long, hHash As Long ) As Long
  If CryptCreateHash( hProv, Which, 0, 0, hHash ) = %FALSE Then
    CryptReleaseContext hProv, 0
  Else
    Function = %TRUE
  End If
End Function      

Function HashText( sText As String) As String
Local hProv, hhash, hSize, WinErr, i As Long
Dim hText As String
Dim hByte( ) As Byte

hProv = crGetDefaultRSAHandle
If hProv = 0 Then
  WinErr = GetLastError
  MessageBox 0, FormatErrMsg( WinErr, " in HashText routine" ), " HashText", %MB_ICONERROR  Or %MB_APPLMODAL Or %MB_TOPMOST
  Function = "Error"
  Exit Function
End If
If CreateHash( hProv, %CALG_SHA1, hHash ) = %False Then ' Use %CALG_MD5 for, yep, MD5
  WinErr = GetLastError
  MessageBox 0, FormatErrMsg( WinErr, " in HashText routine" ), " HashText", %MB_ICONERROR  Or %MB_APPLMODAL Or %MB_TOPMOST
  Function = "Error"
  Exit Function
End If

If CRYPTHASHDATA( hHash, ByVal StrPtr(sText), Len(sText), 0 ) = %False Then
  WinErr = GetLastError
  MessageBox 0, FormatErrMsg( WinErr, " in HashText routine" ), " HashText", %MB_ICONERROR Or %MB_APPLMODAL Or %MB_TOPMOST
  Function = "Error"
  Exit Function
End If

If CryptGetHashParam( hHash, %HP_HASHSIZE, hSize, 4, 0 ) = %FALSE Then
  WinErr = GetLastError
  MessageBox 0, FormatErrMsg( WinErr, " in HashText routine" ), " HashText", %MB_ICONERROR  Or %MB_APPLMODAL Or %MB_TOPMOST
  Function = "Error"
  Exit Function
End If
ReDim hByte( hSize - 1 ) As Byte
If CryptGetHashParam( hHash, %HP_HASHVAL, hByte( 0 ), hSize, 0 ) = %FALSE Then
  WinErr = GetLastError
  MessageBox 0, FormatErrMsg( WinErr, " in HashText routine" ), " HashText", %MB_ICONERROR  Or %MB_APPLMODAL Or %MB_TOPMOST
  Function = "Error"
  Exit Function
End If
hText = ""
For i = 0 To hSize - 1
  hText = hText + Hex$( hByte( i ),2 )
Next 

CryptDestroyHash hHash
CryptReleaseContext hProv, 0

Function = hText

End Function

[David Roberts]

I've just realised that your code in post #20, Elias, is Semen Matusovski's SHA1 code. That is a lot easier to implement than my code. I don't use %CALG_SHA1 directly - I use WhichHash which may be either %CALG_SHA1 or %CALG_MD5.

> Seems like it computes the SHA1 Hash using some kind of a key

SHA1 doesn't use a key but it may be used in hashing a key?

[David Roberts]

alg1.Key = key
hash1 = alg1.ComputeHash(magicb)

You missed a line out, Elias.

alg1 = HMACSHA1.Create
alg1.Key = key
hash1 = alg1.ComputeHash(magicb)

HMAC uses a key - it authenticates the hash.

A good description of the HMAC algorithm can be found here. It is what I use for HMAC-SHA256 because SHA256 is not in the MS Crypto APIs - as does Eddy Van Esch's HIME library which has SHA1 and HMAC-SHA1.

[Elias Montoya]

Thanx robert, Yes, the HMAC is what is giving me fight, this is helping me a lot
for learning, i didnt know anythins just couple days ago. Now i found some HMAC SHA1 specifications and im writting the routines in PB, well maybe just the HMAC part.

Im guessing i am going to need some pre-computed results to test against the results
of the routines i write.

[David Roberts]

HMAC-SHA1 Test Vectors

In addition you can use my HashFile.exe. You will need to save messages as txt files, or whatever, and then HMAC the file with whatever key you want to use. Keys may be Text or Hex strings.

If you let me have an email address I'll send a zip file - 328KB.

[Elias Montoya]

Sure, its in my signature.

[David Roberts]

Sent.

[Mark Strickland]

May not apply --- but

I quickly read through this thread and may have missed something but if you are stuck on the SSL connection part this may help. If not file it away for future reference.

A "quick and dirty" way to implement an SSL connection is to use STUNNEL (www.stunnel.org). It uses OpenSSL and makes a "regular" TCP connection work like an SSL (HTTPS) connection.

It does not work in every case but it can simplify an SSL connection.

[Elias Montoya]

David, i saw your code at:

http://www.powerbasic.com/support/pbforums/showthread.php?t=24812&highlight=HMAC

The results are not the same in all cases, it is supposed to be the same always, right?

[David Roberts]

> The results are not the same in all cases, it is supposed to be the same always, right?

Yes. Code from the old forum is getting mangled up. The messages had lost any capitalisation so their HMAC values would not be the same.

Go back to the Source Code link, Elias, and use the last two posts.

[Elias Montoya]

These ones work perfect. Mines were a mess!!! Not knowing anything about Encryption
makes it almost impossible!!

Thanx David.

[David Roberts]

Come back POFFS- all is forgiven.

[Paul Franks]

A "quick and dirty" way to implement an SSL connection is to use STUNNEL (www.stunnel.org). It uses OpenSSL and makes a "regular" TCP connection work like an SSL (HTTPS) connection.

It does not work in every case but it can simplify an SSL connection.

Just as easy to use the COM services built into Windows (one of which I showed earlier), or the Windows HTTP Services API:

http://msdn2.microsoft.com/en-us/library/aa384273%28VS.85%29.aspx

No third-party software to install and configure, either.

[Elias Montoya]

No third-party software to install and configure, either.

Hmm i ended up using this: but now i dont know why it is not working, do you see anything wrong?:

FUNCTION WriteSSLPOST(XMLPOST AS STRING) AS STRING

  LOCAL v1 AS VARIANT, v2 AS VARIANT, v3 AS VARIANT
  LOCAL v4 AS VARIANT, v5 AS VARIANT, v6 AS VARIANT
  LOCAL objResultXMLDoc AS DISPATCH

  SET objResultXMLDoc   = CreateObject("Msxml2.DOMDocument")

  ' Post the SOAP message.
  DIM objXMLHTTP AS DISPATCH
  SET objXMLHTTP = CreateObject("Microsoft.XMLHTTP")
  v1 ="post"
  v2 = "https://login.live.com/RST.srf"
  v3 = 0
  OBJECT CALL objXMLHTTP.open(v1, v2, v3)

  v1 = "Content-Type"
  v2 = "text/xml; charset=UTF-8"
  OBJECT CALL objXMLHTTP.setRequestHeader(v1, v2)

  v1 = "Accept"
  v2 = "TEXT/*"
  OBJECT CALL objXMLHTTP.setRequestHeader(v1, v2)

  v1 = "USER-Agent"
  v2 = "Vega"
  OBJECT CALL objXMLHTTP.setRequestHeader(v1, v2)

  v1 = "HOST"
  v2 = "loginnet.passport.com"
  OBJECT CALL objXMLHTTP.setRequestHeader(v1, v2)

  v1 = "Content-Length"
  v2 = FORMAT$(LEN(XMLPOST))
  OBJECT CALL objXMLHTTP.setRequestHeader(v1, v2)

  v1 = "Connection"
  v2 = "Keep-Alive"
  OBJECT CALL objXMLHTTP.setRequestHeader(v1, v2)

  v1 = "Cache-CONTROL"
  v2 = "no-cache"
  OBJECT CALL objXMLHTTP.setRequestHeader(v1, v2)


  SET v1 = XMLPOST
  OBJECT CALL objXMLHTTP.send(v1)

  '-- Save the response to v2
  OBJECT GET objXMLHTTP.ResponseText TO v2

  FUNCTION = VARIANT$(v2)

  ' clean up
  SET objXMLHTTP        = NOTHING
  SET objResultXMLDoc   = NOTHING

END FUNCTION

[Paul Franks]

No, it appears to be working fine, just get "Authentication Error" in the result, assume you're using bogus credentials here.

I pieced together your code from your previous posts, this gets a response in a msgbox. I commented out most the the headers, which probably aren't needed, especially the Content-Length, which M$ will calculate for you...

#COMPILE EXE
#DIM ALL

MACRO CreateObject(id) = NEW DISPATCH IN id

$EmailAddress = "[email protected]"
$Password     = "examplepassword"


'=================================================================
FUNCTION WriteMsnPort(FF AS LONG, TCPLine AS STRING, OPT AsIs AS LONG) AS STRING
 STATIC CurTran AS LONG
 LOCAL Index    AS LONG
 LOCAL Buffer   AS STRING
 LOCAL Answer   AS STRING
 ERRCLEAR
 IF INSTR(TCPLine, "%TRN") THEN
  INCR CurTran
  REPLACE "%TRN" WITH FORMAT$(CurTran) IN TCPLine
 END IF
 IF ISTRUE(VARPTR(AsIs)) THEN
  IF AsIs THEN
   'MSGBOX ">>" & TCPLine
   TCP SEND #FF, TCPLine & $CRLF
  ELSE
   GOTO ByParts
  END IF
 ELSE
  ByParts:
  TcpLine = TcpLine & $CRLF
  FOR Index = 1 TO PARSECOUNT(Tcpline, $CRLF)
   IF ISTRUE(LEN(PARSE$(TCPLine, $CRLF, Index))) THEN
     'msgbox ">>" & PARSE$(TCPLine, $CRLF, Index) & $CRLF
     TCP PRINT #FF, PARSE$(TCPLine, $CRLF, Index)
   END IF
  NEXT Index
 END IF


 Keepreading:
  TCP LINE #FF, Buffer
  Answer = (Answer & Buffer) & $CRLF
  IF EOF(FF) THEN GOTO ReceiveDone
  GOTO KeepReading
 ReceiveDone:

 'MSGBOX "<<" & Answer

 FUNCTION = Answer
END FUNCTION
'=================================================================


FUNCTION XMLSkeleton AS STRING

FUNCTION = _
"<Envelope xmlns=""http://schemas.xmlsoap.org/soap/envelope/""" & $CRLF & _
"   xmlns:wsse=""http://schemas.xmlsoap.org/ws/2003/06/secext""" & $CRLF & _
"   xmlns:saml=""urn:oasis:names:tc:SAML:1.0:assertion""" & $CRLF & _
"   xmlns:wsp=""http://schemas.xmlsoap.org/ws/2002/12/policy""" & $CRLF & _
"   xmlns:wsu=""http://docs.oasis-open.org/wss/2004/01/oasis-200401-wss-wssecurity-utility-1.0.xsd""" & $CRLF & _
"   xmlns:wsa=""http://schemas.xmlsoap.org/ws/2004/03/addressing""" & $CRLF & _
"   xmlns:wssc=""http://schemas.xmlsoap.org/ws/2004/04/sc""" & $CRLF & _
"   xmlns:wst=""http://schemas.xmlsoap.org/ws/2004/04/trust"">" & $CRLF & _
"   <Header>" & $CRLF & _
"       <ps:AuthInfo" & $CRLF & _
"           xmlns:ps=""http://schemas.microsoft.com/Passport/SoapServices/PPCRL""" & $CRLF & _
"           Id=""PPAuthInfo"">" & $CRLF & _
"           <ps:HostingApp>{7108E71A-9926-4FCB-BCC9-9A9D3F32E423}</ps:HostingApp>" & $CRLF & _
"           <ps:BinaryVersion>4</ps:BinaryVersion>" & $CRLF & _
"           <ps:UIVersion>1</ps:UIVersion>" & $CRLF & _
"           <ps:Cookies></ps:Cookies>" & $CRLF & _
"           <ps:RequestParams>AQAAAAIAAABsYwQAAAAxMDMz</ps:RequestParams>" & $CRLF & _
"       </ps:AuthInfo>" & $CRLF & _
"       <wsse:Security>" & $CRLF & _
"           <wsse:UsernameToken Id=""user"">" & $CRLF & _
"               <wsse:Username><<<MyEmailAddress>>></wsse:Username>" & $CRLF & _
"               <wsse:Password><<<MyPassword>>></wsse:Password>" & $CRLF & _
"           </wsse:UsernameToken>" & $CRLF & _
"       </wsse:Security>" & $CRLF & _
"   </Header>" & $CRLF & _
"   <Body>" & $CRLF & _
"       <ps:RequestMultipleSecurityTokens" & $CRLF & _
"           xmlns:ps=""http://schemas.microsoft.com/Passport/SoapServices/PPCRL""" & $CRLF & _
"           Id=""RSTS"">" & $CRLF & _
"           <wst:RequestSecurityToken Id=""RST0"">" & $CRLF & _
"               <wst:RequestType>http://schemas.xmlsoap.org/ws/2004/04/security/trust/Issue</wst:RequestType>" & $CRLF & _
"               <wsp:AppliesTo>" & $CRLF & _
"                   <wsa:EndpointReference>" & $CRLF & _
"                       <wsa:Address>http://Passport.NET/tb</wsa:Address>" & $CRLF & _
"                   </wsa:EndpointReference>" & $CRLF & _
"               </wsp:AppliesTo>" & $CRLF & _
"           </wst:RequestSecurityToken>" & $CRLF & _
"           <wst:RequestSecurityToken Id=""RSTn"">" & $CRLF & _
"               <wst:RequestType>http://schemas.xmlsoap.org/ws/2004/04/security/trust/Issue</wst:RequestType>" & $CRLF & _
"               <wsp:AppliesTo>" & $CRLF & _
"                   <wsa:EndpointReference>" & $CRLF & _
"                       <wsa:Address>domain</wsa:Address>" & $CRLF & _
"                   </wsa:EndpointReference>" & $CRLF & _
"               </wsp:AppliesTo>" & $CRLF & _
"               <wsse:PolicyReference URI=""<<<MBI_KEY_OLD>>>""></wsse:PolicyReference>" & $CRLF & _
"           </wst:RequestSecurityToken>" & $CRLF & _
"       </ps:RequestMultipleSecurityTokens>" & $CRLF & _
"   </Body>" & $CRLF & _
"</Envelope>"

END FUNCTION


FUNCTION WriteSSLPOST(XMLPOST AS STRING) AS STRING

  LOCAL v1 AS VARIANT, v2 AS VARIANT, v3 AS VARIANT
  LOCAL v4 AS VARIANT, v5 AS VARIANT, v6 AS VARIANT
  LOCAL objResultXMLDoc AS DISPATCH

  SET objResultXMLDoc   = CreateObject("Msxml2.DOMDocument")

  ' Post the SOAP message.
  DIM objXMLHTTP AS DISPATCH
  SET objXMLHTTP = CreateObject("Microsoft.XMLHTTP")
  v1 ="post"
  v2 = "https://login.live.com/RST.srf"
  v3 = 0
  OBJECT CALL objXMLHTTP.open(v1, v2, v3)

  v1 = "Content-Type"
  v2 = "text/xml; charset=UTF-8"
'  OBJECT CALL objXMLHTTP.setRequestHeader(v1, v2)

  v1 = "Accept"
  v2 = "TEXT/*"
'  OBJECT CALL objXMLHTTP.setRequestHeader(v1, v2)

  v1 = "USER-Agent"
  v2 = "Vega"
'  OBJECT CALL objXMLHTTP.setRequestHeader(v1, v2)

  v1 = "HOST"
  v2 = "loginnet.passport.com"
  OBJECT CALL objXMLHTTP.setRequestHeader(v1, v2)

  v1 = "Content-Length"
  v2 = FORMAT$(LEN(XMLPOST))
'  OBJECT CALL objXMLHTTP.setRequestHeader(v1, v2)

  v1 = "Connection"
  v2 = "Keep-Alive"
'  OBJECT CALL objXMLHTTP.setRequestHeader(v1, v2)

  v1 = "Cache-CONTROL"
  v2 = "no-cache"
'  OBJECT CALL objXMLHTTP.setRequestHeader(v1, v2)


  SET v1 = XMLPOST
  OBJECT CALL objXMLHTTP.send(v1)

  '-- Save the response to v2
  OBJECT GET objXMLHTTP.ResponseText TO v2

  FUNCTION = VARIANT$(v2)

  ' clean up
  SET objXMLHTTP        = NOTHING
  SET objResultXMLDoc   = NOTHING

END FUNCTION

FUNCTION PBMAIN () AS LONG

LOCAL Hserver1   AS LONG
LOCAL HServer2   AS LONG
LOCAL FF1        AS LONG
LOCAL FF2        AS LONG
LOCAL NextServer AS STRING
LOCAL Result     AS STRING
LOCAL XML        AS STRING
LOCAL Key        AS STRING

FF1 = FREEFILE
ERRCLEAR
TCP OPEN PORT 1863 AT "207.46.96.153" AS #FF1

Result     = WriteMsnPort(FF1, "VER %TRN MSNP15 CVR0")
Result     = WriteMsnPort(FF1, "CVR %TRN 0x0C0A winnt 5.1 i686 MSNMSGR 8.1.0178 MSFT " & $EmailAddress )
NextServer = PARSE$(WriteMsnPort(FF1, "USR %TRN SSO I " & $EmailAddress), " ", 4)

TCP CLOSE #FF1

ERRCLEAR

FF1 = FREEFILE
TCP OPEN PORT VAL(PARSE$(NextServer, ":", 2)) AT PARSE$(NextServer, ":", 1) AS #FF1

Result     = WriteMsnPort(FF1, "VER %TRN MSNP15 CVR0")
Result     = WriteMsnPort(FF1, "CVR %TRN 0x0C0A winnt 5.1 i686 MSNMSGR 8.1.0178 MSFT " & $EmailAddress)
Result     = WriteMsnPort(FF1, "USR %TRN SSO I " & $EmailAddress)

Key = TRIM$(MID$(Result, INSTR(-1, Result, " "), 256), ANY " " & $CRLF)

XML = XMLSkeleton()

REPLACE "<<<MyEmailAddress>>>" WITH $emailaddress IN XML
REPLACE "<<<MyPassword>>>"     WITH $Password     IN XML
REPLACE "<<<MBI_KEY_OLD>>>"    WITH Key           IN XML

Result = WriteSSLPOST(XML)

MSGBOX Result

END FUNCTION

[Elias Montoya]

Ah you are right, need to change:

  v1 = "HOST"
  v2 = "loginnet.passport.com"

... To whatever server it tells me to connect before.
It was working before because it was a coincidence. :P