From bae38aad778c574f400102f2cbb7302f9167a561 Mon Sep 17 00:00:00 2001 From: Michael Tuexen Date: Sat, 27 Aug 2016 11:04:43 +0200 Subject: Import to git. --- common.scm | 283 +++++++++++ dotguile | 35 ++ m3ua-asp-tests.scm | 679 +++++++++++++++++++++++++ m3ua-param-testtool.scm | 137 ++++++ m3ua-sgp-tests.scm | 1251 +++++++++++++++++++++++++++++++++++++++++++++++ m3ua.scm | 1227 ++++++++++++++++++++++++++++++++++++++++++++++ run-some-asp-tests | 20 + run-some-sgp-tests | 20 + runm3uatest.c | 146 ++++++ 9 files changed, 3798 insertions(+) create mode 100644 common.scm create mode 100644 dotguile create mode 100644 m3ua-asp-tests.scm create mode 100644 m3ua-param-testtool.scm create mode 100644 m3ua-sgp-tests.scm create mode 100644 m3ua.scm create mode 100755 run-some-asp-tests create mode 100755 run-some-sgp-tests create mode 100644 runm3uatest.c diff --git a/common.scm b/common.scm new file mode 100644 index 0000000..b34b59b --- /dev/null +++ b/common.scm @@ -0,0 +1,283 @@ +;;; +;;; Copyright (c) 2004 - 2012 Michael Tuexen +;;; +;;; 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. + +;;; $Id: common.scm,v 1.8 2012/08/25 14:37:00 tuexen Exp $ + +;;; Load the SCTP API needed. +(if (not (defined? 'sctp-send-with-crc32c)) + (use-modules (net sctp))) + +(if (string=? (major-version) "1") + (use-modules (ice-9 syncase))) + +;;; Just have a convenient way of simple looping. +(define-syntax dotimes + (syntax-rules () + ((_ (var n res) . body) + (do ((limit n) + (var 0 (+ var 1))) + ((>= var limit) res) + . body)) + ((_ (var n) . body) + (do ((limit n) + (var 0 (+ var 1))) + ((>= var limit)) + . body)))) + +;;; The following functions implement modulo arithmetic. +(define 2^8 (expt 2 8)) +(define 2^16 (expt 2 16)) +(define 2^24 (expt 2 24)) +(define 2^32 (expt 2 32)) + +(define 2^8-1 (1- 2^8)) +(define 2^16-1 (1- 2^16)) +(define 2^24-1 (1- 2^24)) +(define 2^32-1 (1- 2^32)) + +(define (+mod2^8 x y) + (modulo (+ x y) 2^8)) +(define (-mod2^8 x y) + (modulo (- x y) 2^8)) +(define (*mod2^8 x y) + (modulo (* x y) 2^8)) + +(define (+mod2^16 x y) + (modulo (+ x y) 2^16)) +(define (-mod2^16 x y) + (modulo (- x y) 2^16)) +(define (*mod2^16 x y) + (modulo (* x y) 2^16)) + +(define (+mod2^24 x y) + (modulo (+ x y) 2^24)) +(define (-mod2^24 x y) + (modulo (- x y) 2^24)) +(define (*mod2^24 x y) + (modulo (* x y) 2^24)) + +(define (+mod2^32 x y) + (modulo (+ x y) 2^32)) +(define (-mod2^32 x y) + (modulo (- x y) 2^32)) +(define (*mod2^32 x y) + (modulo (* x y) 2^32)) + +;;; The following functions convert unsigned integers into +;;; a list of bytes in network byte order. + +(define (uint8->bytes n) + (if (and (exact? n) (integer? n) (<= 0 n 2^8-1)) + (list n) + (error "Argument not a uint8" n))) + +;;;(uint8->bytes 1) +;;;(uint8->bytes -1) +;;;(uint8->bytes 2^8) +;;;(uint8->bytes 2.0) + +(define (uint16->bytes n) + (if (and (exact? n) (integer? n) (<= 0 n 2^16-1)) + (list (quotient n 2^8) + (remainder n 2^8)) + (error "Argument not a uint16" n))) + +;;;(uint16->bytes 1) +;;;(uint16->bytes 2^8) +;;;(uint16->bytes 2^16) +;;;(uint16->bytes 2^16-1) + +(define (uint24->bytes n) + (if (and (exact? n) (integer? n) (<= 0 n 2^24-1)) + (list (quotient n 2^16) + (quotient (remainder n 2^16) 2^8) + (remainder n 2^8)) + (error "Argument not a uint24" n))) + +;;;(uint24->bytes 1) +;;;(uint24->bytes 2^8) +;;;(uint24->bytes 2^16) +;;;(uint24->bytes 2^24-1) + +(define (uint32->bytes n) + (if (and (exact? n) (integer? n) (<= 0 n 2^32-1)) + (list (quotient n 2^24) + (quotient (remainder n 2^24) 2^16) + (quotient (remainder n 2^16) 2^8) + (remainder n 2^8)) + (error "Argument not a uint32" n))) + +;;;(uint32->bytes 1) +;;;(uint32->bytes 2^8) +;;;(uint32->bytes 2^16) +;;;(uint32->bytes 2^24) +;;;(uint32->bytes 2^32-1) + +(define uint8->big-endian-bytes uint8->bytes) +(define uint16->big-endian-bytes uint16->bytes) +(define uint24->big-endian-bytes uint24->bytes) +(define uint32->big-endian-bytes uint32->bytes) + +(define (uint8->little-endian-bytes n) + (reverse (uint8->bytes n))) + +(define (uint16->little-endian-bytes n) + (reverse (uint16->bytes n))) + +(define (uint24->little-endian-bytes n) + (reverse (uint24->bytes n))) + +(define (uint32->little-endian-bytes n) + (reverse (uint32->bytes n))) + +;;;(uint32->little-endian-bytes 1024) + + +;;; The following functions converts the first bytes of the argument +;;; to an unsigned integer in host byte order. + +(define (bytes->uint8 l) + (car l)) + +;;;(bytes->uint8 (uint8->bytes 56)) + +(define (bytes->uint16 l) + (+ (* 2^8 (car l)) + (cadr l))) + +;;;(bytes->uint16 (uint16->bytes 12345)) + +(define (bytes->uint24 l) + (+ (* 2^16 (car l)) + (* 2^8 (cadr l)) + (caddr l))) + +;;;(bytes->uint24 (uint24->bytes 12345567)) + +(define (bytes->uint32 l) + (+ (* 2^24 (car l)) + (* 2^16 (cadr l)) + (* 2^8 (caddr l)) + (cadddr l))) + +;;;(bytes->uint32 (uint32->bytes 2^32-1)) + +(define (list-head l n) + (list-head-1 l n (list))) + +(define (list-head-1 l n r) + (if (<= n 0) + (reverse r) + (list-head-1 (cdr l) (- n 1) (cons (car l) r)))) +;;; (list-head (list 1 2 3) 4) + +(define big-endian-bytes->uint8 bytes->uint8) +(define big-endian-bytes->uint16 bytes->uint16) +(define big-endian-bytes->uint24 bytes->uint24) +(define big-endian-bytes->uint32 bytes->uint32) + +(define (little-endian-bytes->uint8 l) + (bytes->uint8 (reverse (list-head l 1)))) + +(define (little-endian-bytes->uint16 l) + (bytes->uint16 (reverse (list-head l 2)))) + +(define (little-endian-bytes->uint24 l) + (bytes->uint24 (reverse (list-head l 3)))) + +(define (little-endian-bytes->uint32 l) + (bytes->uint32 (reverse (list-head l 4)))) +;;;(little-endian-bytes->uint32 (uint32->little-endian-bytes 123456)) + +;;; This function generates a list of bytes representing a string. + +(define (string->bytes s) + (map char->integer (string->list s))) + +;;;(string->bytes "Hello") + +;;; Convert a list of bytes to a string which can be used by the send call + +(define (bytes->string l) + (list->string (map integer->char l))) + +;;; (bytes->string '(65 65 65 0 65)) + +;;; This function generates a list of random bytes of a given length + +(define (random-bytes n) + (random-bytes-1 n (list))) + +;;; This is the tail-recursive version + +(define (random-bytes-1 n l) + (if (<= n 0) + l + (random-bytes-1 (- n 1) (cons (random 2^8) l)))) + +;;; (random-bytes 10000) + +(define (zero-bytes n) + (zero-bytes-1 n (list))) + +(define (zero-bytes-1 n l) + (if (<= n 0) + l + (zero-bytes-1 (- n 1) (cons 0 l)))) + +;;;(length (zero-bytes 3400)) +;;;(zero-bytes 0) + +(define (remove pred lst) + (if (null? lst) + (list) + (if (pred (car lst)) + (remove pred (cdr lst)) + (cons (car lst) (remove pred (cdr lst)))))) +;;; (remove positive? (list 1 -32 3 -9)) +;;; (remove positive? (list -9)) +;;; (remove positive? (list 1 2 3)) + +(define (filter pred lst) + (if (null? lst) + (list) + (if (pred (car lst)) + (cons (car lst) (filter pred (cdr lst))) + (filter pred (cdr lst))))) +;;; (filter positive? (list 1 -32 3 -9)) +;;; (filter positive? (list -9)) +;;; (filter positive? (list 1 2 3)) + + diff --git a/dotguile b/dotguile new file mode 100644 index 0000000..7e28755 --- /dev/null +++ b/dotguile @@ -0,0 +1,35 @@ +;;; +;;; Copyright (c) 2011 Michael Tuexen +;;; 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. +;;; +;;; THIS SOFTWARE IS PROVIDED BY THE AUTHOR 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 AUTHOR 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. +;;; +;;; $Id: dotguile,v 1.1 2012/08/26 21:06:27 tuexen Exp $ + +;;; Change the following line to reflect where the files are located. +(define dir "/Users/tuexen/Documents/m3ua-testtool/") +(define files (list "common.scm" + "m3ua.scm" + "m3ua-asp-tests.scm" + "m3ua-sgp-tests.scm" + "m3ua-param-testtool.scm")) +(map (lambda (file) (load-from-path (string-append dir file))) files) diff --git a/m3ua-asp-tests.scm b/m3ua-asp-tests.scm new file mode 100644 index 0000000..1dd6541 --- /dev/null +++ b/m3ua-asp-tests.scm @@ -0,0 +1,679 @@ +;;; +;;; Copyright (C) 2005 M. Tuexen tuexen@fh-muenster.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. + +;;; $Id: m3ua-asp-tests.scm,v 1.12 2012/08/28 19:56:13 tuexen Exp $ + +;;; History +;;; 13.09.2005: Implement ASP tests. +;;; 09.10.2005: Provide example calls for the ASP. +;;; 07.01.2006: Implement missing ASP tests. +;;; 27.08.2006: Added m3ua-asp-aspsm-v-005-alternate +;;; 27.08.2006: Added m3ua-asp-aspsm-i-002-alternate +;;; +;;; Definition of the tests for the ASP +;;; + + +(define (m3ua-asp-aspsm-v-002 tester-addr tester-port sut-addr sut-port) + (let ((fd (m3ua-accept tester-addr tester-port))) + (let ((msg (m3ua-wait-for-message fd m3ua-asp-up-message?))) + (close fd) + (if (= (m3ua-get-version msg) 1) + m3ua-test-result-passed + m3ua-test-result-failed)))) +;;; (m3ua-asp-aspsm-v-002 tester-addr tester-port sut-addr sut-port) +;;; This test is passed iff the version in the common header of the +;;; received packet is 1. +;;; (m3ua-run-asp tester-addr (list m3ua-asp-inactive)) + + +(define (m3ua-asp-aspsm-v-005 tester-addr tester-port sut-addr sut-port) + (let ((fd (m3ua-accept tester-addr tester-port))) + (m3ua-wait-for-message fd m3ua-asp-up-message?) + (m3ua-send-message fd 0 (m3ua-make-asp-up-ack-message)) + (let ((msg (m3ua-wait-for-message fd m3ua-asp-down-message?))) + (close fd) + (if (= (m3ua-get-version msg) 1) + m3ua-test-result-passed + m3ua-test-result-failed)))) +;;; (m3ua-asp-aspsm-v-005 tester-addr tester-port sut-addr sut-port) +;;; This test is passed iff the version in the common header of the +;;; received packet is 1. +;;; (m3ua-run-asp tester-addr (list m3ua-asp-inactive m3ua-asp-down)) + + +(define (m3ua-asp-aspsm-v-005-alternate tester-addr tester-port sut-addr sut-port) + (let ((fd (m3ua-accept tester-addr tester-port))) + (m3ua-wait-for-message fd m3ua-asp-up-message?) + (m3ua-send-message fd 0 (m3ua-make-asp-up-ack-message)) + (let ((asp-active (m3ua-wait-for-message fd m3ua-asp-active-message?))) + (m3ua-send-message fd 0 (m3ua-make-asp-active-ack-message (m3ua-get-parameters asp-active)))) + (let ((asp-inactive (m3ua-wait-for-message fd m3ua-asp-inactive-message?))) + (if (= (m3ua-get-version asp-inactive) 1) + (begin + (m3ua-send-message fd 0 (m3ua-make-asp-inactive-ack-message (m3ua-get-parameters asp-inactive))) + (m3ua-wait-for-message fd m3ua-asp-down-message?) + (m3ua-send-message fd 0 (m3ua-make-asp-down-ack-message)) + (close fd) + m3ua-test-result-passed) + (begin + (close fd) + m3ua-test-result-failed))))) +;;; (m3ua-asp-aspsm-v-005-alternate tester-addr tester-port sut-addr sut-port) +;;; This test is passed iff the SUT sends an ASP_INACTIVE with version 1. +;;; (m3ua-run-asp tester-addr (list m3ua-asp-inactive m3ua-asp-active m3ua-asp-inactive)) + + +(define (m3ua-asp-aspsm-i-001 tester-addr tester-port sut-addr sut-port) + (let ((fd (m3ua-accept tester-addr tester-port))) + (m3ua-wait-for-message fd m3ua-asp-up-message?) + (m3ua-send-message fd 0 (m3ua-make-common-header (+ m3ua-version 1) + m3ua-reserved + m3ua-aspsm-message-class + m3ua-aspup-ack-message-type + m3ua-common-header-length)) + (let ((msg (m3ua-wait-for-message fd m3ua-error-message?))) + (close fd) + (if (= (m3ua-get-error-code-from-message msg) + m3ua-invalid-version-error-code) + m3ua-test-result-passed + m3ua-test-result-failed)))) +;;; (m3ua-asp-aspsm-i-001 tester-addr tester-port sut-addr sut-port) +;;; This test is passed iff the SUT returns an ERROR(invalid version) +;;; (m3ua-run-asp tester-addr (list m3ua-asp-inactive)) + + +(define (m3ua-asp-aspsm-i-002 tester-addr tester-port sut-addr sut-port) + (let ((fd (m3ua-accept tester-addr tester-port))) + (m3ua-wait-for-message fd m3ua-asp-up-message?) + (m3ua-send-message fd 0 (m3ua-make-asp-up-ack-message)) + (m3ua-wait-for-message fd m3ua-asp-down-message?) + (m3ua-send-message fd 0 (m3ua-make-common-header (+ m3ua-version 1) + m3ua-reserved + m3ua-aspsm-message-class + m3ua-aspdn-ack-message-type + m3ua-common-header-length)) + (let ((msg (m3ua-wait-for-message fd m3ua-error-message?))) + (close fd) + (if (= (m3ua-get-error-code-from-message msg) + m3ua-invalid-version-error-code) + m3ua-test-result-passed + m3ua-test-result-failed)))) +;;; (m3ua-asp-aspsm-i-002 tester-addr tester-port sut-addr sut-port) +;;; This test is passed iff the SUT returns an ERROR(invalid version) +;;; (m3ua-run-asp tester-addr (list m3ua-asp-inactive m3ua-asp-down)) + + +(define (m3ua-asp-aspsm-i-002-alternate tester-addr tester-port sut-addr sut-port) + (let ((fd (m3ua-accept tester-addr tester-port))) + (m3ua-wait-for-message fd m3ua-asp-up-message?) + (m3ua-send-message fd 0 (m3ua-make-asp-up-ack-message)) + (let ((asp-active (m3ua-wait-for-message fd m3ua-asp-active-message?))) + (m3ua-send-message fd 0 (m3ua-make-asp-active-ack-message (m3ua-get-parameters asp-active)))) + (let ((asp-inactive (m3ua-wait-for-message fd m3ua-asp-inactive-message?))) + (m3ua-send-message fd 0 (m3ua-make-asp-inactive-ack-message (m3ua-get-parameters asp-inactive)))) + (m3ua-wait-for-message fd m3ua-asp-down-message?) + (m3ua-send-message fd 0 (m3ua-make-common-header (+ m3ua-version 1) + m3ua-reserved + m3ua-aspsm-message-class + m3ua-aspdn-ack-message-type + m3ua-common-header-length)) + (let ((msg (m3ua-wait-for-message fd m3ua-error-message?))) + (close fd) + (if (= (m3ua-get-error-code-from-message msg) + m3ua-invalid-version-error-code) + m3ua-test-result-passed + m3ua-test-result-failed)))) +;;; (m3ua-asp-aspsm-i-002-alternate tester-addr tester-port sut-addr sut-port) +;;; This test is passed iff the SUT sends an ASP_INACTIVE with version 1. +;;; (m3ua-run-asp tester-addr (list m3ua-asp-inactive m3ua-asp-active m3ua-asp-inactive m3ua-asp-down)) + + +(define (m3ua-asp-aspsm-i-003 tester-addr tester-port sut-addr sut-port) + (let ((fd (m3ua-accept tester-addr tester-port))) + (m3ua-wait-for-message fd m3ua-asp-up-message?) +;; FIXME: Should I send the ASPUP-ACK? +;; (m3ua-send-message fd 0 (m3ua-make-asp-up-ack-message)) + (m3ua-send-message fd 0 (m3ua-make-message m3ua-aspsm-message-class + m3ua-reserved-aspsm-message-type + (list))) + (let ((msg (m3ua-wait-for-message fd m3ua-error-message?))) + (close fd) + (if (= (m3ua-get-error-code-from-message msg) + m3ua-unsupported-message-type-error-code) + m3ua-test-result-passed + m3ua-test-result-failed)))) +;;; (m3ua-asp-aspsm-i-003 tester-addr tester-port sut-addr sut-port) +;;; FIXME: Why states the ETSI document that the ASP is marked as ASP_INACTIVE +;;; This test is passed iff the SUT returns an ERROR(unsupported message type) +;;; (m3ua-run-asp tester-addr (list m3ua-asp-inactive)) + + +(define (m3ua-asp-aspsm-o-001 tester-addr tester-port sut-addr sut-port) + (let ((fd (m3ua-accept tester-addr tester-port))) + (m3ua-wait-for-message fd m3ua-asp-up-message?) + (m3ua-send-message fd 0 (m3ua-make-asp-down-ack-message)) + (let ((msg (m3ua-wait-for-message-with-timeout fd m3ua-asp-active-message? 2))) + (close fd) + (if (null? msg) + m3ua-test-result-passed + m3ua-test-result-failed)))) +;;; (m3ua-asp-aspsm-o-001 tester-addr tester-port sut-addr sut-port) +;;; This test is passed iff the SUT does not send an ASP_ACTIVE. FIXME. +;;; (m3ua-run-asp tester-addr (list m3ua-asp-inactive)) + + +(define (m3ua-asp-aspsm-o-002 tester-addr tester-port sut-addr sut-port) + (let ((fd (m3ua-accept tester-addr tester-port))) + (m3ua-wait-for-message fd m3ua-asp-up-message?) + (m3ua-send-message fd 0 (m3ua-make-asp-active-ack-message (list))) + (let ((msg (m3ua-recv-message-with-timeout fd 2))) + (close fd) + (if (or (null? msg) + (and (m3ua-error-message? msg) + (= (m3ua-get-error-code-from-message msg) m3ua-unexpected-message-error-code)) + (m3ua-asp-up-message? msg)) + m3ua-test-result-passed + (if (m3ua-data-message? msg) + m3ua-test-result-failed + m3ua-test-result-unknown))))) +;;; (m3ua-asp-aspsm-o-002 tester-addr tester-port sut-addr sut-port) +;;; This test is passed iff the SUT does send an ERROR(unexpected message). +;;; (m3ua-run-asp tester-addr (list m3ua-asp-inactive)) + + +(define (m3ua-asp-asptm-v-001 tester-addr tester-port sut-addr sut-port) + (let ((fd (m3ua-accept tester-addr tester-port))) + (m3ua-wait-for-message fd m3ua-asp-up-message?) + (m3ua-send-message fd 0 (m3ua-make-asp-up-ack-message)) + (let ((asp-active (m3ua-wait-for-message fd m3ua-asp-active-message?))) + (m3ua-send-message fd 0 (m3ua-make-asp-active-ack-message (m3ua-get-parameters asp-active)))) + (close fd) + m3ua-test-result-passed)) +;;; (m3ua-asp-asptm-v-001 tester-addr tester-port sut-addr sut-port) +;;; This test is passed iff the SUT sends an ASP_ACTIVE. +;;; (m3ua-run-asp tester-addr (list m3ua-asp-inactive m3ua-asp-active)) + + +(define (m3ua-asp-asptm-v-002 tester-addr tester-port sut-addr sut-port) + (let ((fd (m3ua-accept tester-addr tester-port))) + (m3ua-wait-for-message fd m3ua-asp-up-message?) + (m3ua-send-message fd 0 (m3ua-make-asp-up-ack-message)) + (let ((asp-active (m3ua-wait-for-message fd m3ua-asp-active-message?))) + (if (= (m3ua-get-version asp-active) 1) + (begin + (m3ua-send-message fd 0 (m3ua-make-asp-active-ack-message (m3ua-get-parameters asp-active))) + (close fd) + m3ua-test-result-passed) + (begin + (close fd) + m3ua-test-result-failed))))) +;;; (m3ua-asp-asptm-v-002 tester-addr tester-port sut-addr sut-port) +;;; This test is passed iff the SUT sends an ASP_ACTIVE with version 1. +;;; (m3ua-run-asp tester-addr (list m3ua-asp-inactive m3ua-asp-active)) + + +(define (m3ua-asp-asptm-v-005 tester-addr tester-port sut-addr sut-port) + (let ((fd (m3ua-accept tester-addr tester-port))) + (m3ua-wait-for-message fd m3ua-asp-up-message?) + (m3ua-send-message fd 0 (m3ua-make-asp-up-ack-message)) + (let ((asp-active (m3ua-wait-for-message fd m3ua-asp-active-message?))) + (m3ua-send-message fd 0 (m3ua-make-asp-active-ack-message (m3ua-get-parameters asp-active)))) + (let ((asp-inactive (m3ua-wait-for-message fd m3ua-asp-inactive-message?))) + (if (= (m3ua-get-version asp-inactive) 1) + (begin + (m3ua-send-message fd 0 (m3ua-make-asp-inactive-ack-message (m3ua-get-parameters asp-inactive))) + (close fd) + m3ua-test-result-passed) + (begin + (close fd) + m3ua-test-result-failed))))) +;;; (m3ua-asp-asptm-v-005 tester-addr tester-port sut-addr sut-port) +;;; This test is passed iff the SUT sends an ASP_INACTIVE with version 1. +;;; (m3ua-run-asp tester-addr (list m3ua-asp-inactive m3ua-asp-active m3ua-asp-inactive)) + + +(define (m3ua-asp-asptm-v-007 tester-addr tester-port sut-addr sut-port) + (let ((fd (m3ua-accept tester-addr tester-port))) + (m3ua-wait-for-message fd m3ua-asp-up-message?) + (m3ua-send-message fd 0 (m3ua-make-asp-up-ack-message)) + (let ((asp-active (m3ua-wait-for-message fd m3ua-asp-active-message?)) + (heartbeat-data (random-bytes 5000))) + (m3ua-send-message fd 0 (m3ua-make-asp-active-ack-message (m3ua-get-parameters asp-active))) + (m3ua-send-message fd 0 (m3ua-make-beat-message heartbeat-data)) + (let ((m (m3ua-wait-for-message fd (lambda (m) (or (m3ua-beat-ack-message? m) + (m3ua-error-message? m)))))) + (close fd) + (if (m3ua-beat-ack-message? m) + m3ua-test-result-passed + m3ua-test-result-failed))))) +;;; (m3ua-asp-asptm-v-007 tester-addr tester-port sut-addr sut-port) +;;; The last parameter is the length the hearbeat data. +;;; This test is passed iff the SUT sends a BEAT_ACK. +;;; (m3ua-run-asp tester-addr (list m3ua-asp-inactive m3ua-asp-active m3ua-asp-reflect-beat)) + + +(define (m3ua-asp-asptm-v-008 tester-addr tester-port sut-addr sut-port) + (let ((fd (m3ua-accept tester-addr tester-port))) + (m3ua-wait-for-message fd m3ua-asp-up-message?) + (m3ua-send-message fd 0 (m3ua-make-asp-up-ack-message)) + (let ((asp-active (m3ua-wait-for-message fd m3ua-asp-active-message?)) + (heartbeat-data (random-bytes 600))) + (m3ua-send-message fd 0 (m3ua-make-asp-active-ack-message (m3ua-get-parameters asp-active))) + (m3ua-send-message fd 0 (m3ua-make-beat-message heartbeat-data)) + (let ((m (m3ua-wait-for-message fd (lambda (m) (or (m3ua-beat-ack-message? m) + (m3ua-error-message? m)))))) + (close fd) + (if (and (m3ua-beat-ack-message? m) + (equal? (m3ua-make-beat-ack-message heartbeat-data) m)) + m3ua-test-result-passed + m3ua-test-result-failed))))) +;;; (m3ua-asp-asptm-v-008 tester-addr tester-port sut-addr sut-port) +;;; This test is passed iff the SUT sends a BEAT_ACK with unchanged data. +;;; This is indicated by returning true. +;;; (m3ua-run-asp tester-addr (list m3ua-asp-inactive m3ua-asp-active m3ua-asp-reflect-beat)) + + +(define (m3ua-asp-asptm-i-001 tester-addr tester-port sut-addr sut-port) + (let ((fd (m3ua-accept tester-addr tester-port))) + (m3ua-wait-for-message fd m3ua-asp-up-message?) + (m3ua-send-message fd 0 (m3ua-make-asp-up-ack-message)) + (let ((asp-active (m3ua-wait-for-message fd m3ua-asp-active-message?))) + (m3ua-send-message fd 0 (m3ua-increment-version + (m3ua-make-asp-active-ack-message (m3ua-get-parameters asp-active)))) + (let ((msg (m3ua-wait-for-message fd m3ua-error-message?))) + (close fd) + (if (= (m3ua-get-error-code-from-message msg) + m3ua-invalid-version-error-code) + m3ua-test-result-passed + m3ua-test-result-failed))))) +;;; (m3ua-asp-asptm-i-001 tester-addr tester-port sut-addr sut-port) +;;; This test is passed iff the SUT sends an ERROR(invalid version). +;;; (m3ua-run-asp tester-addr (list m3ua-asp-inactive m3ua-asp-active)) + + +(define (m3ua-asp-asptm-i-002 tester-addr tester-port sut-addr sut-port) + (let ((fd (m3ua-accept tester-addr tester-port))) + (m3ua-wait-for-message fd m3ua-asp-up-message?) + (m3ua-send-message fd 0 (m3ua-make-asp-up-ack-message)) + (let ((asp-active (m3ua-wait-for-message fd m3ua-asp-active-message?))) + (m3ua-send-message fd 0 (m3ua-make-asp-active-ack-message (m3ua-get-parameters asp-active))) + (m3ua-wait-for-message fd m3ua-asp-inactive-message?) + (m3ua-send-message fd 0 (m3ua-increment-version + (m3ua-make-asp-inactive-ack-message (m3ua-get-parameters asp-active)))) + (let ((msg (m3ua-wait-for-message fd m3ua-error-message?))) + (close fd) + (if (= (m3ua-get-error-code-from-message msg) + m3ua-invalid-version-error-code) + m3ua-test-result-passed + m3ua-test-result-failed))))) +;;; (m3ua-asp-asptm-i-002 tester-addr tester-port sut-addr sut-port) +;;; This test is passed iff the SUT sends an ERROR(invalid version). +;;; (m3ua-run-asp tester-addr (list m3ua-asp-inactive m3ua-asp-active m3ua-asp-inactive)) + + +(define (m3ua-asp-asptm-i-003 tester-addr tester-port sut-addr sut-port) + (let ((fd (m3ua-accept tester-addr tester-port))) + (m3ua-wait-for-message fd m3ua-asp-up-message?) + (m3ua-send-message fd 0 (m3ua-make-asp-up-ack-message)) + (let ((asp-active (m3ua-wait-for-message fd m3ua-asp-active-message?))) + (m3ua-send-message fd 0 (m3ua-make-message m3ua-asptm-message-class + m3ua-reserved-asptm-message-type + (list))) + (let ((msg (m3ua-wait-for-message fd m3ua-error-message?))) + (close fd) + (if (= (m3ua-get-error-code-from-message msg) + m3ua-unsupported-message-type-error-code) + m3ua-test-result-passed + m3ua-test-result-failed))))) +;;; (m3ua-asp-asptm-i-003 tester-addr tester-port sut-addr sut-port) +;;; FIXME: Why does the ETSI doucment state that the IUT is in ASP_DOWN. +;;; This test is passed iff the SUT sends an ERROR(unsupported message type). +;;; (m3ua-run-asp tester-addr (list m3ua-asp-inactive m3ua-asp-active)) + + +(define (m3ua-asp-asptm-o-001 tester-addr tester-port sut-addr sut-port) + (let ((fd (m3ua-accept tester-addr tester-port))) + (m3ua-wait-for-message fd m3ua-asp-up-message?) + (m3ua-send-message fd 0 (m3ua-make-asp-up-ack-message)) + (m3ua-wait-for-message fd m3ua-asp-active-message?) + (m3ua-send-message fd 0 (m3ua-make-asp-up-ack-message)) + (let ((msg (m3ua-recv-message-with-timeout fd 2))) + (close fd) + (if (or (null? msg) + (and (m3ua-error-message? msg) + (= (m3ua-get-error-code-from-message msg) m3ua-unexpected-message-error-code)) + (m3ua-asp-active-message? msg)) + m3ua-test-result-passed + (if (m3ua-data-message? msg) + m3ua-test-result-failed + m3ua-test-result-unknown))))) +;;; (m3ua-asp-asptm-o-001 tester-addr tester-port sut-addr sut-port) +;;; This test is passed iff the SUT sends an ERROR(unexpected message). +;;; FIXME: How to test the data sending? +;;; (m3ua-run-asp tester-addr (list m3ua-asp-inactive m3ua-asp-active)) + + +(define (m3ua-asp-mtr-v-001 tester-addr tester-port sut-addr sut-port) + (let ((fd (m3ua-accept tester-addr tester-port))) + (m3ua-wait-for-message fd m3ua-asp-up-message?) + (m3ua-send-message fd 0 (m3ua-make-asp-up-ack-message)) + (let ((asp-active (m3ua-wait-for-message fd m3ua-asp-active-message?))) + (m3ua-send-message fd 0 (m3ua-make-asp-active-ack-message (m3ua-get-parameters asp-active))) + (let ((m (m3ua-wait-for-message fd (lambda (m) (or (m3ua-data-message? m) + (m3ua-daud-message? m)))))) + (if (m3ua-daud-message? m) + (begin + (m3ua-send-message fd 0 (m3ua-make-dava-message (m3ua-get-parameters m))) + (m3ua-wait-for-message fd m3ua-data-message?)))) + (close fd) + m3ua-test-result-unknown))) +;;; (m3ua-asp-mtr-v-001 tester-addr tester-port sut-addr sut-port) +;;; This test is passed iff the SUT sends DATA including a RC. +;;; FIXME +;;; (m3ua-run-asp tester-addr (list m3ua-asp-inactive m3ua-asp-active m3ua-asp-send-data)) + + +(define (m3ua-asp-mtr-v-002 tester-addr tester-port sut-addr sut-port) + (let ((fd (m3ua-accept tester-addr tester-port))) + (m3ua-wait-for-message fd m3ua-asp-up-message?) + (m3ua-send-message fd 0 (m3ua-make-asp-up-ack-message)) + (let ((asp-active (m3ua-wait-for-message fd m3ua-asp-active-message?))) + (m3ua-send-message fd 0 (m3ua-make-asp-active-ack-message (m3ua-get-parameters asp-active))) + (let ((m (m3ua-wait-for-message fd (lambda (m) (or (m3ua-data-message? m) + (m3ua-daud-message? m)))))) + (if (m3ua-daud-message? m) + (begin + (m3ua-send-message fd 0 (m3ua-make-dava-message (m3ua-get-parameters m))) + (m3ua-wait-for-message fd m3ua-data-message?)))) + (close fd) + m3ua-test-result-unknown))) +;;; (m3ua-asp-mtr-v-002 tester-addr tester-port sut-addr sut-port) +;;; This test is passed iff the SUT sends DATA including data. +;;; FIXME +;;; (m3ua-run-asp tester-addr (list m3ua-asp-inactive m3ua-asp-active m3ua-asp-send-data)) + + +(define (m3ua-asp-mtr-v-003 tester-addr tester-port sut-addr sut-port) + (let ((fd (m3ua-accept tester-addr tester-port))) + (m3ua-wait-for-message fd m3ua-asp-up-message?) + (m3ua-send-message fd 0 (m3ua-make-asp-up-ack-message)) + (let ((asp-active (m3ua-wait-for-message fd m3ua-asp-active-message?))) + (m3ua-send-message fd 0 (m3ua-make-asp-active-ack-message (m3ua-get-parameters asp-active))) + (let ((m (m3ua-wait-for-message fd (lambda (m) (or (m3ua-data-message? m) + (m3ua-daud-message? m)))))) + (if (m3ua-daud-message? m) + (begin + (m3ua-send-message fd 0 (m3ua-make-dava-message (m3ua-get-parameters m))) + (m3ua-wait-for-message fd m3ua-data-message?)))) + (close fd) + m3ua-test-result-unknown))) +;;; (m3ua-asp-mtr-v-001 tester-addr tester-port sut-addr sut-port) +;;; This test is passed iff the SUT sends DATA in a valid stream . +;;; FIXME +;;; (m3ua-run-asp tester-addr (list m3ua-asp-inactive m3ua-asp-active m3ua-asp-send-data)) + + +(define (m3ua-asp-mtr-i-001 tester-addr tester-port sut-addr sut-port) + (let ((fd (m3ua-accept tester-addr tester-port))) + (m3ua-wait-for-message fd m3ua-asp-up-message?) + (m3ua-send-message fd 0 (m3ua-make-asp-up-ack-message)) + (let ((asp-active (m3ua-wait-for-message fd m3ua-asp-active-message?))) + (m3ua-send-message fd 0 (m3ua-make-asp-active-ack-message (m3ua-get-parameters asp-active))) + (m3ua-send-message fd 0 (m3ua-increment-version + (m3ua-make-data-message 0 0 0 0 0 0 (list) (list)))) + (let ((msg (m3ua-wait-for-message fd m3ua-error-message?))) + (close fd) + (if (= (m3ua-get-error-code-from-message msg) + m3ua-invalid-version-error-code) + m3ua-test-result-passed + m3ua-test-result-failed))))) +;;; (m3ua-asp-mtr-i-001 tester-addr tester-port sut-addr sut-port) +;;; This test is passed iff the SUT sends an ERROR(invalid version). +;;; (m3ua-run-asp tester-addr (list m3ua-asp-inactive m3ua-asp-active m3ua-asp-receive-data)) + + +(define (m3ua-asp-mtr-i-002 tester-addr tester-port sut-addr sut-port) + (let ((fd (m3ua-accept tester-addr tester-port))) + (m3ua-wait-for-message fd m3ua-asp-up-message?) + (m3ua-send-message fd 0 (m3ua-make-asp-up-ack-message)) + (let ((asp-active (m3ua-wait-for-message fd m3ua-asp-active-message?))) + (m3ua-send-message fd 0 (m3ua-make-asp-active-ack-message (m3ua-get-parameters asp-active))) + (m3ua-send-message fd 0 (m3ua-make-message m3ua-reserved-message-class + 0 + (list))) + (let ((msg (m3ua-wait-for-message fd m3ua-error-message?))) + (close fd) + (if (= (m3ua-get-error-code-from-message msg) + m3ua-unsupported-message-class-error-code) + m3ua-test-result-passed + m3ua-test-result-failed))))) +;;; (m3ua-asp-mtr-i-002 tester-addr tester-port sut-addr sut-port) +;;; This test is passed iff the SUT sends an ERROR(unsupported message class). +;;; (m3ua-run-asp tester-addr (list m3ua-asp-inactive m3ua-asp-active m3ua-asp-receive-data)) + + +(define (m3ua-asp-mtr-i-003 tester-addr tester-port sut-addr sut-port) + (let ((fd (m3ua-accept tester-addr tester-port))) + (m3ua-wait-for-message fd m3ua-asp-up-message?) + (m3ua-send-message fd 0 (m3ua-make-asp-up-ack-message)) + (let ((asp-active (m3ua-wait-for-message fd m3ua-asp-active-message?))) + (m3ua-send-message fd 0 (m3ua-make-asp-active-ack-message (m3ua-get-parameters asp-active))) + (m3ua-send-message fd 0 (m3ua-make-message m3ua-tfer-message-class + m3ua-reserved-tfer-message-type + (list))) + (let ((msg (m3ua-wait-for-message fd m3ua-error-message?))) + (close fd) + (if (= (m3ua-get-error-code-from-message msg) + m3ua-unsupported-message-type-error-code) + m3ua-test-result-passed + m3ua-test-result-failed))))) +;;; (m3ua-asp-mtr-i-003 tester-addr tester-port sut-addr sut-port) +;;; This test is passed iff the SUT sends an ERROR(unsupported message type). +;;; (m3ua-run-asp tester-addr (list m3ua-asp-inactive m3ua-asp-active m3ua-asp-receive-data)) + + +(define (m3ua-asp-rkm-v-002 tester-addr tester-port sut-addr sut-port) + (let ((fd (m3ua-accept tester-addr tester-port))) + (m3ua-wait-for-message fd m3ua-asp-up-message?) + (m3ua-send-message fd 0 (m3ua-make-asp-up-ack-message)) + (let ((message (m3ua-wait-for-message fd m3ua-reg-req-message?))) + (m3ua-send-message fd 0 (m3ua-make-reg-rsp-from-reg-req message))) + (sleep 1) + (close fd))) +;;; (m3ua-asp-rkm-v-002 tester-addr tester-port sut-addr sut-port) +;;; This test is passed iff the SUT sends a valid routing key. +;;; (m3ua-run-asp tester-addr (list m3ua-asp-inactive m3ua-asp-send-reg-req)) + + +(define (m3ua-asp-rkm-v-003 tester-addr tester-port sut-addr sut-port) + (let ((fd (m3ua-accept tester-addr tester-port))) + (m3ua-wait-for-message fd m3ua-asp-up-message?) + (m3ua-send-message fd 0 (m3ua-make-asp-up-ack-message)) + (let ((reg-req (m3ua-wait-for-message fd m3ua-reg-req-message?))) + (m3ua-send-message fd 0 (m3ua-make-reg-rsp-from-reg-req reg-req)) + (let ((dereg-req (m3ua-wait-for-message fd m3ua-dereg-req-message?))) + (m3ua-send-message fd 0 (m3ua-make-dereg-rsp-from-dereg-req dereg-req)))) + (sleep 1) + (close fd))) +;;; (m3ua-asp-rkm-v-003 tester-addr tester-port sut-addr sut-port) +;;; This test is passed iff the SUT sends a deregistration request. +;;; (m3ua-run-asp tester-addr (list m3ua-asp-inactive m3ua-asp-send-reg-req m3ua-asp-send-dereg-req)) + + +(define (m3ua-asp-rkm-v-004 tester-addr tester-port sut-addr sut-port) + (let ((fd (m3ua-accept tester-addr tester-port))) + (m3ua-wait-for-message fd m3ua-asp-up-message?) + (m3ua-send-message fd 0 (m3ua-make-asp-up-ack-message)) + (let ((reg-req (m3ua-wait-for-message fd m3ua-reg-req-message?))) + (m3ua-send-message fd 0 (m3ua-make-reg-rsp-from-reg-req reg-req)) + (let ((dereg-req (m3ua-wait-for-message fd m3ua-dereg-req-message?))) + (m3ua-send-message fd 0 (m3ua-make-dereg-rsp-from-dereg-req dereg-req)))) + (sleep 1) + (close fd))) +;;; (m3ua-asp-rkm-v-004 tester-addr tester-port sut-addr sut-port) +;;; This test is passed iff the SUT sends a deregistration request with correct routing context. +;;; (m3ua-run-asp tester-addr (list m3ua-asp-inactive m3ua-asp-send-reg-req m3ua-asp-send-dereg-req)) + + +(define (m3ua-asp-rkm-i-001 tester-addr tester-port sut-addr sut-port) + (let ((fd (m3ua-accept tester-addr tester-port))) + (m3ua-wait-for-message fd m3ua-asp-up-message?) + (m3ua-send-message fd 0 (m3ua-make-asp-up-ack-message)) + (m3ua-wait-for-message fd m3ua-reg-req-message?) + (m3ua-send-message fd 0 (m3ua-make-message m3ua-rkm-message-class + m3ua-reserved-rkm-message-type + (list))) + (m3ua-wait-for-message fd m3ua-error-message?) + (sleep 1) + (close fd))) +;;; (m3ua-asp-rkm-i-001 tester-addr tester-port sut-addr sut-port) +;;; This test is passed iff the SUT sends an ERROR(unsupported message type). +;;; (m3ua-run-asp tester-addr (list m3ua-asp-inactive m3ua-asp-send-reg-req m3ua-asp-active)) + + +(define (m3ua-asp-ssnm-001 tester-addr tester-port sut-addr sut-port) + (let ((fd (m3ua-accept tester-addr tester-port))) + (m3ua-wait-for-message fd m3ua-asp-up-message?) + (m3ua-send-message fd 0 (m3ua-make-asp-up-ack-message)) + (let ((asp-active (m3ua-wait-for-message fd m3ua-asp-active-message?))) + (m3ua-send-message fd 0 (m3ua-make-asp-active-ack-message (m3ua-get-parameters asp-active)))) + (m3ua-send-message fd 0 (m3ua-make-duna-message (list (m3ua-make-affected-point-code-parameter (list (list 0 tester-unavailable-pc)))))) + (m3ua-wait-for-message fd m3ua-daud-message?) + (close fd) + m3ua-test-result-passed)) +;;; (m3ua-asp-ssnm-001 tester-addr tester-port sut-addr sut-port) +;;; This test is passed iff the SUT sends an DAUD. +;;; (m3ua-run-asp tester-addr (list m3ua-asp-inactive m3ua-asp-active)) + +(define (m3ua-asp-ssnm-002 tester-addr tester-port sut-addr sut-port) + (let ((fd (m3ua-accept tester-addr tester-port))) + (m3ua-wait-for-message fd m3ua-asp-up-message?) + (m3ua-send-message fd 0 (m3ua-make-asp-up-ack-message)) + (let ((asp-active (m3ua-wait-for-message fd m3ua-asp-active-message?))) + (m3ua-send-message fd 0 (m3ua-make-asp-active-ack-message (m3ua-get-parameters asp-active)))) + (m3ua-send-message fd 0 (m3ua-make-duna-message (list (m3ua-make-affected-point-code-parameter (list (list 255 tester-unavailable-pc)))))) + (m3ua-wait-for-message fd m3ua-daud-message?) + (close fd) + m3ua-test-result-passed)) +;;; (m3ua-asp-ssnm-002 tester-addr tester-port sut-addr sut-port) +;;; This test is passed iff the SUT sends an DAUD. +;;; (m3ua-run-asp tester-addr (list m3ua-asp-inactive m3ua-asp-active)) + +(define (m3ua-asp-ssnm-003 tester-addr tester-port sut-addr sut-port) + (let ((fd (m3ua-accept tester-addr tester-port))) + (m3ua-wait-for-message fd m3ua-asp-up-message?) + (m3ua-send-message fd 0 (m3ua-make-asp-up-ack-message)) + (let ((asp-active (m3ua-wait-for-message fd m3ua-asp-active-message?))) + (m3ua-send-message fd 0 (m3ua-make-asp-active-ack-message (m3ua-get-parameters asp-active)))) + (m3ua-send-message fd 0 (m3ua-make-drst-message (list (m3ua-make-affected-point-code-parameter (list (list 0 tester-restricted-pc)))))) + (m3ua-wait-for-message fd m3ua-daud-message?) + (close fd) + m3ua-test-result-passed)) +;;; (m3ua-asp-ssnm-003 tester-addr tester-port sut-addr sut-port) +;;; This test is passed iff the SUT sends an DAUD. +;;; (m3ua-run-asp tester-addr (list m3ua-asp-inactive m3ua-asp-active)) + +(define (m3ua-asp-ssnm-004 tester-addr tester-port sut-addr sut-port) + (let ((fd (m3ua-accept tester-addr tester-port))) + (m3ua-wait-for-message fd m3ua-asp-up-message?) + (m3ua-send-message fd 0 (m3ua-make-asp-up-ack-message)) + (let ((asp-active (m3ua-wait-for-message fd m3ua-asp-active-message?))) + (m3ua-send-message fd 0 (m3ua-make-asp-active-ack-message (m3ua-get-parameters asp-active)))) + (m3ua-send-message fd 0 (m3ua-make-drst-message (list (m3ua-make-affected-point-code-parameter (list (list 255 tester-restricted-pc)))))) + (m3ua-wait-for-message fd m3ua-daud-message?) + (close fd) + m3ua-test-result-passed)) +;;; (m3ua-asp-ssnm-004 tester-addr tester-port sut-addr sut-port) +;;; This test is passed iff the SUT sends an DAUD. +;;; (m3ua-run-asp tester-addr (list m3ua-asp-inactive m3ua-asp-active)) + +(define (m3ua-asp-ssnm-005 tester-addr tester-port sut-addr sut-port) + (let ((fd (m3ua-accept tester-addr tester-port))) + (m3ua-wait-for-message fd m3ua-asp-up-message?) + (m3ua-send-message fd 0 (m3ua-make-asp-up-ack-message)) + (let ((asp-active (m3ua-wait-for-message fd m3ua-asp-active-message?))) + (m3ua-send-message fd 0 (m3ua-make-asp-active-ack-message (m3ua-get-parameters asp-active)))) + (m3ua-send-message fd 0 (m3ua-make-scon-message (list (m3ua-make-affected-point-code-parameter (list (list 0 tester-congested-pc)))))) + (m3ua-wait-for-message fd m3ua-daud-message?) + (close fd) + m3ua-test-result-passed)) +;;; (m3ua-asp-ssnm-005 tester-addr tester-port sut-addr sut-port) +;;; This test is passed iff the SUT sends an DAUD. +;;; (m3ua-run-asp tester-addr (list m3ua-asp-inactive m3ua-asp-active)) + +(define (m3ua-asp-ssnm-006 tester-addr tester-port sut-addr sut-port) + (let ((fd (m3ua-accept tester-addr tester-port))) + (m3ua-wait-for-message fd m3ua-asp-up-message?) + (m3ua-send-message fd 0 (m3ua-make-asp-up-ack-message)) + (let ((asp-active (m3ua-wait-for-message fd m3ua-asp-active-message?))) + (m3ua-send-message fd 0 (m3ua-make-asp-active-ack-message (m3ua-get-parameters asp-active)))) + (m3ua-send-message fd 0 (m3ua-make-scon-message (list (m3ua-make-affected-point-code-parameter (list (list 255 tester-congested-pc)))))) + (m3ua-wait-for-message fd m3ua-daud-message?) + (close fd) + m3ua-test-result-passed)) +;;; (m3ua-asp-ssnm-006 tester-addr tester-port sut-addr sut-port) +;;; This test is passed iff the SUT sends an DAUD. +;;; (m3ua-run-asp tester-addr (list m3ua-asp-inactive m3ua-asp-active)) + +(define (m3ua-asp-ssnm-007 tester-addr tester-port sut-addr sut-port) + (let ((fd (m3ua-accept tester-addr tester-port))) + (m3ua-wait-for-message fd m3ua-asp-up-message?) + (m3ua-send-message fd 0 (m3ua-make-asp-up-ack-message)) + (let ((asp-active (m3ua-wait-for-message fd m3ua-asp-active-message?))) + (m3ua-send-message fd 0 (m3ua-make-asp-active-ack-message (m3ua-get-parameters asp-active)))) + (m3ua-send-message fd 0 (m3ua-make-dupu-message (list (m3ua-make-affected-point-code-parameter (list (list 0 tester-congested-pc))) + (m3ua-make-user-cause-parameter m3ua-mtp-user-isup m3ua-unequipped-remote-user-cause)))) + (m3ua-wait-for-message fd m3ua-daud-message?) + (close fd) + m3ua-test-result-passed)) +;;; (m3ua-asp-ssnm-006 tester-addr tester-port sut-addr sut-port) +;;; This test is passed iff the SUT sends an DAUD. +;;; (m3ua-run-asp tester-addr (list m3ua-asp-inactive m3ua-asp-active)) + +(define (m3ua-asp-ssnm-008 tester-addr tester-port sut-addr sut-port) + (let ((fd (m3ua-accept tester-addr tester-port))) + (m3ua-wait-for-message fd m3ua-asp-up-message?) + (m3ua-send-message fd 0 (m3ua-make-asp-up-ack-message)) + (let ((asp-active (m3ua-wait-for-message fd m3ua-asp-active-message?))) + (m3ua-send-message fd 0 (m3ua-make-asp-active-ack-message (m3ua-get-parameters asp-active)))) + (m3ua-send-message fd 0 (m3ua-make-dupu-message (list (m3ua-make-affected-point-code-parameter (list (list 255 tester-congested-pc))) + (m3ua-make-user-cause-parameter m3ua-mtp-user-isup m3ua-unequipped-remote-user-cause)))) + (m3ua-wait-for-message fd m3ua-error-message?) + (close fd) + m3ua-test-result-passed)) +;;; (m3ua-asp-ssnm-006 tester-addr tester-port sut-addr sut-port) +;;; This test is passed iff the SUT sends an ERROR. +;;; (m3ua-run-asp tester-addr (list m3ua-asp-inactive m3ua-asp-active)) diff --git a/m3ua-param-testtool.scm b/m3ua-param-testtool.scm new file mode 100644 index 0000000..0f1514c --- /dev/null +++ b/m3ua-param-testtool.scm @@ -0,0 +1,137 @@ +;;; +;;; Copyright (C) 2004, 2005 M. Tuexen tuexen@fh-muenster.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. + +;;; $Id: m3ua-param-testtool.scm,v 1.5 2012/08/28 19:56:13 tuexen Exp $ + +;;; Define a transport address of the system under test +(define sut-addr "127.0.0.1") +(define sut-port 0) +(define sut-port-1 0) +(define sut-port-2 0) + +;;; Define the transport address of the tester +(define tester-addr "127.0.0.1") + +(define tester-port m3ua-port) +(define tester-port-1 3000) +(define tester-port-2 3001) + +;;; Define the point code of the IUT +(define iut-pc 4001) + +;;; Define the point code of the tester +(define tester-pc 100) +(define tester-pc-1 100) +(define tester-pc-2 101) +(define tester-invalid-pc 102) +(define tester-unauthorized-pc 103) +(define tester-unprovisioned-pc 104) +(define tester-unavailable-pc 1234) +(define tester-available-pc 1235) +(define tester-congested-pc 1236) +(define tester-restricted-pc 1237) + +;;; Define a valid SS7 message and SI +(define ss7-message (list 11 34 45 67 67 89)) +(define ss7-si 0) + +(define iut-ni 1) +(define iut-mp 0) +(define iut-sls 0) + + +;;; Define correlation id +(define correlation-id 1) + +;;; Define network appearance +(define network-appearance 1) +(define invalid-network-appearance 2) + +;;; Define an routing context +(define tester-rc-valid 1) +(define tester-rc-valid-1 1) +(define tester-rc-valid-2 2) + +;;; Define an invalid routing context +(define tester-rc-invalid 3) + +;;; Define an asp-identifier +(define asp-id 1) +(define asp-id-1 1) +(define asp-id-2 2) + +;;; Define traffic-type-mode +;;;(define traffic-mode m3ua-traffic-mode-type-override) +(define traffic-mode m3ua-traffic-mode-type-loadshare) +;;;(define traffic-mode m3ua-traffic-mode-type-broadcast) + +(define asp-up-message-parameters (list)) +;;; (define asp-up-message-parameters (list (m3ua-make-asp-id-parameter asp-id))) +;;;asp-up-message-parameters + +(define asp-active-message-parameters (list)) +;;;(define asp-active-message-parameters (list (m3ua-make-traffic-mode-type-parameter traffic-mode) +;;; (m3ua-make-routing-context-parameter (list tester-rc-valid)))) +;;;asp-active-message-parameters + +(define asp-active-ack-message-parameters (list)) +;;;(define asp-active-ack-message-parameters (list (m3ua-make-traffic-mode-type-parameter traffic-mode) +;;; (m3ua-make-routing-context-parameter (list tester-rc-valid)))) +;;;asp-active-ack-message-parameters + +(define asp-inactive-message-parameters (list)) +;;;(define asp-inactive-message-parameters (list (m3ua-make-traffic-mode-type-parameter traffic-mode) +;;; (m3ua-make-routing-context-parameter (list tester-rc-valid)))) +;;;asp-inactive-message-parameters +(define asp-inactive-ack-message-parameters (list)) +;;;(define asp-inactive-ack-message-parameters (list (m3ua-make-routing-context-parameter (list tester-rc-valid)))) +;;;asp-inactive-ack-message-parameters + +(define data-message-parameters (list)) +;;;(define data-message-parameters (list (m3ua-make-network-appearance-parameter network-appearance) +;;; (m3ua-make-routing-context-parameter (list tester-rc-valid)))) +;;;data-message-parameters + +;;; Define parameter for DATA message +(define rc 1) +(define opc 1) +(define dpc 2) +(define si 0) +(define sls 0) +(define ni 0) +(define mp 0) +(define ss7-message (list 11 34 45 67 67 89)) +(define data-message-parameters (list (m3ua-make-routing-context-parameter (list rc)))) + diff --git a/m3ua-sgp-tests.scm b/m3ua-sgp-tests.scm new file mode 100644 index 0000000..49c8ad0 --- /dev/null +++ b/m3ua-sgp-tests.scm @@ -0,0 +1,1251 @@ +;;; +;;; Copyright (C) 2004, 2005, 2006 M. Tuexen tuexen@fh-muenster.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. + +;;; $Id: m3ua-sgp-tests.scm,v 1.9 2012/08/28 19:56:13 tuexen Exp $ + +;;; Version 1.3.0 +;;; +;;; History +;;; 04.12.2004: Fix name test-addr- -> tester-addr in almost all testcases +;;; 04.12.2004: Fix name of m3ua-sgp-mtr-v-001 to m3ua-sgp-mtr-v-002. +;;; 06.12.2004: Move SUT parameter to external file. +;;; 06.12.2004: Use asp-up-message-parameters as default last arg of m3ua-make-asp-up-message. +;;; 06.12.2004: Use asp-active-message-parameters as default last arg of m3ua-make-asp-active-message. +;;; 06.12.2004: Use asp-active-ack-message-parameters as default last arg of m3ua-make-asp-active-ack-message. +;;; 06.12.2004: Use asp-inactive-message-parameters as default last arg of m3ua-make-asp-inactxive-message. +;;; 06.12.2004: Use asp-inactive-ack-message-parameters as default last arg of m3ua-make-asp-inactive-ack-message. +;;; 06.12.2004: Use data-message-parameters as default last arg of m3ua-make-data-message. +;;; 09.12.2004: m3ua-sgp-mtr-v-00[23] implemented according to change request. +;;; 14.12.2004: m3ua-sgp-aspsm-v-009 added. +;;; 14.12.2004: m3ua-sgp-asptm-i-003 added. +;;; 18.12.2004: Use iut-ni iut-mp and iut-sls in m3ua-make-data-message. +;;; 19.12.2004: m3ua-sgp-asptm-v-014 added. +;;; 19.12.2004: m3ua-sgp-asptm-v-015 added. +;;; 19.12.2004: m3ua-sgp-asptm-i-009 added. +;;; 19.12.2004: m3ua-sgp-mtr-v-001 added. +;;; 19.12.2004: m3ua-sgp-mtr-v-002 additional variant added. +;;; 19.12.2004: m3ua-sgp-mtr-v-003 additional variant added. +;;; 13.09.2005: Implement ASP tests. +;;; 18.02.2006: Implement m3ua-sgp-rkm* +;;; 12.03.2006: Fix name of m3ua-sgp-rkm-v-02[123] to m3ua-sgp-rkm-i-02[123] +;;; 27.08.2006: m3ua-sgp-mtr-v-00[12]: do not send data before reception of DAVA. Should I send DAUD? + + +;;; +;;; Definition of the tests for the SGP +;;; + +(define (m3ua-sgp-aspsm-v-001 tester-addr tester-port sut-addr sut-port) + (let ((fd (m3ua-connect tester-addr tester-port sut-addr sut-port))) + (m3ua-send-message fd 0 (m3ua-make-asp-up-message asp-up-message-parameters)) + (m3ua-wait-for-message fd m3ua-asp-up-ack-message?) + (close fd) + m3ua-test-result-passed)) +;;; (m3ua-sgp-aspsm-v-001 tester-addr tester-port sut-addr sut-port) +;;; The test is passed if an ASPUP-ACK is returned + + + +(define (m3ua-sgp-aspsm-v-003 tester-addr tester-port sut-addr sut-port) + (let ((fd (m3ua-connect tester-addr tester-port sut-addr sut-port))) + (m3ua-send-message fd 0 (m3ua-make-asp-up-message asp-up-message-parameters)) + (m3ua-wait-for-message fd m3ua-asp-up-ack-message?) + (let ((msg (m3ua-wait-for-message fd m3ua-notify-message?))) + (close fd) + (if (and (= (m3ua-get-status-type-from-message msg) m3ua-as-state-change-status-type) + (= (m3ua-get-status-info-from-message msg) m3ua-as-inactive)) + m3ua-test-result-passed + m3ua-test-result-failed)))) +;;; (m3ua-sgp-aspsm-v-003 tester-addr tester-port sut-addr sut-port) +;;; This test is passed if there is a ASPUP-ACK and a NOTIFY(AS_INACTIVE) + + + +(define (m3ua-sgp-aspsm-v-005 tester-addr tester-port sut-addr sut-port) + (let ((fd (m3ua-connect tester-addr tester-port sut-addr sut-port))) + (m3ua-send-message fd 0 (m3ua-make-asp-up-message asp-up-message-parameters)) + (m3ua-wait-for-message fd m3ua-asp-up-ack-message?) + (m3ua-send-message fd 0 (m3ua-make-asp-down-message)) + (m3ua-wait-for-message fd m3ua-asp-down-ack-message?) + (close fd) + m3ua-test-result-passed)) +;;; (m3ua-sgp-aspsm-v-005 tester-addr tester-port sut-addr sut-port) +;;; This test is passed if there is a ASPDN-ACK + + + +(define (m3ua-sgp-aspsm-v-009 tester-addr tester-port sut-addr sut-port) + (let ((fd (m3ua-connect tester-addr tester-port sut-addr sut-port))) + (m3ua-send-message fd 0 (m3ua-make-asp-up-message asp-up-message-parameters)) + (let ((msg (m3ua-wait-for-message fd m3ua-error-message?))) + (close fd) + (if (= (m3ua-get-error-code-from-message msg) + m3ua-refused-management-blocking-error-code) + m3ua-test-result-passed + m3ua-test-result-failed)))) +;;; (m3ua-sgp-aspsm-v-009 tester-addr tester-port sut-addr sut-port) +;;; This test is passed if there is an ERROR(Refused - Management Blocking) +;;; is returned. Of course, the ASP has to be configured appropiately at the SUT. + + + +(define (m3ua-sgp-aspsm-i-001 tester-addr tester-port sut-addr sut-port) + (let ((fd (m3ua-connect tester-addr tester-port sut-addr sut-port))) + (m3ua-send-message fd 0 (m3ua-make-common-header (+ m3ua-version 1) + m3ua-reserved + m3ua-aspsm-message-class + m3ua-aspup-message-type + m3ua-common-header-length)) + (let ((msg (m3ua-wait-for-message fd m3ua-error-message?))) + (close fd) + (if (= (m3ua-get-error-code-from-message msg) + m3ua-invalid-version-error-code) + m3ua-test-result-passed + m3ua-test-result-failed)))) +;;; (m3ua-sgp-aspsm-i-001 tester-addr tester-port sut-addr sut-port) +;;; This test is passed if there is a ERROR(invalid version) + + + +(define (m3ua-sgp-aspsm-i-002 tester-addr tester-port sut-addr sut-port) + (let ((fd (m3ua-connect tester-addr tester-port sut-addr sut-port))) + (m3ua-send-message fd 0 (m3ua-make-common-header m3ua-version + m3ua-reserved + m3ua-aspsm-message-class + m3ua-reserved-aspsm-message-type + m3ua-common-header-length)) + (let ((msg (m3ua-wait-for-message fd m3ua-error-message?))) + (close fd) + (if (= (m3ua-get-error-code-from-message msg) + m3ua-unsupported-message-type-error-code) + m3ua-test-result-passed + m3ua-test-result-failed)))) +;;; (m3ua-sgp-aspsm-i-002 tester-addr tester-port sut-addr sut-port) +;;; This test is passed if there is a ERROR(unsupported message type) + + + +(define (m3ua-sgp-aspsm-i-003 tester-addr tester-port sut-addr sut-port) + (let ((fd (m3ua-connect tester-addr tester-port sut-addr sut-port))) + (m3ua-send-message fd 0 (m3ua-make-asp-active-message asp-active-message-parameters)) + (let ((msg (m3ua-wait-for-message fd m3ua-error-message?))) + (close fd) + (if (= (m3ua-get-error-code-from-message msg) + m3ua-unexpected-message-error-code) + m3ua-test-result-passed + m3ua-test-result-failed)))) +;;; (m3ua-sgp-aspsm-i-003 tester-addr tester-port sut-addr sut-port) +;;; This test needs clarification. FIXME. + + + +(define (m3ua-sgp-aspsm-i-004 tester-addr tester-port sut-addr sut-port) + (let ((fd (m3ua-connect tester-addr tester-port sut-addr sut-port))) + (m3ua-send-message fd 0 (m3ua-make-asp-up-message asp-up-message-parameters)) + (m3ua-wait-for-message fd m3ua-asp-up-ack-message?) + (m3ua-send-message fd 0 (m3ua-make-common-header m3ua-version + m3ua-reserved + m3ua-aspsm-message-class + m3ua-reserved-aspsm-message-type + m3ua-common-header-length)) + (let ((msg (m3ua-wait-for-message fd m3ua-error-message?))) + (close fd) + (if (= (m3ua-get-error-code-from-message msg) + m3ua-unsupported-message-type-error-code) + m3ua-test-result-passed + m3ua-test-result-failed)))) +;;; (m3ua-sgp-aspsm-i-004 tester-addr tester-port sut-addr sut-port) +;;; This test is passed if there is an ERROR(unsupported message type) + + + +(define (m3ua-sgp-aspsm-o-001 tester-addr tester-port sut-addr sut-port) + (let ((fd (m3ua-connect tester-addr tester-port sut-addr sut-port))) + (m3ua-send-message fd 0 (m3ua-make-asp-up-message asp-up-message-parameters)) + (m3ua-wait-for-message fd m3ua-asp-up-ack-message?) + (m3ua-send-message fd 0 (m3ua-make-asp-up-message asp-up-message-parameters)) + (m3ua-wait-for-message fd m3ua-asp-up-ack-message?) + (close fd) + m3ua-test-result-passed)) +;;; (m3ua-sgp-aspsm-o-001 tester-addr tester-port sut-addr sut-port) +;;; This test is passed if there is an ASPUP-ACK. + + + +(define (m3ua-sgp-aspsm-o-003 tester-addr tester-port sut-addr sut-port) + (let ((fd (m3ua-connect tester-addr tester-port sut-addr sut-port))) + (m3ua-send-message fd 0 (m3ua-make-asp-up-message asp-up-message-parameters)) + (m3ua-wait-for-message fd m3ua-asp-up-ack-message?) + (m3ua-send-message fd 0 (m3ua-make-asp-active-message asp-active-message-parameters)) + (m3ua-wait-for-message fd m3ua-asp-active-ack-message?) + (m3ua-send-message fd 0 (m3ua-make-asp-up-message asp-up-message-parameters)) + (let ((msg (m3ua-wait-for-message fd m3ua-error-message?))) + (if (= (m3ua-get-error-code-from-message msg) + m3ua-unexpected-message-error-code) + (begin + (m3ua-wait-for-message fd m3ua-asp-up-ack-message?) + (let ((msg (m3ua-wait-for-message fd m3ua-notify-message?))) + (close fd) + (if (and (= (m3ua-get-status-type-from-message msg) m3ua-as-state-change-status-type) + (= (m3ua-get-status-info-from-message msg) m3ua-as-inactive)) + m3ua-test-result-passed + m3ua-test-result-failed))) + (begin + (close fd) + m3ua-test-result-failed))))) +;;; (m3ua-sgp-aspsm-o-003 tester-addr tester-port sut-addr sut-port) +;;; This test is passed if there is an ERROR(unexpected message), +;;; an ASPUP-ACK and a NOTIFY(AS_INACTIVE). + + + +(define (m3ua-sgp-aspsm-o-004 tester-addr tester-port sut-addr sut-port) + (let ((fd (m3ua-connect tester-addr tester-port sut-addr sut-port))) + (m3ua-send-message fd 0 (m3ua-make-asp-down-message)) + (m3ua-wait-for-message fd m3ua-asp-down-ack-message?) + (close fd) + m3ua-test-result-passed)) +;;; (m3ua-sgp-aspsm-o-004 tester-addr tester-port sut-addr sut-port) +;;; This test is passed if there is an ASPDN-ACK, + + + +(define (m3ua-sgp-asptm-v-001 tester-addr tester-port sut-addr sut-port) + (let ((fd (m3ua-connect tester-addr tester-port sut-addr sut-port))) + (m3ua-send-message fd 0 (m3ua-make-asp-up-message asp-up-message-parameters)) + (m3ua-wait-for-message fd m3ua-asp-up-ack-message?) + (m3ua-send-message fd 0 (m3ua-make-asp-active-message asp-active-message-parameters)) + (m3ua-wait-for-message fd m3ua-asp-active-ack-message?) + (close fd) + m3ua-test-result-passed)) +;;; (m3ua-sgp-asptm-v-001 tester-addr tester-port sut-addr sut-port) +;;; This test is passed if there is an ASPAC-ACK. + + + +(define (m3ua-sgp-asptm-v-003 tester-addr tester-port sut-addr sut-port) + (let ((fd (m3ua-connect tester-addr tester-port sut-addr sut-port))) + (m3ua-send-message fd 0 (m3ua-make-asp-up-message asp-up-message-parameters)) + (m3ua-wait-for-message fd m3ua-asp-up-ack-message?) + (m3ua-send-message fd 0 (m3ua-make-asp-active-message asp-active-message-parameters)) + (m3ua-wait-for-message fd m3ua-asp-active-ack-message?) + (let ((msg (m3ua-wait-for-message fd m3ua-notify-message?))) + (close fd) + (if (and (= (m3ua-get-status-type-from-message msg) m3ua-as-state-change-status-type) + (= (m3ua-get-status-info-from-message msg) m3ua-as-active)) + m3ua-test-result-passed + m3ua-test-result-failed)))) +;;; (m3ua-sgp-asptm-v-003 tester-addr tester-port sut-addr sut-port) +;;; This test is passed if there is an ASPAC-ACK and NOTIFY(AS-ACTIVE). + + + +(define (m3ua-sgp-asptm-v-005 tester-addr tester-port sut-addr sut-port rc) + (let ((fd (m3ua-connect tester-addr tester-port sut-addr sut-port))) + (m3ua-send-message fd 0 (m3ua-make-asp-up-message asp-up-message-parameters)) + (m3ua-wait-for-message fd m3ua-asp-up-ack-message?) + (m3ua-send-message fd 0 (m3ua-make-asp-active-message (list (m3ua-make-routing-context-parameter (list rc))))) + (m3ua-wait-for-message fd m3ua-asp-active-ack-message?) + (close fd) + m3ua-test-result-unknown)) +;;; (m3ua-sgp-asptm-v-005 tester-addr tester-port sut-addr sut-port tester-rc-valid) +;;; This test is passed if there is an ASPAC-ACK contains the RC. +;;; NOTE: This test does not use the asp-active-message-parameters variable. + + +(define (m3ua-sgp-asptm-v-006 tester-addr tester-port sut-addr sut-port) + (let ((fd (m3ua-connect tester-addr tester-port sut-addr sut-port))) + (m3ua-send-message fd 0 (m3ua-make-asp-up-message asp-up-message-parameters)) + (m3ua-wait-for-message fd m3ua-asp-up-ack-message?) + (m3ua-send-message fd 0 (m3ua-make-asp-active-message asp-active-message-parameters)) + (m3ua-wait-for-message fd m3ua-asp-active-ack-message?) + (m3ua-send-message fd 0 (m3ua-make-asp-inactive-message asp-inactive-message-parameters)) + (m3ua-wait-for-message fd m3ua-asp-inactive-ack-message?) + (close fd) + m3ua-test-result-passed)) +;;; (m3ua-sgp-asptm-v-006 tester-addr tester-port sut-addr sut-port) +;;; This test is passed if there is an ASPIA-ACK. + + + +(define (m3ua-sgp-asptm-v-008 tester-addr tester-port sut-addr sut-port) + (let ((fd (m3ua-connect tester-addr tester-port sut-addr sut-port))) + (m3ua-send-message fd 0 (m3ua-make-asp-up-message asp-up-message-parameters)) + (m3ua-wait-for-message fd m3ua-asp-up-ack-message?) + (m3ua-send-message fd 0 (m3ua-make-asp-active-message asp-active-message-parameters)) + (m3ua-wait-for-message fd m3ua-asp-active-ack-message?) + (m3ua-send-message fd 0 (m3ua-make-asp-inactive-message asp-inactive-message-parameters)) + (m3ua-wait-for-message fd m3ua-asp-inactive-ack-message?) + (let ((msg (m3ua-wait-for-message fd m3ua-notify-message?))) + (close fd) + (if (and (= (m3ua-get-status-type-from-message msg) m3ua-as-state-change-status-type) + (= (m3ua-get-status-info-from-message msg) m3ua-as-pending)) + m3ua-test-result-passed + m3ua-test-result-failed)))) +;;; (m3ua-sgp-asptm-v-008 tester-addr tester-port sut-addr sut-port) +;;; This test is passed if there is an ASPIA-ACK and NOTIFY(AS-PENDING). + + + +(define (m3ua-sgp-asptm-v-010 tester-addr tester-port sut-addr sut-port) + (let ((fd (m3ua-connect tester-addr tester-port sut-addr sut-port))) + (m3ua-send-message fd 0 (m3ua-make-asp-up-message asp-up-message-parameters)) + (m3ua-wait-for-message fd m3ua-asp-up-ack-message?) + (m3ua-send-message fd 0 (m3ua-make-asp-active-message asp-active-message-parameters)) + (m3ua-wait-for-message fd m3ua-asp-active-ack-message?) + (m3ua-send-message fd 0 (m3ua-make-beat-message (string->bytes "M3UA rocks"))) + (m3ua-wait-for-message fd m3ua-beat-ack-message?) + (close fd) + m3ua-test-result-passed)) +;;; (m3ua-sgp-asptm-v-010 tester-addr tester-port sut-addr sut-port) +;;; This test is passed if there is a BEAT-ACK. + + + +(define (m3ua-sgp-asptm-v-011 tester-addr tester-port sut-addr sut-port) + (let ((fd (m3ua-connect tester-addr tester-port sut-addr sut-port))) + (m3ua-send-message fd 0 (m3ua-make-asp-up-message asp-up-message-parameters)) + (m3ua-wait-for-message fd m3ua-asp-up-ack-message?) + (m3ua-send-message fd 0 (m3ua-make-asp-active-message asp-active-message-parameters)) + (m3ua-wait-for-message fd m3ua-asp-active-ack-message?) + (let ((value (random-bytes 13))) + (m3ua-send-message fd 0 (m3ua-make-beat-message value)) + (let ((msg (m3ua-wait-for-message fd m3ua-beat-ack-message?))) + (close fd) + (if (equal? msg (m3ua-make-beat-ack-message value)) + m3ua-test-result-passed + m3ua-test-result-failed))))) +;;; (m3ua-sgp-asptm-v-011 tester-addr tester-port sut-addr sut-port) +;;; This test is passed if there is a BEAT-ACK with unchanged data. + + + +(define (m3ua-sgp-asptm-v-013 tester-addr tester-port-1 tester-port-2 sut-addr sut-port-1 sut-port-2 asp-id-1 asp-id-2) + (let ((fd1 (m3ua-connect tester-addr tester-port-1 sut-addr sut-port-1)) + (fd2 (m3ua-connect tester-addr tester-port-2 sut-addr sut-port-2))) + ;;; Move ASP1 to ASP-ACTIVE + (m3ua-send-message fd1 0 (m3ua-make-asp-up-message (list (m3ua-make-asp-id-parameter asp-id-1)))) + (m3ua-wait-for-message fd1 m3ua-asp-up-ack-message?) + (m3ua-send-message fd1 0 (m3ua-make-asp-active-message (list (m3ua-make-traffic-mode-type-parameter m3ua-traffic-mode-type-broadcast)))) + (m3ua-wait-for-message fd1 m3ua-asp-active-ack-message?) + ;;; Move ASP2 to ASP-ACTIVE + (m3ua-send-message fd2 0 (m3ua-make-asp-up-message (list (m3ua-make-asp-id-parameter asp-id-2)))) + (m3ua-wait-for-message fd2 m3ua-asp-up-ack-message?) + (m3ua-send-message fd2 0 (m3ua-make-asp-active-message (list (m3ua-make-traffic-mode-type-parameter m3ua-traffic-mode-type-broadcast)))) + (m3ua-wait-for-message fd2 m3ua-asp-active-ack-message?) + ;;; Now move ASP1 to ASP-INACTIVE + (m3ua-send-message fd1 0 (m3ua-make-asp-inactive-message (list))) + (m3ua-wait-for-message fd1 m3ua-asp-inactive-ack-message?) + (let ((msg (m3ua-wait-for-message fd1 m3ua-notify-message?))) + (close fd1) + (close fd2) + (if (and (= (m3ua-get-status-type-from-message msg) m3ua-other-status-type) + (= (m3ua-get-status-info-from-message msg) m3ua-insufficient-resources)) + m3ua-test-result-passed + m3ua-test-result-failed)))) +;;; (m3ua-sgp-asptm-v-013 tester-addr tester-port-1 tester-port-2 sut-addr sut-port-1 sut-port-2 asp-id-1 asp-id-2) +;;; This test is passed if the SUT sends a NOTIFY. + + + +(define (m3ua-sgp-asptm-v-014 tester-addr tester-port-1 tester-port-2 sut-addr sut-port-1 sut-port-2 asp-id-1 asp-id-2) + (let ((fd1 (m3ua-connect tester-addr tester-port-1 sut-addr sut-port-1)) + (fd2 (m3ua-connect tester-addr tester-port-2 sut-addr sut-port-2))) + ;;; Move ASP1 to ASP-INACTIVE + (m3ua-send-message fd1 0 (m3ua-make-asp-up-message (list (m3ua-make-asp-id-parameter asp-id-1)))) + (m3ua-wait-for-message fd1 m3ua-asp-up-ack-message?) + ;;; Move ASP2 to ASP-ACTIVE + (m3ua-send-message fd2 0 (m3ua-make-asp-up-message (list (m3ua-make-asp-id-parameter asp-id-2)))) + (m3ua-wait-for-message fd2 m3ua-asp-up-ack-message?) + (m3ua-send-message fd2 0 (m3ua-make-asp-active-message (list (m3ua-make-traffic-mode-type-parameter m3ua-traffic-mode-type-override)))) + (m3ua-wait-for-message fd2 m3ua-asp-active-ack-message?) + ;;; Now move ASP1 to ASP-ACTIVE + (m3ua-send-message fd1 0 (m3ua-make-asp-active-message (list (m3ua-make-traffic-mode-type-parameter m3ua-traffic-mode-type-override)))) + (m3ua-wait-for-message fd1 m3ua-asp-active-ack-message?) + (m3ua-wait-for-message fd2 m3ua-notify-message?) + (close fd1) + (close fd2) + m3ua-test-result-passed)) +;;; (m3ua-sgp-asptm-v-014 tester-addr tester-port-1 tester-port-2 sut-addr sut-port-1 sut-port-2 asp-id-1 asp-id-2) +;;; This test is passed if the SUT sends an ASPAC-ACK and a NOTIFY. + + + +(define m3ua-sgp-asptm-v-015 m3ua-sgp-asptm-v-014) +;;; (m3ua-sgp-asptm-v-014 tester-addr tester-port-1 tester-port-2 sut-addr sut-port-1 sut-port-2 asp-id-1 asp-id-2) +;;; This test is passed if the SUT sends an ASPAC-ACK and a NOTIFY including the ASP-ID. + + + +(define (m3ua-sgp-asptm-i-001 tester-addr tester-port sut-addr sut-port) + (let ((fd (m3ua-connect tester-addr tester-port sut-addr sut-port))) + (m3ua-send-message fd 0 (m3ua-make-asp-up-message asp-up-message-parameters)) + (m3ua-wait-for-message fd m3ua-asp-up-ack-message?) + (m3ua-send-message fd 0 (m3ua-make-common-header (+ m3ua-version 1) + m3ua-reserved + m3ua-asptm-message-class + m3ua-aspac-message-type + m3ua-common-header-length)) + (let ((msg (m3ua-wait-for-message fd m3ua-error-message?))) + (close fd) + (if (= (m3ua-get-error-code-from-message msg) + m3ua-invalid-version-error-code) + m3ua-test-result-passed + m3ua-test-result-failed)))) +;;; (m3ua-sgp-asptm-i-001 tester-addr tester-port sut-addr sut-port) +;;; This test is passed if there is an ERROR(invalid version). + + + +(define (m3ua-sgp-asptm-i-003 tester-addr tester-port sut-addr sut-port) + (let ((fd (m3ua-connect tester-addr tester-port sut-addr sut-port))) + (m3ua-send-message fd 0 (m3ua-make-asp-up-message asp-up-message-parameters)) + (m3ua-wait-for-message fd m3ua-asp-up-ack-message?) + (m3ua-send-message fd 0 (m3ua-make-asp-active-message (list (m3ua-make-traffic-mode-type-parameter m3ua-traffic-mode-type-broadcast)))) + (let ((msg (m3ua-wait-for-message fd m3ua-error-message?))) + (close fd) + (if (= (m3ua-get-error-code-from-message msg) + m3ua-unsupported-traffic-mode-type-error-code) + m3ua-test-result-passed + m3ua-test-result-failed)))) +;;; (m3ua-sgp-asptm-i-003 tester-addr tester-port sut-addr sut-port) +;;; This test is passed if there is an ERROR(unsupported traffic mode type). +;;; NOTE: This test does not used the asp-active-message-parameters variable. + + + +(define (m3ua-sgp-asptm-i-004 tester-addr tester-port sut-addr sut-port) + (let ((fd (m3ua-connect tester-addr tester-port sut-addr sut-port))) + (m3ua-send-message fd 0 (m3ua-make-asp-up-message asp-up-message-parameters)) + (m3ua-wait-for-message fd m3ua-asp-up-ack-message?) + (m3ua-send-message fd 0 (m3ua-make-asp-active-message (list (m3ua-make-traffic-mode-type-parameter 4)))) + (let ((msg (m3ua-wait-for-message fd m3ua-error-message?))) + (close fd) + (if (= (m3ua-get-error-code-from-message msg) + m3ua-unsupported-traffic-mode-type-error-code) + m3ua-test-result-passed + m3ua-test-result-failed)))) +;;; (m3ua-sgp-asptm-i-004 tester-addr tester-port sut-addr sut-port) +;;; This test is passed if there is an ERROR(unsupported traffic mode type). +;;; NOTE: This test does not used the asp-active-message-parameters variable. + + + +(define (m3ua-sgp-asptm-i-005-help tester-addr tester-port sut-addr sut-port rc) + (let ((fd (m3ua-connect tester-addr tester-port sut-addr sut-port))) + (m3ua-send-message fd 0 (m3ua-make-asp-up-message asp-up-message-parameters)) + (m3ua-wait-for-message fd m3ua-asp-up-ack-message?) + (m3ua-send-message fd 0 (m3ua-make-asp-active-message (list (m3ua-make-routing-context-parameter (list rc))))) + (let ((msg (m3ua-wait-for-message fd m3ua-error-message?))) + (close fd) + (if (= (m3ua-get-error-code-from-message msg) + m3ua-invalid-routing-context-error-code) + m3ua-test-result-passed + m3ua-test-result-failed)))) +(define (m3ua-sgp-asptm-i-005 tester-addr tester-port sut-addr sut-port) + (m3ua-sgp-asptm-i-005-help tester-addr tester-port sut-addr sut-port tester-rc-invalid)) +;;; (m3ua-sgp-asptm-i-005 tester-addr tester-port sut-addr sut-port tester-rc-invalid) +;;; This test is passed if there is an ERROR(invalid routing context).. +;;; NOTE: This test does not use the asp-active-message-parameters variabel. + + + +(define (m3ua-sgp-asptm-i-006 tester-addr tester-port sut-addr sut-port) + (let ((fd (m3ua-connect tester-addr tester-port sut-addr sut-port))) + (m3ua-send-message fd 0 (m3ua-make-asp-up-message asp-up-message-parameters)) + (m3ua-wait-for-message fd m3ua-asp-up-ack-message?) + (m3ua-send-message fd 0 (m3ua-make-common-header m3ua-version + m3ua-reserved + m3ua-asptm-message-class + 5 + m3ua-common-header-length)) + (let ((msg (m3ua-wait-for-message fd m3ua-error-message?))) + (close fd) + (if (= (m3ua-get-error-code-from-message msg) + m3ua-unsupported-message-type-error-code) + m3ua-test-result-passed + m3ua-test-result-failed)))) +;;; (m3ua-sgp-asptm-i-006 tester-addr tester-port sut-addr sut-port) +;;; This test is passed if there is an ERROR(unsupported message type). + + + +(define (m3ua-sgp-asptm-i-008 tester-addr tester-port sut-addr sut-port) + (let ((fd (m3ua-connect tester-addr tester-port sut-addr sut-port))) + (m3ua-send-message fd 0 (m3ua-make-asp-up-message asp-up-message-parameters)) + (m3ua-wait-for-message fd m3ua-asp-up-ack-message?) + (m3ua-send-message fd 0 (m3ua-make-asp-active-message asp-active-message-parameters)) + (m3ua-wait-for-message fd m3ua-asp-active-ack-message?) + (m3ua-send-message fd 0 (m3ua-make-common-header m3ua-version + m3ua-reserved + m3ua-asptm-message-class + 5 + m3ua-common-header-length)) + (let ((msg (m3ua-wait-for-message fd m3ua-error-message?))) + (close fd) + (if (= (m3ua-get-error-code-from-message msg) + m3ua-unsupported-message-type-error-code) + m3ua-test-result-passed + m3ua-test-result-failed)))) +;;; (m3ua-sgp-asptm-i-008 tester-addr tester-port sut-addr sut-port) +;;; This test is passed if there is an ERROR(unsupported message type). + + + +(define (m3ua-sgp-asptm-i-009 tester-addr tester-port-1 tester-port-2 sut-addr sut-port-1 sut-port-2 asp-id-1 asp-id-2) + (let ((fd1 (m3ua-connect tester-addr tester-port-1 sut-addr sut-port-1)) + (fd2 (m3ua-connect tester-addr tester-port-2 sut-addr sut-port-2))) + ;;; Move ASP1 to ASP-ACTIVE + (m3ua-send-message fd1 0 (m3ua-make-asp-up-message (list (m3ua-make-asp-id-parameter asp-id-1)))) + (m3ua-wait-for-message fd1 m3ua-asp-up-ack-message?) + (m3ua-send-message fd1 0 (m3ua-make-asp-active-message (list (m3ua-make-traffic-mode-type-parameter m3ua-traffic-mode-type-override)))) + (m3ua-wait-for-message fd1 m3ua-asp-active-ack-message?) + ;;; Move ASP2 to ASP-ACTIVE + (m3ua-send-message fd2 0 (m3ua-make-asp-up-message (list (m3ua-make-asp-id-parameter asp-id-2)))) + (m3ua-wait-for-message fd2 m3ua-asp-up-ack-message?) + (m3ua-send-message fd2 0 (m3ua-make-asp-active-message (list (m3ua-make-traffic-mode-type-parameter m3ua-traffic-mode-type-override)))) + (m3ua-wait-for-message fd2 m3ua-asp-active-ack-message?) + ;;; Now fail communication to ASP1 via SHUTDOWN procedure. + (close fd1) + (let ((msg (m3ua-wait-for-message fd2 m3ua-notify-message?))) + (close fd2) + (if (and (= (m3ua-get-status-type-from-message msg) m3ua-other-status-type) + (= (m3ua-get-status-info-from-message msg) m3ua-asp-failure)) + m3ua-test-result-passed + m3ua-test-result-failed)))) +;;; (m3ua-sgp-asptm-i-009 tester-addr tester-port-1 tester-port-2 sut-addr sut-port-1 sut-port-2 asp-id-1 asp-id-2) +;;; This test is passed if the SUT sends a NOTIFY(ASP-FAILURE). + + + +(define (m3ua-sgp-asptm-i-010 tester-addr tester-port sut-addr sut-port) + (let ((fd (m3ua-connect tester-addr tester-port sut-addr sut-port))) + (m3ua-send-message fd 0 (m3ua-make-asp-up-message asp-up-message-parameters)) + (m3ua-wait-for-message fd m3ua-asp-up-ack-message?) + (m3ua-send-message fd 0 (m3ua-make-asp-active-message asp-active-message-parameters)) + (m3ua-wait-for-message fd m3ua-asp-active-ack-message?) + (m3ua-send-message fd 0 (m3ua-make-asp-inactive-message asp-inactive-message-parameters)) + (m3ua-wait-for-message fd m3ua-asp-inactive-ack-message?) + (close fd) + m3ua-test-result-passed)) +;;; (m3ua-sgp-asptm-i-010 tester-addr tester-port sut-addr sut-port) +;;; This test is passed if there is an ASPIA-ACK. + + + +(define (m3ua-sgp-asptm-o-001 tester-addr tester-port sut-addr sut-port) + (let ((fd (m3ua-connect tester-addr tester-port sut-addr sut-port))) + (m3ua-send-message fd 0 (m3ua-make-asp-up-message asp-up-message-parameters)) + (m3ua-wait-for-message fd m3ua-asp-up-ack-message?) + (m3ua-send-message fd 0 (m3ua-make-asp-active-message asp-active-message-parameters)) + (m3ua-wait-for-message fd m3ua-asp-active-ack-message?) + (m3ua-send-message fd 0 (m3ua-make-asp-active-message asp-active-message-parameters)) + (m3ua-wait-for-message fd m3ua-asp-active-ack-message?) + (close fd) + m3ua-test-result-passed)) +;;; (m3ua-sgp-asptm-o-001 tester-addr tester-port sut-addr sut-port) +;;; This test is passed if there is an ASPAC-ACK. + + + +(define (m3ua-sgp-asptm-o-003 tester-addr tester-port sut-addr sut-port) + (let ((fd (m3ua-connect tester-addr tester-port sut-addr sut-port))) + (m3ua-send-message fd 0 (m3ua-make-asp-up-message asp-up-message-parameters)) + (m3ua-wait-for-message fd m3ua-asp-up-ack-message?) + (m3ua-send-message fd 0 (m3ua-make-asp-inactive-message asp-inactive-message-parameters)) + (m3ua-wait-for-message fd m3ua-asp-inactive-ack-message?) + (close fd) + m3ua-test-result-passed)) +;;; (m3ua-sgp-asptm-o-003 tester-addr tester-port sut-addr sut-port) +;;; This test is passed if there is an ASPIA-ACK. + + + +(define (m3ua-sgp-mtr-v-001 tester-addr tester-port-1 tester-port-2 sut-addr sut-port-1 sut-port-2 rc-1 rc-2 tester-pc-1 tester-pc-2) + (let ((fd1 (m3ua-connect tester-addr tester-port-1 sut-addr sut-port-1)) + (fd2 (m3ua-connect tester-addr tester-port-2 sut-addr sut-port-2))) + ;;; Move ASP1 to ASP-ACTIVE + (m3ua-send-message fd1 0 (m3ua-make-asp-up-message asp-up-message-parameters)) + (m3ua-wait-for-message fd1 m3ua-asp-up-ack-message?) + (m3ua-send-message fd1 0 (m3ua-make-asp-active-message asp-active-message-parameters)) + (m3ua-wait-for-message fd1 m3ua-asp-active-ack-message?) + ;;; Move ASP2 to ASP-ACTIVE + (m3ua-send-message fd2 0 (m3ua-make-asp-up-message asp-up-message-parameters)) + (m3ua-wait-for-message fd2 m3ua-asp-up-ack-message?) + (m3ua-send-message fd2 0 (m3ua-make-asp-active-message (list (m3ua-make-routing-context-parameter (list rc-1 rc-2))))) + (m3ua-wait-for-message fd2 m3ua-asp-active-ack-message?) + (sleep 10) ;;; wait for DAVA + (do ((sls 0 (+ sls 1))) + ((= sls 16)) + (m3ua-send-message fd1 1 (m3ua-make-data-message tester-pc-1 tester-pc-2 ss7-si iut-ni iut-mp sls ss7-message data-message-parameters)) + (m3ua-wait-for-message fd2 m3ua-data-message?) + (sleep 1)) + (close fd1) + (close fd2) + m3ua-test-result-unknown)) +;;; (m3ua-sgp-mtr-v-001 tester-addr tester-port-1 tester-port-2 sut-addr sut-port-1 sut-port-2 tester-rc-valid-1 tester-rc-valid-2 tester-pc-1 tester-pc-2) +;;; tester-pc-1 must be the point code of ASP corresponding to tester-addr tester-port-1 <-> sut-addr sut-port-1 +;;; tester-pc-2 must be the point code of ASP corresponding to tester-addr tester-port-2 <-> sut-addr sut-port-2 +;;; See ETSI document. + + + +(define (m3ua-sgp-mtr-v-002 tester-addr tester-port-1 tester-port-2 sut-addr sut-port-1 sut-port-2 tester-pc-1 tester-pc-2) + (let ((fd1 (m3ua-connect tester-addr tester-port-1 sut-addr sut-port-1)) + (fd2 (m3ua-connect tester-addr tester-port-2 sut-addr sut-port-2))) + ;;; Move ASP1 to ASP-ACTIVE + (m3ua-send-message fd1 0 (m3ua-make-asp-up-message asp-up-message-parameters)) + (m3ua-wait-for-message fd1 m3ua-asp-up-ack-message?) + (m3ua-send-message fd1 0 (m3ua-make-asp-active-message asp-active-message-parameters)) + (m3ua-wait-for-message fd1 m3ua-asp-active-ack-message?) + ;;; Move ASP2 to ASP-ACTIVE + (m3ua-send-message fd2 0 (m3ua-make-asp-up-message asp-up-message-parameters)) + (m3ua-wait-for-message fd2 m3ua-asp-up-ack-message?) + (m3ua-send-message fd2 0 (m3ua-make-asp-active-message asp-active-message-parameters)) + (m3ua-wait-for-message fd2 m3ua-asp-active-ack-message?) + (sleep 10) ;;; wait for DAVA + (do ((sls 0 (+ sls 1))) + ((= sls 16)) + (m3ua-send-message fd1 1 (m3ua-make-data-message tester-pc-1 tester-pc-2 ss7-si iut-ni iut-mp sls ss7-message data-message-parameters)) + (m3ua-wait-for-message fd2 m3ua-data-message?) + (sleep 1)) + (close fd1) + (close fd2) + m3ua-test-result-unknown)) +;;; (m3ua-sgp-asptm-v-002 tester-addr tester-port-1 tester-port-2 sut-addr sut-port-1 sut-port-2 tester-pc-1 tester-pc-2) +;;; tester-pc-1 must be the point code of ASP corresponding to tester-addr tester-port-1 <-> sut-addr sut-port-1 +;;; tester-pc-2 must be the point code of ASP corresponding to tester-addr tester-port-2 <-> sut-addr sut-port-2 +;;; See ETSI document. + + + +(define (m3ua-sgp-mtr-v-002-alternate tester-addr tester-port sut-addr sut-port) + (let ((fd (m3ua-connect tester-addr tester-port sut-addr sut-port))) + (m3ua-send-message fd 0 (m3ua-make-asp-up-message asp-up-message-parameters)) + (m3ua-wait-for-message fd m3ua-asp-up-ack-message?) + (m3ua-send-message fd 0 (m3ua-make-asp-active-message asp-active-message-parameters)) + (m3ua-wait-for-message fd m3ua-asp-active-ack-message?) + (m3ua-send-message fd 1 (m3ua-make-data-message tester-pc tester-pc ss7-si iut-ni iut-mp iut-sls ss7-message data-message-parameters)) + (m3ua-send-message fd 1 (apply append (cons (m3ua-make-common-header m3ua-version + m3ua-reserved + m3ua-tfer-message-class + m3ua-data-message-type + m3ua-common-header-length) + data-message-parameters))) + (let ((msg (m3ua-wait-for-message fd m3ua-error-message?))) + (close fd) + (if (= (m3ua-get-error-code-from-message msg) + m3ua-missing-parameter-error-code) + m3ua-test-result-passed + m3ua-test-result-failed)))) +;;; (m3ua-sgp-mtr-v-002-alternate tester-addr tester-port sut-addr sut-port) +;;; This test is passed if the SUT responds with an ERROR message to the second DATA message. +;;; FIXME: This does NOT match the current ETSI test but a change request. + + + +(define m3ua-sgp-mtr-v-003 m3ua-sgp-mtr-v-002) +;;; (m3ua-sgp-asptm-v-003 tester-addr tester-port-1 tester-port-2 sut-addr sut-port-1 sut-port-2 tester-pc-1 tester-pc-2) +;;; tester-pc-1 must be the point code of ASP corresponding to tester-addr tester-port-1 <-> sut-addr sut-port-1 +;;; tester-pc-2 must be the point code of ASP corresponding to tester-addr tester-port-2 <-> sut-addr sut-port-2 +;;; See ETSI document. + + + +(define (m3ua-sgp-mtr-v-003-alternate tester-addr tester-port sut-addr sut-port) + (let ((fd (m3ua-connect tester-addr tester-port sut-addr sut-port))) + (m3ua-send-message fd 0 (m3ua-make-asp-up-message asp-up-message-parameters)) + (m3ua-wait-for-message fd m3ua-asp-up-ack-message?) + (m3ua-send-message fd 0 (m3ua-make-asp-active-message asp-active-message-parameters)) + (m3ua-wait-for-message fd m3ua-asp-active-ack-message?) + (m3ua-send-message fd 1 (m3ua-make-data-message tester-pc tester-pc ss7-si iut-ni iut-mp iut-sls ss7-message data-message-parameters)) + (m3ua-send-message fd 0 (m3ua-make-data-message tester-pc tester-pc ss7-si iut-ni iut-mp iut-sls ss7-message data-message-parameters)) + (let ((msg (m3ua-wait-for-message fd m3ua-error-message?))) + (close fd) + (if (= (m3ua-get-error-code-from-message msg) + m3ua-invalid-stream-identifier-error-code) + m3ua-test-result-passed + m3ua-test-result-failed)))) +;;; (m3ua-sgp-mtr-v-003-alternate tester-addr tester-port sut-addr sut-port) +;;; This test is passed if the SUT sends an ERROR message for the second DATA message. +;;; FIXME: This does NOT match the current ETSI test but a change request. + + + +(define m3ua-sgp-mtr-v-004 m3ua-sgp-mtr-v-002) +;;; (m3ua-sgp-asptm-v-004 tester-addr tester-port-1 tester-port-2 sut-addr sut-port-1 sut-port-2 tester-pc-1 tester-pc-2) +;;; tester-pc-1 must be the point code of ASP corresponding to tester-addr tester-port-1 <-> sut-addr sut-port-1 +;;; tester-pc-2 must be the point code of ASP corresponding to tester-addr tester-port-2 <-> sut-addr sut-port-2 +;;; See ETSI document. + + + +(define (m3ua-sgp-mtr-i-001 tester-addr tester-port sut-addr sut-port) + (let ((fd (m3ua-connect tester-addr tester-port sut-addr sut-port))) + (m3ua-send-message fd 0 (m3ua-make-asp-up-message asp-up-message-parameters)) + (m3ua-wait-for-message fd m3ua-asp-up-ack-message?) + (m3ua-send-message fd 0 (m3ua-make-asp-active-message asp-active-message-parameters)) + (m3ua-wait-for-message fd m3ua-asp-active-ack-message?) + (m3ua-send-message fd 1 (append (m3ua-make-common-header (+ 1 m3ua-version) + m3ua-reserved + m3ua-tfer-message-class + m3ua-data-message-type + (+ m3ua-common-header-length + m3ua-data-parameter-header-length + (length ss7-message))) + (m3ua-make-data-parameter tester-pc + tester-pc + ss7-si + 0 + 0 + 4 + ss7-message))) + (let ((msg (m3ua-wait-for-message fd m3ua-error-message?))) + (close fd) + (if (= (m3ua-get-error-code-from-message msg) + m3ua-invalid-version-error-code) + m3ua-test-result-passed + m3ua-test-result-failed)))) +;;; (m3ua-sgp-mtr-i-001 tester-addr tester-port sut-addr sut-port) +;;; This test is passed if there is an ERROR(invalid version). + + + +(define (m3ua-sgp-mtr-i-002 tester-addr tester-port sut-addr sut-port) + (let ((fd (m3ua-connect tester-addr tester-port sut-addr sut-port))) + (m3ua-send-message fd 0 (m3ua-make-asp-up-message asp-up-message-parameters)) + (m3ua-wait-for-message fd m3ua-asp-up-ack-message?) + (m3ua-send-message fd 0 (m3ua-make-asp-active-message asp-active-message-parameters)) + (m3ua-wait-for-message fd m3ua-asp-active-ack-message?) + (m3ua-send-message fd 0 (append (m3ua-make-common-header m3ua-version + m3ua-reserved + 10 + m3ua-data-message-type + (+ m3ua-common-header-length + m3ua-data-parameter-header-length + (length ss7-message))) + (m3ua-make-data-parameter tester-pc + tester-pc + ss7-si + 0 + 0 + 4 + ss7-message))) + (let ((msg (m3ua-wait-for-message fd m3ua-error-message?))) + (close fd) + (if (= (m3ua-get-error-code-from-message msg) + m3ua-unsupported-message-class-error-code) + m3ua-test-result-passed + m3ua-test-result-failed)))) +;;; (m3ua-sgp-mtr-i-002 tester-addr tester-port sut-addr sut-port) +;;; This test is passed if there is an ERROR(unsupported message class). + + + +(define (m3ua-sgp-mtr-i-003 tester-addr tester-port sut-addr sut-port) + (let ((fd (m3ua-connect tester-addr tester-port sut-addr sut-port))) + (m3ua-send-message fd 0 (m3ua-make-asp-up-message asp-up-message-parameters)) + (m3ua-wait-for-message fd m3ua-asp-up-ack-message?) + (m3ua-send-message fd 0 (m3ua-make-asp-active-message asp-active-message-parameters)) + (m3ua-wait-for-message fd m3ua-asp-active-ack-message?) + (m3ua-send-message fd 1 (append (m3ua-make-common-header m3ua-version + m3ua-reserved + m3ua-tfer-message-class + 2 + (+ m3ua-common-header-length + m3ua-data-parameter-header-length + (length ss7-message))) + (m3ua-make-data-parameter tester-pc + tester-pc + ss7-si + 0 + 0 + 4 + ss7-message))) + (let ((msg (m3ua-wait-for-message fd m3ua-error-message?))) + (close fd) + (if (= (m3ua-get-error-code-from-message msg) + m3ua-unsupported-message-type-error-code) + m3ua-test-result-passed + m3ua-test-result-failed)))) +;;; (m3ua-sgp-mtr-i-003 tester-addr tester-port sut-addr sut-port) +;;; This test is passed if there is an ERROR(unsupported message type). + + + +(define (m3ua-sgp-rkm-v-001 tester-addr tester-port sut-addr sut-port) + (let ((fd (m3ua-connect tester-addr tester-port sut-addr sut-port))) + (m3ua-send-message fd 0 (m3ua-make-asp-up-message asp-up-message-parameters)) + (m3ua-wait-for-message fd m3ua-asp-up-ack-message?) + (m3ua-wait-for-message fd m3ua-notify-message?) + (m3ua-send-message fd 0 (m3ua-make-reg-req-message + (list + (m3ua-make-routing-key-parameter + (list (m3ua-make-local-routing-key-identifier-parameter 1) + (m3ua-make-destination-point-code-parameter tester-pc)))))) + (m3ua-wait-for-message fd m3ua-reg-rsp-message?) + (sleep 1) + (close fd))) +;;; (m3ua-sgp-rkm-v-001 tester-addr tester-port sut-addr sut-port) +;;; This test is passed if a REG_RSP with result sucessfully registered is returned. + + + +(define m3ua-sgp-rkm-v-002 m3ua-sgp-rkm-v-001) +;;; (m3ua-sgp-rkm-v-002 tester-addr tester-port sut-addr sut-port) +;;; This test is passed if a REG_RSP with result sucessfully registered is returned. + + + +(define (m3ua-sgp-rkm-v-003 tester-addr tester-port sut-addr sut-port) + (let ((fd (m3ua-connect tester-addr tester-port sut-addr sut-port))) + (m3ua-send-message fd 0 (m3ua-make-asp-up-message asp-up-message-parameters)) + (m3ua-wait-for-message fd m3ua-asp-up-ack-message?) + (m3ua-wait-for-message fd m3ua-notify-message?) + (m3ua-send-message fd 0 (m3ua-make-reg-req-message + (list + (m3ua-make-routing-key-parameter + (list (m3ua-make-local-routing-key-identifier-parameter 1) + (m3ua-make-destination-point-code-parameter tester-pc)))))) + (let ((rc (m3ua-get-routing-context-from-reg-rsp (m3ua-wait-for-message fd m3ua-reg-rsp-message?)))) + (m3ua-send-message fd 0 (m3ua-make-dereg-req-message + (list (m3ua-make-routing-context-parameter (list rc)))))) + (m3ua-wait-for-message fd m3ua-dereg-rsp-message?) + (sleep 1) + (close fd))) +;;; (m3ua-sgp-rkm-v-003 tester-addr tester-port sut-addr sut-port) +;;; This test is passed if a DEREG_RSP with result sucessfully deregistered is returned. + + + +(define (m3ua-sgp-rkm-v-004 tester-addr tester-port sut-addr sut-port) + (let ((fd (m3ua-connect tester-addr tester-port sut-addr sut-port))) + (m3ua-send-message fd 0 (m3ua-make-asp-up-message asp-up-message-parameters)) + (m3ua-wait-for-message fd m3ua-asp-up-ack-message?) + (m3ua-wait-for-message fd m3ua-notify-message?) + (m3ua-send-message fd 0 (m3ua-make-reg-req-message + (list + (m3ua-make-routing-key-parameter + (list (m3ua-make-local-routing-key-identifier-parameter 1) + (m3ua-make-destination-point-code-parameter tester-pc)))))) + (m3ua-wait-for-message fd m3ua-error-message?) + (sleep 1) + (close fd))) +;;; (m3ua-sgp-rkm-v-004 tester-addr tester-port sut-addr sut-port) +;;; This test is passed if an ERROR(Unsupported Message Class) is returned. +;;; FIXME: Other error codes should be also OK. + + +(define (m3ua-sgp-rkm-i-003 tester-addr tester-port sut-addr sut-port) + (let ((fd (m3ua-connect tester-addr tester-port sut-addr sut-port))) + (m3ua-send-message fd 0 (m3ua-make-asp-up-message asp-up-message-parameters)) + (m3ua-wait-for-message fd m3ua-asp-up-ack-message?) + (m3ua-wait-for-message fd m3ua-notify-message?) + (m3ua-send-message fd 0 (m3ua-make-reg-req-message + (list + (m3ua-make-routing-key-parameter + (list (m3ua-make-local-routing-key-identifier-parameter 1)))))) + (m3ua-wait-for-message fd m3ua-reg-rsp-message?) + (sleep 1) + (close fd))) +;;; (m3ua-sgp-rkm-i-003 tester-addr tester-port sut-addr sut-port) +;;; This test is passed if an REG_RSP with result ERROR - Invalid routing key is returned. +;;; FIXME: Is this really an invalid RC? At least it does not make sense... + + + +(define (m3ua-sgp-rkm-i-004 tester-addr tester-port sut-addr sut-port) + (let ((fd (m3ua-connect tester-addr tester-port sut-addr sut-port))) + (m3ua-send-message fd 0 (m3ua-make-asp-up-message asp-up-message-parameters)) + (m3ua-wait-for-message fd m3ua-asp-up-ack-message?) + (m3ua-wait-for-message fd m3ua-notify-message?) + (m3ua-send-message fd 0 (m3ua-make-reg-req-message + (list + (m3ua-make-routing-key-parameter + (list (m3ua-make-local-routing-key-identifier-parameter 1) + (m3ua-make-destination-point-code-parameter tester-invalid-pc)))))) + (m3ua-wait-for-message fd m3ua-reg-rsp-message?) + (sleep 1) + (close fd))) +;;; (m3ua-sgp-rkm-i-004 tester-addr tester-port sut-addr sut-port) +;;; This test is passed if an REG_RSP with result ERROR - Invalid DPC is returned. + + + +(define (m3ua-sgp-rkm-i-005 tester-addr tester-port sut-addr sut-port) + (let ((fd (m3ua-connect tester-addr tester-port sut-addr sut-port))) + (m3ua-send-message fd 0 (m3ua-make-asp-up-message asp-up-message-parameters)) + (m3ua-wait-for-message fd m3ua-asp-up-ack-message?) + (m3ua-wait-for-message fd m3ua-notify-message?) + (m3ua-send-message fd 0 (m3ua-make-reg-req-message + (list + (m3ua-make-routing-key-parameter + (list (m3ua-make-local-routing-key-identifier-parameter 1) + (m3ua-make-destination-point-code-parameter tester-pc) + (m3ua-make-network-appearance-parameter invalid-network-appearance)))))) + (m3ua-wait-for-message fd m3ua-reg-rsp-message?) + (sleep 1) + (close fd))) +;;; (m3ua-sgp-rkm-i-005 tester-addr tester-port sut-addr sut-port) +;;; This test is passed if an REG_RSP with result ERROR - Invalid Network Appearance is returned. + + + +(define (m3ua-sgp-rkm-i-006 tester-addr tester-port sut-addr sut-port) + (let ((fd (m3ua-connect tester-addr tester-port sut-addr sut-port))) + (m3ua-send-message fd 0 (m3ua-make-asp-up-message asp-up-message-parameters)) + (m3ua-wait-for-message fd m3ua-asp-up-ack-message?) + (m3ua-wait-for-message fd m3ua-notify-message?) + (m3ua-send-message fd 0 (m3ua-make-reg-req-message + (list + (m3ua-make-routing-key-parameter + (list (m3ua-make-local-routing-key-identifier-parameter 1) + (m3ua-make-destination-point-code-parameter tester-pc)))))) + (m3ua-wait-for-message fd m3ua-reg-rsp-message?) + (m3ua-send-message fd 0 (m3ua-make-reg-req-message + (list + (m3ua-make-routing-key-parameter + (list (m3ua-make-local-routing-key-identifier-parameter 2) + (m3ua-make-destination-point-code-parameter tester-pc)))))) + (m3ua-wait-for-message fd m3ua-reg-rsp-message?) + (sleep 1) + (close fd))) +;;; (m3ua-sgp-rkm-i-006 tester-addr tester-port sut-addr sut-port) +;;; This test is passed if an REG_RSP with result ERROR - Can not support unique routing key is returned. + + + +(define (m3ua-sgp-rkm-i-007 tester-addr tester-port sut-addr sut-port) + (let ((fd (m3ua-connect tester-addr tester-port sut-addr sut-port))) + (m3ua-send-message fd 0 (m3ua-make-asp-up-message asp-up-message-parameters)) + (m3ua-wait-for-message fd m3ua-asp-up-ack-message?) + (m3ua-wait-for-message fd m3ua-notify-message?) + (m3ua-send-message fd 0 (m3ua-make-reg-req-message + (list + (m3ua-make-routing-key-parameter + (list (m3ua-make-local-routing-key-identifier-parameter 1) + (m3ua-make-destination-point-code-parameter tester-unauthorized-pc)))))) + (m3ua-wait-for-message fd m3ua-reg-rsp-message?) + (sleep 1) + (close fd))) +;;; (m3ua-sgp-rkm-i-007 tester-addr tester-port sut-addr sut-port) +;;; This test is passed if an REG_RSP with result ERROR - Error Permission Denied is returned. + + + +(define (m3ua-sgp-rkm-i-008 tester-addr tester-port sut-addr sut-port) + (let ((fd (m3ua-connect tester-addr tester-port sut-addr sut-port))) + (m3ua-send-message fd 0 (m3ua-make-asp-up-message asp-up-message-parameters)) + (m3ua-wait-for-message fd m3ua-asp-up-ack-message?) + (m3ua-wait-for-message fd m3ua-notify-message?) + (m3ua-send-message fd 0 (m3ua-make-reg-req-message + (list + (m3ua-make-routing-key-parameter + (list (m3ua-make-local-routing-key-identifier-parameter 1) + (m3ua-make-destination-point-code-parameter tester-unprovisioned-pc)))))) + (m3ua-wait-for-message fd m3ua-reg-rsp-message?) + (sleep 1) + (close fd))) +;;; (m3ua-sgp-rkm-i-008 tester-addr tester-port sut-addr sut-port) +;;; This test is passed if an REG_RSP with result ERROR - Error Routing key not currently provsioned is returned. + + + +(define (m3ua-sgp-rkm-i-009 tester-addr tester-port sut-addr sut-port) + (let ((fd (m3ua-connect tester-addr tester-port sut-addr sut-port))) + (m3ua-send-message fd 0 (m3ua-make-asp-up-message asp-up-message-parameters)) + (m3ua-wait-for-message fd m3ua-asp-up-ack-message?) + (m3ua-wait-for-message fd m3ua-notify-message?) + (m3ua-send-message fd 0 (m3ua-make-reg-req-message + (list + (m3ua-make-routing-key-parameter + (list (m3ua-make-local-routing-key-identifier-parameter 1) + (m3ua-make-destination-point-code-parameter tester-pc)))))) + (m3ua-wait-for-message fd m3ua-reg-rsp-message?) + (sleep 1) + (close fd))) +;;; (m3ua-sgp-rkm-i-009 tester-addr tester-port sut-addr sut-port) +;;; This test is passed if an REG_RSP with result ERROR - Error Insufficient Resources is returned. +;;; FIXME: How to arrange that the SUT is out of resources + + + +(define (m3ua-sgp-rkm-i-010 tester-addr tester-port sut-addr sut-port) + (let ((fd (m3ua-connect tester-addr tester-port sut-addr sut-port))) + (m3ua-send-message fd 0 (m3ua-make-asp-up-message asp-up-message-parameters)) + (m3ua-wait-for-message fd m3ua-asp-up-ack-message?) + (m3ua-wait-for-message fd m3ua-notify-message?) + (m3ua-send-message fd 0 (m3ua-make-reg-req-message + (list + (m3ua-make-routing-key-parameter + (list (m3ua-make-local-routing-key-identifier-parameter 1) + (m3ua-make-destination-point-code-parameter tester-pc) + (m3ua-make-circuit-range-parameter (list (list tester-pc 0 0)))))))) + (m3ua-wait-for-message fd m3ua-reg-rsp-message?) + (sleep 1) + (close fd))) +;;; (m3ua-sgp-rkm-i-010 tester-addr tester-port sut-addr sut-port) +;;; This test is passed if an REG_RSP with result ERROR - Error Unsupported RK Parameter Field is returned. +;;; It is assumed that the SUT does not support the circuit range parameter... + + + +(define (m3ua-sgp-rkm-i-traffic-mode-test tester-addr tester-port sut-addr sut-port traffic-mode-type-1 traffic-mode-type-2) + (let ((fd (m3ua-connect tester-addr tester-port sut-addr sut-port))) + (m3ua-send-message fd 0 (m3ua-make-asp-up-message asp-up-message-parameters)) + (m3ua-wait-for-message fd m3ua-asp-up-ack-message?) + (m3ua-wait-for-message fd m3ua-notify-message?) + (m3ua-send-message fd 0 (m3ua-make-reg-req-message + (list + (m3ua-make-routing-key-parameter + (list (m3ua-make-local-routing-key-identifier-parameter 1) + (m3ua-make-traffic-mode-type-parameter traffic-mode-type-1) + (m3ua-make-destination-point-code-parameter tester-pc)))))) + (m3ua-wait-for-message fd m3ua-reg-rsp-message?) + (m3ua-send-message fd 0 (m3ua-make-reg-req-message + (list + (m3ua-make-routing-key-parameter + (list (m3ua-make-local-routing-key-identifier-parameter 2) + (m3ua-make-traffic-mode-type-parameter traffic-mode-type-2) + (m3ua-make-destination-point-code-parameter tester-pc)))))) + (m3ua-wait-for-message fd m3ua-reg-rsp-message?) + (sleep 1) + (close fd))) + + + +(define (m3ua-sgp-rkm-i-011 tester-addr tester-port sut-addr sut-port) + (m3ua-sgp-rkm-i-traffic-mode-test tester-addr tester-port sut-addr sut-port m3ua-traffic-mode-type-override m3ua-traffic-mode-type-loadshare)) +;;; (m3ua-sgp-rkm-i-011 tester-addr tester-port sut-addr sut-port) +;;; This test is passed if an REG_RSP with result ERROR - Error Unsupported/Invalid Traffic Handling Mode is returned. + + + +(define (m3ua-sgp-rkm-i-012 tester-addr tester-port sut-addr sut-port) + (m3ua-sgp-rkm-i-traffic-mode-test tester-addr tester-port sut-addr sut-port m3ua-traffic-mode-type-override m3ua-traffic-mode-type-broadcast)) +;;; (m3ua-sgp-rkm-i-012 tester-addr tester-port sut-addr sut-port) +;;; This test is passed if an REG_RSP with result ERROR - Error Unsupported/Invalid Traffic Handling Mode is returned. + + + +(define (m3ua-sgp-rkm-i-013 tester-addr tester-port sut-addr sut-port) + (let ((fd (m3ua-connect tester-addr tester-port sut-addr sut-port))) + (m3ua-send-message fd 0 (m3ua-make-asp-up-message asp-up-message-parameters)) + (m3ua-wait-for-message fd m3ua-asp-up-ack-message?) + (m3ua-wait-for-message fd m3ua-notify-message?) + (m3ua-send-message fd 0 (m3ua-make-reg-req-message + (list + (m3ua-make-routing-key-parameter + (list (m3ua-make-local-routing-key-identifier-parameter 1) + (m3ua-make-traffic-mode-type-parameter m3ua-traffic-mode-type-invalid) + (m3ua-make-destination-point-code-parameter tester-pc)))))) + (m3ua-wait-for-message fd m3ua-reg-rsp-message?) + (sleep 1) + (close fd))) +;;; (m3ua-sgp-rkm-i-013 tester-addr tester-port sut-addr sut-port) +;;; This test is passed if an REG_RSP with result ERROR - Error Unsupported/Invalid Traffic Handling Mode is returned. + + + +(define (m3ua-sgp-rkm-i-014 tester-addr tester-port sut-addr sut-port) + (m3ua-sgp-rkm-i-traffic-mode-test tester-addr tester-port sut-addr sut-port m3ua-traffic-mode-type-loadshare m3ua-traffic-mode-type-override)) +;;; (m3ua-sgp-rkm-i-014 tester-addr tester-port sut-addr sut-port) +;;; This test is passed if an REG_RSP with result ERROR - Error Unsupported/Invalid Traffic Handling Mode is returned. + + + +(define (m3ua-sgp-rkm-i-015 tester-addr tester-port sut-addr sut-port) + (m3ua-sgp-rkm-i-traffic-mode-test tester-addr tester-port sut-addr sut-port m3ua-traffic-mode-type-loadshare m3ua-traffic-mode-type-broadcast)) +;;; (m3ua-sgp-rkm-i-015 tester-addr tester-port sut-addr sut-port) +;;; This test is passed if an REG_RSP with result ERROR - Error Unsupported/Invalid Traffic Handling Mode is returned. + + + +(define (m3ua-sgp-rkm-i-017 tester-addr tester-port sut-addr sut-port) + (m3ua-sgp-rkm-i-traffic-mode-test tester-addr tester-port sut-addr sut-port m3ua-traffic-mode-type-broadcast m3ua-traffic-mode-type-override)) +;;; (m3ua-sgp-rkm-i-017 tester-addr tester-port sut-addr sut-port) +;;; This test is passed if an REG_RSP with result ERROR - Error Unsupported/Invalid Traffic Handling Mode is returned. + + + +(define (m3ua-sgp-rkm-i-018 tester-addr tester-port sut-addr sut-port) + (m3ua-sgp-rkm-i-traffic-mode-test tester-addr tester-port sut-addr sut-port m3ua-traffic-mode-type-broadcast m3ua-traffic-mode-type-loadshare)) +;;; (m3ua-sgp-rkm-i-018 tester-addr tester-port sut-addr sut-port) +;;; This test is passed if an REG_RSP with result ERROR - Error Unsupported/Invalid Traffic Handling Mode is returned. + + + +(define (m3ua-sgp-rkm-i-020 tester-addr tester-port sut-addr sut-port) + (let ((fd (m3ua-connect tester-addr tester-port sut-addr sut-port))) + (m3ua-send-message fd 0 (m3ua-make-asp-up-message asp-up-message-parameters)) + (m3ua-wait-for-message fd m3ua-asp-up-ack-message?) + (m3ua-wait-for-message fd m3ua-notify-message?) + (m3ua-send-message fd 0 (m3ua-make-reg-req-message + (list + (m3ua-make-routing-key-parameter + (list (m3ua-make-local-routing-key-identifier-parameter 1) + (m3ua-make-destination-point-code-parameter tester-pc)))))) + (m3ua-send-message fd 0 (m3ua-make-dereg-req-message + (list (m3ua-make-routing-context-parameter (list tester-rc-invalid))))) + (m3ua-wait-for-message fd m3ua-dereg-rsp-message?) + (sleep 1) + (close fd))) +;;; (m3ua-sgp-rkm-i-020 tester-addr tester-port sut-addr sut-port) +;;; This test is passed if an REG_RSP with result ERROR - Error Not Registered is returned. + + + +(define (m3ua-sgp-rkm-i-021 tester-addr tester-port sut-addr sut-port) + (let ((fd (m3ua-connect tester-addr tester-port sut-addr sut-port))) + (m3ua-send-message fd 0 (m3ua-make-asp-up-message asp-up-message-parameters)) + (m3ua-wait-for-message fd m3ua-asp-up-ack-message?) + (m3ua-wait-for-message fd m3ua-notify-message?) + (m3ua-send-message fd 0 (m3ua-make-reg-req-message + (list + (m3ua-make-routing-key-parameter + (list (m3ua-make-local-routing-key-identifier-parameter 1) + (m3ua-make-destination-point-code-parameter tester-pc)))))) + (let ((rc (m3ua-get-routing-context-from-reg-rsp (m3ua-wait-for-message fd m3ua-reg-rsp-message?)))) + (m3ua-send-message fd 0 (m3ua-make-dereg-req-message + (list (m3ua-make-routing-context-parameter (list rc)))))) + (m3ua-wait-for-message fd m3ua-dereg-rsp-message?) + (sleep 1) + (close fd))) +;;; (m3ua-sgp-rkm-i-021 tester-addr tester-port sut-addr sut-port) +;;; This test is passed if a DEREG_RSP with result Error - Permission Denied is returned. +;;; FIXME: Please make sure that the registered routing key is not authorized for dereg. + + + +(define (m3ua-sgp-rkm-i-022 tester-addr tester-port sut-addr sut-port) + (let ((fd (m3ua-connect tester-addr tester-port sut-addr sut-port))) + (m3ua-send-message fd 0 (m3ua-make-asp-up-message asp-up-message-parameters)) + (m3ua-wait-for-message fd m3ua-asp-up-ack-message?) + (m3ua-wait-for-message fd m3ua-notify-message?) + (m3ua-send-message fd 0 (m3ua-make-reg-req-message + (list + (m3ua-make-routing-key-parameter + (list (m3ua-make-local-routing-key-identifier-parameter 1) + (m3ua-make-destination-point-code-parameter tester-pc)))))) + (let ((rc (m3ua-get-routing-context-from-reg-rsp (m3ua-wait-for-message fd m3ua-reg-rsp-message?)))) + (m3ua-send-message fd 0 (m3ua-make-asp-active-message (list (m3ua-make-routing-context-parameter (list rc))))) + (m3ua-wait-for-message fd m3ua-asp-active-ack-message?) + (m3ua-wait-for-message fd m3ua-notify-message?) + (m3ua-send-message fd 0 (m3ua-make-dereg-req-message + (list (m3ua-make-routing-context-parameter (list rc)))))) + (m3ua-wait-for-message fd m3ua-dereg-rsp-message?) + (sleep 1) + (close fd))) +;;; (m3ua-sgp-rkm-i-022 tester-addr tester-port sut-addr sut-port) +;;; This test is passed if a DEREG_RSP with result Error - ASP Currently Active For Routing Context is returned. + + + +(define (m3ua-sgp-rkm-i-023 tester-addr tester-port sut-addr sut-port) + (let ((fd (m3ua-connect tester-addr tester-port sut-addr sut-port))) + (m3ua-send-message fd 0 (m3ua-make-asp-up-message asp-up-message-parameters)) + (m3ua-wait-for-message fd m3ua-asp-up-ack-message?) + (m3ua-wait-for-message fd m3ua-notify-message?) + (m3ua-send-message fd 0 (m3ua-make-message m3ua-rkm-message-class m3ua-reserved-rkm-message-type (list))) + (m3ua-wait-for-message fd m3ua-error-message?) + (sleep 1) + (close fd))) +;;; (m3ua-sgp-rkm-i-023 tester-addr tester-port sut-addr sut-port) +;;; This test is passed if an ERROR (Unsuported Message Type) is returned. + +(define (m3ua-sgp-ssnm-001 tester-addr tester-port sut-addr sut-port) + (let ((fd (m3ua-connect tester-addr tester-port sut-addr sut-port))) + (m3ua-send-message fd 0 (m3ua-make-asp-up-message asp-up-message-parameters)) + (m3ua-wait-for-message fd m3ua-asp-up-ack-message?) + (m3ua-send-message fd 0 (m3ua-make-asp-active-message asp-active-message-parameters)) + (m3ua-wait-for-message fd m3ua-asp-active-ack-message?) + (m3ua-send-message fd 0 (m3ua-make-daud-message (list (m3ua-make-affected-point-code-parameter (list (list 0 tester-congested-pc)))))) + (m3ua-wait-for-message fd m3ua-scon-message?) + (close fd) + m3ua-test-result-passed)) +;;; (m3ua-sgp-ssnm-001 tester-addr tester-port sut-addr sut-port) +;;; This test is passed if there is an SCON. + +(define (m3ua-sgp-ssnm-002 tester-addr tester-port sut-addr sut-port) + (let ((fd (m3ua-connect tester-addr tester-port sut-addr sut-port))) + (m3ua-send-message fd 0 (m3ua-make-asp-up-message asp-up-message-parameters)) + (m3ua-wait-for-message fd m3ua-asp-up-ack-message?) + (m3ua-send-message fd 0 (m3ua-make-asp-active-message asp-active-message-parameters)) + (m3ua-wait-for-message fd m3ua-asp-active-ack-message?) + (m3ua-send-message fd 0 (m3ua-make-daud-message (list (m3ua-make-affected-point-code-parameter (list (list 0 tester-restricted-pc)))))) + (m3ua-wait-for-message fd m3ua-drst-message?) + (close fd) + m3ua-test-result-passed)) +;;; (m3ua-sgp-ssnm-002 tester-addr tester-port sut-addr sut-port) +;;; This test is passed if there is an DRST. + +(define (m3ua-sgp-ssnm-003 tester-addr tester-port sut-addr sut-port) + (let ((fd (m3ua-connect tester-addr tester-port sut-addr sut-port))) + (m3ua-send-message fd 0 (m3ua-make-asp-up-message asp-up-message-parameters)) + (m3ua-wait-for-message fd m3ua-asp-up-ack-message?) + (m3ua-send-message fd 0 (m3ua-make-asp-active-message asp-active-message-parameters)) + (m3ua-wait-for-message fd m3ua-asp-active-ack-message?) + (m3ua-send-message fd 0 (m3ua-make-daud-message (list (m3ua-make-affected-point-code-parameter (list (list 0 tester-unavailable-pc)))))) + (m3ua-wait-for-message fd m3ua-duna-message?) + (close fd) + m3ua-test-result-passed)) +;;; (m3ua-sgp-ssnm-003 tester-addr tester-port sut-addr sut-port) +;;; This test is passed if there is an DUNA. + +(define (m3ua-sgp-ssnm-004 tester-addr tester-port sut-addr sut-port) + (let ((fd (m3ua-connect tester-addr tester-port sut-addr sut-port))) + (m3ua-send-message fd 0 (m3ua-make-asp-up-message asp-up-message-parameters)) + (m3ua-wait-for-message fd m3ua-asp-up-ack-message?) + (m3ua-send-message fd 0 (m3ua-make-asp-active-message asp-active-message-parameters)) + (m3ua-wait-for-message fd m3ua-asp-active-ack-message?) + (m3ua-send-message fd 0 (m3ua-make-daud-message (list (m3ua-make-affected-point-code-parameter (list (list 0 tester-available-pc)))))) + (m3ua-wait-for-message fd m3ua-dava-message?) + (close fd) + m3ua-test-result-passed)) +;;; (m3ua-sgp-ssnm-004 tester-addr tester-port sut-addr sut-port) +;;; This test is passed if there is an DAVA. + +(define (m3ua-sgp-ssnm-004 tester-addr tester-port sut-addr sut-port) + (let ((fd (m3ua-connect tester-addr tester-port sut-addr sut-port))) + (m3ua-send-message fd 0 (m3ua-make-asp-up-message asp-up-message-parameters)) + (m3ua-wait-for-message fd m3ua-asp-up-ack-message?) + (m3ua-send-message fd 0 (m3ua-make-asp-active-message asp-active-message-parameters)) + (m3ua-wait-for-message fd m3ua-asp-active-ack-message?) + (m3ua-send-message fd 0 (m3ua-make-daud-message (list (m3ua-make-affected-point-code-parameter (list (list 255 tester-available-pc)))))) + (sleep 1) + (close fd) + m3ua-test-result-unknown)) +;;; (m3ua-sgp-ssnm-004 tester-addr tester-port sut-addr sut-port) +;;; This test is passed if there is an DAVA. diff --git a/m3ua.scm b/m3ua.scm new file mode 100644 index 0000000..9044308 --- /dev/null +++ b/m3ua.scm @@ -0,0 +1,1227 @@ +;;; +;;; Copyright (C) 2004, 2005, 2006 M. Tuexen tuexen@fh-muenster.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. + +;;; $Id: m3ua.scm,v 1.22 2012/08/28 19:56:13 tuexen Exp $ + +;;; Version 1.1.10 +;;; +;;; History of changes: +;;; 04.12.2004 m3ua-reserved-aspsm-message-type added +;;; 04.12.2004 m3ua-make-correlation-id-parameter added +;;; 04.12.2004 m3ua-make-network-appearance-parameter added +;;; 04.12.2004 m3ua-make-asp-parameter added +;;; 04.12.2004 m3ua-traffic-mode-type-broadcast added +;;; 04.12.2004 m3ua-make-asp-up-message now accepts parameters +;;; 04.12.2004 m3ua-make-asp-inactive-message now accepts parameters +;;; 04.12.2004 m3ua-make-asp-inactive-ack-message now accepts parameters +;;; 04.12.2004 m3ua-make-data-message now accepts parameters +;;; 14.12.2004 m3ua-error-message? added +;;; 18.12.2004 m3ua-make-data-message takes now ni mp and sls +;;; 19.12.2004 m3ua-notify-message? added. +;;; 19.12.2004 m3ua-run-sgp accepts a port. +;;; 19.12.2004 m3ua-data-message? added. +;;; 19.12.2004 m3ua-make-routing-context-parameter takes a list of contexts. +;;; 09.09.2005 m3ua-recv-message handles system errors +;;; 09.09.2005 m3ua-wait-for-message returns also on empty messages +;;; 09.09.2005 Use SCTP_NODELAY for all sockets +;;; 10.09.2005 Do the htonl() conversion of the PPID in the scheme code +;;; 04.10.2005 Fix syntax error in m3ua-make-asp-active-ack-message +;;; 04.10.2005 Handle the case where SCTP_NODELAY is not defined +;;; 09.10.2005 Extend m3ua-run-asp to be able to test the APS tests. +;;; 23.12.2005 Add m3ua-send-beats. +;;; 02.01.2006 Added all missing parameter constructors. +;;; 02.01.2006 Added support for RKM messages. +;;; 18.02.2006 Added support for generating REG_RSP messages and the CIC range parameter +;;; 12.03.2006 m3ua-check-common-header now optionally supports RKM messages. +;;; 13.09.2006 Remove info parameter from m3ua-make-data-message. +;;; 11.03.2007 Catch system-errors in send and recv calls. + +(define m3ua-test-result-passed 0) +(define m3ua-test-result-failed 1) +(define m3ua-test-result-unknown 2) +(define m3ua-test-result-not-applicable 253) + +;;; This is the IANA registered PPID for M3UA in host byte order +(define m3ua-ppid 3) + +;;; This is the IANA registered port for M3UA +(define m3ua-port 2905) + +;;; Constants for the message classes +(define m3ua-mgmt-message-class 0) +(define m3ua-tfer-message-class 1) +(define m3ua-ssnm-message-class 2) +(define m3ua-aspsm-message-class 3) +(define m3ua-asptm-message-class 4) +(define m3ua-rkm-message-class 9) +(define m3ua-reserved-message-class 99) + +;;; Constants for the message types +;;; MGMT messages +(define m3ua-err-message-type 0) +(define m3ua-ntfy-message-type 1) + +;;; TFER messages +(define m3ua-data-message-type 1) +(define m3ua-reserved-tfer-message-type 2) + +;;; SSNM messages +(define m3ua-duna-message-type 1) +(define m3ua-dava-message-type 2) +(define m3ua-daud-message-type 3) +(define m3ua-scon-message-type 4) +(define m3ua-dupu-message-type 5) +(define m3ua-drst-message-type 6) + +;;; ASPSM messages +(define m3ua-aspup-message-type 1) +(define m3ua-aspdn-message-type 2) +(define m3ua-beat-message-type 3) +(define m3ua-aspup-ack-message-type 4) +(define m3ua-aspdn-ack-message-type 5) +(define m3ua-beat-ack-message-type 6) +(define m3ua-reserved-aspsm-message-type 7) + +;;;ASPTM messages +(define m3ua-aspac-message-type 1) +(define m3ua-aspia-message-type 2) +(define m3ua-aspac-ack-message-type 3) +(define m3ua-aspia-ack-message-type 4) +(define m3ua-reserved-asptm-message-type 5) + +;;; RKM messages +(define m3ua-reg-req-message-type 1) +(define m3ua-reg-rsp-message-type 2) +(define m3ua-dereg-req-message-type 3) +(define m3ua-dereg-rsp-message-type 4) +(define m3ua-reserved-rkm-message-type 5) + +;;; Constant for the protocol version +(define m3ua-version 1) + +;;; Constant for reserved +(define m3ua-reserved 0) + +;;; +;;; Creator functions for messages +;;; + +(define (m3ua-make-common-header version reserved class type length) + (append (uint8->bytes version) + (uint8->bytes reserved) + (uint8->bytes class) + (uint8->bytes type) + (uint32->bytes length))) + +;;;(m3ua-make-common-header 1 2 3 4 5) +;;;(m3ua-make-common-header m3ua-version m3ua-reserved m3ua-tfer-message-class m3ua-data-message-type 16) + +(define (m3ua-increment-version l) + (if (positive? (length l)) + (cons (+ (car l) 1) (cdr l)) + (list))) +;;;(m3ua-increment-version (list 1 2 3)) +;;;(m3ua-increment-version (list)) + +;;; +;;; Creator functions for parameters +;;; + +(define m3ua-parameter-header-length 4) +(define m3ua-common-header-length 8) +(define m3ua-data-parameter-header-length 16) + +(define (m3ua-number-of-padding-bytes l) + (remainder (- 4 (remainder l 4)) 4)) +;;; (m3ua-number-of-padding-bytes 0) +;;; (m3ua-number-of-padding-bytes 1) +;;; (m3ua-number-of-padding-bytes 2) +;;; (m3ua-number-of-padding-bytes 3) + +(define (m3ua-add-padding l) + (+ l (m3ua-number-of-padding-bytes l))) +;;; (m3ua-add-padding 2) + +(define (m3ua-padding data) + (zero-bytes (m3ua-number-of-padding-bytes (length data)))) +;;;(m3ua-padding (list 1 2 3 4 5)) + +(define (m3ua-make-parameter tag value) + (append (uint16->bytes tag) + (uint16->bytes (+ (length value) m3ua-parameter-header-length)) + value + (m3ua-padding value))) + +(define (m3ua-make-random-parameter l) + (m3ua-make-parameter (random 2^16) (random-bytes l))) +;;;(m3ua-make-random-parameter 10) + +(define (m3ua-add-parameter parameter list) + (cons parameter (remove (lambda(p) (equal? (m3ua-get-parameter-tag p) + (m3ua-get-parameter-tag parameter))) + list))) +;;;(m3ua-add-parameter (m3ua-make-info-string-parameter "Hello1") (list (m3ua-make-correlation-id-parameter 34))) +;;;(m3ua-add-parameter (m3ua-make-info-string-parameter "Hello1") (list (m3ua-make-correlation-id-parameter 34) (m3ua-make-info-string-parameter "Hello"))) + +(define (m3ua-make-message class type parameters) + (append (m3ua-make-common-header m3ua-version + m3ua-reserved + class + type + (+ m3ua-common-header-length (apply + (map length parameters)))) + (apply append parameters))) + +(define m3ua-info-string-tag #x0004) +(define m3ua-routing-context-tag #x0006) +(define m3ua-diagnostic-info-tag #x0007) +(define m3ua-heartbeat-data-tag #x0009) +(define m3ua-traffic-mode-type-tag #x000b) +(define m3ua-error-code-tag #x000c) +(define m3ua-status-tag #x000d) +(define m3ua-asp-identifier-tag #x0011) +(define m3ua-affected-point-code-tag #x0012) +(define m3ua-correlation-id-tag #x0013) + +(define m3ua-network-appearance-tag #x0200) +(define m3ua-user-cause-tag #x0204) +(define m3ua-congestion-indications-tag #x0205) +(define m3ua-concerned-destination-tag #x0206) +(define m3ua-routing-key-tag #x0207) +(define m3ua-registration-result-tag #x0208) +(define m3ua-deregistration-result-tag #x0209) +(define m3ua-local-routing-key-identifier-tag #x020a) +(define m3ua-destination-point-code-tag #x020b) +(define m3ua-service-indicators-tag #x020c) +(define m3ua-originating-point-code-list-tag #x020e) +(define m3ua-circuit-range-tag #x020f) +(define m3ua-protocol-data-tag #x0210) +(define m3ua-registration-status-tag #x0212) +(define m3ua-deregistration-status-tag #x0213) + +(define (m3ua-make-info-string-parameter string) + (m3ua-make-parameter m3ua-info-string-tag (string->bytes string))) +;;; (m3ua-make-info-string-parameter "Hello") + +(define (m3ua-make-routing-context-parameter contexts) + (m3ua-make-parameter m3ua-routing-context-tag (apply append (map uint32->bytes contexts)))) +;;; (m3ua-make-routing-context-parameter (list 1024)) +;;; (m3ua-make-routing-context-parameter (list)) +;;; (m3ua-make-routing-context-parameter (list 1024 4 5 6)) + +(define (m3ua-make-diagnostic-info-parameter info) + (m3ua-make-parameter m3ua-diagnostic-info-tag info)) +;;; (m3ua-make-diagnostic-info-parameter (list 1 2 3 4 5)) + +(define (m3ua-make-heartbeat-data-parameter data) + (m3ua-make-parameter m3ua-heartbeat-data-tag data)) +;;; (m3ua-make-heartbeat-data-parameter (string->bytes "M3UA rocks")) + +(define m3ua-traffic-mode-type-override 1) +(define m3ua-traffic-mode-type-loadshare 2) +(define m3ua-traffic-mode-type-broadcast 3) +(define m3ua-traffic-mode-type-invalid 4) + +(define (m3ua-make-traffic-mode-type-parameter mode) + (m3ua-make-parameter m3ua-traffic-mode-type-tag (uint32->bytes mode))) +;;; (m3ua-make-traffic-mode-type-parameter m3ua-traffic-mode-type-override) + +(define m3ua-invalid-version-error-code #x0001) +(define m3ua-unsupported-message-class-error-code #x0003) +(define m3ua-unsupported-message-type-error-code #x0004) +(define m3ua-unsupported-traffic-mode-type-error-code #x0005) +(define m3ua-unexpected-message-error-code #x0006) +(define m3ua-protocol-error-error-code #x0007) +(define m3ua-invalid-stream-identifier-error-code #x0009) +(define m3ua-refused-management-blocking-error-code #x000d) +(define m3ua-asp-identifier-required-error-code #x000e) +(define m3ua-invalid-parameter-value-error-code #x0011) +(define m3ua-parameter-field-error-error-code #x0012) +(define m3ua-unexpected-parameter-error-code #x0013) +(define m3ua-destination-status-unknown-error-code #x0014) +(define m3ua-invalid-network-appearance-error-code #x0015) +(define m3ua-missing-parameter-error-code #x0016) +(define m3ua-invalid-routing-context-error-code #x0019) +(define m3ua-no-configure-as-for-asp-error-code #x001a) + +(define (m3ua-make-error-code-parameter code) + (m3ua-make-parameter m3ua-error-code-tag (uint32->bytes code))) +;;; (m3ua-make-error-code-parameter m3ua-protocol-error-error-code) + +(define (m3ua-get-error-code-from-parameter p) + (bytes->uint32 (m3ua-get-parameter-value p))) +;;;(m3ua-get-error-code-from-parameter (m3ua-make-error-code-parameter m3ua-protocol-error-error-code)) + +(define m3ua-as-state-change-status-type 1) +(define m3ua-other-status-type 2) + +(define m3ua-as-inactive 2) +(define m3ua-as-active 3) +(define m3ua-as-pending 4) + +(define m3ua-insufficient-resources 1) +(define m3ua-alternate-asp-active 2) +(define m3ua-asp-failure 3) + +(define (m3ua-make-status-parameter type info) + (m3ua-make-parameter m3ua-status-tag + (append (uint16->bytes type) + (uint16->bytes info)))) +;;; (m3ua-make-status-parameter 2 3) + +(define (m3ua-get-status-type-from-parameter l) + (bytes->uint16 (m3ua-get-parameter-value l))) +;;; (m3ua-get-status-type-from-parameter (m3ua-make-status-parameter 2 3)) + +(define (m3ua-get-status-info-from-parameter l) + (bytes->uint16 (list-tail (m3ua-get-parameter-value l) 2))) +;;; (m3ua-get-status-info-from-parameter (m3ua-make-status-parameter 2 3)) + +(define (m3ua-make-asp-id-parameter aid) + (m3ua-make-parameter m3ua-asp-identifier-tag (uint32->bytes aid))) +;;; (m3ua-make-asp-id-parameter 1024) + +(define (m3ua-make-affected-point-code-parameter mask-pc-pair-list) + (m3ua-make-parameter m3ua-affected-point-code-tag + (apply append (map (lambda (x) + (append (uint8->bytes (car x)) + (uint24->bytes (cadr x)))) + mask-pc-pair-list)))) +;;; (m3ua-make-affected-point-code-parameter (list (list 0 34) (list 255 89))) + +(define (m3ua-make-correlation-id-parameter id) + (m3ua-make-parameter m3ua-correlation-id-tag (uint32->bytes id))) +;;; (m3ua-make-correlation-id-parameter 1024) + +(define (m3ua-make-network-appearance-parameter na) + (m3ua-make-parameter m3ua-network-appearance-tag (uint32->bytes na))) +;;; (m3ua-make-network-appearance-parameter 1024) + +(define m3ua-unknown-cause 0) +(define m3ua-unequipped-remote-user-cause 1) +(define m3ua-inaccessible-remote-user-cause 2) + +(define m3ua-mtp-user-sccp 3) +(define m3ua-mtp-user-tup 4) +(define m3ua-mtp-user-isup 5) +(define m3ua-mtp-user-broadband-isup 9) +(define m3ua-mtp-user-satellite-isup 10) +(define m3ua-mtp-user-aal-type-2-signalling 12) +(define m3ua-mtp-user-bicc 13) +(define m3ua-mtp-user-gcp 14) + +(define (m3ua-make-user-cause-parameter user cause) + (m3ua-make-parameter m3ua-user-cause-tag (append (uint16->bytes cause) + (uint16->bytes user)))) +;;; (m3ua-make-user-cause-parameter m3ua-mtp-user-isup m3ua-unknown-cause) + +(define m3ua-no-congestion-level 0) +(define m3ua-congestion-level-1 1) +(define m3ua-congestion-level-2 2) +(define m3ua-congestion-level-3 3) + +(define (m3ua-make-congestion-indications-parameter level) + (m3ua-make-parameter m3ua-congestion-indications-tag (append (uint24->bytes 0) + (uint8->bytes level)))) +;;; (m3ua-make-congestion-indications-parameter m3ua-congestion-level-2) + +(define (m3ua-make-concerned-destination-parameter pc) + (m3ua-make-parameter m3ua-concerned-destination-tag (append (uint8->bytes 0) + (uint24->bytes pc)))) +;;; (m3ua-make-concerned-destination-parameter 45) + +(define (m3ua-make-routing-key-parameter parameterlist) + (m3ua-make-parameter m3ua-routing-key-tag (apply append parameterlist))) +;;; (m3ua-make-routing-key-parameter (list (m3ua-make-local-routing-key-identifier-parameter 12) (m3ua-make-destination-point-code-parameter 34))) + +(define (m3ua-make-registration-result-parameter parameterlist) + (m3ua-make-parameter m3ua-registration-result-tag (apply append parameterlist))) +;;; (m3ua-make-registration-result-parameter (list (m3ua-make-local-routing-key-identifier-parameter 1234) (m3ua-make-registration-status-parameter m3ua-successfully-registered-reg-status) (m3ua-make-routing-context-parameter (list 12)))) + +(define (m3ua-make-deregistration-result-parameter parameterlist) + (m3ua-make-parameter m3ua-deregistration-result-tag (apply append parameterlist))) +;;; (m3ua-make-deregistration-result-parameter (list (m3ua-make-routing-context-parameter (list 12)) (m3ua-make-deregistration-status-parameter m3ua-successfully-deregistered-dereg-status))) + +(define (m3ua-make-local-routing-key-identifier-parameter id) + (m3ua-make-parameter m3ua-local-routing-key-identifier-tag (uint32->bytes id))) +;;; (m3ua-make-local-routing-key-identifier-parameter 234) + +(define (m3ua-make-destination-point-code-parameter pc) + (m3ua-make-parameter m3ua-destination-point-code-tag (append (uint8->bytes 0) + (uint24->bytes pc)))) +;;; (m3ua-make-destination-point-code-parameter 45) + +(define (m3ua-make-circuit-range-parameter pc-cic-triple-list) + (m3ua-make-parameter m3ua-circuit-range-tag + (apply append (map (lambda (x) + (append (uint8->bytes 0) + (uint24->bytes (car x)) + (uint16->bytes (cadr x)) + (uint16->bytes (caddr x)))) + pc-cic-triple-list)))) +;;; (m3ua-make-circuit-range-parameter (list (list 1 2 3) (list 4 5 6))) + +(define (m3ua-make-service-indicators-parameter si-list) + (m3ua-make-parameter m3ua-service-indicators-tag (apply append (map uint8->bytes si-list)))) +;;; (m3ua-make-service-indicators-parameter (list 2 4)) + +(define (m3ua-make-originating-point-code-list-parameter mask-pc-pair-list) + (m3ua-make-parameter m3ua-originating-point-code-list-tag + (apply append (map (lambda (x) + (append (uint8->bytes (car x)) + (uint24->bytes (cadr x)))) + mask-pc-pair-list)))) + +;;; (m3ua-make-originating-point-code-list-parameter (list (list 0 34) (list 255 89))) + +(define (m3ua-make-data-parameter opc dpc si ni mp sls data) + (m3ua-make-parameter m3ua-protocol-data-tag + (append (uint32->bytes opc) + (uint32->bytes dpc) + (uint8->bytes si) + (uint8->bytes ni) + (uint8->bytes mp) + (uint8->bytes sls) + data))) +;;; (m3ua-make-data-parameter 3 4 3 2 1 3 (list 1 2 3)) + +(define m3ua-successfully-registered-reg-status 0) +(define m3ua-error-unknown-reg-status 1) +(define m3ua-error-invalid-dpc-reg-status 2) +(define m3ua-error-invalid-network-appearance-reg-status 3) +(define m3ua-error-invalid-routing-key-reg-status 4) +(define m3ua-error-permission-denied-reg-status 5) +(define m3ua-error-cannot-support-unique-routing-reg-status 6) +(define m3ua-error-routing-key-not-currently-provisioned-reg-status 7) +(define m3ua-error-insufficient-resources-reg-status 8) +(define m3ua-error-unsupported-rk-parameter-field-reg-status 9) +(define m3ua-error-unsupported-invalid-traffic-handling-mode-reg-status 10) +(define m3ua-error-routing-key-change-refused-reg-status 11) +(define m3ua-error-routing-key-already-registered-req-status 12) + +(define (m3ua-make-registration-status-parameter status) + (m3ua-make-parameter m3ua-registration-status-tag (uint32->bytes status))) +;;; (m3ua-make-registration-status-parameter 123) + +(define m3ua-successfully-deregistered-dereg-status 0) +(define m3ua-error-unknown-dereg-status 1) +(define m3ua-error-invalid-routing-context-dereg-status 2) +(define m3ua-error-permission-denied-dereg-status 3) +(define m3ua-error-not-registered-dereg-status 4) +(define m3ua-error-asp-currently-active-for-routing-context-dereg-status 5) + +(define (m3ua-make-deregistration-status-parameter status) + (m3ua-make-parameter m3ua-deregistration-status-tag (uint32->bytes status))) +;;; (m3ua-make-deregistration-status-parameter 123) + + +;;;------------------------------------------------------------------ +;;; Parameter Predicates +;;;------------------------------------------------------------------ + +(define (m3ua-error-code-parameter? l) + (= (m3ua-get-parameter-tag l) m3ua-error-code-tag)) + +(define (m3ua-status-parameter? l) + (= (m3ua-get-parameter-tag l) m3ua-status-tag)) + +(define (m3ua-routing-key-parameter? l) + (= (m3ua-get-parameter-tag l) m3ua-routing-key-tag)) + +(define (m3ua-local-routing-key-identifier-parameter? l) + (= (m3ua-get-parameter-tag l) m3ua-local-routing-key-identifier-tag)) + +(define (m3ua-routing-context-parameter? l) + (= (m3ua-get-parameter-tag l) m3ua-routing-context-tag)) + +(define (m3ua-registration-result-parameter? l) + (= (m3ua-get-parameter-tag l) m3ua-registration-result-tag)) + +;;;------------------------------------------------------------------ +;;; Message Contructors +;;;------------------------------------------------------------------ + +(define (m3ua-make-error-message code) + (m3ua-make-message m3ua-mgmt-message-class + m3ua-err-message-type + (list (m3ua-make-error-code-parameter code)))) +;;; (m3ua-make-error-message m3ua-no-configure-as-for-asp-error-code) + +(define (m3ua-make-notify-message type info) + (m3ua-make-message m3ua-mgmt-message-class + m3ua-ntfy-message-type + (list (m3ua-make-status-parameter type info)))) +;;; (m3ua-make-notify-message m3ua-as-state-change-status-type m3ua-as-inactive) + +(define (m3ua-make-beat-message data) + (m3ua-make-message m3ua-aspsm-message-class + m3ua-beat-message-type + (list (m3ua-make-heartbeat-data-parameter data)))) +;;; (m3ua-make-beat-message (string->bytes "M3UA rocks")) + +(define (m3ua-make-beat-ack-message data) + (m3ua-make-message m3ua-aspsm-message-class + m3ua-beat-ack-message-type + (list (m3ua-make-heartbeat-data-parameter data)))) +;;; (m3ua-make-beat-ack-message (string->bytes "M3UA rocks")) + +(define (m3ua-make-asp-up-message parameters) + (m3ua-make-message m3ua-aspsm-message-class + m3ua-aspup-message-type + (m3ua-add-parameter (m3ua-make-info-string-parameter "M3UA rocks") parameters))) +;;; (m3ua-make-asp-up-message (list)) + +(define (m3ua-make-asp-down-message) + (m3ua-make-message m3ua-aspsm-message-class + m3ua-aspdn-message-type + (list (m3ua-make-info-string-parameter "M3UA rocks")))) +;;; (m3ua-make-asp-down-message) + +(define (m3ua-make-asp-up-ack-message) + (m3ua-make-message m3ua-aspsm-message-class + m3ua-aspup-ack-message-type + (list (m3ua-make-info-string-parameter "M3UA rocks")))) +;;; (m3ua-make-asp-up-ack-message) + +(define (m3ua-make-asp-down-ack-message) + (m3ua-make-message m3ua-aspsm-message-class + m3ua-aspdn-ack-message-type + (list (m3ua-make-info-string-parameter "M3UA rocks")))) +;;; (m3ua-make-asp-down-ack-message) + +(define (m3ua-make-asp-active-message parameters) + (m3ua-make-message m3ua-asptm-message-class + m3ua-aspac-message-type + (m3ua-add-parameter (m3ua-make-info-string-parameter "M3UA rocks") parameters))) +;;; (m3ua-make-asp-active-message (list (m3ua-make-routing-context-parameter (list 3)))) + +(define (m3ua-make-asp-active-ack-message parameters) + (m3ua-make-message m3ua-asptm-message-class + m3ua-aspac-ack-message-type + (m3ua-add-parameter (m3ua-make-info-string-parameter "M3UA rocks") parameters))) +;;; (m3ua-make-asp-active-ack-message (list)) + +(define (m3ua-make-asp-inactive-message parameters) + (m3ua-make-message m3ua-asptm-message-class + m3ua-aspia-message-type + (m3ua-add-parameter (m3ua-make-info-string-parameter "M3UA rocks") parameters))) +;;; (m3ua-make-asp-inactive-message (list)) + +(define (m3ua-make-asp-inactive-ack-message parameters) + (m3ua-make-message m3ua-asptm-message-class + m3ua-aspia-ack-message-type + (m3ua-add-parameter (m3ua-make-info-string-parameter "M3UA rocks") parameters))) +;;; (m3ua-make-asp-inactive-ack-message (list)) + +(define (m3ua-make-data-message opc dpc si ni mp sls data parameters) + (m3ua-make-message m3ua-tfer-message-class + m3ua-data-message-type + (append parameters + (list (m3ua-make-data-parameter opc dpc si ni mp sls data))))) +;;; (m3ua-make-data-message 1 2 3 4 5 6 (list 1 2) (list)) +;;; FIXME: Make sure that no parameter is duplicated. + +(define (m3ua-make-duna-message parameters) + (m3ua-make-message m3ua-ssnm-message-class + m3ua-duna-message-type + (m3ua-add-parameter (m3ua-make-info-string-parameter "M3UA rocks") parameters))) +;;; (m3ua-make-duna-message (list)) + +(define (m3ua-make-dava-message parameters) + (m3ua-make-message m3ua-ssnm-message-class + m3ua-dava-message-type + (m3ua-add-parameter (m3ua-make-info-string-parameter "M3UA rocks") parameters))) +;;; (m3ua-make-dava-message (list)) + +(define (m3ua-make-daud-message parameters) + (m3ua-make-message m3ua-ssnm-message-class + m3ua-daud-message-type + (m3ua-add-parameter (m3ua-make-info-string-parameter "M3UA rocks") parameters))) +;;; (m3ua-make-daud-message (list)) + +(define (m3ua-make-scon-message parameters) + (m3ua-make-message m3ua-ssnm-message-class + m3ua-scon-message-type + (m3ua-add-parameter (m3ua-make-info-string-parameter "M3UA rocks") parameters))) +;;; (m3ua-make-scon-message (list)) + +(define (m3ua-make-dupu-message parameters) + (m3ua-make-message m3ua-ssnm-message-class + m3ua-dupu-message-type + (m3ua-add-parameter (m3ua-make-info-string-parameter "M3UA rocks") parameters))) +;;; (m3ua-make-dupu-message (list)) + +(define (m3ua-make-drst-message parameters) + (m3ua-make-message m3ua-ssnm-message-class + m3ua-drst-message-type + (m3ua-add-parameter (m3ua-make-info-string-parameter "M3UA rocks") parameters))) +;;; (m3ua-make-drst-message (list)) + +(define (m3ua-make-reg-req-message parameters) + (m3ua-make-message m3ua-rkm-message-class + m3ua-reg-req-message-type + (m3ua-add-parameter (m3ua-make-info-string-parameter "M3UA rocks") parameters))) + +(define (m3ua-make-reg-rsp-message parameters) + (m3ua-make-message m3ua-rkm-message-class + m3ua-reg-rsp-message-type + (m3ua-add-parameter (m3ua-make-info-string-parameter "M3UA rocks") parameters))) + + +(define (m3ua-make-dereg-req-message parameters) + (m3ua-make-message m3ua-rkm-message-class + m3ua-dereg-req-message-type + (m3ua-add-parameter (m3ua-make-info-string-parameter "M3UA rocks") parameters))) + + +(define (m3ua-make-dereg-rsp-message parameters) + (m3ua-make-message m3ua-rkm-message-class + m3ua-dereg-rsp-message-type + (m3ua-add-parameter (m3ua-make-info-string-parameter "M3UA rocks") parameters))) + +;;; +;;; General accessor functions for messages +;;; + +(define (m3ua-get-common-header l) + (list-head l m3ua-common-header-length)) +;;; (m3ua-get-common-header (m3ua-make-asp-up-message (list))) + +(define m3ua-version-offset 0) +(define m3ua-reserved-offset 1) +(define m3ua-message-class-offset 2) +(define m3ua-message-type-offset 3) +(define m3ua-message-length-offset 4) + +(define (m3ua-get-version l) + (bytes->uint8 (list-tail l m3ua-version-offset))) + +;;;(define hb (m3ua-make-beat-message (string->bytes "M3UA rocks"))) +;;;(m3ua-get-version hb) + +(define (m3ua-get-reserved l) + (bytes->uint8 (list-tail l m3ua-reserved-offset))) +;;;(m3ua-get-reserved hb) + +(define (m3ua-get-message-class l) + (bytes->uint8 (list-tail l m3ua-message-class-offset))) +;;;(m3ua-get-message-class hb) + +(define (m3ua-get-message-type l) + (bytes->uint8 (list-tail l m3ua-message-type-offset))) +;;;(m3ua-get-message-type hb) + +(define (m3ua-get-message-length l) + (bytes->uint32 (list-tail l m3ua-message-length-offset))) +;;;(m3ua-get-message-length hb) + +(define (m3ua-get-parameters-1 l) + (if (>= (length l) m3ua-parameter-header-length) + (let ((parameter-length (m3ua-add-padding (m3ua-get-parameter-length l)))) + (cons (list-head l parameter-length) + (m3ua-get-parameters-1 (list-tail l parameter-length)))) + (list))) + +(define (m3ua-get-parameters-of-message l) + (if (>= (length l) m3ua-common-header-length) + (m3ua-get-parameters-1 (list-tail l m3ua-common-header-length)) + (list))) +;;; (m3ua-get-parameters-of-message (m3ua-make-beat-message (string->bytes "M3UA rocks"))) +;;; (m3ua-get-parameters-of-message (list 2 2)) + +(define m3ua-get-parameters m3ua-get-parameters-of-message) + +(define (m3ua-get-parameters-of-parameter l) + (if (>= (length l) m3ua-common-header-length) + (m3ua-get-parameters-1 (list-tail l m3ua-parameter-header-length)) + (list))) +;;; (m3ua-get-parameters-of-parameter (m3ua-make-routing-key-parameter (list (m3ua-make-local-routing-key-identifier-parameter 3) (m3ua-make-destination-point-code-parameter 4)))) + +(define (m3ua-make-registration-result-from-routing-key key status) + (let ((local-rk-id (bytes->uint32 (list-tail (car (filter m3ua-local-routing-key-identifier-parameter? + (m3ua-get-parameters-of-parameter key))) + m3ua-parameter-header-length)))) + (if (= status m3ua-successfully-registered-reg-status) + (let ((routing-contexts (filter m3ua-routing-context-parameter? (m3ua-get-parameters-of-parameter key)))) + (if (null? routing-contexts) + (m3ua-make-registration-result-parameter (list (m3ua-make-local-routing-key-identifier-parameter local-rk-id) + (m3ua-make-registration-status-parameter status) + (m3ua-make-routing-context-parameter (list tester-rc-valid)))) + (let ((rc (bytes->uint32 (list-tail routing-contexts m3ua-parameter-header-length)))) + (m3ua-make-registration-result-parameter (list (m3ua-make-local-routing-key-identifier-parameter local-rk-id) + (m3ua-make-registration-status-parameter status) + (m3ua-make-routing-context-parameter (list rc))))))) + (m3ua-make-registration-result-parameter (list (m3ua-make-local-routing-key-identifier-parameter local-rk-id) + (m3ua-make-registration-status-parameter status) + (m3ua-make-routing-context-parameter (list 0))))))) + +;;;(m3ua-make-registration-result-from-routing-key (m3ua-make-routing-key-parameter (list (m3ua-make-local-routing-key-identifier-parameter 3) (m3ua-make-destination-point-code-parameter 4))) 0) + +(define (m3ua-make-reg-rsp-from-reg-req reg-req) + (let ((routing-keys (filter m3ua-routing-key-parameter? (m3ua-get-parameters-of-message reg-req)))) + (m3ua-make-reg-rsp-message + (cons (m3ua-make-registration-result-from-routing-key (car routing-keys) m3ua-successfully-registered-reg-status) + (map (lambda (key) (m3ua-make-registration-result-from-routing-key key m3ua-error-insufficient-resources-reg-status)) + (cdr routing-keys)))))) + +;;;(m3ua-make-reg-rsp-from-reg-req (m3ua-make-reg-req-message (list (m3ua-make-routing-key-parameter (list (m3ua-make-local-routing-key-identifier-parameter 3) (m3ua-make-destination-point-code-parameter 4)))))) + + +(define (m3ua-make-dereg-rsp-from-dereg-req dereg-req) + (let ((rc (bytes->uint32 (list-tail (car (filter m3ua-routing-context-parameter? (m3ua-get-parameters-of-message dereg-req))) + m3ua-parameter-header-length)))) + (m3ua-make-dereg-rsp-message (list (m3ua-make-deregistration-result-parameter + (list (m3ua-make-routing-context-parameter (list rc)) + (m3ua-make-deregistration-status-parameter m3ua-successfully-deregistered-dereg-status))))))) + +;;;(m3ua-make-dereg-rsp-from-dereg-req (m3ua-make-dereg-req-message (list (m3ua-make-routing-context-parameter (list 1 2 3))))) + + + +(define (m3ua-make-simple-reg-rsp-message id status context) + (m3ua-make-reg-rsp-message (list (m3ua-make-registration-result-parameter + (list (m3ua-make-local-routing-key-identifier-parameter id) + (m3ua-make-registration-status-parameter status) + (m3ua-make-routing-context-parameter (list context))))))) +;;; (m3ua-make-simple-reg-rsp-message 1 0 0) + + +(define (m3ua-get-routing-context-from-reg-rsp reg-rsp) + (bytes->uint32 (list-tail (car (filter m3ua-routing-context-parameter? + (m3ua-get-parameters-of-parameter + (car (filter m3ua-registration-result-parameter? (m3ua-get-parameters-of-message reg-rsp)))))) + m3ua-parameter-header-length))) +;;; (m3ua-get-routing-context-from-reg-rsp (m3ua-make-simple-reg-rsp-message 1 2 6)) + + +(define (m3ua-get-error-code-from-message msg) + (m3ua-get-error-code-from-parameter (car (filter m3ua-error-code-parameter? (m3ua-get-parameters msg))))) +;;;(m3ua-get-error-code-from-message (m3ua-make-error-message m3ua-unexpected-message-error-code)) + + +(define (m3ua-get-status-type-from-message msg) + (m3ua-get-status-type-from-parameter (car (filter m3ua-status-parameter? (m3ua-get-parameters msg))))) +;;;(m3ua-get-status-type-from-message (m3ua-make-notify-message 2 3)) + + +(define (m3ua-get-status-info-from-message msg) + (m3ua-get-status-info-from-parameter (car (filter m3ua-status-parameter? (m3ua-get-parameters msg))))) +;;;(m3ua-get-status-info-from-message (m3ua-make-notify-message 2 3)) + + + +;;; +;;; General accessor function for parameters +;;; + +(define m3ua-parameter-tag-offset 0) +(define m3ua-parameter-length-offset 2) +(define m3ua-parameter-value-offset 4) + +(define (m3ua-get-parameter-tag l) + (bytes->uint16 (list-tail l m3ua-parameter-tag-offset))) +;;; (m3ua-get-parameter-tag (m3ua-make-parameter 1 (list 1 2 3))) + +(define (m3ua-get-parameter-length l) + (bytes->uint16 (list-tail l m3ua-parameter-length-offset))) +;;; (m3ua-get-parameter-length (m3ua-make-parameter 1 (list 1 2 3))) + +(define (m3ua-get-parameter-value l) + (list-tail (list-head l (m3ua-get-parameter-length l)) m3ua-parameter-value-offset)) +;;; (m3ua-get-parameter-value (m3ua-make-parameter 1 (list 1 2 3))) + +(define (m3ua-get-parameter-padding l) + (list-tail l (m3ua-get-parameter-length l))) +;;; (m3ua-get-parameter-padding (m3ua-make-parameter 1 (list 1 2 3 4))) + + +;;; +;;; M3UA helper routines +;;; + +(define m3ua-maximum-message-length (expt 2 16)) + +(define (m3ua-connect local-addr local-port remote-addr remote-port) + (let ((s (socket AF_INET SOCK_STREAM IPPROTO_SCTP))) + (catch 'system-error + (lambda () + (bind s AF_INET (inet-aton local-addr) local-port) + (connect s AF_INET (inet-aton remote-addr) remote-port) + (if (defined? 'SCTP_NODELAY) + (setsockopt s IPPROTO_SCTP SCTP_NODELAY 1)) + s) + (lambda (key . args) + (close s))))) + +;;; (m3ua-connect "127.0.0.1" 0 "127.0.0.1" m3ua-port) + +(define (m3ua-accept local-addr local-port) + (let ((s (socket AF_INET SOCK_STREAM IPPROTO_SCTP))) + (catch 'system-error + (lambda () + (bind s AF_INET (inet-aton local-addr) local-port) + (listen s 1) + (let ((ss (car (accept s)))) + (close s) + (if (defined? 'SCTP_NODELAY) + (setsockopt ss IPPROTO_SCTP SCTP_NODELAY 1)) + ss)) + (lambda (key . args) + (close s))))) + + +;;;(m3ua-accept "127.0.0.1" m3ua-port) + +(define (m3ua-send-message socket stream message) + (catch 'system-error + (lambda() + (sctp-sendmsg socket (bytes->string message) (htonl m3ua-ppid) stream 0 0 AF_INET INADDR_ANY 0)) + (lambda (key . args) + 0))) + +(define (m3ua-recv-message socket) + (let ((buffer (make-string m3ua-maximum-message-length))) + (catch 'system-error + (lambda () + (let ((n (recv! socket buffer))) + (string->bytes (substring buffer 0 n)))) + (lambda (key . args) + (list))))) + +;;; (m3ua-recv-message s) +(define (m3ua-recv-message-with-timeout socket seconds) + (let ((buffer (make-string m3ua-maximum-message-length))) + (catch 'system-error + (lambda () + (let ((result (select (list socket) (list) (list) seconds))) + (if (null? (car result)) + (list) + (let ((n (recv! socket buffer))) + (string->bytes (substring buffer 0 n)))))) + (lambda (key . args) + (list))))) + +;;; (m3ua-recv-message-with-timeout s 2) + +(define (m3ua-wait-for-message socket predicate) + (let ((m (m3ua-recv-message socket))) + (if (or (zero? (length m)) (predicate m)) + m + (m3ua-wait-for-message socket predicate)))) + +(define (m3ua-wait-for-message-with-timeout socket predicate seconds) + (let ((m (m3ua-recv-message-with-timeout socket seconds))) + (if (or (zero? (length m)) (predicate m)) + m + (m3ua-wait-for-message-with-timeout socket predicate seconds)))) + +(define (m3ua-version-ok? version) + (= version m3ua-version)) +;;; (m3ua-version-ok? m3ua-version) +;;; (m3ua-version-ok? (+ m3ua-version 1)) + +(define (m3ua-message-class-ok? class rkm-message-class-supported?) + (or (= class m3ua-mgmt-message-class) + (= class m3ua-tfer-message-class) + (= class m3ua-ssnm-message-class) + (= class m3ua-aspsm-message-class) + (= class m3ua-asptm-message-class) + (and rkm-message-class-supported? (= class m3ua-rkm-message-class)))) +;;; (m3ua-message-class-ok? m3ua-mgmt-message-class #t) +;;; (m3ua-message-class-ok? m3ua-rkm-message-class #t) +;;; (m3ua-message-class-ok? m3ua-rkm-message-class #f) +;;; (m3ua-message-class-ok? 1000) + +(define (m3ua-message-type-ok? class type) + (cond + ((= class m3ua-mgmt-message-class) + (or (= type m3ua-err-message-type) + (= type m3ua-ntfy-message-type))) + ((= class m3ua-tfer-message-class) + (or (= type m3ua-data-message-type))) + ((= class m3ua-ssnm-message-class) + (or (= type m3ua-duna-message-type) + (= type m3ua-dava-message-type) + (= type m3ua-daud-message-type) + (= type m3ua-scon-message-type) + (= type m3ua-dupu-message-type) + (= type m3ua-drst-message-type))) + ((= class m3ua-aspsm-message-class) + (or (= type m3ua-aspup-message-type) + (= type m3ua-aspdn-message-type) + (= type m3ua-beat-message-type) + (= type m3ua-aspup-ack-message-type) + (= type m3ua-aspdn-ack-message-type) + (= type m3ua-beat-ack-message-type))) + ((= class m3ua-asptm-message-class) + (or (= type m3ua-aspac-message-type) + (= type m3ua-aspia-message-type) + (= type m3ua-aspac-ack-message-type) + (= type m3ua-aspia-ack-message-type))) + ((= class m3ua-rkm-message-class) + (or (= type m3ua-reg-req-message-type) + (= type m3ua-reg-rsp-message-type) + (= type m3ua-dereg-req-message-type) + (= type m3ua-dereg-rsp-message-type))))) + +;;; (m3ua-message-type-ok? m3ua-aspsm-message-class 7) + +(define (m3ua-check-common-header fd message rkm-message-class-supported?) + (if (not (m3ua-version-ok? (m3ua-get-version message))) + (begin + (m3ua-send-message fd 0 (m3ua-make-error-message m3ua-invalid-version-error-code)) + #f) + (if (not (m3ua-message-class-ok? (m3ua-get-message-class message) rkm-message-class-supported?)) + (begin + (m3ua-send-message fd 0 (m3ua-make-error-message m3ua-unsupported-message-class-error-code)) + #f) + (if (not (m3ua-message-type-ok? (m3ua-get-message-class message) + (m3ua-get-message-type message))) + (begin + (m3ua-send-message fd 0 (m3ua-make-error-message m3ua-unsupported-message-type-error-code)) + #f) + #t)))) + +(define (m3ua-data-message? message) + (and (= (m3ua-get-message-class message) m3ua-tfer-message-class) + (= (m3ua-get-message-type message) m3ua-data-message-type))) +;;; (m3ua-data-message? (m3ua-make-data-message 1 2 3 4 5 6 (list 1 2) (list))) +;;; (m3ua-data-message? (m3ua-make-asp-up-message (list))) + +(define (m3ua-error-message? message) + (and (= (m3ua-get-message-class message) m3ua-mgmt-message-class) + (= (m3ua-get-message-type message) m3ua-err-message-type))) +;;; (m3ua-error-message? (m3ua-make-error-message m3ua-unexpected-message-error-code)) +;;; (m3ua-error-message? (m3ua-make-asp-up-message (list))) + +(define (m3ua-notify-message? message) + (and (= (m3ua-get-message-class message) m3ua-mgmt-message-class) + (= (m3ua-get-message-type message) m3ua-ntfy-message-type))) +;;; (m3ua-notify-message? (m3ua-make-notify-message m3ua-as-state-change-status-type m3ua-as-inactive)) +;;; (m3ua-notify-message? (m3ua-make-asp-up-message (list))) + +(define (m3ua-beat-message? message) + (and (= (m3ua-get-message-class message) m3ua-aspsm-message-class) + (= (m3ua-get-message-type message) m3ua-beat-message-type))) +;;; (m3ua-beat-message? (m3ua-make-beat-message (list 1 2 3))) +;;; (m3ua-beat-message? (m3ua-make-asp-up-message (list))) + +(define (m3ua-beat-ack-message? message) + (and (= (m3ua-get-message-class message) m3ua-aspsm-message-class) + (= (m3ua-get-message-type message) m3ua-beat-ack-message-type))) +;;; (m3ua-beat-ack-message? (m3ua-make-beat-ack-message (list 1 2 3))) +;;; (m3ua-beat-ack-message? (m3ua-make-asp-up-message (list))) + +(define (m3ua-asp-up-message? message) + (and (= (m3ua-get-message-class message) m3ua-aspsm-message-class) + (= (m3ua-get-message-type message) m3ua-aspup-message-type))) +;;; (m3ua-asp-up-message? (m3ua-make-asp-up-message (list))) +;;; (m3ua-asp-up-message? (m3ua-make-asp-down-message)) + +(define (m3ua-asp-up-ack-message? message) + (and (= (m3ua-get-message-class message) m3ua-aspsm-message-class) + (= (m3ua-get-message-type message) m3ua-aspup-ack-message-type))) +;;; (m3ua-asp-up-ack-message? (m3ua-make-asp-up-ack-message)) +;;; (m3ua-asp-up-ack-message? (m3ua-make-asp-down-message)) + +(define (m3ua-asp-active-message? message) + (and (= (m3ua-get-message-class message) m3ua-asptm-message-class) + (= (m3ua-get-message-type message) m3ua-aspac-message-type))) +;;; (m3ua-asp-active-message? (m3ua-make-asp-active-message (list))) +;;; (m3ua-asp-active-message? (m3ua-make-asp-down-message)) + +(define (m3ua-asp-active-ack-message? message) + (and (= (m3ua-get-message-class message) m3ua-asptm-message-class) + (= (m3ua-get-message-type message) m3ua-aspac-ack-message-type))) +;;; (m3ua-asp-active-ack-message? (m3ua-make-asp-active-ack-message (list))) +;;; (m3ua-asp-active-ack-message? (m3ua-make-asp-down-message)) + +(define (m3ua-asp-down-message? message) + (and (= (m3ua-get-message-class message) m3ua-aspsm-message-class) + (= (m3ua-get-message-type message) m3ua-aspdn-message-type))) +;;; (m3ua-asp-down-message? (m3ua-make-asp-down-message)) +;;; (m3ua-asp-down-message? (m3ua-make-asp-up-message (list))) + +(define (m3ua-asp-down-ack-message? message) + (and (= (m3ua-get-message-class message) m3ua-aspsm-message-class) + (= (m3ua-get-message-type message) m3ua-aspdn-ack-message-type))) +;;; (m3ua-asp-down-ack-message? (m3ua-make-asp-down-ack-message)) +;;; (m3ua-asp-down-ack-message? (m3ua-make-asp-up-message (list))) + +(define (m3ua-asp-inactive-message? message) + (and (= (m3ua-get-message-class message) m3ua-asptm-message-class) + (= (m3ua-get-message-type message) m3ua-aspia-message-type))) +;;; (m3ua-asp-inactive-message? (m3ua-make-asp-inactive-message (list))) +;;; (m3ua-asp-inactive-message? (m3ua-make-asp-down-message)) + +(define (m3ua-asp-inactive-ack-message? message) + (and (= (m3ua-get-message-class message) m3ua-asptm-message-class) + (= (m3ua-get-message-type message) m3ua-aspia-ack-message-type))) +;;; (m3ua-asp-inactive-ack-message? (m3ua-make-asp-inactive-ack-message (list))) +;;; (m3ua-asp-inactive-ack-message? (m3ua-make-asp-down-message)) + +(define (m3ua-daud-message? message) + (and (= (m3ua-get-message-class message) m3ua-ssnm-message-class) + (= (m3ua-get-message-type message) m3ua-daud-message-type))) +;;; (m3ua-daud-message? (m3ua-make-daud-message (list))) +;;; (m3ua-daud-message? (m3ua-make-asp-down-message)) + +(define (m3ua-duna-message? message) + (and (= (m3ua-get-message-class message) m3ua-ssnm-message-class) + (= (m3ua-get-message-type message) m3ua-duna-message-type))) +;;; (m3ua-duna-message? (m3ua-make-duna-message (list))) +;;; (m3ua-duna-message? (m3ua-make-asp-down-message)) + +(define (m3ua-dava-message? message) + (and (= (m3ua-get-message-class message) m3ua-ssnm-message-class) + (= (m3ua-get-message-type message) m3ua-dava-message-type))) +;;; (m3ua-dava-message? (m3ua-make-dava-message (list))) +;;; (m3ua-dava-message? (m3ua-make-asp-down-message)) + +(define (m3ua-drst-message? message) + (and (= (m3ua-get-message-class message) m3ua-ssnm-message-class) + (= (m3ua-get-message-type message) m3ua-drst-message-type))) +;;; (m3ua-drst-message? (m3ua-make-drst-message (list))) +;;; (m3ua-drst-message? (m3ua-make-asp-down-message)) + +(define (m3ua-scon-message? message) + (and (= (m3ua-get-message-class message) m3ua-ssnm-message-class) + (= (m3ua-get-message-type message) m3ua-scon-message-type))) +;;; (m3ua-scon-message? (m3ua-make-scon-message (list))) +;;; (m3ua-scon-message? (m3ua-make-asp-down-message)) + +(define (m3ua-reg-req-message? message) + (and (= (m3ua-get-message-class message) m3ua-rkm-message-class) + (= (m3ua-get-message-type message) m3ua-reg-req-message-type))) +;;; (m3ua-reg-req-message? (m3ua-make-reg-req-message (list))) +;;; (m3ua-reg-req-message? (m3ua-make-asp-down-message)) + +(define (m3ua-reg-rsp-message? message) + (and (= (m3ua-get-message-class message) m3ua-rkm-message-class) + (= (m3ua-get-message-type message) m3ua-reg-rsp-message-type))) +;;; (m3ua-reg-rsp-message? (m3ua-make-reg-rsp-message (list))) +;;; (m3ua-reg-rsp-message? (m3ua-make-asp-down-message)) + +(define (m3ua-dereg-req-message? message) + (and (= (m3ua-get-message-class message) m3ua-rkm-message-class) + (= (m3ua-get-message-type message) m3ua-dereg-req-message-type))) +;;; (m3ua-dereg-req-message? (m3ua-make-dereg-req-message (list))) +;;; (m3ua-dereg-req-message? (m3ua-make-asp-down-message)) + +(define (m3ua-dereg-rsp-message? message) + (and (= (m3ua-get-message-class message) m3ua-rkm-message-class) + (= (m3ua-get-message-type message) m3ua-dereg-rsp-message-type))) +;;; (m3ua-dereg-rsp-message? (m3ua-make-dereg-rsp-message (list))) +;;; (m3ua-dereg-rsp-message? (m3ua-make-asp-down-message)) + +(define m3ua-asp-down 0) +(define m3ua-asp-inactive 1) +(define m3ua-asp-active 2) +(define m3ua-asp-reflect-beat 3) +(define m3ua-asp-send-data 4) +(define m3ua-asp-receive-data 5) +(define m3ua-asp-send-reg-req 6) +(define m3ua-asp-send-dereg-req 7) + +(define (m3ua-handle-sgp-message fd state rkm-message-class-supported?) + (let ((message (m3ua-recv-message fd))) + (if (positive? (length message)) + (if (m3ua-check-common-header fd message rkm-message-class-supported?) + (cond + ((m3ua-beat-message? message) + (m3ua-send-message fd 0 (m3ua-make-message m3ua-aspsm-message-class + m3ua-beat-ack-message-type + (m3ua-get-parameters message))) + (m3ua-handle-sgp-message fd state rkm-message-class-supported?)) + + ((m3ua-asp-up-message? message) + (if (= state m3ua-asp-active) + (m3ua-send-message fd 0 (m3ua-make-error-message m3ua-unexpected-message-error-code))) + (m3ua-send-message fd 0 (m3ua-make-asp-up-ack-message)) + (if (not (= state m3ua-asp-inactive)) + (m3ua-send-message fd 0 (m3ua-make-notify-message m3ua-as-state-change-status-type + m3ua-as-inactive))) + (m3ua-handle-sgp-message fd m3ua-asp-inactive rkm-message-class-supported?)) + + ((m3ua-asp-active-message? message) + (if (= state m3ua-asp-down) + (begin + (m3ua-send-message fd 0 (m3ua-make-error-message m3ua-unexpected-message-error-code)) + (m3ua-handle-sgp-message fd m3ua-asp-down rkm-message-class-supported?)) + (begin + (m3ua-send-message fd 0 (m3ua-make-asp-active-ack-message (m3ua-get-parameters message))) + (if (not (= state m3ua-asp-active)) + (m3ua-send-message fd 0 (m3ua-make-notify-message m3ua-as-state-change-status-type + m3ua-as-active))) + (m3ua-handle-sgp-message fd m3ua-asp-active rkm-message-class-supported?)))) + + ((m3ua-asp-down-message? message) + (m3ua-send-message fd 0 (m3ua-make-asp-down-ack-message)) + (m3ua-handle-sgp-message fd m3ua-asp-down rkm-message-class-supported?)) + + ((m3ua-asp-inactive-message? message) + (if (= state m3ua-asp-down) + (begin + (m3ua-send-message fd 0 (m3ua-make-asp-down-ack-message)) + (m3ua-handle-sgp-message fd m3ua-asp-down rkm-message-class-supported?)) + (begin + (m3ua-send-message fd 0 (m3ua-make-asp-inactive-ack-message (list))) + (if (= state m3ua-asp-active) + (m3ua-send-message fd 0 (m3ua-make-notify-message m3ua-as-state-change-status-type + m3ua-as-pending))) + (m3ua-handle-sgp-message fd m3ua-asp-inactive rkm-message-class-supported?)))) + ((m3ua-reg-req-message? message) + (if (= state m3ua-asp-inactive) + (m3ua-send-message fd 0 (m3ua-make-reg-rsp-from-reg-req message)) + (m3ua-send-message fd 0 (m3ua-make-error-message m3ua-unexpected-message-error-code))) + (m3ua-handle-sgp-message fd state rkm-message-class-supported?)) + ((m3ua-dereg-req-message? message) + (m3ua-send-message fd 0 (m3ua-make-dereg-rsp-from-dereg-req message)) + (m3ua-handle-sgp-message fd state rkm-message-class-supported?)) + (else + (m3ua-send-message fd 0 (m3ua-make-error-message m3ua-unexpected-message-error-code)) + (m3ua-handle-sgp-message fd state rkm-message-class-supported?))))))) + +(define (m3ua-run-sgp port rkm-message-class-supported?) + (let ((fd (m3ua-accept "0.0.0.0" port))) + (m3ua-handle-sgp-message fd m3ua-asp-down rkm-message-class-supported?) + (close fd))) +;;; (m3ua-run-sgp m3ua-port #t) ;;; RKM message class supported +;;; (m3ua-run-sgp m3ua-port #f) ;;; RKM message class not supported + + + + +(define (m3ua-perform-asp-states fd current-state states) + (if (null? states) + (close fd) + (cond + ((= (car states) m3ua-asp-down) + (m3ua-send-message fd 0 (m3ua-make-asp-down-message)) + (let ((message (m3ua-recv-message fd))) + (if (positive? (length message)) + (if (m3ua-check-common-header fd message #t) + (if (m3ua-asp-down-ack-message? message) + (m3ua-perform-asp-states fd m3ua-asp-down (cdr states)) + (close fd)) + (close fd))) + (close fd))) + ((= (car states) m3ua-asp-inactive) + (if (= current-state m3ua-asp-down) + (begin + (m3ua-send-message fd 0 (m3ua-make-asp-up-message (list))) + (let ((message (m3ua-recv-message fd))) + (if (positive? (length message)) + (if (m3ua-check-common-header fd message #t) + (if (m3ua-asp-up-ack-message? message) + (m3ua-perform-asp-states fd m3ua-asp-inactive (cdr states)) + (close fd)) + (close fd)) + (close fd)))) + (begin + (m3ua-send-message fd 0 (m3ua-make-asp-inactive-message (list))) + (let ((message (m3ua-recv-message fd))) + (if (positive? (length message)) + (if (m3ua-check-common-header fd message #t) + (if (m3ua-asp-inactive-ack-message? message) + (m3ua-perform-asp-states fd m3ua-asp-inactive (cdr states)) + (close fd)) + (close fd)) + (close fd)))))) + ((= (car states) m3ua-asp-active) + (m3ua-send-message fd 0 (m3ua-make-asp-active-message (list))) + (let ((message (m3ua-recv-message fd))) + (if (positive? (length message)) + (if (m3ua-check-common-header fd message #t) + (if (m3ua-asp-active-ack-message? message) + (m3ua-perform-asp-states fd m3ua-asp-active (cdr states)) + (close fd)) + (close fd)) + (close fd)))) + ((= (car states) m3ua-asp-reflect-beat) + (let ((message (m3ua-recv-message fd))) + (if (positive? (length message)) + (if (m3ua-check-common-header fd message #t) + (if (m3ua-beat-message? message) + (begin + (m3ua-send-message fd 0 (m3ua-make-beat-ack-message (m3ua-get-parameter-value (car (m3ua-get-parameters message))))) + (m3ua-perform-asp-states fd current-state (cdr states))) + (m3ua-perform-asp-states fd current-state states)) + (close fd)) + (close fd)))) + ((= (car states) m3ua-asp-send-data) + (m3ua-send-message fd 1 (m3ua-make-data-message opc dpc si ni mp sls ss7-message data-message-parameters)) + (m3ua-perform-asp-states fd current-state (cdr states))) + ((= (car states) m3ua-asp-receive-data) + (let ((message (m3ua-recv-message fd))) + (if (positive? (length message)) + (if (m3ua-check-common-header fd message #t) + (m3ua-perform-asp-states fd current-state (cdr states)) + (close fd)) + (close fd)))) + ((= (car states) m3ua-asp-send-reg-req) + (m3ua-send-message fd 0 (m3ua-make-reg-req-message + (list (m3ua-make-routing-key-parameter + (list (m3ua-make-local-routing-key-identifier-parameter 1) + (m3ua-make-destination-point-code-parameter 2)))))) + (let ((message (m3ua-recv-message fd))) + (if (positive? (length message)) + (if (m3ua-check-common-header fd message #t) + (m3ua-perform-asp-states fd current-state (cdr states)) + (close fd)) + (close fd)))) + ((= (car states) m3ua-asp-send-dereg-req) + (m3ua-send-message fd 0 (m3ua-make-dereg-req-message (list (m3ua-make-routing-context-parameter (list 1))))) + (let ((message (m3ua-recv-message fd))) + (if (positive? (length message)) + (if (m3ua-check-common-header fd message #t) + (m3ua-perform-asp-states fd current-state (cdr states)) + (close fd)) + (close fd)))) + (else + (error 'wrong-state))))) + +(define (m3ua-run-asp remote-addr states) + (let ((fd (m3ua-connect "0.0.0.0" 0 remote-addr m3ua-port))) + (m3ua-perform-asp-states fd m3ua-asp-down states))) + +(define (m3ua-send-beats local-addr local-port remote-addr remote-port number length) + (let ((fd (m3ua-connect local-addr local-port remote-addr remote-port)) + (beat-message (m3ua-make-beat-message (random-bytes length)))) + (dotimes (n number) + (m3ua-send-message fd 0 beat-message) + (m3ua-recv-message fd)) + (sleep 1) + (close fd))) +;;; (m3ua-send-beats "192.168.1.2" m3ua-port "192.168.1.8" m3ua-port 1000 1000) diff --git a/run-some-asp-tests b/run-some-asp-tests new file mode 100755 index 0000000..8afaf75 --- /dev/null +++ b/run-some-asp-tests @@ -0,0 +1,20 @@ +#!/bin/tcsh + +set timeout = 10 +set sleeptime = 1 + +set testcases = (m3ua-asp-aspsm-v-002 \ + m3ua-asp-aspsm-i-001 \ + m3ua-asp-aspsm-i-003 \ + m3ua-asp-aspsm-o-001 \ + m3ua-asp-aspsm-o-002 \ + m3ua-asp-asptm-v-001 \ + m3ua-asp-asptm-v-008 \ + m3ua-asp-asptm-i-003 \ + m3ua-asp-asptm-o-001 \ + m3ua-asp-mtr-i-002 ) + +foreach testcase ($testcases) + (runm3uatest -t $timeout $testcase > /dev/tty) >& /dev/null + sleep $sleeptime +end diff --git a/run-some-sgp-tests b/run-some-sgp-tests new file mode 100755 index 0000000..050f4ff --- /dev/null +++ b/run-some-sgp-tests @@ -0,0 +1,20 @@ +#!/bin/tcsh + +set timeout = 10 +set sleeptime = 1 + +set testcases = (m3ua-sgp-aspsm-v-003 \ + m3ua-sgp-aspsm-i-001 \ + m3ua-sgp-aspsm-i-002 \ + m3ua-sgp-aspsm-i-003 \ + m3ua-sgp-aspsm-o-001 \ + m3ua-sgp-asptm-v-003 \ + m3ua-sgp-asptm-v-008 \ + m3ua-sgp-asptm-v-011 \ + m3ua-sgp-asptm-i-004 \ + m3ua-sgp-asptm-o-001) + +foreach testcase ($testcases) + (runm3uatest -t $timeout $testcase > /dev/tty) >& /dev/null + sleep $sleeptime +end diff --git a/runm3uatest.c b/runm3uatest.c new file mode 100644 index 0000000..8b7773e --- /dev/null +++ b/runm3uatest.c @@ -0,0 +1,146 @@ +/*- + * Copyright (c) 2009 Michael Tuexen tuexen@fh-muenster.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. + * + * THIS SOFTWARE IS PROVIDED BY THE AUTHOR 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 AUTHOR 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. + * + * $Id: runm3uatest.c,v 1.8 2012/08/25 23:41:55 tuexen Exp $ + */ + +#include +#include +#include +#include +#include +#include + +#define TIMEOUT 0 +#define COMMAND_LENGTH 2048 + +#define RED(string) "\033[31m"string"\033[0m" +#define GREEN(string) "\033[32m"string"\033[0m" +#define YELLOW(string) "\033[33m"string"\033[0m" +#define BLUE(string) "\033[34m"string"\033[0m" + +char command_skel[] = +"(load-from-path \"%s/.guile\")" +"(let ((test-name \"%s\"))" +" (if (defined? (string->symbol test-name))" +" (exit ((eval-string test-name)" +" tester-addr tester-port sut-addr sut-port))" +" (exit 254)))"; + +char usage[] = +"Usage: runm3uatest [options] testname\n" +"Options:\n" +" -h display this help\n" +" -t time maximum runtime in seconds (default: no limit)\n"; + +pid_t pid; + +void +handler(int n) { + kill(pid, SIGKILL); +} + +void +print_usage() { + fprintf(stderr, "%s", usage); +} +int +main(int argc, char *argv[]) { + unsigned int timeout; + int status, c; + char command[COMMAND_LENGTH]; + + timeout = TIMEOUT; + + while ((c = getopt(argc, argv, "t:")) != -1) { + switch(c) { + case 'h': + print_usage(); + return (0); + break; + case 't': + timeout = (unsigned int)atoi(optarg); + break; + default: + print_usage(); + return (1); + } + } + + if (optind == argc - 1) { + snprintf(command, COMMAND_LENGTH, command_skel, getenv("HOME"), argv[optind]); + } else { + print_usage(); + return (1); + } + + if ((pid = fork()) == 0) { +#if defined(__APPLE__) || defined(__FreeBSD__) + execlp("/usr/local/bin/guile", "guile", "-c", command, NULL); +#else + execlp("/usr/bin/guile", "guile", "-c", command, NULL); +#endif + return (255); + } + printf("Test %-40.40s ", argv[optind]); + fflush(stdout); + if (timeout > 0) { + signal(SIGALRM, handler); + alarm(timeout); + } + + if (wait(&status) == -1) { + fprintf(stderr, "%s\n", "Couldn't start guile."); + return (1); + } + if (WIFSIGNALED(status)) { + printf("%-29.29s\n", YELLOW("TIMEOUT")); + } else { + switch (WEXITSTATUS(status)) { + case 0: + printf("%-29.29s\n", GREEN("PASSED")); + break; + case 1: + printf("%-29.29s\n", RED("FAILED")); + break; + case 2: + printf("%-29.29s\n", YELLOW("UNKNOWN")); + break; + case 253: + printf("%-29.29s\n", BLUE("NON-APPLICABLE")); + break; + case 254: + printf("%-29.29s\n", YELLOW("NON-EXISTENT")); + break; + case 255: + printf("%-29.29s\n", YELLOW("COULDN'T START GUILE")); + break; + default: + printf("%-29.29s\n", YELLOW("BUG")); + break; + } + } + return (0); +} -- cgit v1.2.3