cl-rw

commit d909aa587d009047ba1bf0c8cc86a26b791cf90c
parent 5f2c8e45b03d594345aee3d1fb60339965f8e848
Author: Tomas Hlavaty <tom@logand.com>
Date:   Sat,  1 Nov 2014 10:09:29 +0100

make-openssl-client and make-gnutls-client added

Diffstat:
M
net.lisp
 | 
51
+++++++++++++++++++++++++++++++++++++++++++++++++--

1 file changed, 49 insertions(+), 2 deletions(-)
diff --git a/net.lisp b/net.lisp
@@ -23,8 +23,10 @@
 (defpackage :rw.net
   (:use :cl)
   (:export :curl
-           :wget
-           :download-rss))
+           :download-rss
+           :make-openssl-client
+           :make-gnutls-client
+           :wget))
 
 (in-package :rw.net)
 
@@ -75,3 +77,48 @@
           rss)))))
 
 ;;(download-rss "http://www.spiegel.de/international/index.rss")
+(defun make-openssl-client (host port &key starttls)
+  (rw.os:make-program :stream :stream "openssl"
+                      `("s_client"
+                        "-quiet"
+                        "-no_ssl2" "-no_ssl3" "-no_tls1" "-no_tls1_1"
+                        "-connect" ,(format nil "~a:~d" host port)
+                        ,@ (ecase starttls
+                             ((nil))
+                             #+nil ;; TODO starttls
+                             ((:smtp :pop3 :imap :ftp :xmpp)
+                              `("-starttls" ,(string-downcase starttls)))))
+                      nil))
+
+#+nil
+(rw.os:with-program-io (i o (make-openssl-client "wikipedia.org" 443))
+  (write-string "GET / HTTP/1.0" i)
+  (write-char #\return i)
+  (write-char #\linefeed i)
+  (write-char #\return i)
+  (write-char #\linefeed i)
+  (finish-output i)
+  (rw:till (rw:peek-reader (rw:char-reader o))))
+
+(defun make-gnutls-client (host port &key starttls) ;; TODO remove junk output
+  (rw.os:make-program :stream :stream "gnutls-cli"
+                      `("--crlf"
+                        "-p" ,(format nil "~d" port) ,host
+                        ,@ (ecase starttls
+                             ((nil))
+                             #+nil ;; TODO starttls
+                             ((:smtp :pop3 :imap :ftp #+nil :xmpp)
+                              `("-starttls"
+                                ,(format nil "-~(~a~)" starttls)))))
+                      nil))
+
+;;- Simple Client Mode:
+#+nil
+(rw.os:with-program-io (i o (make-gnutls-client "wikipedia.org" 443))
+  (write-string "GET / HTTP/1.0" i)
+  (write-char #\return i)
+  (write-char #\linefeed i)
+  (write-char #\return i)
+  (write-char #\linefeed i)
+  (finish-output i)
+  (rw:till (rw:peek-reader (rw:char-reader o))))