1 ;;; --------------------------------------------------------------------------
2 ;;; CLFSWM - FullScreen Window Manager
4 ;;; --------------------------------------------------------------------------
5 ;;; Documentation: Client/server connection.
6 ;;; The connection is crypted and you can only connect to the server with the
7 ;;; same clfswm binary.
8 ;;; --------------------------------------------------------------------------
10 ;;; (C) 2012 Philippe Brochard <pbrochard@common-lisp.net>
12 ;;; This program is free software; you can redistribute it and/or modify
13 ;;; it under the terms of the GNU General Public License as published by
14 ;;; the Free Software Foundation; either version 3 of the License, or
15 ;;; (at your option) any later version.
17 ;;; This program is distributed in the hope that it will be useful,
18 ;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
19 ;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
20 ;;; GNU General Public License for more details.
22 ;;; You should have received a copy of the GNU General Public License
23 ;;; along with this program; if not, write to the Free Software
24 ;;; Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
26 ;;; --------------------------------------------------------------------------
28 ;;; Server -> Client: orig_key=a generated key crypted with *key*
29 ;;; Client : build its new_key with orig_key+*key*
30 ;;; Client -> Server: new_key+(md5 new_key) crypted with new_key
31 ;;; Server -> Client: check if the keys match and then authenticate the client.
32 ;;; Server <-> Client: All connections are crypted with new_key
33 ;;; --------------------------------------------------------------------------
35 (in-package :common-lisp-user
)
37 (defpackage :clfswm-client
38 (:use
:common-lisp
:crypt
)
39 (:export
:start-client
))
41 (in-package :clfswm-client
)
44 #+(or clisp cmu
) (ext:quit
)
49 #+(or allegro-cl allegro-cl-trial
) (excl:exit
)
53 ;;(defparameter *server-port* 33333)
55 (defun print-output (sock &optional wait
)
56 (when (or wait
(ignore-errors (listen sock
)))
57 (let ((line (ignore-errors (string-trim '(#\newline
) (read-line sock nil nil
)))))
59 (format t
"~&~A" (decrypt line
*key
*))
63 (defun quit-on-command (line sock
)
64 (when (member line
'("quit" "close" "bye") :test
#'string-equal
)
65 (loop for line
= (read-line sock nil nil
)
67 do
(format t
"~&~A" (decrypt line
*key
*))
73 (defun parse-args (sock args
)
74 (unless (string= args
"")
75 (multiple-value-bind (form pos
)
76 (read-from-string args
)
77 (let ((str (format nil
"~A" form
)))
78 (format t
"~A~% " str
)
79 (format sock
"~A~%" (crypt str
*key
*))
82 (quit-on-command str sock
)
83 (parse-args sock
(subseq args pos
))))))
86 (defun start-client (args &optional
(url "127.0.0.1") (port clfswm
::*server-port
*))
88 (let* ((sock (port:open-socket url port
))
89 (key (string-trim '(#\Newline
#\Space
) (decrypt (read-line sock nil nil
) *key
*))))
90 (setf *key
* (concatenate 'string key
*key
*))
91 (write-line (crypt (format nil
"~A~A" *key
* (md5:md5
*key
*)) *key
*) sock
)
99 (let ((line (read-line)))
100 (write-line (crypt line
*key
*) sock
)
102 (quit-on-command line sock
)))