1 ;;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; indent-tabs-mode: NIL -*-
3 ;;; pkgdcl.lisp --- Package definition.
5 ;;; Copyright (C) 2006-2008, Attila Lendvai <attila.lendvai@gmail.com>
7 ;;; This code is free software; you can redistribute it and/or
8 ;;; modify it under the terms of the version 2.1 of
9 ;;; the GNU Lesser General Public License as published by
10 ;;; the Free Software Foundation, as clarified by the
11 ;;; preamble found here:
12 ;;; http://opensource.franz.com/preamble.html
14 ;;; This program is distributed in the hope that it will be useful,
15 ;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
16 ;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
17 ;;; GNU General Public License for more details.
19 ;;; You should have received a copy of the GNU Lesser General
20 ;;; Public License along with this library; if not, write to the
21 ;;; Free Software Foundation, Inc., 51 Franklin St, Fifth Floor,
22 ;;; Boston, MA 02110-1301, USA
24 (in-package :sockets
/cc-tests
)
28 (defparameter *reverser-external-format
* (babel:ensure-external-format
'(:utf-8
:eol-style
:crlf
)))
30 (defun start-reverser-server (&key
(address +loopback
+) (port 4242) (worker-count 4)
31 (external-format *reverser-external-format
*))
32 (bind ((acceptor (make-connection-acceptor "reverser server"
33 'reverser-connection-handler
34 :worker-count worker-count
35 :external-format external-format
)))
38 (startup-acceptor acceptor
:address address
:port port
)
39 ;; TODO until epoll based multiplexing is added
40 (break "Server started, continue to shut it down")
41 ;;(sockets/cc::busy-loop-hack acceptor)
43 (shutdown-acceptor acceptor
)))
46 (defun/cc reverser-connection-handler
(connection)
48 :for line
= (read-line/cc connection nil
:eof
)
49 :until
(or (eq line
:eof
)
50 (zerop (length line
)))
52 (format *debug-io
* "SERVER: read line ~S~%" line
)
53 (write-string/cc
(nreverse line
) connection
)
55 (finish-output connection
)
56 (format *debug-io
* "SERVER: written, looping~%" line
))))
58 (defun start-reverser-client (&key
(address +loopback
+) (port 4242) (worker-count 0)
59 (external-format *reverser-external-format
*))
60 (if (zerop worker-count
)
61 (with-open-socket (stream :remote-host address
:remote-port port
:external-format external-format
)
63 (format *debug-io
* "CLIENT: writing line~%")
64 (write-line "asdf" stream
)
65 (finish-output stream
)
66 (format *debug-io
* "CLIENT: reading answer~%")
67 (format *debug-io
* "CLIENT: at ~A, answer is ~S~%" (get-universal-time) (read-line stream
))
69 (error "TODO not yet")))
71 #+nil
(defun start-reverser-client (&key
(address +loopback
+) (port 4242) ;; (worker-count 4)
72 (external-format *reverser-external-format
*))
73 (bind ((multiplexer (make-connection-multiplexer "reverser client"))
74 (connection (make-client-connection address
:port port
75 :external-format external-format
76 :wait-reason
:write
)))
77 (setf (continuation-of connection
) (with-call/cc
81 (write-line/cc
"asdf" connection
)
82 (finish-output connection
)
83 (format *debug-io
* "~A: ~S" (get-universal-time) (read-line/cc connection
)))))
84 (startup-connection-multiplexer multiplexer
)
85 (register-connection multiplexer connection
)))
88 (defun reverser-client-worker-loop (address port external-format
)
89 (bind ((socket (make-socket :connect
:active
:external-format external-format
))
93 (setf (fd-non-blocking socket
) t
)
94 (bind-address socket
(ensure-hostname address
)
97 (apply 'listen-on socket
(when backlog
98 (list :backlog backlog
)))
99 (setf (socket-of acceptor
) socket
)
100 #+nil
(loop repeat
(worker-count-of acceptor
) do
101 (spawn-worker-thread-for-acceptor acceptor
))