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