More work on network tests.
This commit is contained in:
lotodore
@@ -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
|
||||
;;;
|
||||
|
||||
+105
-11
@@ -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))
|
||||
!#
|
||||
|
||||
@@ -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)
|
||||
@@ -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)
|
||||
Reference in New Issue
Block a user