Browse Source

Import from CVS.

master
Michael Tuexen 6 years ago
parent
commit
48300f08f2
  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

@ -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

@ -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

@ -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

@ -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

@ -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

@ -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

@ -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

@ -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

@ -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)