The Trunk: SqueakSSL-Tests-ul.18.mcz

Tobias Pape uploaded a new version of SqueakSSL-Tests to project The Trunk:
http://source.squeak.org/trunk/SqueakSSL-Tests-ul.18.mcz

==================== Summary ====================

Name: SqueakSSL-Tests-ul.18
Author: ul
Time: 15 October 2014, 9:14:41.944 pm
UUID: 3a075d4b-2fd5-4b84-9f84-ffd8f5a95a50
Ancestors: SqueakSSL-Tests-ar.17

Yahoo OpenID uses yahoo.com instead of yahooapis.com.

==================== Snapshot ====================

SystemOrganization addCategory: #'SqueakSSL-Tests'!

TestCase subclass: #SqueakSSLTest
        instanceVariableNames: 'clientReadQueue serverWriteQueue serverReadQueue clientWriteQueue sslClient sslServer clientProcess serverProcess'
        classVariableNames: 'CertName'
        poolDictionaries: ''
        category: 'SqueakSSL-Tests'!

----- Method: SqueakSSLTest class>>certName (in category 'accessing') -----
certName
        "The name of the cert to use for the test"

        ^CertName!

----- Method: SqueakSSLTest class>>certName: (in category 'accessing') -----
certName: aString
        "The name of the cert to use for the test.
                SqueakSSLTest certName: nil.
                SqueakSSLTest certName: 'Internet Widgits Pty'.
                SqueakSSLTest certName: '/home/andreas/certs/testcert.pem'.
        "

        CertName := aString!

----- Method: SqueakSSLTest class>>ensureValidCert (in category 'utilities') -----
ensureValidCert
        "Ensure that we have a valid certificate for the tests"

        CertName := SqueakSSL ensureSampleCert.
!

----- Method: SqueakSSLTest>>certName (in category 'setup') -----
certName
        "Answer the name of the cert to use in tests"
       
        ^self class certName!

