clic/3rdparties/software/cl+ssl-20200427-git/example.lisp

3rdparties/software/cl+ssl-20200427-git/example.lisp (3612 bytes)
1 ;;; Copyright (C) 2001, 2003  Eric Marsden
2 ;;; Copyright (C) 2005  David Lichteblau
3 ;;; "the conditions and ENSURE-SSL-FUNCALL are by Jochen Schmidt."
4 ;;;
5 ;;; See LICENSE for details.
6 
7 #|
8 (load "example.lisp")
9 (ssl-test::test-https-client "www.google.com")
10 (ssl-test::test-https-server)
11 |#
12 
13 (defpackage :ssl-test
14   (:use :cl))
15 (in-package :ssl-test)
16 
17 (eval-when (:compile-toplevel :load-toplevel :execute)
18   (asdf:operate 'asdf:load-op :trivial-sockets))
19 
20 (defun read-line-crlf (stream &optional eof-error-p)
21   (let ((s (make-string-output-stream)))
22     (loop
23         for empty = t then nil
24   for c = (read-char stream eof-error-p nil)
25   while (and c (not (eql c #\return)))
26   do
27     (unless (eql c #\newline)
28       (write-char c s))
29   finally
30     (return
31       (if empty nil (get-output-stream-string s))))))
32 
33 (defun test-nntps-client (&optional (host "snews.gmane.org") (port 563))
34   (let* ((fd (trivial-sockets:open-stream host port
35             :element-type '(unsigned-byte 8)))
36          (nntps (cl+ssl:make-ssl-client-stream fd :external-format '(:iso-8859-1 :eol-style :lf))))
37     (format t "NNTPS> ~A~%" (read-line-crlf nntps))
38     (write-line "HELP" nntps)
39     (force-output nntps)
40     (loop :for line = (read-line-crlf nntps nil)
41           :until (string-equal "." line)
42           :do (format t "NNTPS> ~A~%" line))))
43 
44 
45 ;; open an HTTPS connection to a secure web server and make a
46 ;; HEAD request
47 (defun test-https-client (host &optional (port 443))
48   (let* ((deadline (+ (get-internal-real-time)
49           (* 3 internal-time-units-per-second)))
50    (socket (ccl:make-socket :address-family :internet
51           :connect :active
52           :type :stream
53           :remote-host host
54           :remote-port port
55 ;;            :local-host (resolve-hostname local-host)
56 ;;           :local-port local-port
57           :deadline deadline))
58          (https
59     (progn
60       (cl+ssl:make-ssl-client-stream
61        socket
62        :unwrap-stream-p t
63        :external-format '(:iso-8859-1 :eol-style :lf)))))
64     (unwind-protect
65   (progn
66     (format https "GET / HTTP/1.0~%Host: ~a~%~%" host)
67     (force-output https)
68     (loop :for line = (read-line-crlf https nil)
69           :while line :do
70           (format t "HTTPS> ~a~%" line)))
71     (close https))))
72 
73 ;; start a simple HTTPS server. See the mod_ssl documentation at
74 ;; <URL:http://www.modssl.org/> for information on generating the
75 ;; server certificate and key
76 ;;
77 ;; You can stress-test the server with
78 ;;
79 ;;    siege -c 10 -u https://host:8080/foobar
80 ;;
81 (defun test-https-server
82     (&key (port 8080)
83     (cert "/home/david/newcert.pem")
84     (key "/home/david/newkey.pem"))
85   (format t "~&SSL server listening on port ~d~%" port)
86   (trivial-sockets:with-server (server (:port port))
87     (loop
88       (let* ((socket (trivial-sockets:accept-connection
89           server
90           :element-type '(unsigned-byte 8)))
91        (client (cl+ssl:make-ssl-server-stream
92           socket
93           :external-format '(:iso-8859-1 :eol-style :lf)
94           :certificate cert
95           :key key)))
96   (unwind-protect
97       (progn
98         (loop :for line = (read-line-crlf client nil)
99         :while (> (length line) 1) :do
100         (format t "HTTPS> ~a~%" line))
101         (format client "HTTP/1.0 200 OK~%")
102         (format client "Server: SSL-CMUCL/1.1~%")
103         (format client "Content-Type: text/plain~%")
104         (terpri client)
105         (format client "G'day at ~A!~%"
106           (multiple-value-list (get-decoded-time)))
107         (format client "CL+SSL running in ~A ~A~%"
108           (lisp-implementation-type)
109           (lisp-implementation-version)))
110     (close client))))))