com.paskvil.uhttp-server.lisp

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
61

;;; -*- Lisp -*- mode

(in-package #:com.paskvil.uhttp)

(defun server-start (addr port)
  "Open a socket at ADDR:PORT for listening.
   Provided restarts: TRY-NEXT-PORT, can be used with
   the USOCKET:ADDRESS-IN-USE-ERROR condition."
  (restart-case (usocket:socket-listen addr port)
    (try-next-port () (server-start addr (1+ port)))))

(defun server-stop (socket)
  "Close the server socket, or server socket stream."
  (usocket:socket-close socket))

(defun server-wait-for-client (socket)
  "Function that waits for incoming connections on SOCKET,
   and returns socket stream for each client."
  (usocket:socket-accept socket))

(defun server-data-ready (stream)
  "Check whether there are data that can be read on STREAM."
  (not (eq (listen (usocket:socket-stream stream)) nil)))

(defun server-read (stream &key (max-length 0))
  "Reads at most MAX-LENGTH bytes from the input.
   If MAX-LENGHT is 0, reads all data available on input."
  (let ((instr (usocket:socket-stream stream)))
    (with-output-to-string (str)
      (do ((len 0 (1+ len))
           (c (read-char-no-hang instr nil nil)
              (read-char-no-hang instr nil nil)))
          ((or (not c)
               (and (< 0 max-length) (>= len max-length))))
        (princ c str)))))

(defun server-read-line (stream &optional (non-blocking nil))
  "Reads a single line from a socket STREAM.
   If NON-BLOCKING is nil, checks whether any data
   are ready for reading; if none, returns empty string."
  (let ((line ""))
    (if non-blocking
        (when (server-data-ready stream)
          (setf line (read-line (usocket:socket-stream stream))))
        (setf line (read-line (usocket:socket-stream stream))))
    (string-right-trim '(#\Newline #\Return) line)))

(defun server-read-all-lines (stream &key (stop-on ""))
  "Read all data that are waiting to be read from socket STREAM,
   and return them as a list of strings. If one of the lines read
   is :STOP-ON string, this line is dropped and reading is stopped."
  (let (line)
    (loop while (server-data-ready stream)
       do (setf line (server-read-line stream))
       while (string-not-equal line stop-on)
       collecting line)))

(defun server-send (string stream)
  "Write a STRING to the server's socket STREAM."
  (print string (usocket:socket-stream stream))
  (force-output (usocket:socket-stream stream)))