----- Method: SqueakSSLTest>>expectedFailures (in category 'setup') -----
expectedFailures
        "If we don't have a cert all the tests fail"

        SqueakSSL platformName = 'Mac OS' ifTrue:[
                "The following tests all need certificate selection
                to work properly."
                ^#(
                        testConnectAccept
                        testEncryptDecrypt
                        testMultiFrameDecrypt
                        testSingleByteDecrypt
                        testSplitTlsFrameRead
                        testStreamAccept
                        testStreamConnect
                        testStreamTransfer
                )
        ] ifFalse:[^#()].!

----- Method: SqueakSSLTest>>hasCertInfo (in category 'setup') -----
hasCertInfo
        "Returns true if we have cert information available"

        ^self class certName notNil!

----- Method: SqueakSSLTest>>port (in category 'setup') -----
port
        ^8844!

----- Method: SqueakSSLTest>>secureSocket (in category 'setup') -----
secureSocket
        ^SqueakSSL secureSocket!

----- Method: SqueakSSLTest>>secureSocketStream (in category 'setup') -----
secureSocketStream
        ^SqueakSSL secureSocketStream!

----- Method: SqueakSSLTest>>setUp (in category 'setup') -----
setUp
        "The default setUp"

        self class ensureValidCert.

        clientReadQueue := serverWriteQueue := SharedQueue new.
        serverReadQueue := clientWriteQueue := SharedQueue new.
       
        sslClient := SqueakSSL new.
        sslClient readBlock:[:buffer| | inbuf |
                inbuf := clientReadQueue next.
                buffer replaceFrom: 1 to: inbuf size with: inbuf startingAt: 1.
                inbuf size.
        ].
        sslClient writeBlock:[:buffer :count|
                clientWriteQueue nextPut: (buffer copyFrom: 1 to: count)
        ].

        sslServer := SqueakSSL new.
        sslServer certName: self certName.
        sslServer readBlock:[:buffer| | inbuf |
                inbuf := serverReadQueue next.
                buffer replaceFrom: 1 to: inbuf size with: inbuf startingAt: 1.
                inbuf size.
        ].
        sslServer writeBlock:[:buffer :count|
                serverWriteQueue nextPut: (buffer copyFrom: 1 to: count)
        ].
!

----- Method: SqueakSSLTest>>tearDown (in category 'setup') -----
tearDown
        "Shut down everything"

        clientProcess ifNotNil:[clientProcess terminate].
        serverProcess ifNotNil:[serverProcess].
        sslClient ifNotNil:[sslClient destroy].
        sslServer ifNotNil:[sslServer destroy].
!

----- Method: SqueakSSLTest>>testConnectAccept (in category 'tests') -----
testConnectAccept
        "Tests the SqueakSSL server and client handshake. "

        | buf process |
        process := Processor activeProcess.

        "Separate queues so we can watch the handshake"
        clientReadQueue := SharedQueue new.
        serverWriteQueue := SharedQueue new.
        serverReadQueue := SharedQueue new.
        clientWriteQueue := SharedQueue new.

        "Start the connect and accept loop"
        clientProcess := [
                [sslClient connect]
                        on: Error
                        do:[:ex| process signalException: ex]. "uncomment for debugging"
        ] forkAt: Processor activePriority + 1.
        serverProcess := [
                [sslServer accept]
                        on: Error
                        do:[:ex| process signalException: ex]. "uncomment for debugging"
        ] forkAt: Processor activePriority + 1.

        "Do the handshake"
        buf := clientWriteQueue next.
        serverReadQueue nextPut: buf.
        buf := serverWriteQueue next.
        clientReadQueue nextPut: buf.

        buf := clientWriteQueue next.
        serverReadQueue nextPut: buf.
        buf := serverWriteQueue next.
        clientReadQueue nextPut: buf.

        "Both client and server should now be connected"
        self assert:(clientProcess isTerminated).
        self assert:(serverProcess isTerminated).

        self assert: sslClient isConnected.
        self assert: sslServer isConnected.
!

----- Method: SqueakSSLTest>>testEncryptDecrypt (in category 'tests') -----
testEncryptDecrypt
        "Simple encrypt/decrypt test with a single frame of data.
        Ensures that the common case works properly."

        | encrypted decrypted |

        self testConnectAccept.

        encrypted := sslClient encrypt: 'Client to Server'.
        decrypted := sslServer decrypt: encrypted.

        self assert: decrypted = 'Client to Server'.

        encrypted := sslServer encrypt: 'Server to Client'.
        decrypted := sslClient decrypt: encrypted.

        self assert: decrypted = 'Server to Client'.
!

----- Method: SqueakSSLTest>>testFaceBookAPI (in category 'tests') -----
testFaceBookAPI
        "Facebook sends incomplete data during SSL handshake.
        Useful for testing an edge condition in SqueakSSL."

        Smalltalk at: #WebClient ifPresent:[:webClient|
                self shouldnt:[
                        [webClient httpGet: 'https://graph.facebook.com/oauth/access_token']
                                "Allow certificate errors on the Mac since cert validation isn't
                                implemented yet."
                                on: SqueakSSLCertificateError do:[:ex|
                                        SqueakSSL platformName = 'Mac OS'
                                                ifTrue:[ex resume]
                                                ifFalse:[ex pass]].
                ] raise: Error.
        ]..
!

----- Method: SqueakSSLTest>>testGooglePopStream (in category 'tests') -----
testGooglePopStream
        "This tests the dreaded data-in-last-handshake problem that some people
        have been seeing. Google mail (at times) sends the first data chunk together
        with the last handshake and the Windows SSL code did not handle that correctly"

        "self run: #testGooglePopStream"
        | hostName address socket response stream |
        hostName := 'pop.gmail.com'.
        address := NetNameResolver addressForName: hostName.
        socket := Socket newTCP.
        socket connectTo: address port: 995.
        socket waitForConnectionFor: 10.
        stream := self secureSocketStream on: socket.
        [
                stream sslConnect.
                response := stream upToAll: String crlf.
                self assert: response notEmpty.
        ] ensure:[stream destroy].
!

