01 ;;; -*- Lisp -*- mode
02 
03 (in-package #:com.paskvil.uhttp)
04 
05 (defun server-start (addr port)
06   "Open a socket at ADDR:PORT for listening.
07    Provided restarts: TRY-NEXT-PORT, can be used with
08    the USOCKET:ADDRESS-IN-USE-ERROR condition."
09   (restart-case (usocket:socket-listen addr port)
10     (try-next-port () (server-start addr (1+ port)))))
11 
12 (defun server-stop (socket)
13   "Close the server socket, or server socket stream."
14   (usocket:socket-close socket))
15 
16 (defun server-wait-for-client (socket)
17   "Function that waits for incoming connections on SOCKET,
18    and returns socket stream for each client."
19   (usocket:socket-accept socket))
20 
21 (defun server-data-ready (stream)
22   "Check whether there are data that can be read on STREAM."
23   (not (eq (listen (usocket:socket-stream stream)) nil)))
24 
25 (defun server-read (stream &key (max-length 0))
26   "Reads at most MAX-LENGTH bytes from the input.
27    If MAX-LENGHT is 0, reads all data available on input."
28   (let ((instr (usocket:socket-stream stream)))
29     (with-output-to-string (str)
30       (do ((len 0 (1+ len))
31            (c (read-char-no-hang instr nil nil)
32               (read-char-no-hang instr nil nil)))
33           ((or (not c)
34                (and (< 0 max-length) (>= len max-length))))
35         (princ c str)))))
36 
37 (defun server-read-line (stream &optional (non-blocking nil))
38   "Reads a single line from a socket STREAM.
39    If NON-BLOCKING is nil, checks whether any data
40    are ready for reading; if none, returns empty string."
41   (let ((line ""))
42     (if non-blocking
43         (when (server-data-ready stream)
44           (setf line (read-line (usocket:socket-stream stream))))
45         (setf line (read-line (usocket:socket-stream stream))))
46     (string-right-trim '(#\Newline #\Return) line)))
47 
48 (defun server-read-all-lines (stream &key (stop-on ""))
49   "Read all data that are waiting to be read from socket STREAM,
50    and return them as a list of strings. If one of the lines read
51    is :STOP-ON string, this line is dropped and reading is stopped."
52   (let (line)
53     (loop while (server-data-ready stream)
54        do (setf line (server-read-line stream))
55        while (string-not-equal line stop-on)
56        collecting line)))
57 
58 (defun server-send (string stream)
59   "Write a STRING to the server's socket STREAM."
60   (print string (usocket:socket-stream stream))
61   (force-output (usocket:socket-stream stream)))
62