1 34719c28 2021-12-31 cage ;; test stuite for kami
 2 34719c28 2021-12-31 cage ;; Copyright (C) 2021  cage
 3 34719c28 2021-12-31 cage 
 4 34719c28 2021-12-31 cage ;; This program is free software: you can redistribute it and/or modify
 5 34719c28 2021-12-31 cage ;; it under the terms of the GNU General Public License as published by
 6 34719c28 2021-12-31 cage ;; the Free Software Foundation, either version 3 of the License, or
 7 34719c28 2021-12-31 cage ;; (at your option) any later version.
 8 34719c28 2021-12-31 cage 
 9 34719c28 2021-12-31 cage ;; This program is distributed in the hope that it will be useful,
10 34719c28 2021-12-31 cage ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
11 34719c28 2021-12-31 cage ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
12 34719c28 2021-12-31 cage ;; GNU General Public License for more details.
13 34719c28 2021-12-31 cage 
14 34719c28 2021-12-31 cage ;; You should have received a copy of the GNU General Public License
15 34719c28 2021-12-31 cage ;; along with this program.  If not, see <http://www.gnu.org/licenses/>.
16 34719c28 2021-12-31 cage 
17 34719c28 2021-12-31 cage (in-package :all-tests)
18 34719c28 2021-12-31 cage 
19 34719c28 2021-12-31 cage (defparameter *client-certificate* "")
20 34719c28 2021-12-31 cage 
21 34719c28 2021-12-31 cage (defparameter *certificate-key*    "")
22 34719c28 2021-12-31 cage 
23 34719c28 2021-12-31 cage (defparameter *host*               "localhost")
24 34719c28 2021-12-31 cage 
25 34719c28 2021-12-31 cage (defparameter *port*               10564)
26 34719c28 2021-12-31 cage 
27 34719c28 2021-12-31 cage (defun open-tls-socket (host port)
28 34719c28 2021-12-31 cage   (flet ((open-socket (hostname)
29 34719c28 2021-12-31 cage            (usocket:socket-connect hostname
30 34719c28 2021-12-31 cage                                    port
31 34719c28 2021-12-31 cage                                    :element-type '(unsigned-byte 8))))
32 34719c28 2021-12-31 cage     (or (ignore-errors (open-socket host))
33 34719c28 2021-12-31 cage         (open-socket host))))
34 34719c28 2021-12-31 cage 
35 34719c28 2021-12-31 cage (defmacro with-open-ssl-stream ((ssl-stream socket host port
36 34719c28 2021-12-31 cage                                  client-certificate
37 34719c28 2021-12-31 cage                                  certificate-key)
38 34719c28 2021-12-31 cage                                 &body body)
39 34719c28 2021-12-31 cage   (alexandria:with-gensyms (tls-context socket-stream ssl-hostname)
40 34719c28 2021-12-31 cage     `(let ((,tls-context (cl+ssl:make-context :verify-mode cl+ssl:+ssl-verify-none+)))
41 34719c28 2021-12-31 cage        (cl+ssl:with-global-context (,tls-context :auto-free-p t)
42 34719c28 2021-12-31 cage          (let* ((,socket        (open-tls-socket ,host ,port))
43 34719c28 2021-12-31 cage                 (,socket-stream (usocket:socket-stream ,socket))
44 34719c28 2021-12-31 cage                 (,ssl-hostname  ,host)
45 34719c28 2021-12-31 cage                 (,ssl-stream
46 34719c28 2021-12-31 cage                   (cl+ssl:make-ssl-client-stream ,socket-stream
47 34719c28 2021-12-31 cage                                                  :certificate     ,client-certificate
48 34719c28 2021-12-31 cage                                                  :key             ,certificate-key
49 34719c28 2021-12-31 cage                                                  :external-format nil ; unsigned byte 8
50 34719c28 2021-12-31 cage                                                  :unwrap-stream-p t
51 34719c28 2021-12-31 cage                                                  :verify          nil
52 34719c28 2021-12-31 cage                                                  :hostname        ,ssl-hostname)))
53 34719c28 2021-12-31 cage            ,@body)))))
54 34719c28 2021-12-31 cage 
55 34719c28 2021-12-31 cage (defsuite all-suite ())
56 34719c28 2021-12-31 cage 
57 34719c28 2021-12-31 cage (defun exit-program (&optional (exit-code 0))
58 34719c28 2021-12-31 cage   (uiop:quit exit-code))
59 34719c28 2021-12-31 cage 
60 116ee6e4 2022-01-10 cage (defun run-all-tests-with-debugger (&optional (use-debugger t))
61 34719c28 2021-12-31 cage   (setf *client-certificate* (uiop:getenv "REGRESS_CERT")
62 34719c28 2021-12-31 cage         *certificate-key*    (uiop:getenv "REGRESS_KEY")
63 34719c28 2021-12-31 cage         *host*               (uiop:getenv "REGRESS_HOSTNAME")
64 34719c28 2021-12-31 cage         *port*               (parse-integer (uiop:getenv "REGRESS_PORT")))
65 116ee6e4 2022-01-10 cage   (clunit:run-suite 'all-suite :use-debugger use-debugger :report-progress t)
66 116ee6e4 2022-01-10 cage   (exit-program 0))
67 116ee6e4 2022-01-10 cage 
68 116ee6e4 2022-01-10 cage (defun run-all-tests (&key (use-debugger t))
69 34719c28 2021-12-31 cage   (handler-bind ((error (lambda (e)
70 34719c28 2021-12-31 cage                           (declare (ignore e))
71 34719c28 2021-12-31 cage                           (exit-program 1)))
72 34719c28 2021-12-31 cage                  (clunit::assertion-failed (lambda (e)
73 34719c28 2021-12-31 cage                           (declare (ignore e))
74 34719c28 2021-12-31 cage                           (exit-program 2))))
75 116ee6e4 2022-01-10 cage     (run-all-tests-with-debugger use-debugger)))