nplab
/
sua-testtool
1
0
Fork 0
Code Issues Pull Requests Projects Releases Wiki Activity
Browse Source

Import from CVS.

master
Michael Tuexen 6 years ago
parent
d27e9dff08
commit
48300f08f2
10 changed files with 3362 additions and 0 deletions
Whitespace
Show all changes Ignore whitespace when comparing lines Ignore changes in amount of whitespace Ignore changes in whitespace at EOL
Split View
Diff Options
Show Stats Download Patch File Download Diff File
  1. 275
      common.scm
  2. 36
      dotguile
  3. 35
      run-some-sua-asp-tests
  4. 35
      run-some-sua-sgp-tests
  5. 141
      run-sua-test.c
  6. 496
      sua-asp-tests.scm
  7. 46
      sua-param-testtool-asp.scm
  8. 110
      sua-param-testtool-sgp.scm
  9. 775
      sua-sgp-tests.scm
  10. 1413
      sua.scm

275
common.scm
Unescape View File

@ -0,0 +1,275 @@
;;;
;;; 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: common.scm,v 1.1 2011/03/20 16:48:30 tuexen Exp $
;;; Load the SCTP API needed.
(if (not (defined? 'sctp-send-with-crc32c))
(use-modules (net sctp)))
;;; Just have a convenient way of simple looping.
(use-modules (ice-9 syncase))
(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^4 (expt 2 4))
(define 2^8 (expt 2 8))
(define 2^14 (expt 2 14))
(define 2^16 (expt 2 16))
(define 2^24 (expt 2 24))
(define 2^28 (expt 2 28))
(define 2^32 (expt 2 32))
(define 2^4-1 (- 2^4 -1))
(define 2^8-1 (1- 2^8))
(define 2^14-1 (- 2^14 1))
(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))

36
dotguile
Unescape View File

@ -0,0 +1,36 @@
;;;
;;; 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 2011/03/20 16:48:30 tuexen Exp $
;;; Change the following line to reflect where the files are located.
(define dir "/Users/tuexen/Documents/sua-testtool/")
(define files (list "common.scm"
"sua.scm"
"sua-asp-tests.scm"
"sua-sgp-tests.scm"
"sua-param-testtool-asp.scm"
"sua-param-testtool-sgp.scm"))
(map (lambda (file) (load-from-path (string-append dir file))) files)

35
run-some-sua-asp-tests
Unescape View File

@ -0,0 +1,35 @@
#!/usr/bin/env tcsh
#
# 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: run-some-sua-asp-tests,v 1.3 2011/03/20 16:53:06 tuexen Exp $
#
set timeout = 10
set testcases = ( )
foreach testcase ($testcases)
(runm3uatest -t $timeout $testcase > /dev/tty) >& /dev/null
end

35
run-some-sua-sgp-tests
Unescape View File

@ -0,0 +1,35 @@
#!/usr/bin/env tcsh
#
# 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: run-some-sua-sgp-tests,v 1.3 2011/03/20 16:53:06 tuexen Exp $
#
set timeout = 10
set testcases = ( )
foreach testcase ($testcases)
(runm3uatest -t $timeout $testcase > /dev/tty) >& /dev/null
end

141
run-sua-test.c
Unescape View File

@ -0,0 +1,141 @@
/*-
* Copyright (c) 2011 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: run-sua-test.c,v 1.1 2011/03/20 16:48:30 tuexen Exp $
*/
#include <signal.h>
#include <unistd.h>
#include <stdlib.h>
#include <stdio.h>
#include <sys/types.h>
#include <sys/wait.h>
#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: runm2patest [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) {
execlp("/usr/local/bin/guile", "guile",
"-c", command,
(char *)0);
fprintf(stderr, "%s\n", "Couln't start guile.");
}
printf("Test %-40.40s ", argv[optind]);
fflush(stdout);
if (timeout > 0) {
signal(SIGALRM, handler);
alarm(timeout);
}
if (wait(&status) == -1) {
fprintf(stderr, "%s\n", "Couln't start guile.");
}
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;
default:
printf("%-29.29s\n", YELLOW("BUG"));
break;
}
}
return 0;
}

496
sua-asp-tests.scm
Unescape View File

