diff --git a/tests/helper.scm b/tests/helper.scm index 1da8b818..bea7cfbe 100644 --- a/tests/helper.scm +++ b/tests/helper.scm @@ -37,6 +37,25 @@ (load "test.scm") ;;; Software timer (load "timer.scm") +(define m2pa-var-forward-seq #xFFFFFF) + +;;; Helper constants + +(define helper-direction-recv 1) +(define helper-direction-send 2) + +;;; Helper variables + +(define helper-var-last-display-msg '()) +(define helper-var-last-display-direction 0) +(define helper-var-display-newline #f) + +(define helper-init-vars + (lambda () + (set! helper-var-last-display-msg '()) + (set! helper-var-last-display-direction 0) + (set! helper-var-display-newline #f) + )) (define predicate? (lambda (pred data) @@ -94,6 +113,25 @@ ret)) !# +(define msg-display + (lambda (message direction) + (if (and (equal? message helper-var-last-display-msg) (= direction helper-var-last-display-direction)) + (begin + (display ".") + (set! helper-var-display-newline #t)) + (begin + (if helper-var-display-newline + (begin + (display "\n") + (set! helper-var-display-newline #f))) + (if (= direction helper-direction-recv) + (display "<-") + (display "->")) + (set! helper-var-last-display-msg (list-copy message)) + (set! helper-var-last-display-direction direction) + (display message) + (display "\n"))))) + ;;; ;;; Padding helper functions ;;; diff --git a/tests/pkth.scm b/tests/pkth.scm index 4e875f70..555c6633 100644 --- a/tests/pkth.scm +++ b/tests/pkth.scm @@ -39,11 +39,13 @@ (load "sock.scm") ;;; Helper functions (load "helper.scm") +;;; Network configuration +(load "pkth_config.scm") ;;; SCTP Payload Protocol Identifier for PKTH (define pkth-ppid 0) -;;; SCTP Port for PKTH +;;; TCP/SCTP Port for PKTH (define pkth-port 7234) ;;; PKTH protocol version @@ -152,6 +154,7 @@ ;;; Value lengths (define pkth-length-version 2) +(define pkth-length-revision 2) (define pkth-length-string-length 2) (define pkth-length-flags 2) (define pkth-length-reserved 2) @@ -178,7 +181,7 @@ ;;; Value offsets pkth-type-init-ack (define pkth-init-ack-offset-game-version pkth-offset-data) (define pkth-init-ack-offset-beta-revision (+ pkth-init-ack-offset-game-version pkth-length-version)) -(define pkth-init-ack-offset-session-id (+ pkth-init-ack-offset-beta-revision pkth-length-version)) +(define pkth-init-ack-offset-session-id (+ pkth-init-ack-offset-beta-revision pkth-length-revision)) (define pkth-init-ack-offset-player-id (+ pkth-init-ack-offset-session-id pkth-length-session-id)) ;;; Minimum/maximum packet length @@ -348,7 +351,6 @@ (lambda (message) (pkth-assert-minimal-length message) (let ((type (bytes->uint16 (list-head (list-tail message pkth-offset-type) pkth-length-type)))) - (test-assert (pkth-is-valid-type? type)) type))) (define pkth-get-length @@ -361,6 +363,28 @@ (pkth-assert-minimal-length message) (list-tail message pkth-offset-data))) +;;; init-ack + +(define pkth-get-init-ack-game-version + (lambda (message) + (pkth-assert-length message (+ pkth-header-length-common pkth-length-version)) + (bytes->uint16 (list-head (pkth-get-data message) pkth-length-version)))) + +(define pkth-get-init-ack-beta-revision + (lambda (message) + (pkth-assert-length message (+ pkth-header-length-common pkth-init-ack-offset-beta-revision pkth-length-revision)) + (bytes->uint16 (list-head (list-tail (pkth-get-data message) pkth-init-ack-offset-beta-revision) pkth-length-revision)))) + +(define pkth-get-init-ack-session-id + (lambda (message) + (pkth-assert-length message (+ pkth-header-length-common pkth-init-ack-offset-session-id pkth-length-session-id)) + (bytes->uint32 (list-head (list-tail (pkth-get-data message) pkth-init-ack-offset-session-id) pkth-length-session-id)))) + +(define pkth-get-init-ack-player-id + (lambda (message) + (pkth-assert-length message (+ pkth-header-length-common pkth-init-ack-offset-player-id pkth-length-player-id)) + (bytes->uint32 (list-head (list-tail (pkth-get-data message) pkth-init-ack-offset-player-id) pkth-length-player-id)))) + ;;; ;;; Type check functions ;;; @@ -547,15 +571,85 @@ ;;; pkth-type-init +;;; +;;; I/O functions +;;; + +;;; Close helper +(define pkth-has-sock #f) +(define pkth-sock 0) +(define pkth-recv-buf "") + +(define pkth-close + (lambda () + (if pkth-has-sock + (begin + (sock-close pkth-sock) + (set! pkth-has-sock #f) + (set! pkth-recv-buf ""))))) + +;;; Connect to server according to config. +(define pkth-connect + (lambda () + (pkth-close) + (helper-init-vars) + (let ((sock (sock-create-tcp PKTH_CONF_CONNECT_ADDR_FAMILY))) + (sock-bind sock PKTH_CONF_CONNECT_LOCAL_ADDR PKTH_CONF_CONNECT_LOCAL_PORT) + (sock-connect sock PKTH_CONF_CONNECT_REMOTE_ADDR PKTH_CONF_CONNECT_REMOTE_PORT) + (set! pkth-sock sock) + (set! pkth-has-sock #t) + sock))) + +(define pkth-send-message-nolog + (lambda (socket message) + (sock-send socket (bytes->string message)))) + +(define pkth-send-message + (lambda (socket message) + (msg-display message helper-direction-send) + (pkth-send-message-nolog socket message))) + +; The recv function for PKTH is somewhat more complicated, because +; TCP has to be supported. We have to check for message boundaries. +(define pkth-recv-message + (lambda (socket) + (let ((ret 0)) + (do ((abort #f)) + (abort) + (let ((buflen (string-length pkth-recv-buf))) + (if (>= buflen pkth-header-length-common) + (begin + (let ((packetlen (pkth-get-length (string->bytes pkth-recv-buf)))) + (if (<= packetlen buflen) + (begin + (set! abort #t) + (let ((packet (string-copy (substring pkth-recv-buf 0 packetlen)))) + (set! pkth-recv-buf (string-drop pkth-recv-buf packetlen)) + (set! ret (string->bytes packet)) + (test-assert (pkth-is-valid-type? (pkth-get-type ret)) "Invalid PKTH message type.") + (msg-display ret helper-direction-recv)))))))) + (if (not abort) + (let ((buf (make-string pkth-maximum-message-length))) + (let ((recvret (sock-recv! socket buf))) + (let ((tmpbuf (substring buf 0 (car recvret)))) + (if (string-null? tmpbuf) ; Abort if connection closed. + (begin + (set! pkth-recv-buf "") + (set! abort #t) + (set! ret #f)) + (begin + (set! pkth-recv-buf (string-append pkth-recv-buf tmpbuf))))))))) + ret))) + #! -(let ((sock (sock-connect (sock-create-tcp AF_INET) "127.0.0.1" pkth-port))) - (sock-send +(let ((sock (pkth-connect))) + (pkth-send-message sock - (bytes->string - (pkth-create-init - (pkth-create-md5 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16) - "" - "hallo"))) + (pkth-create-init + (pkth-create-md5 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16) + "" + "hallo")) + (pkth-recv-message sock) (sleep 1) - (sock-close sock)) + (pkth-close)) !# diff --git a/tests/pkth_config.scm b/tests/pkth_config.scm new file mode 100644 index 00000000..da264868 --- /dev/null +++ b/tests/pkth_config.scm @@ -0,0 +1,40 @@ +;;; +;;; Copyright (C) 2007 Lothar May l-may@gmx.de +;;; +;;; All rights reserved. +;;; +;;; Redistribution and use in source and binary forms, with or +;;; without modification, are permitted provided that the +;;; following conditions are met: +;;; 1. Redistributions of source code must retain the above +;;; copyright notice, this list of conditions and the +;;; following disclaimer. +;;; 2. Redistributions in binary form must reproduce the +;;; above copyright notice, this list of conditions and +;;; the following disclaimer in the documentation and/or +;;; other materials provided with the distribution. +;;; 3. Neither the name of the project nor the names of +;;; its contributors may be used to endorse or promote +;;; products derived from this software without specific +;;; prior written permission. +;;; +;;; THIS SOFTWARE IS PROVIDED BY THE PROJECT AND CONTRIBUTORS +;;; ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, +;;; BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF +;;; MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE +;;; DISCLAIMED. IN NO EVENT SHALL THE PROJECT OR CONTRIBUTORS +;;; BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, +;;; EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT +;;; LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; +;;; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) +;;; HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER +;;; IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING +;;; NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE +;;; USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY +;;; OF SUCH DAMAGE. + +(define PKTH_CONF_CONNECT_LOCAL_ADDR "192.168.1.5") +(define PKTH_CONF_CONNECT_LOCAL_PORT 0) +(define PKTH_CONF_CONNECT_REMOTE_ADDR "192.168.1.4") +(define PKTH_CONF_CONNECT_REMOTE_PORT 7234) +(define PKTH_CONF_CONNECT_ADDR_FAMILY AF_INET) diff --git a/tests/pkth_tests.scm b/tests/pkth_tests.scm new file mode 100644 index 00000000..70e8138f --- /dev/null +++ b/tests/pkth_tests.scm @@ -0,0 +1,64 @@ +;;; +;;; Copyright (C) 2007 Lothar May l-may@gmx.de +;;; +;;; All rights reserved. +;;; +;;; Redistribution and use in source and binary forms, with or +;;; without modification, are permitted provided that the +;;; following conditions are met: +;;; 1. Redistributions of source code must retain the above +;;; copyright notice, this list of conditions and the +;;; following disclaimer. +;;; 2. Redistributions in binary form must reproduce the +;;; above copyright notice, this list of conditions and +;;; the following disclaimer in the documentation and/or +;;; other materials provided with the distribution. +;;; 3. Neither the name of the project nor the names of +;;; its contributors may be used to endorse or promote +;;; products derived from this software without specific +;;; prior written permission. +;;; +;;; THIS SOFTWARE IS PROVIDED BY THE PROJECT AND CONTRIBUTORS +;;; ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, +;;; BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF +;;; MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE +;;; DISCLAIMED. IN NO EVENT SHALL THE PROJECT OR CONTRIBUTORS +;;; BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, +;;; EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT +;;; LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; +;;; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) +;;; HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER +;;; IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING +;;; NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE +;;; USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY +;;; OF SUCH DAMAGE. + +;;; PKTH functions +(load "pkth.scm") + +(define pkth-test-list '()) + +(define (pkth-test-init-packet-too-large) + (let ((sock (pkth-connect))) + (display "Sending loads of large init packets...\n") + (dotimes (n 2048) + (pkth-send-message + sock + (pkth-create-packet + pkth-type-init + (list + (uint16->bytes pkth-version-major) + (uint16->bytes pkth-version-minor) + (uint16->bytes (string-length "")) + (uint16->bytes (string-length "test")) + (uint16->bytes 0) + (uint16->bytes 0) + (append-padding (string->bytes "")) + (append-padding (string->bytes "test")) + (make-list 1024 0))))) + (display "Done.\n") + )) +(set! pkth-test-list (test-register pkth-test-list "PKTH Test 1 Init with too large packets" pkth-test-init-packet-too-large)) + +(test-run-all pkth-test-list) +(pkth-close)