Захотелось странного. Давно Lisp покоя не дает. С некоторой периодичностью возвращаюсь к теме, просидев два дня над книжками по лиспу, - получаю дикую головную боль (думать начинаю, что ли?...) - и снова забрасываю в долгий ящик.

Сегодня вот очередное обострение случилось. Весь день был посвящен сочинению работающего приложения из серии "Hello, World!". Сочинить так и не сложилось, зато нашел и успешно запустил че-то готовый вариант echo-сервера в качестве работающего примера.

Времени убил уйму. Голова больше ничего не соображает - зато цель достигнута.

По ссылке дальше - собственно, код примера. Красота не знает границ...

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60

(require :sb-bsd-sockets)
 
(defpackage echo-server
  (:use :cl :sb-bsd-sockets))
 
(in-package echo-server)
 
(defvar *port* 7000)
 
(defun make-echoer (stream id disconnector)
  (lambda (_)
    (declare (ignore _))
    (handler-case
        (let ((line (read-line stream)))
          (setf line (subseq line 0 (1- (length line))))
          (cond ((string= line "quit")
                 (funcall disconnector))
                (t
                 (format t "~a: ~a~%" id line)
                 (format stream "~a: ~a~%" id line)
                 (force-output stream))))
      (end-of-file ()
        (funcall disconnector)))))
 
(defun make-disconnector (socket id)
  (lambda ()
    (let ((fd (socket-file-descriptor socket)))
      (format t "~a: closing~%" id)
      (sb-impl::invalidate-descriptor fd)
      (socket-close socket))))
 
(defun serve (socket id)
  (let ((stream (socket-make-stream socket :output t :input t))
        (fd (socket-file-descriptor socket)))
    (sb-impl::add-fd-handler fd
                             :input
                             (make-echoer stream
                                          id
                                          (make-disconnector socket id)))))
 
(defun echo-server (&optional (port *port*))
  (let ((socket (make-instance 'inet-socket :type :stream :protocol :tcp))
        (counter 0))
    (socket-bind socket #(127 0 0 1) port)
    (socket-listen socket 5)
    (sb-impl::add-fd-handler (socket-file-descriptor socket)
                             :input
                             (lambda (_)
                               (declare (ignore _))
                               (incf counter)
                               (format t "Accepted client ~A~%" counter)
                               (serve (socket-accept socket) counter)))))
 
#+sb-thread
(sb-thread:make-thread (lambda ()
                         (echo-server)
                         (loop
                            (sb-impl::serve-all-events))))
#-sb-thread
(echo-server)

Связанные посты