----- Method: SqueakSSLTest>>testMultiFrameDecrypt (in category 'tests') -----
testMultiFrameDecrypt
        "A test verifying that even if we feed multiple encrypted frames at once
        we get them one-by-one out of the decryptor. Mainly a test to ensure
        consistent plugin behavior."

        | encrypted decrypted |

        "Also does setup"
        self testConnectAccept.

        "Encrypt the text"
        encrypted := #(
                'Hello World'
                'This is a test'
                'How do you do'
        ) collect:[:each| sslClient encrypt: each].

        "Now feed the the encrypted contents at once to the decryptor"
        decrypted := sslServer decrypt: (encrypted inject:'' into:[:a :b| a, b]).

        "This should only decrypt the first frame"
        self assert: decrypted = 'Hello World'.

        "The second time (with no input) we should get the second piece."
        decrypted := sslServer decrypt: ''.
        self assert: decrypted = 'This is a test'.

        "The third time (with extra input) we should get the last piece from the first round."
        encrypted := sslClient encrypt: 'More data is coming'.
        decrypted := sslServer decrypt: encrypted.
        self assert: decrypted = 'How do you do'.

        "And finally the last piece"
        decrypted := sslServer decrypt: ''.
        self assert: decrypted = 'More data is coming'.
!

----- Method: SqueakSSLTest>>testSSLSockets (in category 'tests') -----
testSSLSockets

        "Connect client and server"
        | client listener server sema |
        [listener := SecureSocket newTCP.
        listener listenOn: self port backlogSize: 4.
        client := SecureSocket newTCP.
        client connectTo: #[127 0 0 1] port: self port.
        server := listener waitForAcceptFor: 1.

        "Perform SSL handshake"
        sema := Semaphore new.
        [client sslConnect.
        sema signal] fork.
        server sslAccept: self certName.
        sema wait.

        "Send data"
        client sendData: 'Hello World'.
        server waitForDataFor: 1.
        self assert: server receiveData = 'Hello World'.
        ] ensure:[
                listener ifNotNil:[listener destroy].
                client ifNotNil:[client destroy].
                server ifNotNil:[server destroy].
        ].!

----- Method: SqueakSSLTest>>testSingleByteDecrypt (in category 'tests') -----
testSingleByteDecrypt
        "A test verifying that even if we feed the decryptor with single bytes it
        produces the correct output. Mainly a test that the underlying plugin
        deals with corner cases correctly."

        | encrypted decrypted |

        "Also does setup"
        self testConnectAccept.

        "Encrypt the text"
        encrypted := sslClient encrypt: 'Hello World'.

        "Now feed the encrypted contents byte-by-byte into the decryptor"
        1 to: encrypted size-1 do:[:i|
                decrypted := sslServer decrypt: (encrypted copyFrom: i to: i).
                self assert: decrypted isEmpty.
        ].

        "And upon feeding the last byte we expect the result"
        decrypted := sslServer decrypt: (encrypted last: 1).
        self assert: decrypted = 'Hello World'.!

----- Method: SqueakSSLTest>>testSocketAccept (in category 'tests') -----
testSocketAccept
        "Tests the SecureSocketStream server handshake. "

        | process listener clientSocket serverSocket |
        process := Processor activeProcess.

        [listener := self secureSocket newTCP.
        listener listenOn: self port backlogSize: 4.
        clientSocket := Socket newTCP.
        clientSocket connectTo: #[127 0 0 1] port: self port.
        clientSocket waitForConnectionFor: 1.
        serverSocket := listener waitForAcceptFor: 1.
        self assert: clientSocket isConnected.
        self assert: serverSocket notNil.
        self assert: serverSocket isConnected.

        "Set up the client for the handshake"
        sslClient on: clientSocket.
        clientProcess := [
                [sslClient connect]
                        on: Error
                        do:[:ex| process signalException: ex].
        ] forkAt: Processor activePriority + 1.

        "Set up the server"
        serverSocket sslAccept: self certName.
        self assert: serverSocket isConnected.
        ] ensure:[
                listener ifNotNil:[listener destroy].
                clientSocket ifNotNil:[clientSocket destroy].
                serverSocket ifNotNil:[serverSocket destroy].
        ].!

