1"====================================================================== 2| 3| Swazoo 2.1 testcases 4| 5| 6 ======================================================================" 7 8"====================================================================== 9| 10| Copyright 2000-2009 the Swazoo team. 11| 12| This file is part of Swazoo. 13| 14| Swazoo is free software; you can redistribute it and/or modify it 15| under the terms of the GNU Lesser General Public License as published 16| by the Free Software Foundation; either version 2.1, or (at your option) 17| any later version. 18| 19| Swazoo is distributed in the hope that it will be useful, but WITHOUT 20| ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or 21| FITNESS FOR A PARTICULAR PURPOSE. See the GNU Lesser General Public 22| License for more details. 23| 24| You should have received a copy of the GNU Lesser General Public License 25| along with the GNU Smalltalk class library; see the file COPYING.LIB. 26| If not, write to the Free Software Foundation, 59 Temple Place - Suite 27| 330, Boston, MA 02110-1301, USA. 28| 29 ======================================================================" 30 31 32Object subclass: SwazooBenchmarks [ 33 | server content | 34 35 <category: 'Swazoo-Tests'> 36 <comment: 'SwazooBenchmarks stores several benchmarks and performance routines 37 38'> 39 40 Singleton := nil. 41 42 SwazooBenchmarks class >> singleton [ 43 <category: 'accessing'> 44 Singleton isNil ifTrue: [Singleton := self new]. 45 ^Singleton 46 ] 47 48 content [ 49 "test content to be writen to the socket" 50 51 <category: 'accessing'> 52 content isNil ifTrue: [self initContent]. 53 ^content 54 ] 55 56 content: aByteArray [ 57 <category: 'accessing'> 58 content := aByteArray 59 ] 60 61 contentSize [ 62 <category: 'initialize-release'> 63 ^4 64 ] 65 66 initContent [ 67 <category: 'initialize-release'> 68 | response ws | 69 response := HTTPResponse ok. 70 response entity: (ByteArray new: self contentSize withAll: 85). 71 ws := SwazooStream on: String new. 72 HTTPPrinter writeResponse: response to: ws. 73 content := ws writeBufferContents 74 ] 75 76 server [ 77 "TCP server loop" 78 79 <category: 'accessing'> 80 ^server 81 ] 82 83 server: aProcess [ 84 "TCP server loop" 85 86 <category: 'accessing'> 87 server := aProcess 88 ] 89 90 serverLoop [ 91 <category: 'socket performance'> 92 | socket clientSocket | 93 socket := SpSocket newTCPSocket. 94 socket 95 setAddressReuse: true; 96 bindSocketAddress: (SpIPAddress hostName: 'localhost' port: 9999). 97 98 [socket listenBackloggingUpTo: 50. 99 [true] whileTrue: 100 [clientSocket := socket accept. 101 102 [[true] whileTrue: 103 [clientSocket underlyingSocket waitForData. 104 clientSocket read: 60. "HTTP request" 105 clientSocket write: self content]] 106 on: Error 107 do: [:ex | ]]] 108 ensure: 109 [clientSocket notNil ifTrue: [clientSocket close]. 110 socket close] 111 ] 112 113 startSocketServer [ 114 "SwazooBenchmarks singleton startSocketServer" 115 116 "SwazooBenchmarks singleton stopSocketServer" 117 118 "testing raw socket performance. 119 it will start a server on localhost:9999 to receive a request 120 and respond with 10K response as drirectly as possible." 121 122 <category: 'socket performance'> 123 self stopSocketServer. 124 self server: [self serverLoop] fork 125 ] 126 127 stopSocketServer [ 128 "SwazooBenchmarks singleton stopSocketServer" 129 130 <category: 'socket performance'> 131 self server notNil 132 ifTrue: 133 [self server terminate. 134 self server: nil]. 135 self content: nil. 136 (Delay forMilliseconds: 1000) wait 137 ] 138] 139 140 141 142Object subclass: TestPseudoSocket [ 143 | byteStreamToServer byteStreamFromServer clientWaitSemaphore serverWaitSemaphore ipAddress | 144 145 <category: 'Swazoo-Tests'> 146 <comment: 'TestPseudoSocket is a drop in replacement for a SwazooSocket that can be used during testing to feed bytes into a running SwazooHTTPServer and grab the responses without having to start a real socket pair. 147 148So, to the HTTP server it must look like a server socket. To the tester it must look like a write stream (to send bytes to the HTTP server) and a read stream (to read the HTTP responses).'> 149 150 TestPseudoSocket class >> newTCPSocket [ 151 "^a TestPseudoSocket 152 I simply return a new instance of myself." 153 154 <category: 'instance creation'> 155 ^self new 156 ] 157 158 TestPseudoSocket class >> serverOnIP: host port: port [ 159 "^self 160 I'm only pretending to be a socket class, so I ignore the host and port." 161 162 <category: 'instance creation'> 163 ^self new 164 ] 165 166 acceptRetryingIfTransientErrors [ 167 "^another TestSocketThing 168 The sender expects me to block until a request comes in 'over the socket'. What I really do is wait for someone to ask me to 'send in' a Byte array and then I return myself. Note that I will only handle one request at a time!!" 169 170 <category: 'socket stuff'> 171 self serverWaitSemaphore wait. 172 ^self 173 ] 174 175 bindSocketAddress: anOSkIPAddress [ 176 "^self 177 This is a no-op for me." 178 179 <category: 'socket stuff'> 180 ipAddress := anOSkIPAddress. 181 ^self 182 ] 183 184 byteStreamFromServer [ 185 <category: 'accessing'> 186 ^byteStreamFromServer 187 ] 188 189 byteStreamFromServer: aByteStream [ 190 <category: 'accessing'> 191 byteStreamFromServer := aByteStream. 192 ^self 193 ] 194 195 byteStreamToServer [ 196 <category: 'accessing'> 197 ^byteStreamToServer 198 ] 199 200 byteStreamToServer: aByteStream [ 201 <category: 'accessing'> 202 byteStreamToServer := aByteStream. 203 ^self 204 ] 205 206 clientWaitSemaphore [ 207 "^a Semaphore 208 I return the semaphore I use to control 'client' activity." 209 210 <category: 'accessing'> 211 clientWaitSemaphore isNil ifTrue: [clientWaitSemaphore := Semaphore new]. 212 ^clientWaitSemaphore 213 ] 214 215 close [ 216 "^self 217 The server has finished with us at this point, so we signal the semaphore to give the client end chance to grab the response." 218 219 <category: 'socket stuff'> 220 self clientWaitSemaphore signal. 221 ^self 222 ] 223 224 flush [ 225 <category: 'socket stuff'> 226 ^self 227 ] 228 229 getPeerName [ 230 <category: 'socket stuff'> 231 ^ipAddress 232 ] 233 234 getSocketName [ 235 <category: 'socket stuff'> 236 ^ipAddress 237 ] 238 239 isActive [ 240 "^self 241 I am pretending to be a socket, and the sender wants to know if I am active. Of course I am!!." 242 243 <category: 'socket stuff'> 244 ^true 245 ] 246 247 listenBackloggingUpTo: anInteger [ 248 "^self 249 This is a no-op for me." 250 251 <category: 'socket stuff'> 252 ^self 253 ] 254 255 listenFor: anInteger [ 256 "^self 257 This is a no-op for now." 258 259 <category: 'socket stuff'> 260 ^self 261 ] 262 263 next [ 264 <category: 'stream-toServer'> 265 ^self byteStreamToServer next 266 ] 267 268 nextPut: aCharacter [ 269 <category: 'stream-fromServer'> 270 self byteStreamFromServer nextPut: aCharacter asInteger 271 ] 272 273 nextPutAll: aCollection [ 274 "^self 275 At present it seems that aCollection will always be a string of chacters." 276 277 <category: 'stream-fromServer'> 278 ^self byteStreamFromServer nextPutAll: aCollection asByteArray 279 ] 280 281 nextPutBytes: aByteArray [ 282 <category: 'stream-fromServer'> 283 self byteStreamFromServer nextPutAll: aByteArray 284 ] 285 286 peek [ 287 "^a Character 288 It seems that the HTTP server is expecting Characters not Bytes - this will have to change." 289 290 <category: 'stream-toServer'> 291 ^byteStreamToServer isNil 292 ifTrue: [nil] 293 ifFalse: [Character value: self byteStreamToServer peek] 294 ] 295 296 print: anObject [ 297 <category: 'stream-fromServer'> 298 self nextPutAll: anObject printString asByteArray. 299 ^self 300 ] 301 302 read: integerNumberOfBytes [ 303 "^a ByteArray 304 I read the next numberOfBytes from my underlying stream." 305 306 <category: 'stream-toServer'> 307 ^byteStreamToServer isNil 308 ifTrue: [ByteArray new] 309 ifFalse: [self byteStreamToServer nextAvailable: integerNumberOfBytes] 310 ] 311 312 serverWaitSemaphore [ 313 "^a Semaphore 314 I return the semaphore I use to control 'server' activity." 315 316 <category: 'accessing'> 317 serverWaitSemaphore isNil ifTrue: [serverWaitSemaphore := Semaphore new]. 318 ^serverWaitSemaphore 319 ] 320 321 setAddressReuse: aBoolean [ 322 "^self 323 This is a no-op for me." 324 325 <category: 'socket stuff'> 326 ^self 327 ] 328 329 socket [ 330 "^self 331 I am being asked this as if I am a socket stream. I return myself because I'm pretending to be both the socket and the socket stream." 332 333 <category: 'stream-toServer'> 334 ^self 335 ] 336 337 space [ 338 <category: 'stream-fromServer'> 339 self nextPut: Character space. 340 ^self 341 ] 342 343 stream [ 344 "^self 345 I have to pretend to be a socket stream too." 346 347 <category: 'socket stuff'> 348 ^self 349 ] 350 351 upTo: aCharacter [ 352 "a ByteString 353 For some reason, we have to look for a character in a ByteStream - this is a Swazoo thing." 354 355 <category: 'stream-toServer'> 356 ^self byteStreamToServer upTo: aCharacter asInteger 357 ] 358 359 write: aByteArray [ 360 "^an Integer 361 I write the contents of the sourceByteArray to my underlying Socket. 362 I return the number of bytes written." 363 364 <category: 'stream-fromServer'> 365 self byteStreamFromServer nextPutAll: aByteArray. 366 ^aByteArray size 367 ] 368 369 writeBytesToServer: aByteArray [ 370 "^self 371 This is where we make the bytes available over the pseudo socket. Unlike a socket this is a one off thing (at least in this implementation of the pseudo socket). Once the bytes are written, control passes to the server and stays there until the server sends a close to what it thinks is the client socket, but is really me." 372 373 <category: 'actions-client'> 374 | results | 375 self byteStreamToServer: (ReadStream on: aByteArray). 376 self byteStreamFromServer: (WriteStream on: (ByteArray new: 1000)). 377 self serverWaitSemaphore signal. 378 self clientWaitSemaphore wait. 379 results := self byteStreamFromServer contents. 380 self byteStreamToServer: nil. 381 self byteStreamFromServer: nil. 382 ^results 383 ] 384] 385 386 387 388TestCase subclass: CompositeResourceTest [ 389 | composite | 390 391 <comment: nil> 392 <category: 'Swazoo-Tests'> 393 394 sampleInSite [ 395 <category: 'testing'> 396 | site | 397 site := SwazooSite new. 398 site 399 host: 'swazoo.org' 400 ip: '127.0.0.1' 401 port: 8200. 402 site addResource: composite 403 ] 404 405 setUp [ 406 <category: 'running'> 407 composite := CompositeResource uriPattern: '/' 408 ] 409 410 testAddResource [ 411 <category: 'testing'> 412 | child | 413 composite 414 addResource: (child := HelloWorldResource uriPattern: 'hello.html'). 415 self assert: composite children size = 1. 416 self assert: composite children first == child. 417 self assert: child parent == composite 418 ] 419 420 testAddResources [ 421 <category: 'testing'> 422 | child1 child2 | 423 child1 := HelloWorldResource uriPattern: 'hello1.html'. 424 child2 := HelloWorldResource uriPattern: 'hello2.html'. 425 composite addResources: (Array with: child1 with: child2). 426 self assert: composite children size = 2. 427 composite children do: 428 [:each | 429 self assert: (composite children includes: each). 430 self assert: each parent == composite] 431 ] 432 433 testCurrentUrl [ 434 <category: 'testing'> 435 | child leaf | 436 self sampleInSite. 437 self assert: composite currentUrl = 'http://swazoo.org:8200/'. 438 composite addResource: (child := CompositeResource uriPattern: 'foo'). 439 self assert: child currentUrl = 'http://swazoo.org:8200/foo/'. 440 child addResource: (leaf := HelloWorldResource uriPattern: 'hi.html'). 441 self assert: leaf currentUrl = 'http://swazoo.org:8200/foo/hi.html' 442 ] 443 444 testEmptyURIPatternInvalid [ 445 <category: 'testing'> 446 composite uriPattern: ''. 447 self deny: composite isValidlyConfigured 448 ] 449 450 testNilURIPatternDoesNothing [ 451 <category: 'testing'> 452 | pattern | 453 pattern := composite uriPattern. 454 composite uriPattern: nil. 455 self assert: composite uriPattern = pattern 456 ] 457 458 testValidlyConfigured [ 459 <category: 'testing'> 460 self assert: composite isValidlyConfigured 461 ] 462] 463 464 465 466TestCase subclass: FileResourceTest [ 467 | resource | 468 469 <comment: nil> 470 <category: 'Swazoo-Tests'> 471 472 setUp [ 473 <category: 'running'> 474 | directory firstFile ws | 475 directory := SpFilename named: 'fResTest'. 476 directory exists ifFalse: [directory makeDirectory]. 477 firstFile := (SpFilename named: 'fResTest') construct: 'abc.html'. 478 ws := firstFile writeStream. 479 [ws nextPutAll: 'hello'] ensure: [ws close]. 480 resource := FileResource uriPattern: 'foo' filePath: 'fResTest' 481 ] 482 483 tearDown [ 484 <category: 'running'> 485 ((SpFilename named: 'fResTest') construct: 'abc.html') delete. 486 (SpFilename named: 'fResTest') delete 487 ] 488 489 testContentType [ 490 <category: 'testing'> 491 self assert: (resource contentTypeFor: '.txt') = 'text/plain'. 492 self assert: (resource contentTypeFor: '.html') = 'text/html' 493 ] 494 495 testDirectoryIndex [ 496 <category: 'testing'> 497 | request response | 498 request := HTTPGet request: 'foo/'. 499 resource directoryIndex: 'abc.html'. 500 response := URIResolution resolveRequest: request startingAt: resource. 501 self assert: response code = 200. 502 self assert: request resourcePath size = 1. 503 self assert: request resourcePath first = 'foo' 504 ] 505 506 testETag [ 507 "Filename etags do not have the leading and trailing double quotes. Header fields add the quotes as necessary" 508 509 <category: 'testing'> 510 | request response etag | 511 request := HTTPGet request: 'foo/abc.html'. 512 response := URIResolution resolveRequest: request startingAt: resource. 513 self assert: response code = 200. 514 self 515 assert: (etag := (response headers fieldOfClass: HTTPETagField) entityTag) 516 notNil. 517 request := HTTPGet request: 'foo/abc.html'. 518 request headers addField: (HTTPIfNoneMatchField new addEntityTag: etag). 519 response := URIResolution resolveRequest: request startingAt: resource. 520 self assert: response code = 304. 521 self 522 assert: (response headers fieldOfClass: HTTPETagField) entityTag = etag. 523 request := HTTPGet request: 'foo/abc.html'. 524 request headers addField: (HTTPIfNoneMatchField new valueFrom: '"wrong"'). 525 response := URIResolution resolveRequest: request startingAt: resource. 526 self assert: response code = 200. 527 self 528 assert: (response headers fieldOfClass: HTTPETagField) entityTag = etag 529 ] 530 531 testExistantFile [ 532 <category: 'testing'> 533 | request response | 534 request := HTTPGet request: 'foo/abc.html'. 535 response := URIResolution resolveRequest: request startingAt: resource. 536 self assert: response code = 200. 537 self assert: request resourcePath size = 1. 538 self assert: request resourcePath first = 'foo' 539 ] 540 541 testNonexistantFile [ 542 <category: 'testing'> 543 | request response | 544 request := HTTPGet request: 'foo/notThere.html'. 545 response := URIResolution resolveRequest: request startingAt: resource. 546 self assert: response isNil 547 ] 548 549 testRedirection [ 550 <category: 'testing'> 551 | request response | 552 request := HTTPGet request: 'foo'. 553 resource directoryIndex: 'abc.html'. 554 response := URIResolution resolveRequest: request startingAt: resource. 555 self assert: response code = 301. 556 self assert: (response headers fieldNamed: 'Location') uri asString 557 = 'http://foo/'. 558 self assert: (response headers fieldNamed: 'Location') uri host = 'foo' 559 ] 560 561 testRelativeFile [ 562 "it doesn't work anyway!! 563 | request response | 564 request := HTTPGet request: 'foo/../', resource fileDirectory tail, '/abc.html'. 565 response := URIResolution resolveRequest: request startingAt: resource. 566 self assert: response isNil" 567 568 <category: 'testing'> 569 570 ] 571 572 testSafeConstruct [ 573 <category: 'testing'> 574 | request response | 575 request := HTTPGet request: 'foo/../abc.html'. 576 response := URIResolution resolveRequest: request startingAt: resource. 577 self assert: response code = 200. 578 request := HTTPGet request: 'foo/.. /./abc.html'. 579 response := URIResolution resolveRequest: request startingAt: resource. 580 self assert: response code = 200 581 ] 582] 583 584 585 586TestCase subclass: HTTPPostTest [ 587 | request | 588 589 <comment: nil> 590 <category: 'Swazoo-Tests'> 591 592 crlf [ 593 <category: 'requests'> 594 ^String with: Character cr with: Character lf 595 ] 596 597 fileContents [ 598 "HTTPRequestTest new fileContents" 599 600 <category: 'requests'> 601 | stream | 602 stream := SwazooStream on: String new. 603 stream 604 nextPutLine: 'BEGIN:VCALENDAR'; 605 nextPutLine: 'PRODID:-//Squeak-iCalendar//-'; 606 nextPutLine: 'VERSION:2.0'; 607 nextPutLine: 'X-WR-CALNAME:test'; 608 nextPutLine: 'METHOD:PUBLISH'; 609 nextPutLine: 'BEGIN:VEVENT'; 610 nextPutLine: 'UID:an event with a start date and not date and time'; 611 nextPutLine: 'CATEGORIES:category1,category2'; 612 nextPutLine: 'CREATED:20050501T110231Z'; 613 nextPutLine: 'SEQUENCE:0'; 614 nextPutLine: 'SUMMARY:aTitle'; 615 nextPutLine: 'PRIORITY:5'; 616 nextPutLine: 'DTSTART;VALUE=DATE:20050425'; 617 nextPutLine: 'END:VEVENT'; 618 nextPutLine: 'END:VCALENDAR'. 619 ^stream writeBufferContents asString 620 ] 621 622 postDashes [ 623 <category: 'requests'> 624 | requestStream | 625 requestStream := SwazooStream on: String new. 626 requestStream 627 nextPutLine: 'POST /document/aab.html HTTP/1.1'; 628 nextPutLine: 'Host: biart.eranova.si'; 629 nextPutLine: 'Content-Type: multipart/form-data; boundary= boundary'; 630 nextPutLine: 'Content-Length: 149'; 631 crlf; 632 nextPutLine: '--boundary'; 633 nextPutLine: 'Content-Disposition: form-data; name="id5273"'; 634 crlf; 635 nextPutLine: '----'; 636 nextPutLine: '--boundary'; 637 nextPutLine: 'Content-Disposition: form-data; name="field2"'; 638 crlf; 639 nextPutLine: '- --'; 640 nextPutLine: '--boundary--'. 641 ^HTTPRequest 642 readFrom: (SwazooStream on: requestStream writeBufferContents) 643 ] 644 645 postEmpty [ 646 "post entity with empty value" 647 648 <category: 'requests'> 649 | requestStream | 650 requestStream := SwazooStream on: String new. 651 requestStream 652 nextPutLine: 'POST /document/aab.html HTTP/1.1'; 653 nextPutLine: 'Host: biart.eranova.si'; 654 nextPutLine: 'Content-Type: multipart/form-data; boundary= boundary'; 655 nextPutLine: 'Content-Length: 75'; 656 crlf; 657 nextPutLine: '--boundary'; 658 nextPutLine: 'Content-Disposition: form-data; name="id5273"'; 659 crlf; 660 nextPutLine: ''; 661 nextPutLine: '--boundary--'. 662 ^HTTPRequest 663 readFrom: (SwazooStream on: requestStream writeBufferContents) 664 ] 665 666 postFile [ 667 <category: 'requests'> 668 | requestStream | 669 requestStream := SwazooStream on: String new. 670 requestStream 671 nextPutLine: 'POST /document/aab.html HTTP/1.1'; 672 nextPutLine: 'Connection: Keep-Alive'; 673 nextPutLine: 'User-Agent: Mozilla/4.72 [en] (X11; I; Linux 2.3.51 i686)'; 674 nextPutLine: 'Host: biart.eranova.si'; 675 nextPutLine: 'Referer: http://www.bar.com/takeMeThere.html'; 676 nextPutLine: 'Content-Type: multipart/form-data; boundary= -----------------20752836116568320241700153999'; 677 nextPutLine: 'Content-Length: ' 678 , (527 + self fileContents size) printString; 679 crlf; 680 nextPutLine: '-------------------20752836116568320241700153999'; 681 nextPutLine: 'Content-Disposition: form-data; name="id5273"'; 682 crlf; 683 nextPutLine: 'main'; 684 nextPutLine: '-------------------20752836116568320241700153999'; 685 nextPutLine: 'Content-Disposition: form-data; name="field2"'; 686 crlf; 687 crlf; 688 nextPutLine: '-------------------20752836116568320241700153999'; 689 nextPutLine: 'Content-Disposition: form-data; name="field7"; filename="event.ical"'; 690 nextPutLine: 'Content-Type: application/octet-stream'; 691 crlf; 692 nextPutAll: self fileContents; 693 crlf; 694 nextPutLine: '-------------------20752836116568320241700153999'; 695 nextPutLine: 'Content-Disposition: form-data; name="attach"'; 696 crlf; 697 nextPutLine: 'Attach'; 698 nextPutLine: '-------------------20752836116568320241700153999--'. 699 ^HTTPRequest 700 readFrom: (SwazooStream on: requestStream writeBufferContents) 701 ] 702 703 postPreambleEpilogue [ 704 <category: 'requests'> 705 | requestStream | 706 requestStream := SwazooStream on: String new. 707 requestStream 708 nextPutLine: 'POST /document/aab.html HTTP/1.1'; 709 nextPutLine: 'Host: biart.eranova.si'; 710 nextPutLine: 'Content-Type: multipart/form-data; boundary= boundary'; 711 nextPutLine: 'Content-Length: 146'; 712 crlf; 713 nextPutLine: 'This is a multi-part message in MIME format'; 714 nextPutLine: '--boundary'; 715 nextPutLine: 'Content-Disposition: form-data; name="id5273"'; 716 crlf; 717 nextPutLine: 'main'; 718 nextPutLine: '--boundary--'; 719 nextPutLine: 'This is the epilogue'. 720 ^HTTPRequest 721 readFrom: (SwazooStream on: requestStream writeBufferContents) 722 ] 723 724 postSimple [ 725 <category: 'requests'> 726 | requestStream | 727 requestStream := SwazooStream on: String new. 728 requestStream 729 nextPutLine: 'POST /document/aab.html HTTP/1.1'; 730 nextPutLine: 'Host: biart.eranova.si'; 731 nextPutLine: 'Content-Type: multipart/form-data; boundary= boundary'; 732 nextPutLine: 'Content-Length: 79'; 733 crlf; 734 nextPutLine: '--boundary'; 735 nextPutLine: 'Content-Disposition: form-data; name="id5273"'; 736 crlf; 737 nextPutLine: 'main'; 738 nextPutLine: '--boundary--'. 739 ^HTTPRequest 740 readFrom: (SwazooStream on: requestStream writeBufferContents) 741 ] 742 743 postUrlEncoded [ 744 <category: 'requests'> 745 | requestStream | 746 requestStream := SwazooStream on: String new. 747 requestStream 748 nextPutLine: 'POST /document/aab.html HTTP/1.1'; 749 nextPutLine: 'Host: biart.eranova.si'; 750 nextPutLine: 'Content-Type: application/x-www-form-urlencoded'; 751 nextPutLine: 'Content-Length: 36'; 752 crlf; 753 nextPutAll: 'home=Cosby+one&favorite+flavor=flies'. 754 ^HTTPRequest 755 readFrom: (SwazooStream on: requestStream writeBufferContents) 756 ] 757 758 testBlockCopy [ 759 "streaming with 8k blocks for performance" 760 761 "this is just a basic test with content shorter that one block" 762 763 <category: 'testing-mime parsing'> 764 | boundary message in out | 765 boundary := '--boundary--'. 766 message := 'just something'. 767 in := SwazooStream on: message , self crlf , boundary. 768 out := WriteStream on: String new. 769 HTTPPost new 770 blockStreamingFrom: in 771 to: out 772 until: boundary. 773 self assert: out contents = message 774 ] 775 776 testPost10Simple [ 777 "just one entity" 778 779 <category: 'testing-posts'> 780 | post | 781 post := self postSimple. 782 self assert: post isPostDataEmpty not. 783 self assert: (post postDataStringAt: 'id5273') = 'main' 784 ] 785 786 testPost2Empty [ 787 "post entity with empty value" 788 789 <category: 'testing-posts'> 790 | post | 791 post := self postEmpty. 792 self assert: post isPostDataEmpty not. 793 self assert: (post postDataStringAt: 'id5273') = '' 794 ] 795 796 testPost3Dashes [ 797 "some ---- inside post data" 798 799 <category: 'testing-posts'> 800 | post | 801 post := self postDashes. 802 self assert: post isPostDataEmpty not. 803 self assert: (post postDataStringAt: 'id5273') = '----'. 804 self assert: (post postDataStringAt: 'field2') = '- --' 805 ] 806 807 testPost40File [ 808 <category: 'testing-file posts'> 809 | post | 810 post := self postFile. 811 self assert: post isPostDataEmpty not. 812 self assert: (post postDataStringAt: 'id5273') = 'main'. 813 self assert: (post postDataStringAt: 'field2') = ''. 814 self assert: (post postDataAt: 'field7') filename = 'event.ical'. 815 self 816 assert: ((post postDataStringAt: 'field7') readStream upTo: Character cr) 817 = 'BEGIN:VCALENDAR'. 818 self assert: (post postDataStringAt: 'field7') = self fileContents. 819 self assert: (post postDataStringAt: 'attach') = 'Attach' 820 ] 821 822 testPost41FileStreamed [ 823 <category: 'testing-file posts'> 824 | post stream | 825 post := self postFile. 826 stream := WriteStream on: ByteArray new. 827 post postDataAt: 'field7' streamTo: stream. 828 self assert: (post isPostDataStreamedAt: 'field7'). 829 self deny: post postData isParsed. "post data read from socket defered" 830 self assert: (post postDataStringAt: 'id5273') = 'main'. 831 self assert: post postData isParsed. "first access to post data trigger full read and parse" 832 self assert: (post postDataAt: 'field7') filename = 'event.ical'. 833 self assert: (stream contents asString readStream upTo: Character cr) 834 = 'BEGIN:VCALENDAR'. 835 self assert: stream contents asString = self fileContents. 836 self assert: (post postDataStringAt: 'attach') = 'Attach' 837 ] 838 839 testPost42FileContentType [ 840 <category: 'testing-file posts'> 841 | post | 842 post := self postFile. "set the data to the post" 843 self assert: post isPostDataEmpty not. "read the content of the stream" 844 self assert: (post postDataAt: 'field7') contentType 845 = 'application/octet-stream' 846 ] 847 848 testPost5UrlEncoded [ 849 "just one entity" 850 851 <category: 'testing-posts'> 852 | post | 853 post := self postUrlEncoded. 854 self assert: post isPostDataEmpty not. 855 self assert: (post postDataStringAt: 'home') = 'Cosby one'. 856 self assert: (post postDataStringAt: 'favorite flavor') = 'flies' 857 ] 858 859 testPostPreambleEpilogue [ 860 "mime preamble before first part and epilogue at the end. See #postPreambleEpilogue" 861 862 <category: 'testing-posts'> 863 | post | 864 post := self postPreambleEpilogue. 865 self assert: post isPostDataEmpty not. 866 self assert: (post postDataStringAt: 'id5273') = 'main' 867 ] 868 869 testPostRawEntity [ 870 <category: 'testing-posts'> 871 | requestStream post | 872 requestStream := SwazooStream on: String new. 873 requestStream 874 nextPutLine: 'POST /foobar HTTP/1.0'; 875 nextPutLine: 'Host: foo.com'; 876 nextPutLine: 'Content-Type: text/plain'; 877 nextPutLine: 'Content-Length: 12'; 878 crlf; 879 nextPutLine: 'Hello, World'. 880 post := HTTPRequest 881 readFrom: (SwazooStream on: requestStream writeBufferContents). 882 self assert: post isPostDataEmpty. 883 self assert: post entityBody = 'Hello, World' 884 ] 885 886 testPostUrlEncodedData [ 887 <category: 'testing-posts'> 888 | requestStream post | 889 requestStream := SwazooStream on: String new. 890 requestStream 891 nextPutLine: 'POST / HTTP/1.1'; 892 nextPutLine: 'Host: foo.com'; 893 nextPutLine: 'Content-Type: application/x-www-form-urlencoded'; 894 nextPutLine: 'Content-Length: 31'; 895 crlf; 896 nextPutLine: 'address=+fs&product=&quantity=1'. 897 post := HTTPRequest 898 readFrom: (SwazooStream on: requestStream writeBufferContents). 899 self assert: (post postDataAt: 'address') value = ' fs'. 900 self assert: (post postDataAt: 'product') value = ''. 901 self assert: (post postDataAt: 'quantity') value = '1' 902 ] 903] 904 905 906 907TestCase subclass: HTTPRequestTest [ 908 | request | 909 910 <comment: nil> 911 <category: 'Swazoo-Tests'> 912 913 basicGet [ 914 <category: 'requests-gets'> 915 | requestStream | 916 requestStream := SwazooStream on: String new. 917 requestStream 918 nextPutLine: 'GET / HTTP/1.1'; 919 nextPutLine: 'Host: foo.com'; 920 crlf. 921 ^HTTPRequest 922 readFrom: (SwazooStream on: requestStream writeBufferContents) 923 ] 924 925 basicGetHTTP10 [ 926 <category: 'requests-gets'> 927 | requestStream | 928 requestStream := SwazooStream on: String new. 929 requestStream 930 nextPutLine: 'GET / HTTP/1.0'; 931 crlf. 932 ^HTTPRequest 933 readFrom: (SwazooStream on: requestStream writeBufferContents) 934 ] 935 936 basicGetHTTP10Keepalive [ 937 <category: 'requests-gets'> 938 | requestStream | 939 requestStream := SwazooStream on: String new. 940 requestStream 941 nextPutLine: 'GET / HTTP/1.0'; 942 nextPutLine: 'Connection: Keep-Alive'; 943 crlf. 944 ^HTTPRequest 945 readFrom: (SwazooStream on: requestStream writeBufferContents) 946 ] 947 948 basicHead [ 949 <category: 'requests-gets'> 950 | requestStream | 951 requestStream := SwazooStream on: String new. 952 requestStream 953 nextPutLine: 'HEAD / HTTP/1.1'; 954 nextPutLine: 'Host: foo.com'; 955 crlf. 956 ^HTTPRequest 957 readFrom: (SwazooStream on: requestStream writeBufferContents) 958 ] 959 960 crlfOn: aStream [ 961 <category: 'private'> 962 aStream 963 nextPut: Character cr; 964 nextPut: Character lf 965 ] 966 967 fullGet [ 968 <category: 'requests-gets'> 969 | requestStream | 970 requestStream := SwazooStream on: String new. 971 requestStream 972 nextPutLine: 'GET /aaa/bbb/ccc.html?foo=bar&baz=quux HTTP/1.1'; 973 nextPutLine: 'Connection: Keep-Alive'; 974 nextPutLine: 'User-Agent: Mozilla/4.72 [en] (X11; I; Linux 2.3.51 i686)'; 975 nextPutLine: 'Host: foo.com:8888'; 976 nextPutLine: 'Referer: http://www.bar.com/takeMeThere.html'; 977 crlf. 978 ^HTTPRequest 979 readFrom: (SwazooStream on: requestStream writeBufferContents) 980 ] 981 982 getMultiValueHeader [ 983 <category: 'requests-gets'> 984 | requestStream | 985 requestStream := SwazooStream on: String new. 986 requestStream 987 nextPutLine: 'GET /aaa/bbb/ccc.html?foo=bar&baz=quux HTTP/1.1'; 988 nextPutLine: 'Content-Type: multipart/form-data; boundary= --boundary'; 989 crlf. 990 ^HTTPRequest 991 readFrom: (SwazooStream on: requestStream writeBufferContents) 992 ] 993 994 portedGet [ 995 <category: 'requests-gets'> 996 | requestStream | 997 requestStream := SwazooStream on: String new. 998 requestStream 999 nextPutLine: 'GET / HTTP/1.1'; 1000 nextPutLine: 'Host: foo.com:8888'; 1001 crlf. 1002 ^HTTPRequest 1003 readFrom: (SwazooStream on: requestStream writeBufferContents) 1004 ] 1005 1006 test10ConnectionClose [ 1007 <category: 'testing-other'> 1008 request := self basicGetHTTP10. 1009 self assert: request wantsConnectionClose 1010 ] 1011 1012 test10KeepAliveConnectionClose [ 1013 <category: 'testing-other'> 1014 request := self basicGetHTTP10Keepalive. 1015 self deny: request wantsConnectionClose 1016 ] 1017 1018 testBasicGet [ 1019 <category: 'testing-gets'> 1020 request := self basicGet. 1021 self assert: request isGet. 1022 self assert: request isHttp11. 1023 self deny: request isHead. 1024 self deny: request isPost. 1025 self deny: request isPut 1026 ] 1027 1028 testBasicGetHTTP10 [ 1029 <category: 'testing-gets'> 1030 request := self basicGetHTTP10. 1031 self assert: request isGet. 1032 self assert: request isHttp10. 1033 self deny: request isHead. 1034 self deny: request isPost. 1035 self deny: request isPut 1036 ] 1037 1038 testBasicGetHost [ 1039 <category: 'testing-gets'> 1040 request := self basicGet. 1041 self assert: request host = 'foo.com' 1042 ] 1043 1044 testBasicGetPort [ 1045 <category: 'testing-gets'> 1046 request := self basicGet. 1047 self assert: request port = 80 1048 ] 1049 1050 testBasicHead [ 1051 <category: 'testing-gets'> 1052 request := self basicHead. 1053 self assert: request isHead. 1054 self deny: request isGet. 1055 self deny: request isPost. 1056 self deny: request isPut 1057 ] 1058 1059 testConnection [ 1060 <category: 'testing-other'> 1061 request := self fullGet. 1062 self assert: request connection = 'Keep-Alive' 1063 ] 1064 1065 testGetMultiValueHeader [ 1066 <category: 'testing-gets'> 1067 | header | 1068 request := self getMultiValueHeader. 1069 header := request headerAt: 'Content-Type' ifAbsent: [nil]. 1070 self assert: header mediaType = 'multipart/form-data'. 1071 self assert: (header transferCodings at: 'boundary') = '--boundary'. 1072 self 1073 assert: header valuesAsString = 'multipart/form-data boundary=--boundary' 1074 1075 "'Content-Type: multipart/form-data; boundary= --boundary';" 1076 ] 1077 1078 testHeaderAtIfPresent [ 1079 <category: 'testing-other'> 1080 request := self basicGet. 1081 self assert: (request headers 1082 fieldOfClass: HTTPIfRangeField 1083 ifPresent: [:header | header == (request headers fieldOfClass: HTTPIfRangeField)] 1084 ifAbsent: [true]). 1085 self assert: (request headers 1086 fieldOfClass: HTTPHostField 1087 ifPresent: [:header | header == (request headers fieldOfClass: HTTPHostField)] 1088 ifAbsent: [false]) 1089 ] 1090 1091 testMissingContentType [ 1092 <category: 'testing-other'> 1093 | requestStream result | 1094 requestStream := SwazooStream on: String new. 1095 requestStream 1096 nextPutLine: 'POST /foobar HTTP/1.0'; 1097 nextPutLine: 'Host: foo.com'; 1098 nextPutLine: 'Content-Length: 12'; 1099 crlf; 1100 nextPutLine: 'Hello, World'. 1101 "nextPutLine: 'Content-Type: text/plain'. <-- this is missing!! - and should be for this test" 1102 result := SpExceptionContext 1103 for: 1104 [(HTTPRequest 1105 readFrom: (SwazooStream on: requestStream writeBufferContents)) 1106 ensureFullRead "because of defered post data parsing"] 1107 on: SpError 1108 do: [:ex | ex]. 1109 self assert: result class == SwazooHTTPPostError. 1110 ^self 1111 ] 1112 1113 testNo11ConnectionClose [ 1114 <category: 'testing-other'> 1115 request := self basicGet. 1116 self deny: request wantsConnectionClose 1117 ] 1118 1119 testNoEqualsQueries [ 1120 "The last assert here used to check that 'request queryAt: 'WSDL'' is nil, but a test for an empty string is more consistent with query argument formats." 1121 1122 <category: 'testing-other'> 1123 | requestStream | 1124 requestStream := SwazooStream on: String new. 1125 requestStream 1126 nextPutLine: 'GET /test/typed.asmx?WSDL HTTP/1.1'; 1127 nextPutLine: 'Host: foo.com:8888'; 1128 crlf. 1129 request := HTTPRequest 1130 readFrom: (SwazooStream on: requestStream writeBufferContents). 1131 self assert: (request includesQuery: 'WSDL'). 1132 self assert: (request queryAt: 'WSDL') isEmpty 1133 ] 1134 1135 testPortedGetPort [ 1136 <category: 'testing-gets'> 1137 request := self portedGet. 1138 self assert: request port = 8888 1139 ] 1140 1141 testReferer [ 1142 <category: 'testing-other'> 1143 request := self fullGet. 1144 self 1145 assert: request referer asString = 'http://www.bar.com/takeMeThere.html' 1146 ] 1147 1148 testRequestWithCRButNoLF [ 1149 "| requestStream result | 1150 requestStream := SwazooStream on: String new. 1151 requestStream 1152 nextPutAll: 'GET / HTTP/1.1'; 1153 cr. 1154 result := SpExceptionContext 1155 for: [HTTPRequest readFrom: (SwazooStream on: requestStream writeBufferContents)] 1156 on: SpError 1157 do: [:ex | ex]. 1158 self assert: result class == SwazooHTTPParseError. 1159 ^self" 1160 1161 <category: 'testing-other'> 1162 1163 ] 1164 1165 testUserAgent [ 1166 <category: 'testing-other'> 1167 request := self fullGet. 1168 self 1169 assert: request userAgent = 'Mozilla/4.72 [en] (X11; I; Linux 2.3.51 i686)' 1170 ] 1171] 1172 1173 1174 1175TestCase subclass: HTTPResponseTest [ 1176 | response | 1177 1178 <comment: nil> 1179 <category: 'Swazoo-Tests'> 1180 1181 crlf [ 1182 <category: 'private'> 1183 ^String with: Character cr with: Character lf 1184 ] 1185 1186 testInternalServerError [ 1187 <category: 'testing'> 1188 | ws rs | 1189 response := HTTPResponse internalServerError. 1190 ws := SwazooStream on: String new. 1191 HTTPPrinter new response: response; stream: ws; printStatus. 1192 rs := SwazooStream on: ws writeBufferContents. 1193 self assert: rs nextLine = 'HTTP/1.1 500 Internal Server Error' 1194 ] 1195 1196 testOK [ 1197 <category: 'testing'> 1198 | ws rs | 1199 response := HTTPResponse ok. 1200 ws := SwazooStream on: String new. 1201 HTTPPrinter new response: response; stream: ws; printStatus. 1202 rs := SwazooStream on: ws writeBufferContents. 1203 self assert: rs nextLine = 'HTTP/1.1 200 OK' 1204 ] 1205 1206 testResponseTypes [ 1207 <category: 'testing'> 1208 self assert: HTTPResponse badRequest isBadRequest. 1209 self assert: HTTPResponse found isFound. 1210 self assert: HTTPResponse internalServerError isInternalServerError. 1211 self assert: HTTPResponse movedPermanently isMovedPermanently. 1212 self assert: HTTPResponse notFound isNotFound. 1213 self assert: HTTPResponse notImplemented isNotImplemented. 1214 self assert: HTTPResponse notModified isNotModified. 1215 self assert: HTTPResponse ok isOk. 1216 self assert: HTTPResponse redirectLink isRedirectLink. 1217 self assert: HTTPResponse seeOther isSeeOther 1218 ] 1219] 1220 1221 1222 1223TestCase subclass: HTTPServerTest [ 1224 | server stream | 1225 1226 <comment: nil> 1227 <category: 'Swazoo-Tests'> 1228 1229 setUp [ 1230 <category: 'running'> 1231 | socket | 1232 (Delay forMilliseconds: 100) wait. 1233 server := HTTPServer new. 1234 1235 [server 1236 ip: 'localhost'; 1237 port: 8123. 1238 server start] fork. 1239 (Delay forMilliseconds: 100) wait. 1240 "stream := (SocketAccessor newTCPclientToHost: 'localhost' port: 8123) 1241 readAppendStream" 1242 socket := SpSocket connectToServerOnHost: 'localhost' port: 8123. 1243 stream := SwazooStream socket: socket 1244 ] 1245 1246 tearDown [ 1247 <category: 'running'> 1248 server stop. 1249 stream close. 1250 stream := nil. 1251 Delay forMilliseconds: 500 1252 ] 1253 1254 testServing [ 1255 <category: 'tests'> 1256 self assert: server isServing 1257 ] 1258 1259 testStopServing [ 1260 <category: 'tests'> 1261 server stop. 1262 self deny: server isServing 1263 ] 1264] 1265 1266 1267 1268TestCase subclass: HeaderFieldTest [ 1269 1270 <comment: nil> 1271 <category: 'Swazoo-Tests'> 1272 1273 testCombine [ 1274 "Entity tags must be quoted strings - RFC 2616 3.11" 1275 1276 <category: 'testing'> 1277 | header1 header2 header3 | 1278 header1 := HeaderField fromLine: 'If-Match: "a"'. 1279 header2 := HeaderField fromLine: 'If-Match: "b","c"'. 1280 header3 := HeaderField fromLine: 'If-Match: "d"'. 1281 header1 combineWith: header2. 1282 self assert: header1 valuesAsString = '"a","b","c"'. 1283 header1 combineWith: header3. 1284 self assert: header1 valuesAsString = '"a","b","c","d"' 1285 ] 1286 1287 testContentTypeMultiple [ 1288 "HTTP/1.1 header field values can be folded onto multiple lines if the 1289 continuation line begins with a space or horizontal tab. All linear 1290 white space, including folding, has the same semantics as SP. A 1291 recipient MAY replace any linear white space with a single SP before 1292 interpreting the field value or forwarding the message downstream. 1293 1294 LWS = [CRLF] 1*( SP | HT )" 1295 1296 <category: 'testing'> 1297 | requestStream request field | 1298 requestStream := SwazooStream on: String new. 1299 requestStream 1300 nextPutLine: 'GET / HTTP/1.1'; 1301 nextPutLine: 'Host: 127.0.0.1'; 1302 nextPutLine: 'Content-Type: text/html; '; 1303 nextPutLine: ' charset=iso-8859-1'; 1304 crlf. 1305 request := HTTPRequest 1306 readFrom: (SwazooStream on: requestStream writeBufferContents). 1307 field := request headers fieldNamed: 'content-type'. 1308 self assert: field name = 'Content-Type'. 1309 self assert: field mediaType = 'text/html'. 1310 self assert: (field transferCodings at: 'charset') = 'iso-8859-1' 1311 ] 1312 1313 testValues [ 1314 "Entity tags are held internally as simple strings. Any necessary leading and trailing double quotes are added by the header fields as needed. Note that it is OK to have a comma in an entity tag - see the second of the group of 3 tags below." 1315 1316 <category: 'testing'> 1317 | header | 1318 header := HeaderField fromLine: 'If-Match: "xyzzy" '. 1319 self assert: header name = 'If-Match'. 1320 self assert: header entityTags first = 'xyzzy'. 1321 header := HeaderField 1322 fromLine: 'If-Match: "xyzzy", "r2d2,xxxx", "c3piozzzz" '. 1323 self assert: header name = 'If-Match'. 1324 self assert: header entityTags first = 'xyzzy'. 1325 self assert: (header entityTags at: 2) = 'r2d2,xxxx'. 1326 self assert: header entityTags last = 'c3piozzzz' 1327 ] 1328] 1329 1330 1331 1332TestCase subclass: HelloWorldResourceTest [ 1333 | hello | 1334 1335 <comment: nil> 1336 <category: 'Swazoo-Tests'> 1337 1338 setUp [ 1339 <category: 'running'> 1340 hello := HelloWorldResource uriPattern: 'hello.html' 1341 ] 1342 1343 testResponse [ 1344 <category: 'testing'> 1345 | request response | 1346 request := HTTPGet request: 'hello.html'. 1347 response := URIResolution resolveRequest: request startingAt: hello. 1348 self assert: response code = 200. 1349 self assert: request resourcePath size = 1. 1350 self assert: request resourcePath first = 'hello.html' 1351 ] 1352] 1353 1354 1355 1356TestCase subclass: HomeResourceTest [ 1357 | resource | 1358 1359 <comment: nil> 1360 <category: 'Swazoo-Tests'> 1361 1362 setUp [ 1363 <category: 'running'> 1364 resource := HomeResource uriPattern: '/' filePath: 'home' 1365 ] 1366 1367 testRootFileFor [ 1368 <category: 'running'> 1369 | request | 1370 request := HTTPGet request: '/~someUser'. 1371 URIResolution new initializeRequest: request. 1372 self assert: (resource rootFileFor: request) asString 1373 = (((SpFilename named: 'home') construct: 'someUser') construct: 'html') 1374 asString 1375 ] 1376 1377 testValidateHomePath [ 1378 <category: 'running'> 1379 self assert: (resource validateHomePath: '~somebody'). 1380 self assert: (resource validateHomePath: '~somebodyElse'). 1381 self deny: (resource validateHomePath: 'someplace'). 1382 self deny: (resource validateHomePath: 'some~body') 1383 ] 1384] 1385 1386 1387 1388TestCase subclass: RedirectionResourceTest [ 1389 | resource | 1390 1391 <comment: nil> 1392 <category: 'Swazoo-Tests'> 1393 1394 setUp [ 1395 <category: 'running'> 1396 resource := RedirectionResource uriPattern: 'foo' 1397 targetUri: 'http://abc.def.com' 1398 ] 1399 1400 testGetResource [ 1401 <category: 'testing'> 1402 | request response | 1403 request := HTTPGet request: 'foo'. 1404 response := URIResolution resolveRequest: request startingAt: resource. 1405 self assert: response code = 301. 1406 self assert: (response headers fieldNamed: 'Location') uri asString 1407 = 'http://abc.def.com'. 1408 self assert: request resourcePath size = 1. 1409 self assert: request resourcePath first = 'foo' 1410 ] 1411] 1412 1413 1414 1415TestCase subclass: ResourceTest [ 1416 | resource | 1417 1418 <comment: nil> 1419 <category: 'Swazoo-Tests'> 1420 1421 basicGet: uri [ 1422 <category: 'private'> 1423 | ws | 1424 ws := WriteStream on: String new. 1425 ws nextPutAll: 'GET ' , uri , ' HTTP/1.1'. 1426 self crlfOn: ws. 1427 ws nextPutAll: 'Host: swazoo.org'. 1428 self crlfOn: ws. 1429 self crlfOn: ws. 1430 ^HTTPRequest readFrom: (ReadStream on: ws contents) 1431 ] 1432 1433 basicGetUri: uriString [ 1434 <category: 'private'> 1435 | ws | 1436 ws := WriteStream on: String new. 1437 ws nextPutAll: 'GET ' , uriString , ' HTTP/1.1'. 1438 self crlfOn: ws. 1439 ws nextPutAll: 'Host: swazoo.org'. 1440 self crlfOn: ws. 1441 self crlfOn: ws. 1442 ^HTTPRequest readFrom: (ReadStream on: ws contents) 1443 ] 1444 1445 basicGetUri: uriString host: hostname port: port [ 1446 <category: 'private'> 1447 | ws | 1448 ws := WriteStream on: String new. 1449 ws nextPutAll: 'GET ' , uriString , ' HTTP/1.1'. 1450 self crlfOn: ws. 1451 ws nextPutAll: 'Host: ' , hostname. 1452 port notNil 1453 ifTrue: 1454 [ws 1455 nextPut: $:; 1456 print: port]. 1457 self crlfOn: ws. 1458 self crlfOn: ws. 1459 ^HTTPRequest readFrom: (ReadStream on: ws contents) 1460 ] 1461 1462 crlfOn: aStream [ 1463 <category: 'private'> 1464 aStream 1465 nextPut: Character cr; 1466 nextPut: Character lf 1467 ] 1468 1469 setUp [ 1470 <category: 'running'> 1471 resource := SwazooResource uriPattern: 'foo' 1472 ] 1473 1474 testEmptyURIPatternInvalid [ 1475 <category: 'testing'> 1476 resource uriPattern: ''. 1477 self deny: resource isValidlyConfigured 1478 ] 1479 1480 testEnabledByDefault [ 1481 <category: 'testing'> 1482 self assert: resource isEnabled 1483 ] 1484 1485 testNilURIPatternDoesNothing [ 1486 <category: 'testing'> 1487 | pattern | 1488 pattern := resource uriPattern. 1489 resource uriPattern: nil. 1490 self assert: resource uriPattern = pattern 1491 ] 1492 1493 testValidlyConfigured [ 1494 <category: 'testing'> 1495 self assert: resource isValidlyConfigured 1496 ] 1497 1498 testLeafMatch [ 1499 <category: 'testing'> 1500 self assert: (resource match: 'foo') 1501 ] 1502 1503 testLeafMismatch [ 1504 <category: 'testing'> 1505 self deny: (resource match: 'Foo') 1506 ] 1507 1508] 1509 1510 1511 1512TestCase subclass: SiteIdentifierTest [ 1513 | identifier | 1514 1515 <comment: nil> 1516 <category: 'Swazoo-Tests'> 1517 1518 setUp [ 1519 <category: 'running'> 1520 identifier := SiteIdentifier 1521 host: 'localhost' 1522 ip: '127.0.0.1' 1523 port: 80 1524 ] 1525 1526 testCaseInsensitiveMatch [ 1527 <category: 'testing'> 1528 | another | 1529 another := SiteIdentifier 1530 host: 'lOCaLhOST' 1531 ip: '127.0.0.1' 1532 port: 80. 1533 self assert: (identifier match: another) 1534 ] 1535 1536 testCurrentUrl [ 1537 <category: 'testing'> 1538 self assert: identifier currentUrl = 'http://localhost'. 1539 identifier := SiteIdentifier 1540 host: 'localhost' 1541 ip: '127.0.0.1' 1542 port: 81. 1543 self assert: identifier currentUrl = 'http://localhost:81' 1544 ] 1545 1546 testHostMismatch [ 1547 <category: 'testing'> 1548 | another | 1549 another := SiteIdentifier 1550 host: 'thisIsMyMachine' 1551 ip: '127.0.0.1' 1552 port: 80. 1553 self deny: (identifier match: another) 1554 ] 1555 1556 testIPMismatch [ 1557 <category: 'testing'> 1558 | another | 1559 another := SiteIdentifier 1560 host: 'localhost' 1561 ip: '127.0.0.2' 1562 port: 80. 1563 self deny: (identifier match: another) 1564 ] 1565 1566 testMatch [ 1567 <category: 'testing'> 1568 | another | 1569 another := SiteIdentifier 1570 host: 'localhost' 1571 ip: '127.0.0.1' 1572 port: 80. 1573 self assert: (identifier match: another) 1574 ] 1575 1576 testPortMismatch [ 1577 <category: 'testing'> 1578 | another | 1579 another := SiteIdentifier 1580 host: 'localhost' 1581 ip: '127.0.0.1' 1582 port: 81. 1583 self deny: (identifier match: another) 1584 ] 1585] 1586 1587 1588 1589TestCase subclass: SiteTest [ 1590 | site | 1591 1592 <comment: nil> 1593 <category: 'Swazoo-Tests'> 1594 1595 addSecondAlias [ 1596 <category: 'running'> 1597 site addAlias: (SiteIdentifier 1598 host: 'swazoo2.org' 1599 ip: '127.0.0.2' 1600 port: 8202) 1601 ] 1602 1603 setUp [ 1604 <category: 'running'> 1605 super setUp. 1606 site := SwazooSite new. 1607 site addAlias: (SiteIdentifier 1608 host: 'swazoo.org' 1609 ip: '127.0.0.1' 1610 port: 8200) 1611 ] 1612 1613 testCurrentUrl [ 1614 <category: 'testing'> 1615 site currentUrl = 'http://swazoo.org:8200'. 1616 self addSecondAlias. 1617 site currentUrl = 'http://swazoo.org:8200' 1618 ] 1619 1620 testCurrentUrl80 [ 1621 <category: 'testing'> 1622 | aSite | 1623 aSite := SwazooSite new. 1624 aSite addAlias: (SiteIdentifier 1625 host: 'swazoo.org' 1626 ip: '127.0.0.1' 1627 port: 80). 1628 aSite currentUrl = 'http://swazoo.org'. 1629 aSite currentUrl = 'http://swazoo.org' 1630 ] 1631 1632 testRequestMatch [ 1633 <category: 'testing'> 1634 | request site visitor | 1635 request := HTTPGet 1636 request: 'foo' 1637 from: 'myhosthost:1234' 1638 at: '1.2.3.4'. 1639 visitor := URIResolution new initializeRequest: request. 1640 site := SwazooSite new 1641 host: 'myhosthost' 1642 ip: '1.2.3.4' 1643 port: 1234. 1644 self assert: (site match: request) 1645 ] 1646 1647 testRequestMismatch [ 1648 <category: 'testing'> 1649 | request site | 1650 request := HTTPGet 1651 request: 'foo' 1652 from: 'localhost:1234' 1653 at: '1.2.3.4'. 1654 site := SwazooSite new 1655 host: 'remotehost' 1656 ip: '1.2.3.4' 1657 port: 1234. 1658 self deny: (site match: request) 1659 ] 1660 1661] 1662 1663 1664 1665TestCase subclass: SwazooBaseExtensionsTest [ 1666 1667 <comment: nil> 1668 <category: 'Swazoo-Tests'> 1669 1670 testCharacterArrayTrimBlanks [ 1671 <category: 'testing'> 1672 self 1673 assert: (HTTPString trimBlanksFrom: ' a b c d e f g') = 'a b c d e f g'. 1674 self assert: (HTTPString trimBlanksFrom: 'no blanks') = 'no blanks'. 1675 self assert: (HTTPString trimBlanksFrom: ' leading') = 'leading'. 1676 self assert: (HTTPString trimBlanksFrom: 'trailing ') = 'trailing'. 1677 self assert: (HTTPString trimBlanksFrom: '') = ''. 1678 self 1679 assert: (HTTPString 1680 trimBlanksFrom: (String with: Character cr with: Character lf)) isEmpty 1681 ] 1682 1683 testFilenameEtag [ 1684 "The filename etag is a simple string and does not contain double quotes. Header fields apply double quotes as necessary when writing themselves." 1685 1686 <category: 'testing'> 1687 | fn etag1 etag2 | 1688 fn := SpFilename named: 'etagTest'. 1689 1690 [(fn writeStream) 1691 nextPut: $-; 1692 close. "create file" 1693 etag1 := fn etag. 1694 (Delay forSeconds: 1) wait. 1695 (fn appendStream) 1696 nextPut: $-; 1697 close. "modify file" 1698 etag2 := fn etag. 1699 self assert: (etag1 isKindOf: String). 1700 self assert: (etag2 isKindOf: String). 1701 self deny: etag1 = etag2] 1702 ensure: [fn delete] 1703 ] 1704 1705 testStringNewRandom [ 1706 <category: 'testing'> 1707 | sizes strings | 1708 sizes := #(5 20 6127 2 100). 1709 strings := sizes collect: [:each | HTTPString newRandomString: each]. 1710 strings with: sizes do: [:string :size | self assert: string size = size] 1711 ] 1712] 1713 1714 1715 1716TestCase subclass: SwazooBoundaryTest [ 1717 1718 <comment: nil> 1719 <category: 'Swazoo-Tests'> 1720 1721 testBoundaryFull [ 1722 <category: 'testing-mime boundary'> 1723 | boundary stream | 1724 boundary := '--boundary--'. 1725 stream := SwazooStream on: 'just--boundary--something'. "full boundary" 1726 self assert: (stream signsOfBoundary: boundary) = boundary size 1727 ] 1728 1729 testBoundaryMixed [ 1730 <category: 'testing-mime boundary'> 1731 | boundary stream | 1732 boundary := '--boundary--'. 1733 stream := SwazooStream on: 'yes,--just--boundary--something'. "partial, later full boundary" 1734 self assert: (stream signsOfBoundary: boundary) = boundary size 1735 ] 1736 1737 testBoundaryOnEdge [ 1738 "part of boundary at the end of this stream, remaining probably in the next" 1739 1740 <category: 'testing-mime boundary'> 1741 | boundary stream | 1742 boundary := '--boundary--'. 1743 stream := SwazooStream on: 'just something-'. "just first char of boundary" 1744 self assert: (stream signsOfBoundary: boundary) = 1. 1745 stream := SwazooStream on: 'just something--'. "two chars" 1746 self assert: (stream signsOfBoundary: boundary) = 2. 1747 stream := SwazooStream on: 'just something--bound'. "half" 1748 self assert: (stream signsOfBoundary: boundary) = 7. 1749 stream := SwazooStream on: 'just something--boundary--'. "full boundary at the edge" 1750 self assert: (stream signsOfBoundary: boundary) = boundary size 1751 ] 1752 1753 testBoundaryOnEdgeMixed [ 1754 "signs of boundary in the middle part at the end of this buffer, remaining probably in the next" 1755 1756 <category: 'testing-mime boundary'> 1757 | boundary stream | 1758 boundary := '--boundary--'. 1759 stream := SwazooStream on: 'just-something-'. "sign in the middle, one char at the end" 1760 self assert: (stream signsOfBoundary: boundary) = 1. 1761 stream := SwazooStream on: 'just-something--'. "two chars" 1762 self assert: (stream signsOfBoundary: boundary) = 2. 1763 stream := SwazooStream on: 'just-so--mething--bound'. "even more mixed case" 1764 self assert: (stream signsOfBoundary: boundary) = 7 1765 ] 1766 1767 testBoundarySimple [ 1768 <category: 'testing-mime boundary'> 1769 | boundary stream | 1770 boundary := '--boundary--'. 1771 stream := SwazooStream on: 'just something'. "no boundary" 1772 self assert: (stream signsOfBoundary: boundary) = 0. 1773 stream := SwazooStream on: 'just-something'. "sign of boundary" 1774 self assert: (stream signsOfBoundary: boundary) = 0. 1775 stream := SwazooStream on: 'just--something'. "more sign of boundary" 1776 self assert: (stream signsOfBoundary: boundary) = 0. 1777 stream := SwazooStream on: 'just--boundary--something'. "full boundary" 1778 self assert: (stream signsOfBoundary: boundary) = boundary size 1779 ] 1780 1781 testIndexOfBoundary [ 1782 "index of start of boundary in buffer, both full or partial at the edge/end of buffer" 1783 1784 <category: 'testing-mime boundary'> 1785 | boundary stream | 1786 boundary := '--boundary--'. 1787 stream := SwazooStream on: 'just something'. "no boundary" 1788 self assert: (stream indexOfBoundary: boundary) = 0. 1789 stream := SwazooStream on: 'just--boundary--something-'. "full boundary" 1790 self assert: (stream indexOfBoundary: boundary) = 5. 1791 stream := SwazooStream on: 'just something--boun'. "partial boundary at the edge" 1792 self assert: (stream indexOfBoundary: boundary) = 15. 1793 stream := SwazooStream on: 'just something-'. "partial boundary, one char only" 1794 self assert: (stream indexOfBoundary: boundary) = 15. 1795 stream := SwazooStream on: 'just-som--ething--boun'. "mixed case with partial at the edge" 1796 self assert: (stream indexOfBoundary: boundary) = 17 1797 ] 1798] 1799 1800 1801 1802TestCase subclass: SwazooCacheControlTest [ 1803 | resource cacheTarget request cacheControl | 1804 1805 <comment: nil> 1806 <category: 'Swazoo-Tests'> 1807 1808 setUp [ 1809 <category: 'running'> 1810 | directory firstFile ws | 1811 directory := SpFilename named: 'fResTest'. 1812 directory exists ifFalse: [directory makeDirectory]. 1813 firstFile := directory construct: 'abc.html'. 1814 ws := firstFile writeStream. 1815 [ws nextPutAll: 'hello'] ensure: [ws close]. 1816 resource := FileResource uriPattern: 'foo' filePath: 'fResTest'. 1817 request := HTTPGet request: 'foo/abc.html'. 1818 URIResolution resolveRequest: request startingAt: resource. 1819 cacheControl := SwazooCacheControl new request: request 1820 cacheTarget: (cacheTarget := resource fileFor: request) 1821 ] 1822 1823 tearDown [ 1824 <category: 'running'> 1825 ((SpFilename named: 'fResTest') construct: 'abc.html') delete. 1826 (SpFilename named: 'fResTest') delete 1827 ] 1828 1829 testIfModifiedSinceModified [ 1830 <category: 'testing'> 1831 | response timestampInThePast | 1832 request := HTTPGet request: 'foo/abc.html'. 1833 timestampInThePast := SpTimestamp fromDate: (Date today subtractDays: 1) 1834 andTime: Time now. 1835 request headers addField: (HTTPIfModifiedSinceField new 1836 valueFrom: timestampInThePast asRFC1123String). 1837 cacheControl := SwazooCacheControl new request: request 1838 cacheTarget: cacheTarget. 1839 self assert: cacheControl isNotModified not. 1840 self assert: cacheControl isIfModifiedSince. 1841 response := HTTPResponse ok. 1842 cacheControl addResponseHeaders: response. 1843 self 1844 assert: (response headers fieldNamed: 'ETag') entityTag = cacheTarget etag. 1845 self assert: (response headers fieldNamed: 'Last-Modified') timestamp 1846 = cacheTarget lastModified 1847 ] 1848 1849 testIfModifiedSinceNot [ 1850 <category: 'testing'> 1851 | response | 1852 request headers addField: (HTTPIfModifiedSinceField new 1853 valueFrom: cacheTarget lastModified asRFC1123String). 1854 self assert: cacheControl isNotModified. 1855 self assert: cacheControl isIfModifiedSince not. 1856 response := HTTPResponse notModified. 1857 cacheControl addResponseHeaders: response. 1858 self 1859 assert: (response headers fieldNamed: 'ETag') entityTag = cacheTarget etag. 1860 self assert: (response headers fieldNamed: 'Last-Modified') timestamp 1861 = cacheTarget lastModified 1862 ] 1863 1864 testIfNoneMatchHeaderMatch [ 1865 "same etag" 1866 1867 <category: 'testing'> 1868 | response | 1869 request headers 1870 addField: (HTTPIfNoneMatchField new addEntityTag: cacheTarget etag). 1871 self assert: cacheControl isNotModified. 1872 self deny: cacheControl isIfNoneMatch. 1873 1874 "do NOT include last-modified" 1875 response := HTTPResponse notModified. 1876 cacheControl addResponseHeaders: response. 1877 self 1878 assert: (response headers fieldNamed: 'ETag') entityTag = cacheTarget etag. 1879 self 1880 assert: (response headers fieldNamed: 'Last-Modified' ifNone: [nil]) isNil 1881 ] 1882 1883 testIfNoneMatchHeaderNone [ 1884 "same etag" 1885 1886 <category: 'testing'> 1887 | response | 1888 request := HTTPGet request: 'foo/abc.html'. 1889 request headers addField: (HTTPIfNoneMatchField new valueFrom: 'blah'). 1890 cacheControl := SwazooCacheControl new request: request 1891 cacheTarget: cacheTarget. 1892 self assert: cacheControl isNotModified not. 1893 self assert: cacheControl isIfNoneMatch. 1894 response := HTTPResponse ok. 1895 cacheControl addResponseHeaders: response. 1896 self 1897 assert: (response headers fieldNamed: 'ETag') entityTag = cacheTarget etag. 1898 self assert: (response headers fieldNamed: 'Last-Modified') timestamp 1899 = cacheTarget lastModified 1900 ] 1901 1902 testNoHeaders [ 1903 <category: 'testing'> 1904 | response | 1905 self assert: cacheControl isNotModified not. 1906 self assert: cacheControl isIfNoneMatch. 1907 self assert: cacheControl isIfModifiedSince. 1908 1909 "add both" 1910 response := HTTPResponse ok. 1911 cacheControl addResponseHeaders: response. 1912 self 1913 assert: (response headers fieldNamed: 'ETag') entityTag = cacheTarget etag. 1914 self assert: (response headers fieldNamed: 'Last-Modified') timestamp 1915 = cacheTarget lastModified 1916 ] 1917] 1918 1919 1920 1921TestCase subclass: SwazooCompilerTest [ 1922 1923 <comment: nil> 1924 <category: 'Swazoo-Tests'> 1925 1926 testEvaluate [ 1927 <category: 'running'> 1928 self assert: (SwazooCompiler evaluate: '1 + 2 * 3') = 9 1929 ] 1930 1931 testEvaluateReceiver [ 1932 <category: 'running'> 1933 self assert: (SwazooCompiler evaluate: 'self + 2 * 3' receiver: 1) = 9 1934 ] 1935] 1936 1937 1938 1939TestCase subclass: SwazooConfigurationTest [ 1940 1941 <comment: nil> 1942 <category: 'Swazoo-Tests'> 1943 1944 testCompositeResourceSite [ 1945 <category: 'testing'> 1946 | rs site composite howdy duh hithere | 1947 rs := ReadStream 1948 on: '<Site> 1949 <CompositeResource uriPattern: ''/''> 1950 <HelloWorldResource uriPattern: ''howdy''> 1951 <CompositeResource uriPattern: ''duh''> 1952 <HelloWorldResource uriPattern: ''hithere''> 1953 </CompositeResource> 1954 </CompositeResource> 1955</Site>'. 1956 site := SwazooSite new readFrom: rs. 1957 self assert: site children size = 1. 1958 composite := site children first. 1959 self assert: composite class == CompositeResource. 1960 self assert: composite uriPattern = '/'. 1961 self assert: composite children size = 2. 1962 self assert: composite parent == site. 1963 howdy := composite children first. 1964 self assert: howdy class == HelloWorldResource. 1965 self assert: howdy uriPattern = 'howdy'. 1966 self assert: howdy parent == composite. 1967 duh := composite children last. 1968 self assert: duh children size = 1. 1969 self assert: duh class == CompositeResource. 1970 self assert: duh uriPattern = 'duh'. 1971 self assert: duh parent == composite. 1972 hithere := duh children first. 1973 self assert: hithere class == HelloWorldResource. 1974 self assert: hithere uriPattern = 'hithere'. 1975 self assert: hithere parent == duh 1976 ] 1977 1978 testEmptySite [ 1979 <category: 'testing'> 1980 | rs site alias | 1981 rs := ReadStream 1982 on: '<Site> 1983 <SiteIdentifier ip: ''192.168.1.66'' port: 80 host: ''swazoo.org''> 1984</Site>'. 1985 site := SwazooSite new readFrom: rs. 1986 self assert: site aliases size = 1. 1987 self assert: site currentUrl = 'http://swazoo.org/'. 1988 alias := site aliases first. 1989 self assert: alias host = 'swazoo.org'. 1990 self assert: alias ip = '192.168.1.66'. 1991 self assert: alias port = 80 1992 ] 1993 1994 testFileResourceSite [ 1995 <category: 'testing'> 1996 | rs site resource | 1997 rs := ReadStream 1998 on: '<Site> 1999<SiteIdentifier ip: ''192.168.1.66'' port: 80 host: ''swazoo.org''> 2000 <FileResource uriPattern: ''/'' filePath: ''files''> 2001</Site>'. 2002 site := SwazooSite new readFrom: rs. 2003 self assert: site children size = 1. 2004 resource := site children first. 2005 self assert: resource class == FileResource. 2006 self assert: resource uriPattern = '/'. 2007 self assert: resource filePath = 'files'. 2008 self assert: resource parent == site. 2009 self assert: resource currentUrl = 'http://swazoo.org/' 2010 ] 2011 2012 testMultipleResourcesSite [ 2013 <category: 'testing'> 2014 | rs site resource1 resource2 | 2015 rs := ReadStream 2016 on: '<Site> 2017 <HelloWorldResource uriPattern: ''/''> 2018 <HelloWorldResource uriPattern: ''/''> 2019</Site>'. 2020 site := SwazooSite new readFrom: rs. 2021 self assert: site children size = 2. 2022 resource1 := site children first. 2023 self assert: resource1 class == HelloWorldResource. 2024 self assert: resource1 uriPattern = '/'. 2025 resource2 := site children last. 2026 self assert: resource2 class == HelloWorldResource. 2027 self assert: resource2 uriPattern = '/' 2028 ] 2029 2030 testMultipleSites [ 2031 <category: 'testing'> 2032 | rs sites site alias1 alias2 | 2033 rs := ReadStream 2034 on: '<Site> 2035 <SiteIdentifier ip: ''192.168.1.66'' port: 80 host: ''swazoo.org''> 2036 <SiteIdentifier ip: ''192.168.1.66'' port: 81 host: ''swazoo.org''> 2037</Site> 2038<Site> 2039</Site>'. 2040 sites := SwazooServer readSitesFrom: rs. 2041 self assert: sites size = 2. 2042 site := sites first. 2043 self assert: site aliases size = 2. 2044 alias1 := site aliases first. 2045 self assert: alias1 host = 'swazoo.org'. 2046 self assert: alias1 ip = '192.168.1.66'. 2047 self assert: alias1 port = 80. 2048 alias2 := site aliases last. 2049 self assert: alias2 host = 'swazoo.org'. 2050 self assert: alias2 ip = '192.168.1.66'. 2051 self assert: alias2 port = 81 2052 ] 2053 2054 testSingleResourceSite [ 2055 <category: 'testing'> 2056 | rs site resource | 2057 rs := ReadStream 2058 on: '<Site> 2059<SiteIdentifier ip: ''192.168.1.66'' port: 80 host: ''swazoo.org''> 2060 <HelloWorldResource uriPattern: ''/''> 2061</Site>'. 2062 site := SwazooSite new readFrom: rs. 2063 self assert: site children size = 1. 2064 resource := site children first. 2065 self assert: resource class == HelloWorldResource. 2066 self assert: resource uriPattern = '/'. 2067 self assert: resource parent == site. 2068 self assert: resource currentUrl = 'http://swazoo.org/' 2069 ] 2070 2071 testSiteTag [ 2072 <category: 'testing'> 2073 | rs config tag | 2074 rs := ReadStream on: ' <Site> 2075 2076</Site> '. 2077 config := SwazooSite new. 2078 tag := config nextTagFrom: rs. 2079 self assert: tag = 'Site'. 2080 tag := config nextTagFrom: rs. 2081 self assert: tag = '/Site'. 2082 self assert: (config nextTagFrom: rs) isNil 2083 ] 2084] 2085 2086 2087 2088TestCase subclass: SwazooServerTest [ 2089 2090 <comment: nil> 2091 <category: 'Swazoo-Tests'> 2092 2093 removeTestSiteIfAny [ 2094 <category: 'support'> 2095 | site | 2096 site := SwazooServer siteNamed: self testSiteName. 2097 site notNil ifTrue: [SwazooServer singleton removeSite: site] 2098 ] 2099 2100 testAccessingSite [ 2101 <category: 'testing'> 2102 | site | 2103 self removeTestSiteIfAny. 2104 site := (SwazooSite new) 2105 name: self testSiteName; 2106 host: 'test.org' 2107 ip: 'localhost' 2108 port: 8543. 2109 2110 [SwazooServer singleton addSite: site. 2111 self assert: (SwazooServer siteNamed: self testSiteName) notNil. 2112 site := SwazooServer siteNamed: self testSiteName. 2113 self assert: site name = self testSiteName. 2114 self assert: (SwazooServer siteHostnamed: 'test.org') notNil. 2115 site := SwazooServer siteHostnamed: 'test.org'. 2116 self assert: site host = 'test.org'] 2117 ensure: [SwazooServer singleton removeSite: site] 2118 ] 2119 2120 testAddingAllInterfacesSite [ 2121 "site to listen on all IP interfaces but on specified port" 2122 2123 <category: 'testing-adding sites'> 2124 | site server | 2125 self removeTestSiteIfAny. 2126 server := SwazooServer singleton. 2127 self assert: (server siteNamed: self testSiteName) isNil. 2128 site := (SwazooSite new) 2129 name: self testSiteName; 2130 host: '*' 2131 ip: '*' 2132 port: 7261. 2133 2134 [server addSite: site. 2135 self assert: (server siteNamed: self testSiteName) notNil] 2136 ensure: [server removeSite: site] 2137 ] 2138 2139 testAddingSite [ 2140 <category: 'testing-adding sites'> 2141 | site server nrSites | 2142 self removeTestSiteIfAny. 2143 server := SwazooServer singleton. 2144 nrSites := server sites size. 2145 self assert: (server siteNamed: self testSiteName) isNil. 2146 self assert: (server siteHostnamed: self testSiteName) isNil. 2147 site := (SwazooSite new) 2148 name: self testSiteName; 2149 host: 'test.org' 2150 ip: 'localhost' 2151 port: 5798. 2152 server addSite: site. 2153 self assert: (server siteNamed: self testSiteName) notNil. 2154 self assert: (server siteHostnamed: 'test.org') notNil. 2155 server removeSite: site. 2156 self assert: server sites size = nrSites 2157 ] 2158 2159 testAllInterfacesTwoPortSites [ 2160 "two sites can run on all IP interfaces and different port" 2161 2162 <category: 'testing-adding sites'> 2163 | server site1 site2 | 2164 server := SwazooServer singleton. 2165 site1 := (SwazooSite new) 2166 name: 'allInterfaces1'; 2167 host: '*' 2168 ip: '*' 2169 port: 7261. 2170 site2 := (SwazooSite new) 2171 name: 'allInterfaces2'; 2172 host: '*' 2173 ip: '*' 2174 port: 7262. 2175 2176 [server addSite: site1. 2177 self shouldnt: [server addSite: site2] raise: Error] 2178 ensure: 2179 [server 2180 removeSite: site1; 2181 removeSite: site2] 2182 ] 2183 2184 testAllStarsThenExactOnOtherPort [ 2185 <category: 'testing-adding sites'> 2186 | server site1 site2 | 2187 server := SwazooServer singleton. 2188 site1 := (SwazooSite new) 2189 name: 'allstar232'; 2190 host: '*' 2191 ip: '*' 2192 port: 7261. 2193 site2 := (SwazooSite new) 2194 name: 'exactdfdf'; 2195 host: 'localhost' 2196 ip: 'localhost' 2197 port: 7262. 2198 2199 [server addSite: site1. 2200 self shouldnt: 2201 [server 2202 addSite: site2; 2203 removeSite: site2] 2204 raise: Error] 2205 ensure: [server removeSite: site1] 2206 ] 2207 2208 testDuplicateAllInterfacesSite [ 2209 "two sites cannot run on all IP interfaces and same port" 2210 2211 <category: 'testing-adding sites'> 2212 | server site1 site2 | 2213 server := SwazooServer singleton. 2214 site1 := (SwazooSite new) 2215 name: 'allInterfaces1'; 2216 host: '*' 2217 ip: '*' 2218 port: 7261. 2219 site2 := (SwazooSite new) 2220 name: 'allInterfaces2'; 2221 host: '*' 2222 ip: '*' 2223 port: 7261. 2224 2225 [server addSite: site1. 2226 self should: [server addSite: site2] raise: Error] 2227 ensure: [server removeSite: site1] 2228 ] 2229 2230 testDuplicateNames [ 2231 <category: 'testing-adding sites'> 2232 | site server | 2233 self removeTestSiteIfAny. 2234 server := SwazooServer singleton. 2235 site := (SwazooSite new) 2236 name: self testSiteName; 2237 host: 'test.org' 2238 ip: 'localhost' 2239 port: 6376. 2240 2241 [server addSite: site. 2242 self should: [site name: self testSiteName] raise: Error. 2243 self shouldnt: [site host: 'test.org'] raise: Error. 2244 self should: 2245 [(SwazooSite new) 2246 name: self testSiteName; 2247 host: 'test.org' 2248 ip: 'localhost' 2249 port: 6376] 2250 raise: Error] 2251 ensure: [server removeSite: site] 2252 ] 2253 2254 testSiteName [ 2255 <category: 'support'> 2256 ^'aaabbcc987' 2257 ] 2258 2259 testStartingOnAPort [ 2260 "and all ip interfaces, any host" 2261 2262 <category: 'testing'> 2263 | site server nrServers | 2264 server := SwazooServer singleton. 2265 nrServers := server servers size. 2266 2267 [site := server startOn: 4924. 2268 self assert: site isServing. 2269 self assert: server servers size = (nrServers + 1). 2270 server stopOn: 4924. 2271 self assert: site isServing not. 2272 self assert: server servers size = nrServers] 2273 ensure: 2274 [site stop. 2275 server removeSite: site] 2276 ] 2277 2278 testStartingOnTwoPorts [ 2279 "and all ip interfaces, any host" 2280 2281 <category: 'testing'> 2282 | server nrServers site1 site2 | 2283 server := SwazooServer singleton. 2284 nrServers := server servers size. 2285 2286 [site1 := server startOn: 4924. 2287 site2 := server startOn: 4925. 2288 self assert: site1 isServing. 2289 self assert: site2 isServing. 2290 self assert: server servers size = (nrServers + 2). 2291 server stopOn: 4924. 2292 server stopOn: 4925. 2293 self assert: site1 isServing not. 2294 self assert: site2 isServing not. 2295 self assert: server servers size = nrServers] 2296 ensure: 2297 [site1 stop. 2298 site2 stop. 2299 server 2300 removeSite: site1; 2301 removeSite: site2] 2302 ] 2303 2304 testStartingSite [ 2305 <category: 'testing'> 2306 | site server nrServers | 2307 self removeTestSiteIfAny. 2308 server := SwazooServer singleton. 2309 nrServers := server servers size. 2310 site := (SwazooSite new) 2311 name: self testSiteName; 2312 host: 'test.org' 2313 ip: 'localhost' 2314 port: 8765. 2315 2316 [server addSite: site. 2317 self assert: site isServing not. 2318 SwazooServer startSite: self testSiteName. 2319 self assert: server servers size = (nrServers + 1). 2320 self assert: site isServing. 2321 SwazooServer stopSite: self testSiteName. 2322 self assert: site isServing not. 2323 self assert: server servers size = nrServers] 2324 ensure: 2325 [site stop. 2326 server removeSite: site] 2327 ] 2328] 2329 2330 2331 2332TestCase subclass: SwazooSocketTest [ 2333 | input output | 2334 2335 <comment: nil> 2336 <category: 'Swazoo-Tests'> 2337 2338 setUp [ 2339 <category: 'running'> 2340 | pair | 2341 pair := SwazooSocket connectedPair. 2342 input := pair first. 2343 output := pair last 2344 ] 2345 2346 tearDown [ 2347 <category: 'running'> 2348 input close. 2349 output close 2350 ] 2351 2352 testConnectedPair [ 2353 <category: 'testing'> 2354 (Array with: input with: output) 2355 do: [:each | self assert: (each isKindOf: SwazooSocket)] 2356 ] 2357 2358 testNetworkConnection [ 2359 <category: 'testing'> 2360 | server sem | 2361 input close. 2362 output close. 2363 sem := Semaphore new. 2364 2365 [server := SwazooSocket serverOnIP: '127.0.0.1' port: 65423. 2366 server listenFor: 50. 2367 2368 [input := server accept. 2369 sem signal] fork. 2370 output := SwazooSocket connectTo: 'localhost' port: 65423. 2371 sem wait. 2372 self testReadWrite] 2373 ensure: [server close] 2374 ] 2375 2376 testPartialRead [ 2377 <category: 'testing'> 2378 | bytes | 2379 bytes := ByteArray withAll: #(5 4 3). 2380 self assert: (input write: bytes) = 3. 2381 self assert: (output read: 5) = bytes 2382 ] 2383 2384 testReadTimeout [ 2385 "on Squeak doesn't come back, and also we don't need it for now !!" 2386 2387 "input write: (ByteArray withAll: #(1 2 3)). 2388 self assert: (output read: 3 timeout: 40) = (ByteArray withAll: #(1 2 3)). 2389 self assert: (output read: 3 timeout: 40) = ByteArray new" 2390 2391 <category: 'testing'> 2392 2393 ] 2394 2395 testReadWrite [ 2396 <category: 'testing'> 2397 | bytes | 2398 bytes := ByteArray withAll: #(1 2 3 4 5). 2399 self assert: (input write: bytes) = 5. 2400 self assert: (output read: 5) = bytes. 2401 bytes := ByteArray with: 4. 2402 self assert: (input write: bytes) = 1. 2403 self assert: (output read: 1) = bytes 2404 ] 2405] 2406 2407 2408 2409TestCase subclass: SwazooStreamTest [ 2410 | input output | 2411 2412 <comment: nil> 2413 <category: 'Swazoo-Tests'> 2414 2415 crlfOn: aSwazooStream [ 2416 <category: 'running'> 2417 aSwazooStream 2418 nextPut: Character cr; 2419 nextPut: Character lf 2420 ] 2421 2422 setUp [ 2423 <category: 'running'> 2424 | pair | 2425 pair := SwazooStream connectedPair. 2426 input := pair first. 2427 output := pair last 2428 ] 2429 2430 tearDown [ 2431 <category: 'running'> 2432 input close. 2433 output close 2434 ] 2435 2436 testConnectedPair [ 2437 <category: 'testing'> 2438 (Array with: input with: output) 2439 do: [:each | self assert: (each isKindOf: SwazooStream)] 2440 ] 2441 2442 testErrorOnInputClose [ 2443 <category: 'testing'> 2444 self should: 2445 [input close. 2446 output next] 2447 raise: Error 2448 ] 2449 2450 testLinesWithDoubleCRLF [ 2451 <category: 'testing-lines'> 2452 | ws rs comparisonString | 2453 comparisonString := 'abcd'. 2454 ws := SwazooStream on: String new. 2455 ws nextPutAll: comparisonString. 2456 self crlfOn: ws. 2457 self crlfOn: ws. 2458 rs := SwazooStream on: ws writeBufferContents. 2459 self assert: rs nextLine = comparisonString. 2460 self assert: rs nextLine = '' 2461 ] 2462 2463 testNextPut [ 2464 <category: 'testing'> 2465 #($A $M $Y $b $r $z) do: 2466 [:each | 2467 self assert: (input nextPut: each) = each. 2468 input flush. 2469 self assert: output next = each] 2470 ] 2471 2472 testNextPutAll [ 2473 <category: 'testing'> 2474 #('123' 'abc' 'swazoo') do: 2475 [:each | 2476 self assert: (input nextPutAll: each) = each. 2477 input flush. 2478 self assert: (output next: each size) = each] 2479 ] 2480 2481 testNextPutByte [ 2482 <category: 'testing'> 2483 | bytes | 2484 bytes := ByteArray 2485 with: 6 2486 with: 5 2487 with: 0 2488 with: 2. 2489 bytes do: 2490 [:each | 2491 self assert: (input nextPutByte: each) = each. 2492 input flush. 2493 self assert: output nextByte = each] 2494 ] 2495 2496 testNextPutBytes [ 2497 <category: 'testing'> 2498 | bytes1 bytes2 bytes3 | 2499 bytes1 := ByteArray withAll: #(1 2 3 4). 2500 bytes2 := ByteArray withAll: #(5 4 3 2 1). 2501 bytes3 := ByteArray withAll: #(1 1 2 3 5). 2502 (Array 2503 with: bytes1 2504 with: bytes2 2505 with: bytes3) do: 2506 [:each | 2507 self assert: (input nextPutBytes: each) = each. 2508 input flush. 2509 self assert: (output nextBytes: each size) = each] 2510 ] 2511 2512 testPeek [ 2513 <category: 'testing'> 2514 #($K $J $D $j $m $z) do: 2515 [:each | 2516 input nextPut: each. 2517 input flush. 2518 self assert: output peek = each. 2519 output next] 2520 ] 2521 2522 testPeekByte [ 2523 <category: 'testing'> 2524 | bytes | 2525 bytes := ByteArray withAll: #(5 2 8 4 11 231). 2526 bytes do: 2527 [:each | 2528 input nextPutByte: each. 2529 input flush. 2530 self assert: output peekByte = each. 2531 output nextByte] 2532 ] 2533 2534 testSingleLineWithCR [ 2535 <category: 'testing-lines'> 2536 | ws rs comparisonString errored | 2537 comparisonString := 'abcd' , (String with: Character cr) , 'efg'. 2538 ws := SwazooStream on: String new. 2539 ws nextPutAll: comparisonString. 2540 ws nextPut: Character cr. 2541 rs := SwazooStream on: ws writeBufferContents. 2542 errored := false. 2543 SpExceptionContext 2544 for: [rs nextLine] 2545 on: SpError 2546 do: [:ex | errored := true]. 2547 self assert: errored 2548 ] 2549 2550 testSingleLineWithCRLF [ 2551 <category: 'testing-lines'> 2552 | ws rs comparisonString | 2553 comparisonString := 'abcd'. 2554 ws := SwazooStream on: String new. 2555 ws nextPutAll: comparisonString. 2556 self crlfOn: ws. 2557 rs := SwazooStream on: ws writeBufferContents. 2558 self assert: rs nextLine = comparisonString 2559 ] 2560] 2561 2562 2563 2564TestCase subclass: SwazooURITest [ 2565 | fooURI encodedURI barURI queryURI | 2566 2567 <comment: nil> 2568 <category: 'Swazoo-Tests'> 2569 2570 setUp [ 2571 <category: 'running'> 2572 fooURI := SwazooURI fromString: 'www.foo.com/index.html'. 2573 encodedURI := SwazooURI fromString: 'www.foo.com/index%3F.html'. 2574 queryURI := SwazooURI fromString: 'www.foo.com/index.html?foo=1&bar=hi%26'. 2575 barURI := SwazooURI fromString: 'www.bar.com:8080/files/' 2576 ] 2577 2578 testHostname [ 2579 <category: 'running'> 2580 self assert: fooURI hostname = 'www.foo.com'. 2581 self assert: encodedURI hostname = 'www.foo.com'. 2582 self assert: queryURI hostname = 'www.foo.com'. 2583 self assert: barURI hostname = 'www.bar.com' 2584 ] 2585 2586 testIdentifier [ 2587 <category: 'running'> 2588 self assert: fooURI identifier = '/index.html'. 2589 self assert: encodedURI identifier = '/index%3F.html'. 2590 self assert: queryURI identifier = '/index.html'. 2591 self assert: barURI identifier = '/files/' 2592 ] 2593 2594 testIdentifierPath [ 2595 <category: 'running'> 2596 self assert: fooURI identifierPath 2597 = (OrderedCollection with: '/' with: 'index.html'). 2598 self assert: encodedURI identifierPath 2599 = (OrderedCollection with: '/' with: 'index?.html'). 2600 self assert: queryURI identifierPath 2601 = (OrderedCollection with: '/' with: 'index.html'). 2602 self 2603 assert: barURI identifierPath = (OrderedCollection with: '/' with: 'files') 2604 ] 2605 2606 testIsDirectory [ 2607 <category: 'running'> 2608 self deny: fooURI isDirectory. 2609 self deny: encodedURI isDirectory. 2610 self deny: queryURI isDirectory. 2611 self assert: barURI isDirectory 2612 ] 2613 2614 testPort [ 2615 <category: 'running'> 2616 self assert: fooURI port = 80. 2617 self assert: encodedURI port = 80. 2618 self assert: queryURI port = 80. 2619 self assert: barURI port = 8080 2620 ] 2621 2622 testQueries [ 2623 <category: 'running'> 2624 self deny: (queryURI includesQuery: 'hi'). 2625 self assert: (queryURI includesQuery: 'foo'). 2626 self assert: (queryURI includesQuery: 'bar'). 2627 self assert: (queryURI queryAt: 'foo') = '1'. 2628 self assert: (queryURI queryAt: 'bar') = 'hi&' 2629 ] 2630 2631 testValue [ 2632 <category: 'running'> 2633 self assert: fooURI value = 'http://www.foo.com/index.html'. 2634 self assert: encodedURI value = 'http://www.foo.com/index%3F.html'. 2635 self assert: queryURI value = 'http://www.foo.com/index.html?foo=1&bar=hi%26'. 2636 self assert: barURI value = 'http://www.bar.com:8080/files/' 2637 ] 2638] 2639 2640 2641 2642TestCase subclass: URIParsingTest [ 2643 2644 <comment: nil> 2645 <category: 'Swazoo-Tests'> 2646 2647 test05SimpleFullURI [ 2648 <category: 'testing'> 2649 | uri | 2650 uri := SwazooURI fromString: 'http://abc.com:8080/smith/home.html'. 2651 self assert: uri protocol = 'http'. 2652 self assert: uri hostname = 'abc.com'. 2653 self assert: uri port = 8080. 2654 self assert: uri identifier = '/smith/home.html'. 2655 self assert: uri asString = 'http://abc.com:8080/smith/home.html' 2656 ] 2657 2658 test10SimpleFullURIWithQuery [ 2659 <category: 'testing'> 2660 | uri | 2661 uri := SwazooURI fromString: 'http://abc.com:8080/smith/home.html?a=1&b=2'. 2662 self assert: uri protocol = 'http'. 2663 self assert: uri hostname = 'abc.com'. 2664 self assert: uri port = 8080. 2665 self assert: uri identifier = '/smith/home.html'. 2666 self assert: uri asString = 'http://abc.com:8080/smith/home.html?a=1&b=2' 2667 ] 2668 2669 test15SimpleFullURIWithPort80 [ 2670 <category: 'testing'> 2671 | uri | 2672 uri := SwazooURI fromString: 'http://abc.com:80/smith/home.html?a=1&b=2'. 2673 self assert: uri protocol = 'http'. 2674 self assert: uri hostname = 'abc.com'. 2675 self assert: uri port = 80. 2676 self assert: uri identifier = '/smith/home.html'. 2677 self assert: uri asString = 'http://abc.com/smith/home.html?a=1&b=2' 2678 ] 2679 2680 test20SimpleFullURIWithNoPort [ 2681 <category: 'testing'> 2682 | uri | 2683 uri := SwazooURI fromString: 'http://abc.com/smith/home.html?a=1&b=2'. 2684 self assert: uri protocol = 'http'. 2685 self assert: uri hostname = 'abc.com'. 2686 self assert: uri port = 80. 2687 self assert: uri identifier = '/smith/home.html'. 2688 self assert: uri asString = 'http://abc.com/smith/home.html?a=1&b=2' 2689 ] 2690] 2691 2692 2693 2694TestCase subclass: URIResolutionTest [ 2695 2696 <comment: nil> 2697 <category: 'Swazoo-Tests'> 2698 2699 testCompositeAnswer [ 2700 <category: 'testing'> 2701 | resource request response | 2702 resource := CompositeResource uriPattern: 'base'. 2703 resource addResource: (HelloWorldResource uriPattern: 'hi'). 2704 request := HTTPGet request: 'base/hi'. 2705 response := URIResolution resolveRequest: request startingAt: resource. 2706 self assert: response code = 200. 2707 self assert: request resourcePath size = 2. 2708 self assert: request resourcePath first = 'base'. 2709 self assert: request resourcePath last = 'hi' 2710 ] 2711 2712 testCompositeItselfCannotAnswer [ 2713 <category: 'testing'> 2714 | resource request response | 2715 resource := CompositeResource uriPattern: 'base'. 2716 request := HTTPGet request: 'base'. 2717 response := URIResolution resolveRequest: request startingAt: resource. 2718 self assert: response isNil 2719 ] 2720 2721 testCompositeNoAnswer [ 2722 <category: 'testing'> 2723 | resource request response | 2724 resource := CompositeResource uriPattern: 'base'. 2725 resource addResource: (HelloWorldResource uriPattern: 'hi'). 2726 request := HTTPGet request: 'tail/hi'. 2727 response := URIResolution resolveRequest: request startingAt: resource. 2728 self assert: response isNil 2729 ] 2730 2731 testLeafAnswer [ 2732 <category: 'testing'> 2733 | resource request response | 2734 resource := HelloWorldResource uriPattern: 'hi'. 2735 request := HTTPGet request: 'hi'. 2736 response := URIResolution resolveRequest: request startingAt: resource. 2737 self assert: response code = 200. 2738 self assert: request resourcePath size = 1. 2739 self assert: request resourcePath first = 'hi' 2740 ] 2741 2742 testNoAnswerWhenDisabled [ 2743 <category: 'testing'> 2744 | resource request response | 2745 resource := HelloWorldResource uriPattern: 'hi'. 2746 resource disable. 2747 request := HTTPGet request: 'hi'. 2748 response := URIResolution resolveRequest: request startingAt: resource. 2749 self assert: response isNil 2750 ] 2751 2752 testResourcePath [ 2753 <category: 'testing'> 2754 | request resolution | 2755 request := HTTPGet 2756 request: 'foo/bar/baz/quux' 2757 from: 'localhost:1234' 2758 at: '1.2.3.4'. 2759 resolution := URIResolution new initializeRequest: request. 2760 self assert: resolution resourcePath = #('foo') asOrderedCollection. 2761 resolution advance. 2762 self assert: resolution resourcePath = #('foo' 'bar') asOrderedCollection. 2763 resolution advance. 2764 self 2765 assert: resolution resourcePath = #('foo' 'bar' 'baz') asOrderedCollection. 2766 resolution advance. 2767 self assert: resolution resourcePath 2768 = #('foo' 'bar' 'baz' 'quux') asOrderedCollection 2769 ] 2770 2771 testSiteAnswer [ 2772 <category: 'testing'> 2773 | resource request response | 2774 resource := SwazooSite new 2775 port: 80. 2776 resource addResource: (HelloWorldResource uriPattern: '/'). 2777 request := HTTPGet 2778 request: '/' 2779 from: 'foo.com' 2780 at: '1.2.3.4'. 2781 response := URIResolution resolveRequest: request startingAt: resource. 2782 self assert: response code = 200. 2783 self assert: request resourcePath size = 1. 2784 self assert: request resourcePath first = '/' 2785 ] 2786 2787 testSiteMatch [ 2788 <category: 'testing'> 2789 | request site response | 2790 request := HTTPGet 2791 request: '/' 2792 from: 'myhosthost:1234' 2793 at: '1.2.3.4'. 2794 site := SwazooSite new 2795 host: 'myhosthost' 2796 ip: '1.2.3.4' 2797 port: 1234. 2798 site addResource: (HelloWorldResource uriPattern: '/'). 2799 response := URIResolution resolveRequest: request startingAt: site. 2800 self assert: response code = 200. 2801 ] 2802 2803 testSiteMismatch [ 2804 <category: 'testing'> 2805 | request site response | 2806 request := HTTPGet 2807 request: '/' 2808 from: 'localhost:1234' 2809 at: '1.2.3.4'. 2810 site := SwazooSite new 2811 host: 'remotehost' 2812 ip: '1.2.3.4' 2813 port: 1234. 2814 site addResource: (HelloWorldResource uriPattern: '/'). 2815 response := URIResolution resolveRequest: request startingAt: site. 2816 self assert: response isNil. 2817 ] 2818 2819 testStringMatch [ 2820 <category: 'testing'> 2821 | request response resource | 2822 request := HTTPGet request: 'foo'. 2823 resource := HelloWorldResource uriPattern: 'foo'. 2824 response := URIResolution resolveRequest: request startingAt: resource. 2825 self assert: response code = 200. 2826 ] 2827 2828 testStringMismatch [ 2829 <category: 'testing'> 2830 | request response resource | 2831 request := HTTPGet request: 'foo'. 2832 resource := HelloWorldResource uriPattern: 'Foo'. 2833 response := URIResolution resolveRequest: request startingAt: resource. 2834 self assert: response isNil. 2835 ] 2836 2837 testTailPath [ 2838 <category: 'testing'> 2839 | request resolution | 2840 request := HTTPGet 2841 request: 'foo/bar/baz/quux' 2842 from: 'localhost:1234' 2843 at: '1.2.3.4'. 2844 resolution := URIResolution new initializeRequest: request. 2845 self 2846 assert: resolution tailPath = #('bar' 'baz' 'quux') asOrderedCollection. 2847 resolution advance. 2848 self assert: resolution tailPath = #('baz' 'quux') asOrderedCollection. 2849 resolution advance. 2850 self assert: resolution tailPath = #('quux') asOrderedCollection. 2851 resolution advance. 2852 self assert: resolution tailPath isEmpty 2853 ] 2854] 2855 2856 2857 2858