#|
Seeing xiled taking gopheresponsibility with his cook new server, and
realising that phlogs like stug's sumo records are being updated
upstream gopher.club tunnels, I'm running a server I wrote
again. tl;dr it's (how confusing is usocket!) (this is because usocket
is just sb-bsdsockets frankensteined into other lisp compilers).

Specifically I wanted to use openbsd's libc. But I'm not actually sure
what usocket needs from me to work (in ecl on openbsd). Hopefully
someone knows! I'll talk about it on the lispy gopher show.

7991 is my meta-arpa assigned port and how you are visiting this
lynx gopher://beastie.sdf.org:7991/1/
|#
;;;;ontape.lisp
;;;Interrupting is messy because usocket tramples condition handling.

(in-package "ONTAPE")

(ffi:clines "
#include <stdlib.h>
")

(defparameter *delay* 0.5)
(defparameter *host* "beastie.sdf.org")
(defparameter *port* 7991)
(defparameter *timeout* 5)

(defun serve-gopher ()
 (usocket:with-socket-listener 
         (listener *host* *port* :reuse-address t)
  (loop named waiting 
   for responses = *responses* 
   do (usocket:with-connected-socket 
              (socket (usocket:socket-accept listener))
       (awhen (usocket:wait-for-input socket :timeout *timeout*)
        (let* ((bivalent (usocket:socket-stream it)))
         (sleep *delay*)
         (unwind-protect 
          (awhen 
           (loop named response-getter
            for x from 0 for ch? = (read-char-no-hang bivalent)
            do (setf responses (when ch? 
                                (remove-if-not 
                                 (lambda (w) 
                                  (char= ch? (char (car w) x)))
                                 responses)))
            when (< (length responses) 2) 
            return (prog1 (cdar responses)
                    (format t "~@{~a~^ ~}~%" 
                     (usocket:get-peer-address socket) 
                     (get-universal-time)
                     (caar responses))))
           (princ it bivalent) (terpri bivalent)
           (force-output bivalent))
          (continue 'waiting))))))))

(defun softboil-gopher (&optional
                        (to-file #p"~/common-lisp/ontape/softboiled.lisp") 
                        &aux
                        (file-list (sort (directory #p"phlogs/*.*")
                                    (lambda (a b)
                                     (> (file-write-date a)
                                        (file-write-date b))))))
 (with-open-file (out to-file :direction :output)
  (format out "
(in-package \"ONTAPE\")
(defvar *responses*
'(" #|))|# )
  (let ((keys (loop for f in file-list
               for key = (format nil "~a~a~a" (enough-namestring f)
                          #\return #\newline)
               for body = (with-open-file (in f)
                           (format nil "~{~a~^~%~}~%.~%"
                            (loop for line = (read-line in nil nil)
                             while line collect line)))
               do (format out "(~s . ~s)~%" key body)
               collect key)))
   (format out "(\"/\" . \"~{~{~a~a	~a	~a	~d~a~}~%~}\""
    (mapcar (lambda (k)
             (let* ((f (pathname k))
                    (ftype (pathname-type f))
                    (type-char (if ftype #\0 #\1))
                    (desc (subseq k 0 (- (length k) 2)))
                    (spec (subseq k 0 (- (length k) 2)))
                    (srv *host*)
                    (port *port*))
              (list type-char desc spec srv port #\return)))
     keys)))
  (princ #|((|# ")))" out)))
 
 #| I'm not sure what usocket's requirements are.
 (unless (zerop (ffi:c-inline () () :int 
                 "pledge(\"inet stdio unix\")" :one-liner t))
  (error "pledge"))
 (unless (zerop (ffi:c-inline () () :int 
                 "unveil(\"/\",\"\")" :one-liner t))
  (error "unveil"))
|#
(unwind-protect (serve-gopher) (si:quit))