----- Method: SqueakSSLTest>>testSocketConnect (in category 'tests') -----
testSocketConnect
        "Tests the SecureSocket client handshake. "

        | process listener clientSocket serverSocket |
        process := Processor activeProcess.

        [listener := Socket newTCP.
        listener listenOn: self port backlogSize: 4.
        clientSocket := self secureSocket newTCP.
        clientSocket connectTo: #[127 0 0 1] port: self port.
        clientSocket waitForConnectionFor: 1.
        serverSocket := listener waitForAcceptFor: 1.
        self assert: clientSocket isConnected.
        self assert: serverSocket notNil.
        self assert: serverSocket isConnected.

        "Set up the server for the handshake"
        sslServer on: serverSocket.
        serverProcess := [
                [sslServer accept]
                        on: Error
                        do:[:ex| process signalException: ex]. "uncomment for debugging"
        ] forkAt: Processor activePriority + 1.

        "Set up the client using SecureSocketStream"
        clientSocket sslConnect.
        clientSocket isConnected.
        ] ensure:[
                listener ifNotNil:[listener destroy].
                clientSocket ifNotNil:[clientSocket destroy].
                serverSocket ifNotNil:[serverSocket destroy].
        ].!

----- Method: SqueakSSLTest>>testSplitTlsFrameRead (in category 'tests') -----
testSplitTlsFrameRead
        "Tests the SecureSocketStream client handshake. "

        | process listener clientSocket serverSocket secureStream char |
        process := Processor activeProcess.

        [listener := Socket newTCP.
        listener listenOn: self port backlogSize: 4.
        clientSocket := Socket newTCP.
        clientSocket connectTo: #[127 0 0 1] port: self port.
        clientSocket waitForConnectionFor: 1.
        serverSocket := listener waitForAcceptFor: 1.
        self assert: clientSocket isConnected.
        self assert: serverSocket notNil.
        self assert: serverSocket isConnected.

        "Set up the server for the handshake"
        sslServer on: serverSocket.
        serverProcess := [ | encrypted |
                [sslServer accept.
                encrypted := sslServer encrypt: 'Hello World'.
                1 to: encrypted size do:[:i|
                        sslServer writeData: (encrypted copyFrom: i to: i) count: 1.
                        (Delay forMilliseconds: 10) wait.
                ].
                ] on: Error
                        do:[:ex| process signalException: ex]. "uncomment for debugging"
        ] forkAt: Processor activePriority + 1.

        "Set up the client using SecureSocketStream"
        secureStream := SecureSocketStream on: clientSocket.
        secureStream sslConnect.
        self assert: secureStream isConnected.
        char := secureStream next.
        self assert: char = $H.
        ] ensure:[
                listener ifNotNil:[listener destroy].
                clientSocket ifNotNil:[clientSocket destroy].
                serverSocket ifNotNil:[serverSocket destroy].
                secureStream ifNotNil:[secureStream destroy].
        ].!

----- Method: SqueakSSLTest>>testStreamAccept (in category 'tests') -----
testStreamAccept
        "Tests the SecureSocketStream server handshake. "

        | process listener clientSocket serverSocket secureStream |
        process := Processor activeProcess.

        [listener := Socket newTCP.
        listener listenOn: self port backlogSize: 4.
        clientSocket := Socket newTCP.
        clientSocket connectTo: #[127 0 0 1] port: self port.
        clientSocket waitForConnectionFor: 1.
        serverSocket := listener waitForAcceptFor: 1.
        self assert: clientSocket isConnected.
        self assert: serverSocket notNil.
        self assert: serverSocket isConnected.

        "Set up the client for the handshake"
        sslClient on: clientSocket.
        clientProcess := [
                [sslClient connect]
                        on: Error
                        do:[:ex| process signalException: ex].
        ] forkAt: Processor activePriority + 1.

        "Set up the client using SecureSocketStream"
        secureStream := SecureSocketStream on: serverSocket.
        secureStream sslAccept: self certName.
        self assert: secureStream isConnected.
        ] ensure:[
                listener ifNotNil:[listener destroy].
                clientSocket ifNotNil:[clientSocket destroy].
                serverSocket ifNotNil:[serverSocket destroy].
                secureStream ifNotNil:[secureStream destroy].
        ].!