@ -0,0 +1,496 @@
;;;
;;; 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: sua-asp-tests.scm,v 1.3 2011/03/21 23:51:58 tuexen Exp $
(define (sua-asp-aspsm-v-01 tester-addr tester-port sut-addr sut-port)
(let ((fd (sua-accept tester-addr tester-port)))
(let ((msg (sua-wait-for-message fd sua-asp-up-message?)))
(close fd)
(if (= (sua-get-version msg) 1)
sua-test-result-passed
sua-test-result-failed))))
;;; (sua-asp-aspsm-v-01 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.
;;; (sua-run-asp tester-addr (list sua-asp-inactive))
(define (sua-asp-aspsm-v-02 tester-addr tester-port sut-addr sut-port)
(let ((fd (sua-accept tester-addr tester-port)))
(sua-wait-for-message fd sua-asp-up-message?)
(sua-send-message fd 0 (sua-make-asp-up-ack-message))
(let ((msg (sua-wait-for-message fd sua-asp-down-message?)))
(close fd)
(if (= (sua-get-version msg) 1)
sua-test-result-passed
sua-test-result-failed))))
;;; (2ua-asp-aspsm-v-02 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.
;;; (sua-run-asp tester-addr (list sua-asp-inactive sua-asp-down))
(define (sua-asp-aspsm-v-02-alternate tester-addr tester-port sut-addr sut-port)
(let ((fd (sua-accept tester-addr tester-port)))
(sua-wait-for-message fd sua-asp-up-message?)
(sua-send-message fd 0 (sua-make-asp-up-ack-message))
(let ((asp-active (sua-wait-for-message fd sua-asp-active-message?)))
(sua-send-message fd 0 (sua-make-asp-active-ack-message (sua-get-parameters asp-active))))
(let ((asp-inactive (sua-wait-for-message fd sua-asp-inactive-message?)))
(if (= (sua-get-version asp-inactive) 1)
(begin
(sua-send-message fd 0 (sua-make-asp-inactive-ack-message (sua-get-parameters asp-inactive)))
(sua-wait-for-message fd sua-asp-down-message?)
(sua-send-message fd 0 (sua-make-asp-down-ack-message))
(close fd)
sua-test-result-passed)
(begin
(close fd)
sua-test-result-failed)))))
;;; (sua-asp-aspsm-v-02-alternate tester-addr tester-port sut-addr sut-port)
;;; This test is passed iff the SUT sends an ASP_INACTIVE with version 1.
;;; (sua-run-asp tester-addr (list sua-asp-inactive sua-asp-active sua-asp-inactive))
(define (sua-asp-aspsm-i-01 tester-addr tester-port sut-addr sut-port)
(let ((fd (sua-accept tester-addr tester-port)))
(sua-wait-for-message fd sua-asp-up-message?)
(sua-send-message fd 0 (sua-make-common-header (+ sua-version 1)
sua-reserved
sua-aspsm-message-class
sua-aspup-ack-message-type
sua-common-header-length))
(let ((msg (sua-wait-for-message fd sua-error-message?)))
(close fd)
(if (= (sua-get-error-code-from-message msg)
sua-invalid-version-error-code)
sua-test-result-passed
sua-test-result-failed))))
;;; (sua-asp-aspsm-i-01 tester-addr tester-port sut-addr sut-port)
;;; This test is passed iff the SUT returns an ERROR(invalid version)
;;; (sua-run-asp tester-addr (list sua-asp-inactive))
(define (sua-asp-aspsm-i-02 tester-addr tester-port sut-addr sut-port)
(let ((fd (sua-accept tester-addr tester-port)))
(sua-wait-for-message fd sua-asp-up-message?)
(sua-send-message fd 0 (sua-make-asp-up-ack-message))
(sua-wait-for-message fd sua-asp-down-message?)
(sua-send-message fd 0 (sua-make-common-header (+ sua-version 1)
sua-reserved
sua-aspsm-message-class
sua-aspdn-ack-message-type
sua-common-header-length))
(let ((msg (sua-wait-for-message fd sua-error-message?)))
(close fd)
(if (= (sua-get-error-code-from-message msg)
sua-invalid-version-error-code)
sua-test-result-passed
sua-test-result-failed))))
;;; (sua-asp-aspsm-i-02 tester-addr tester-port sut-addr sut-port)
;;; This test is passed iff the SUT returns an ERROR(invalid version)
;;; (sua-run-asp tester-addr (list sua-asp-inactive sua-asp-down))
(define (sua-asp-aspsm-i-02-alternate tester-addr tester-port sut-addr sut-port)
(let ((fd (sua-accept tester-addr tester-port)))
(sua-wait-for-message fd sua-asp-up-message?)
(sua-send-message fd 0 (sua-make-asp-up-ack-message))
(let ((asp-active (sua-wait-for-message fd sua-asp-active-message?)))
(sua-send-message fd 0 (sua-make-asp-active-ack-message (sua-get-parameters asp-active))))
(let ((asp-inactive (sua-wait-for-message fd sua-asp-inactive-message?)))
(sua-send-message fd 0 (sua-make-asp-inactive-ack-message (sua-get-parameters asp-inactive))))
(sua-wait-for-message fd sua-asp-down-message?)
(sua-send-message fd 0 (sua-make-common-header (+ sua-version 1)
sua-reserved
sua-aspsm-message-class
sua-aspdn-ack-message-type
sua-common-header-length))
(let ((msg (sua-wait-for-message fd sua-error-message?)))
(close fd)
(if (= (sua-get-error-code-from-message msg)
sua-invalid-version-error-code)
sua-test-result-passed
sua-test-result-failed))))
;;; (sua-asp-aspsm-i-02-alternate tester-addr tester-port sut-addr sut-port)
;;; This test is passed iff the SUT sends an ASP_INACTIVE with version 1.
;;; (sua-run-asp tester-addr (list sua-asp-inactive sua-asp-active sua-asp-inactive sua-asp-down))
(define (sua-asp-aspsm-i-03 tester-addr tester-port sut-addr sut-port)
(let ((fd (sua-accept tester-addr tester-port)))
(sua-wait-for-message fd sua-asp-up-message?)
;; FIXME: Should I send the ASPUP-ACK?
;; (sua-send-message fd 0 (sua-make-asp-up-ack-message))
(sua-send-message fd 0 (sua-make-message sua-aspsm-message-class
sua-reserved-aspsm-message-type
(list)))
(let ((msg (sua-wait-for-message fd sua-error-message?)))
(close fd)
(if (= (sua-get-error-code-from-message msg)
sua-unsupported-message-type-error-code)
sua-test-result-passed
sua-test-result-failed))))
;;; (sua-asp-aspsm-i-03 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)
;;; (sua-run-asp tester-addr (list sua-asp-inactive))
(define (sua-asp-aspsm-o-01 tester-addr tester-port sut-addr sut-port)
(let ((fd (sua-accept tester-addr tester-port)))
(sua-wait-for-message fd sua-asp-up-message?)
(sua-send-message fd 0 (sua-make-asp-down-ack-message))
(let ((msg (sua-wait-for-message-with-timeout fd sua-asp-active-message? 2)))
(close fd)
(if (null? msg)
sua-test-result-passed
sua-test-result-failed))))
;;; (sua-asp-aspsm-o-01 tester-addr tester-port sut-addr sut-port)
;;; This test is passed iff the SUT does not send an ASP_ACTIVE. FIXME.
;;; (sua-run-asp tester-addr (list sua-asp-inactive))
(define (sua-asp-aspsm-o-02 tester-addr tester-port sut-addr sut-port)
(let ((fd (sua-accept tester-addr tester-port)))
(sua-wait-for-message fd sua-asp-up-message?)
(sua-send-message fd 0 (sua-make-asp-active-ack-message (list)))
(let ((msg (sua-recv-message-with-timeout fd 2)))
(close fd)
(if (or (null? msg)
(and (sua-error-message? msg)
(= (sua-get-error-code-from-message msg) sua-unexpected-message-error-code))
(sua-asp-up-message? msg))
sua-test-result-passed
(if (sua-cldt-message? msg)
sua-test-result-failed
sua-test-result-unknown)))))
;;; (sua-asp-aspsm-o-02 tester-addr tester-port sut-addr sut-port)
;;; This test is passed iff the SUT does send an ERROR(unexpected message).
;;; (sua-run-asp tester-addr (list sua-asp-inactive))
(define (sua-asp-asptm-v-01 tester-addr tester-port sut-addr sut-port)
(let ((fd (sua-accept tester-addr tester-port)))
(sua-wait-for-message fd sua-asp-up-message?)
(sua-send-message fd 0 (sua-make-asp-up-ack-message))
(let ((asp-active (sua-wait-for-message fd sua-asp-active-message?)))
(sua-send-message fd 0 (sua-make-asp-active-ack-message (sua-get-parameters asp-active))))
(close fd)
sua-test-result-passed))
;;; (sua-asp-asptm-v-01 tester-addr tester-port sut-addr sut-port)
;;; This test is passed iff the SUT sends an ASP_ACTIVE.
;;; (sua-run-asp tester-addr (list sua-asp-inactive sua-asp-active))
(define (sua-asp-asptm-v-02 tester-addr tester-port sut-addr sut-port)
(let ((fd (sua-accept tester-addr tester-port)))
(sua-wait-for-message fd sua-asp-up-message?)
(sua-send-message fd 0 (sua-make-asp-up-ack-message))
(let ((asp-active (sua-wait-for-message fd sua-asp-active-message?)))
(if (= (sua-get-version asp-active) 1)
(begin
(sua-send-message fd 0 (sua-make-asp-active-ack-message (sua-get-parameters asp-active)))
(close fd)
sua-test-result-passed)
(begin
(close fd)
sua-test-result-failed)))))
;;; (sua-asp-asptm-v-02 tester-addr tester-port sut-addr sut-port)
;;; This test is passed iff the SUT sends an ASP_ACTIVE with version 1.
;;; (sua-run-asp tester-addr (list sua-asp-inactive sua-asp-active))
(define (sua-asp-asptm-v-03 tester-addr tester-port sut-addr sut-port)
(let ((fd (sua-accept tester-addr tester-port)))
(sua-wait-for-message fd sua-asp-up-message?)
(sua-send-message fd 0 (sua-make-asp-up-ack-message))
(let ((asp-active (sua-wait-for-message fd sua-asp-active-message?)))
(sua-send-message fd 0 (sua-make-asp-active-ack-message (sua-get-parameters asp-active))))
(let ((asp-inactive (sua-wait-for-message fd sua-asp-inactive-message?)))
(if (= (sua-get-version asp-inactive) 1)
(begin
(sua-send-message fd 0 (sua-make-asp-inactive-ack-message (sua-get-parameters asp-inactive)))
(close fd)
sua-test-result-passed)
(begin
(close fd)
sua-test-result-failed)))))
;;; (sua-asp-asptm-v-03 tester-addr tester-port sut-addr sut-port)
;;; This test is passed iff the SUT sends an ASP_INACTIVE with version 1.
;;; (sua-run-asp tester-addr (list sua-asp-inactive sua-asp-active sua-asp-inactive))
(define (sua-asp-asptm-v-04 tester-addr tester-port sut-addr sut-port)
(let ((fd (sua-accept tester-addr tester-port)))
(sua-wait-for-message fd sua-asp-up-message?)
(sua-send-message fd 0 (sua-make-asp-up-ack-message))
(let ((asp-active (sua-wait-for-message fd sua-asp-active-message?))
(heartbeat-data (random-bytes 5000)))
(sua-send-message fd 0 (sua-make-asp-active-ack-message (sua-get-parameters asp-active)))
(sua-send-message fd 0 (sua-make-beat-message heartbeat-data))
(let ((m (sua-wait-for-message fd (lambda (m) (or (sua-beat-ack-message? m)
(sua-error-message? m))))))
(close fd)
(if (sua-beat-ack-message? m)
sua-test-result-passed
sua-test-result-failed)))))
;;; (sua-asp-asptm-v-04 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.
;;; (sua-run-asp tester-addr (list sua-asp-inactive sua-asp-active sua-asp-reflect-beat))
(define (sua-asp-asptm-v-05 tester-addr tester-port sut-addr sut-port)
(let ((fd (sua-accept tester-addr tester-port)))
(sua-wait-for-message fd sua-asp-up-message?)
(sua-send-message fd 0 (sua-make-asp-up-ack-message))
(let ((asp-active (sua-wait-for-message fd sua-asp-active-message?))
(heartbeat-data (random-bytes 600)))
(sua-send-message fd 0 (sua-make-asp-active-ack-message (sua-get-parameters asp-active)))
(sua-send-message fd 0 (sua-make-beat-message heartbeat-data))
(let ((m (sua-wait-for-message fd (lambda (m) (or (sua-beat-ack-message? m)
(sua-error-message? m))))))
(close fd)
(if (and (sua-beat-ack-message? m)
(equal? (sua-make-beat-ack-message heartbeat-data) m))
sua-test-result-passed
sua-test-result-failed)))))
;;; (sua-asp-asptm-v-05 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.
;;; (sua-run-asp tester-addr (list sua-asp-inactive sua-asp-active sua-asp-reflect-beat))
(define (sua-asp-asptm-i-01 tester-addr tester-port sut-addr sut-port)
(let ((fd (sua-accept tester-addr tester-port)))
(sua-wait-for-message fd sua-asp-up-message?)
(sua-send-message fd 0 (sua-make-asp-up-ack-message))
(let ((asp-active (sua-wait-for-message fd sua-asp-active-message?)))
(sua-send-message fd 0 (sua-increment-version
(sua-make-asp-active-ack-message (sua-get-parameters asp-active))))
(let ((msg (sua-wait-for-message fd sua-error-message?)))
(close fd)
(if (= (sua-get-error-code-from-message msg)
sua-invalid-version-error-code)
sua-test-result-passed
sua-test-result-failed)))))
;;; (sua-asp-asptm-i-01 tester-addr tester-port sut-addr sut-port)
;;; This test is passed iff the SUT sends an ERROR(invalid version).
;;; (sua-run-asp tester-addr (list sua-asp-inactive sua-asp-active))
(define (sua-asp-asptm-i-02 tester-addr tester-port sut-addr sut-port)
(let ((fd (sua-accept tester-addr tester-port)))
(sua-wait-for-message fd sua-asp-up-message?)
(sua-send-message fd 0 (sua-make-asp-up-ack-message))
(let ((asp-active (sua-wait-for-message fd sua-asp-active-message?)))
(sua-send-message fd 0 (sua-make-asp-active-ack-message (sua-get-parameters asp-active)))
(sua-wait-for-message fd sua-asp-inactive-message?)
(sua-send-message fd 0 (sua-increment-version
(sua-make-asp-inactive-ack-message (sua-get-parameters asp-active))))
(let ((msg (sua-wait-for-message fd sua-error-message?)))
(close fd)
(if (= (sua-get-error-code-from-message msg)
sua-invalid-version-error-code)
sua-test-result-passed
sua-test-result-failed)))))
;;; (sua-asp-asptm-i-02 tester-addr tester-port sut-addr sut-port)
;;; This test is passed iff the SUT sends an ERROR(invalid version).
;;; (sua-run-asp tester-addr (list sua-asp-inactive sua-asp-active sua-asp-inactive))
(define (sua-asp-asptm-i-03 tester-addr tester-port sut-addr sut-port)
(let ((fd (sua-accept tester-addr tester-port)))
(sua-wait-for-message fd sua-asp-up-message?)
(sua-send-message fd 0 (sua-make-asp-up-ack-message))
(let ((asp-active (sua-wait-for-message fd sua-asp-active-message?)))
(sua-send-message fd 0 (sua-make-message sua-asptm-message-class
sua-reserved-asptm-message-type
(list)))
(let ((msg (sua-wait-for-message fd sua-error-message?)))
(close fd)
(if (= (sua-get-error-code-from-message msg)
sua-unsupported-message-type-error-code)
sua-test-result-passed
sua-test-result-failed)))))
;;; (sua-asp-asptm-i-03 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).
;;; (sua-run-asp tester-addr (list sua-asp-inactive sua-asp-active))
(define (sua-asp-asptm-o-01 tester-addr tester-port sut-addr sut-port)
(let ((fd (sua-accept tester-addr tester-port)))
(sua-wait-for-message fd sua-asp-up-message?)
(sua-send-message fd 0 (sua-make-asp-up-ack-message))
(sua-wait-for-message fd sua-asp-active-message?)
(sua-send-message fd 0 (sua-make-asp-up-ack-message))
(let ((msg (sua-recv-message-with-timeout fd 2)))
(close fd)
(if (or (null? msg)
(and (sua-error-message? msg)
(= (sua-get-error-code-from-message msg) sua-unexpected-message-error-code))
(sua-asp-active-message? msg))
sua-test-result-passed
(if (sua-data-message? msg)
sua-test-result-failed
sua-test-result-unknown)))))
;;; (sua-asp-asptm-o-01 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?
;;; (sua-run-asp tester-addr (list sua-asp-inactive sua-asp-active))
(define (sua-asp-mtr-v-01 tester-addr tester-port sut-addr sut-port)
(let ((fd (sua-accept tester-addr tester-port)))
(sua-wait-for-message fd sua-asp-up-message?)
(sua-send-message fd 0 (sua-make-asp-up-ack-message))
(let ((asp-active (sua-wait-for-message fd sua-asp-active-message?)))
(sua-send-message fd 0 (sua-make-asp-active-ack-message (sua-get-parameters asp-active)))
(let ((m (sua-wait-for-message fd (lambda (m) (or (sua-cldt-message? m)
(sua-daud-message? m))))))
(if (sua-daud-message? m)
(begin
(sua-send-message fd 0 (sua-make-dava-message (sua-get-parameters m)))
(sua-wait-for-message fd sua-cldt-message?))))
(close fd)
sua-test-result-unknown)))
;;; (sua-asp-mtr-v-01 tester-addr tester-port sut-addr sut-port)
;;; This test is passed iff the SUT sends DATA including a RC.
;;; FIXME
;;; (sua-run-asp tester-addr (list sua-asp-inactive sua-asp-active sua-asp-send-data))
(define sua-asp-mtr-v-02 sua-asp-mtr-v-01)
;;; (sua-asp-mtr-v-02 tester-addr tester-port sut-addr sut-port)
;;; This test is passed iff the SUT sends DATA including data.
;;; FIXME
;;; (sua-run-asp tester-addr (list sua-asp-inactive sua-asp-active sua-asp-send-data))
(define sua-asp-mtr-v-03 sua-asp-mtr-v-01)
;;; (sua-asp-mtr-v-03 tester-addr tester-port sut-addr sut-port)
;;; This test is passed iff the SUT sends DATA in a valid stream .
;;; FIXME
;;; (sua-run-asp tester-addr (list sua-asp-inactive sua-asp-active sua-asp-send-data))
(define (sua-asp-mtr-i-01 tester-addr tester-port sut-addr sut-port)
(let ((fd (sua-accept tester-addr tester-port)))
(sua-wait-for-message fd sua-asp-up-message?)
(sua-send-message fd 0 (sua-make-asp-up-ack-message))
(let ((asp-active (sua-wait-for-message fd sua-asp-active-message?)))
(sua-send-message fd 0 (sua-make-asp-active-ack-message (sua-get-parameters asp-active))))
(sua-send-message fd 1 (append (sua-make-common-header (+ 1 sua-version)
sua-reserved
sua-connection-less-message-class
sua-cldt-message-type
(+ sua-common-header-length
8 8 24 24 8 4
(length sccp-test-message)))
(sua-make-routing-context-parameter (list tester-rc-valid))
(sua-make-protocol-class-parameter sua-protocol-class-0 #f)
(sua-make-source-address-parameter sua-route-on-ssn-and-pc-indicator
sua-address-indicator-ssn-mask
(list (sua-make-point-code-parameter tester-pc)
(sua-make-subsystem-number-parameter tester-ssn)))
(sua-make-destination-address-parameter sua-route-on-ssn-and-pc-indicator
sua-address-indicator-ssn-mask
(list (sua-make-point-code-parameter sut-pc)
(sua-make-subsystem-number-parameter sut-ssn)))
(sua-make-sequence-control-parameter 0)
(sua-make-data-parameter sccp-test-message)))
(let ((msg (sua-wait-for-message fd sua-error-message?)))
(close fd)
(if (= (sua-get-error-code-from-message msg)
sua-invalid-version-error-code)
sua-test-result-passed
sua-test-result-failed))))
;;; (sua-asp-mtr-i-01 tester-addr tester-port sut-addr sut-port)
;;; This test is passed iff the SUT sends an ERROR(invalid version).
;;; (sua-run-asp tester-addr (list sua-asp-inactive sua-asp-active sua-asp-receive-data))
(define (sua-asp-mtr-i-02 tester-addr tester-port sut-addr sut-port)
(let ((fd (sua-accept tester-addr tester-port)))
(sua-wait-for-message fd sua-asp-up-message?)
(sua-send-message fd 0 (sua-make-asp-up-ack-message))
(let ((asp-active (sua-wait-for-message fd sua-asp-active-message?)))
(sua-send-message fd 0 (sua-make-asp-active-ack-message (sua-get-parameters asp-active)))
(sua-send-message fd 0 (sua-make-message sua-reserved-message-class 0 (list)))
(let ((msg (sua-wait-for-message fd sua-error-message?)))
(close fd)
(if (= (sua-get-error-code-from-message msg)
sua-unsupported-message-class-error-code)
sua-test-result-passed
sua-test-result-failed)))))
;;; (sua-asp-mtr-i-02 tester-addr tester-port sut-addr sut-port)
;;; This test is passed iff the SUT sends an ERROR(unsupported message class).
;;; (sua-run-asp tester-addr (list sua-asp-inactive sua-asp-active sua-asp-receive-data))
(define (sua-asp-mtr-i-03 tester-addr tester-port sut-addr sut-port)
(let ((fd (sua-accept tester-addr tester-port)))
(sua-wait-for-message fd sua-asp-up-message?)
(sua-send-message fd 0 (sua-make-asp-up-ack-message))
(let ((asp-active (sua-wait-for-message fd sua-asp-active-message?)))
(sua-send-message fd 0 (sua-make-asp-active-ack-message (sua-get-parameters asp-active)))
(sua-send-message fd 0 (sua-make-message sua-connection-less-message-class
sua-reserved-cl-message-type
(list)))
(let ((msg (sua-wait-for-message fd sua-error-message?)))
(close fd)
(if (= (sua-get-error-code-from-message msg)
sua-unsupported-message-type-error-code)
sua-test-result-passed
sua-test-result-failed)))))
;;; (sua-asp-mtr-i-03 tester-addr tester-port sut-addr sut-port)
;;; This test is passed iff the SUT sends an ERROR(unsupported message type).
;;; (sua-run-asp tester-addr (list sua-asp-inactive sua-asp-active sua-asp-receive-data))
(define (sua-asp-mtr-i-04 tester-addr tester-port sut-addr sut-port)
(let ((fd (sua-accept tester-addr tester-port)))
(sua-wait-for-message fd sua-asp-up-message?)
(sua-send-message fd 0 (sua-make-asp-up-ack-message))
(let ((asp-active (sua-wait-for-message fd sua-asp-active-message?)))
(sua-send-message fd 0 (sua-make-asp-active-ack-message (sua-get-parameters asp-active)))
(sua-send-message fd 0 (sua-make-message sua-connection-oriented-message-class
sua-reserved-co-message-type
(list)))
(let ((msg (sua-wait-for-message fd sua-error-message?)))
(close fd)
(if (= (sua-get-error-code-from-message msg)
sua-unsupported-message-type-error-code)
sua-test-result-passed
sua-test-result-failed)))))
;;; (sua-asp-mtr-i-04 tester-addr tester-port sut-addr sut-port)
;;; This test is passed iff the SUT sends an ERROR(unsupported message type).
;;; (sua-run-asp tester-addr (list sua-asp-inactive sua-asp-active sua-asp-receive-data))

46
sua-param-testtool-asp.scm
Unescape View File

@ -0,0 +1,46 @@
;;;
;;; 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: sua-param-testtool-asp.scm,v 1.2 2011/03/21 23:51:58 tuexen Exp $
;;; Define a transport address of the system under test
;;; Currently not used.
(define sut-addr "0.0.0.0")
(define sut-port 0)
(define sut-pc 3)
(define sut-ssn 4)
;;; Define the transport address of the tester
(define tester-addr "127.0.0.1")
(define tester-port sua-port)
(define tester-pc 1)
(define tester-ssn 3)
;;; Define valid RC
(define tester-rc-valid 1)
;;; Define a test message
(define sccp-test-message (list))

110
sua-param-testtool-sgp.scm
Unescape View File

@ -0,0 +1,110 @@
;;;
;;; 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: sua-param-testtool-sgp.scm,v 1.2 2011/03/21 22:18:29 tuexen Exp $
;;; Define a transport address of the system under test
(define sut-addr "127.0.0.1")
(define sut-port sua-port)
(define sut-port-1 sua-port)
(define sut-port-2 (1+ sua-port))
;;; Define the transport address of the tester
(define tester-addr "127.0.0.1")
(define tester-port 0)
(define tester-port-1 3000)
(define tester-port-2 3001)
;;; Define the point code of the SUT
(define sut-pc 4001)
;;; Define the SSN of the SUT
(define sut-ssn 3)
;;; 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 the SSN of the tester
(define tester-ssn 3)
;;; 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 sccp-test-message (list))
;;; Define traffic-type-mode
;;;(define traffic-mode sua-traffic-mode-type-override)
(define traffic-mode sua-traffic-mode-type-loadshare)
;;;(define traffic-mode sua-traffic-mode-type-broadcast)
(define asp-up-message-parameters (list))
;;; (define asp-up-message-parameters (list (sua-make-asp-id-parameter asp-id)))
;;;asp-up-message-parameters
(define asp-active-message-parameters (list))
;;;(define asp-active-message-parameters (list (sua-make-traffic-mode-type-parameter traffic-mode)
;;; (sua-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 (sua-make-traffic-mode-type-parameter traffic-mode)
;;; (sua-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 (sua-make-traffic-mode-type-parameter traffic-mode)
;;; (sua-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 (sua-make-routing-context-parameter (list tester-rc-valid))))
;;;asp-inactive-ack-message-parameters
(define data-message-parameters (list))
;;;(define data-message-parameters (list (sua-make-network-appearance-parameter network-appearance)
;;; (sua-make-routing-context-parameter (list tester-rc-valid))))
;;;data-message-parameters

775
sua-sgp-tests.scm
Unescape View File

@ -0,0 +1,775 @@
;;;
;;; 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: sua-sgp-tests.scm,v 1.4 2011/03/21 22:21:46 tuexen Exp $
;;;
;;; Definition of the tests for the SGP
;;;
(define (sua-sgp-aspsm-v-01 tester-addr tester-port sut-addr sut-port)
(let ((fd (sua-connect tester-addr tester-port sut-addr sut-port)))
(sua-send-message fd 0 (sua-make-asp-up-message asp-up-message-parameters))
(sua-wait-for-message fd sua-asp-up-ack-message?)
(close fd)
sua-test-result-passed))
;;; (sua-sgp-aspsm-v-01 tester-addr tester-port sut-addr sut-port)
;;; The test is passed if an ASPUP-ACK is returned
(define (sua-sgp-aspsm-v-02 tester-addr tester-port sut-addr sut-port)
(let ((fd (sua-connect tester-addr tester-port sut-addr sut-port)))
(sua-send-message fd 0 (sua-make-asp-up-message asp-up-message-parameters))
(sua-wait-for-message fd sua-asp-up-ack-message?)
(let ((msg (sua-wait-for-message fd sua-notify-message?)))
(close fd)
(if (and (= (sua-get-status-type-from-message msg) sua-as-state-change-status-type)
(= (sua-get-status-info-from-message msg) sua-as-inactive))
sua-test-result-passed
sua-test-result-failed))))
;;; (sua-sgp-aspsm-v-02 tester-addr tester-port sut-addr sut-port)
;;; This test is passed if there is a ASPUP-ACK and a NOTIFY(AS_INACTIVE)
(define (sua-sgp-aspsm-v-03 tester-addr tester-port sut-addr sut-port)
(let ((fd (sua-connect tester-addr tester-port sut-addr sut-port)))
(sua-send-message fd 0 (sua-make-asp-up-message asp-up-message-parameters))
(sua-wait-for-message fd sua-asp-up-ack-message?)
(sua-send-message fd 0 (sua-make-asp-down-message))
(sua-wait-for-message fd sua-asp-down-ack-message?)
(close fd)
sua-test-result-passed))
;;; (sua-sgp-aspsm-v-03 tester-addr tester-port sut-addr sut-port)
;;; This test is passed if there is a ASPDN-ACK
(define (sua-sgp-aspsm-v-04 tester-addr tester-port sut-addr sut-port)
(let ((fd (sua-connect tester-addr tester-port sut-addr sut-port)))
(sua-send-message fd 0 (sua-make-asp-up-message asp-up-message-parameters))
(let ((msg (sua-wait-for-message fd sua-error-message?)))
(close fd)
(if (= (sua-get-error-code-from-message msg)
sua-refused-management-blocking-error-code)
sua-test-result-passed
sua-test-result-failed))))
;;; (sua-sgp-aspsm-v-04 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 (sua-sgp-aspsm-i-01 tester-addr tester-port sut-addr sut-port)
(let ((fd (sua-connect tester-addr tester-port sut-addr sut-port)))
(sua-send-message fd 0 (sua-make-common-header (+ sua-version 1)
sua-reserved
sua-aspsm-message-class
sua-aspup-message-type
sua-common-header-length))
(let ((msg (sua-wait-for-message fd sua-error-message?)))
(close fd)
(if (= (sua-get-error-code-from-message msg)
sua-invalid-version-error-code)
sua-test-result-passed
sua-test-result-failed))))
;;; (sua-sgp-aspsm-i-01 tester-addr tester-port sut-addr sut-port)
;;; This test is passed if there is a ERROR(invalid version)
(define (sua-sgp-aspsm-i-02 tester-addr tester-port sut-addr sut-port)
(let ((fd (sua-connect tester-addr tester-port sut-addr sut-port)))
(sua-send-message fd 0 (sua-make-common-header sua-version
sua-reserved
sua-aspsm-message-class
sua-reserved-aspsm-message-type
sua-common-header-length))
(let ((msg (sua-wait-for-message fd sua-error-message?)))
(close fd)
(if (= (sua-get-error-code-from-message msg)
sua-unsupported-message-type-error-code)
sua-test-result-passed
sua-test-result-failed))))
;;; (sua-sgp-aspsm-i-02 tester-addr tester-port sut-addr sut-port)
;;; This test is passed if there is a ERROR(unsupported message type)
(define (sua-sgp-aspsm-i-03 tester-addr tester-port sut-addr sut-port)
(let ((fd (sua-connect tester-addr tester-port sut-addr sut-port)))
(sua-send-message fd 0 (sua-make-asp-active-message asp-active-message-parameters))
(let ((msg (sua-wait-for-message fd sua-error-message?)))
(close fd)
(if (= (sua-get-error-code-from-message msg)
sua-unexpected-message-error-code)
sua-test-result-passed
sua-test-result-failed))))
;;; (sua-sgp-aspsm-i-03 tester-addr tester-port sut-addr sut-port)
;;; This test needs clarification. FIXME.
(define (sua-sgp-aspsm-i-04 tester-addr tester-port sut-addr sut-port)
(let ((fd (sua-connect tester-addr tester-port sut-addr sut-port)))
(sua-send-message fd 0 (sua-make-asp-up-message asp-up-message-parameters))
(sua-wait-for-message fd sua-asp-up-ack-message?)
(sua-send-message fd 0 (sua-make-common-header sua-version
sua-reserved
sua-aspsm-message-class
sua-reserved-aspsm-message-type
sua-common-header-length))
(let ((msg (sua-wait-for-message fd sua-error-message?)))
(close fd)
(if (= (sua-get-error-code-from-message msg)
sua-unsupported-message-type-error-code)
sua-test-result-passed
sua-test-result-failed))))
;;; (sua-sgp-aspsm-i-04 tester-addr tester-port sut-addr sut-port)
;;; This test is passed if there is an ERROR(unsupported message type)
(define (sua-sgp-aspsm-o-01 tester-addr tester-port sut-addr sut-port)
(let ((fd (sua-connect tester-addr tester-port sut-addr sut-port)))
(sua-send-message fd 0 (sua-make-asp-up-message asp-up-message-parameters))
(sua-wait-for-message fd sua-asp-up-ack-message?)
(sua-send-message fd 0 (sua-make-asp-up-message asp-up-message-parameters))
(sua-wait-for-message fd sua-asp-up-ack-message?)
(close fd)
sua-test-result-passed))
;;; (sua-sgp-aspsm-o-01 tester-addr tester-port sut-addr sut-port)
;;; This test is passed if there is an ASPUP-ACK.
(define (sua-sgp-aspsm-o-02 tester-addr tester-port sut-addr sut-port)
(let ((fd (sua-connect tester-addr tester-port sut-addr sut-port)))
(sua-send-message fd 0 (sua-make-asp-up-message asp-up-message-parameters))
(sua-wait-for-message fd sua-asp-up-ack-message?)
(sua-send-message fd 0 (sua-make-asp-active-message asp-active-message-parameters))
(sua-wait-for-message fd sua-asp-active-ack-message?)
(sua-send-message fd 0 (sua-make-asp-up-message asp-up-message-parameters))
(let ((msg (sua-wait-for-message fd sua-error-message?)))
(if (= (sua-get-error-code-from-message msg)
sua-unexpected-message-error-code)
(begin
(sua-wait-for-message fd sua-asp-up-ack-message?)
(let ((msg (sua-wait-for-message fd sua-notify-message?)))
(close fd)
(if (and (= (sua-get-status-type-from-message msg) sua-as-state-change-status-type)
(= (sua-get-status-info-from-message msg) sua-as-inactive))
sua-test-result-passed
sua-test-result-failed)))
(begin
(close fd)
sua-test-result-failed)))))
;;; (sua-sgp-aspsm-o-002 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 (sua-sgp-aspsm-o-03 tester-addr tester-port sut-addr sut-port)
(let ((fd (sua-connect tester-addr tester-port sut-addr sut-port)))
(sua-send-message fd 0 (sua-make-asp-down-message))
(sua-wait-for-message fd sua-asp-down-ack-message?)
(close fd)
sua-test-result-passed))
;;; (sua-sgp-aspsm-o-03 tester-addr tester-port sut-addr sut-port)
;;; This test is passed if there is an ASPDN-ACK,
(define (sua-sgp-asptm-v-01 tester-addr tester-port sut-addr sut-port)
(let ((fd (sua-connect tester-addr tester-port sut-addr sut-port)))
(sua-send-message fd 0 (sua-make-asp-up-message asp-up-message-parameters))
(sua-wait-for-message fd sua-asp-up-ack-message?)
(sua-send-message fd 0 (sua-make-asp-active-message asp-active-message-parameters))
(sua-wait-for-message fd sua-asp-active-ack-message?)
(close fd)
sua-test-result-passed))
;;; (sua-sgp-asptm-v-01 tester-addr tester-port sut-addr sut-port)
;;; This test is passed if there is an ASPAC-ACK.
(define (sua-sgp-asptm-v-02 tester-addr tester-port sut-addr sut-port)
(let ((fd (sua-connect tester-addr tester-port sut-addr sut-port)))
(sua-send-message fd 0 (sua-make-asp-up-message asp-up-message-parameters))
(sua-wait-for-message fd sua-asp-up-ack-message?)
(sua-send-message fd 0 (sua-make-asp-active-message asp-active-message-parameters))
(sua-wait-for-message fd sua-asp-active-ack-message?)
(let ((msg (sua-wait-for-message fd sua-notify-message?)))
(close fd)
(if (and (= (sua-get-status-type-from-message msg) sua-as-state-change-status-type)
(= (sua-get-status-info-from-message msg) sua-as-active))
sua-test-result-passed
sua-test-result-failed))))
;;; (sua-sgp-asptm-v-02 tester-addr tester-port sut-addr sut-port)
;;; This test is passed if there is an ASPAC-ACK and NOTIFY(AS-ACTIVE).
(define (sua-sgp-asptm-v-03 tester-addr tester-port sut-addr sut-port rc)
(let ((fd (sua-connect tester-addr tester-port sut-addr sut-port)))
(sua-send-message fd 0 (sua-make-asp-up-message asp-up-message-parameters))
(sua-wait-for-message fd sua-asp-up-ack-message?)
(sua-send-message fd 0 (sua-make-asp-active-message (list (sua-make-routing-context-parameter (list rc)))))
(sua-wait-for-message fd sua-asp-active-ack-message?)
(close fd)
sua-test-result-unknown))
;;; (sua-sgp-asptm-v-03 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 (sua-sgp-asptm-v-04 tester-addr tester-port sut-addr sut-port)
(let ((fd (sua-connect tester-addr tester-port sut-addr sut-port)))
(sua-send-message fd 0 (sua-make-asp-up-message asp-up-message-parameters))
(sua-wait-for-message fd sua-asp-up-ack-message?)
(sua-send-message fd 0 (sua-make-asp-active-message asp-active-message-parameters))
(sua-wait-for-message fd sua-asp-active-ack-message?)
(sua-send-message fd 0 (sua-make-asp-inactive-message asp-inactive-message-parameters))
(sua-wait-for-message fd sua-asp-inactive-ack-message?)
(close fd)
sua-test-result-passed))
;;; (sua-sgp-asptm-v-04 tester-addr tester-port sut-addr sut-port)