----- Method: SqueakSSLTest>>testStreamConnect (in category 'tests') -----
testStreamConnect
        "Tests the SecureSocketStream client handshake. "

        | process listener clientSocket serverSocket secureStream |
        process := Processor activeProcess.

        [listener := Socket newTCP.
        listener listenOn: self port backlogSize: 4.
        clientSocket := Socket newTCP.
        clientSocket connectTo: #[127 0 0 1] port: self port.
        clientSocket waitForConnectionFor: 1.
        serverSocket := listener waitForAcceptFor: 1.
        self assert: clientSocket isConnected.
        self assert: serverSocket notNil.
        self assert: serverSocket isConnected.

        "Set up the server for the handshake"
        sslServer on: serverSocket.
        serverProcess := [
                [sslServer accept]
                        on: Error
                        do:[:ex| process signalException: ex]. "uncomment for debugging"
        ] forkAt: Processor activePriority + 1.

        "Set up the client using SecureSocketStream"
        secureStream := SecureSocketStream on: clientSocket.
        secureStream sslConnect.
        self assert: secureStream isConnected.
        ] ensure:[
                listener ifNotNil:[listener destroy].
                clientSocket ifNotNil:[clientSocket destroy].
                serverSocket ifNotNil:[serverSocket destroy].
                secureStream ifNotNil:[secureStream destroy].
        ].!

----- Method: SqueakSSLTest>>testStreamTransfer (in category 'tests') -----
testStreamTransfer
        "Tests the SecureSocketStream data transfer"

        | listener clientSocket serverSocket serverStream clientStream |
        [listener := Socket newTCP.
        listener listenOn: self port backlogSize: 4.
        clientSocket := Socket newTCP.
        clientSocket connectTo: #[127 0 0 1] port: self port.
        clientSocket waitForConnectionFor: 1.
        serverSocket := listener waitForAcceptFor: 1.
        self assert: clientSocket isConnected.
        self assert: serverSocket notNil.
        self assert: serverSocket isConnected.

        "Set up client and server streams"
        serverStream := self secureSocketStream on: serverSocket.
        serverProcess := [
                [serverStream sslAccept: self certName]
                        on: Error do:[:ex| serverStream destroy].
        ] forkAt: Processor activePriority + 1.

        clientStream := self secureSocketStream on: clientSocket.
        clientStream sslConnect.
        self assert: clientStream isConnected.
        self assert: serverStream isConnected.
        clientStream nextPutAll: 'Hello World'; flush.
        self assert: (serverStream next: 11) = 'Hello World'.
        serverStream nextPutAll: 'The other way'; flush.
        self assert: (clientStream next: 13) = 'The other way'.

        ] ensure:[
                listener ifNotNil:[listener destroy].
                clientSocket ifNotNil:[clientSocket destroy].
                serverSocket ifNotNil:[serverSocket destroy].
                clientStream ifNotNil:[clientStream destroy].
                serverStream ifNotNil:[serverStream destroy].
        ].!

----- Method: SqueakSSLTest>>testYahooOpenID (in category 'tests') -----
testYahooOpenID
        "Yahoo sends an SSL shutdown sequence which we didn't handle in the past.
        Also, there were some issues with SecureSocketStream that were unearthed
        by using it via WebClient's chunking method (not easy to reproduce without WC)."

        Smalltalk at: #WebClient ifPresent:[:webClient|
                self shouldnt:[
                        [webClient httpGet: 'https://open.login.yahoo.com/openid/op/auth']
                                "Allow certificate errors on the Mac since cert validation isn't
                                implemented yet."
                                on: SqueakSSLCertificateError do:[:ex|
                                        SqueakSSL platformName = 'Mac OS'
                                                ifTrue:[ex resume]
                                                ifFalse:[ex pass]].
                ] raise: Error.
        ]..
!