(defpackage i2pher (:use cl))
(in-package i2pher)

;;; #'serve uses spawned openbsd-nc process processes
;;; But the #'make-load-form method recursive serialization is good on its own
;;;These are geared at serving via a generic i2pd server tunnel config.
(defvar *local-port* 54321)
(defvar *local-address* "127.0.0.1")
(defvar *foreign-port* 54321)
(defvar *foreign-address* "localhost")

(defclass gopher ()
 ((item-type :initarg :item-type :reader item-type)
  (item-description :initarg :item-description :reader item-description)
  (item-specifier :initarg :item-specifier :reader item-specifier)
  (in-memory :initarg :in-memory :reader in-memory)
  (server :initarg :server :reader server)
  (port :initarg :port :accessor port))
 (:default-initargs :item-type 0 :port *foreign-port* :server *foreign-address*)
 (:documentation "
(make-instance 'gopher :item-type :item-description :item-specifier
 :in-memory :server :port )
Intends to make an in-memory gopher item whose content is the type 0
text (potentially other sequence) given by :in-memory.
Intended to be added to a gophermap via #'spawn
"))

(defmethod make-load-form ((obj gopher) &optional env) "
Admittedly locally tramples 'new-gopher
"
 (declare (ignore env))
 (multiple-value-bind (allocation slots)
  (make-load-form-saving-slots obj)
  (setf (second allocation) `(find-class ',(class-name (class-of obj))))
  (mapc (lambda (x) (setf (second (second x)) 'new-gopher)) (cdr slots))
  `(let ((new-gopher ,allocation))
    ,slots
    (values new-gopher))))

(defclass gophermap (gopher)
 ((item-type :initform 1)
  (litter :initarg :litter :type 'list :accessor litter)
  (lock :initform (mp:make-lock) :reader lock)
  (filename :initarg :filename :reader filename)
  (in-memory :initform nil))
 (:default-initargs :litter (list) :item-specifier '(:map))
 (:documentation "
(make-instance 'gophermap :filename :item-description (:item-specifer '(:map)))
 is the central class of i2pher.
Whence, gophers can spawn from it using #'spawn,
it can be persisted to disk using #'save (recursively (make-load-form)s)
Or can be #'serve -d
"))

(defmethod make-load-form ((obj gophermap) &optional env)
 (declare (ignore env))
 (let* ((gopher-load-form (call-next-method))
        (setf-slots (cdaddr gopher-load-form)))
  (dolist (s setf-slots)
   (case (cadar (cddadr s))
    ('litter
     (setf (third s) 
      (append '(list) `(,@(mapcar 'make-load-form (cadr (third s)))))))
    ('lock (setf (third s) '(mp:make-lock)))))
  (values gopher-load-form)))

(defmethod in-memory ((obj gophermap))
 (let ((properties (mapcar (lambda (x) (mapcar (lambda (y) (funcall y x)) 

	    	       '(item-type item-description item-specifier server port)))
   		    (litter obj))))
 (print properties)
 (format nil "~{~{~d~a	 ~s	~a	~d~%~}~%~}" properties)))

(defmethod spawn ((obj gophermap) item-type item-description item-specifier in-memory) "
(spawn (obj gophermap) item-type item-description item-specifier in-memory)
Adds the pursuant gopher details to a gophermap.
in-memory should be the text of the (item type 0).
"
 (push (make-instance 'gopher :item-type item-type :item-description item-description 
			     :item-specifier item-specifier :in-memory in-memory)
      (litter obj)))

;;;-------trying to make sure external processes end, in general.
(defvar *external-process-checkins* (list))
(defvar *ext-procs-lock* (mp:make-lock))

(defun make-checkin (external-process) "
(make-checkin external-process)
Erratically eventually signal processes to stop
(which should be due to client misbehaviour)
This is achieved by putting a closure somewhere the process in
*natural-killer* periodically bothers.
"
 (mp:with-lock (*ext-procs-lock*)
  (push 
   (let ((count 0))
    (lambda () (mp:with-lock (*ext-procs-lock*)
                (if (zerop count) (incf count)
                   (progn (si:killpid (ext:external-process-pid external-process)
                             ext:+SIGHUP+) (values))))))
   *external-process-checkins*)))

(defvar *natural-killer*
 (mp:process-run-function (gensym) (lambda ()
  (loop (sleep (1+ (random 5)))
   (setq *external-process-checkins*
    (mapcan (lambda (x) (when (funcall x) (list x))) *external-process-checkins*))))))
;;;----------------------------------------------------------------------

(defmethod serve ((obj gophermap)) "
A multithreaded shell server using openbsd-netcat.
Should actually be called via (add-thread gophermap)
after which threads will be in *threads*.
Writes a sequence of items delimited as org mode sections by item descriptions
from
(responses 
            (remove-if-not (lambda (x) (subsetp item-specifier (item-specifier x) :test 'equalp))
                 (append (list obj) (litter obj))))
followed by
.
#\eot
(force-output)
after which, threads are eventually signalled to hang up in case the client is behaving badly.
Figure out the distribution by which they are hung up without looking ;p
Hopefully a client punctually hangs up upon receiving eot, but not guarunteed.
"
 (multiple-value-bind (stream status external-process)
  (ext:run-program "nc" `("-v" "-l" ,*local-address* ,(format nil "~d" *local-port*)) :wait nil)
  (unwind-protect (progn
   (assert (null status))
   (let ((nc-verbose (print (read-line (two-way-stream-input-stream stream))))
         (expecting (format nil "Listening on localhost ~d" *local-port*)))
    (unless (string=  nc-verbose expecting) (return-from serve)))
   (let ((nc-verbose (print (read-line (two-way-stream-input-stream stream))))
         (expecting "Connection received on localhost "))
    (unless (string= expecting (subseq nc-verbose 0 33)) (return-from serve)))
   (make-checkin external-process)
   (mp:with-lock ((lock obj))
    (let* ((unused-char (peek-char #\( #|)|# (two-way-stream-input-stream stream)))
           (item-specifier (let ((*read-eval* nil)) (read (two-way-stream-input-stream stream))))
           (unused (print item-specifier))
           (responses 
            (remove-if-not (lambda (x) (subsetp item-specifier (item-specifier x) :test 'equalp))
                 (append (list obj) (litter obj)))))
     (print (mapcar 'item-description responses)) (terpri)
     (format (two-way-stream-output-stream stream) "~{~{~A~%	~s~%~A~%~}~}"
      (mapcar (lambda (x) (list (item-description x) (item-specifier x) (in-memory x)))
             responses))
     (format (two-way-stream-output-stream stream) "~%.~%")
     (write-char #\eot (two-way-stream-output-stream stream))
     (force-output (two-way-stream-output-stream stream)))))
   (progn (format t "Hanging up on ~d~%..." (ext:external-process-pid external-process))
    (princ (si:killpid (ext:external-process-pid external-process) ext:+SIGHUP+))
    (terpri)
    (ext:external-process-wait external-process)
    (format t "Hung up~%utime: ~d~%" (get-universal-time))))))

;;;--------------------------------multithreading-----------------
(defvar *threads* (list))
(defun add-thread (gophermap)
 (push (mp:process-run-function (gensym) (lambda ()
        (loop
         (let ((err (nth-value 1 (ignore-errors (serve gophermap)))))
          (when err (print err))))))
  *threads*))
;;;--------------------------------multithreading-----------------
;;;----------------fileops-----
(defmethod save ((obj gophermap)) "
(save (obj gophermap))
writes (make-load-form obj) to (filename obj).
This will run out of stack if there are cycles in the local gophermap lineage
because it recursively fills in its children (who must be local).
"
 (mp:with-lock ((lock obj))
  (with-open-file (out (filename obj) :direction :output)
   (prin1 (make-load-form obj) out) (terpri out))))
;;;----------------------------

;;;Smoking
(defun test ()
 (let ((gopher (make-instance 'gopher :item-type 0 :item-description "foo" :item-specifier '("bar") :in-memory "baz")))
  (make-load-form (eval (make-load-form gopher)))))

(defun test2 ()
 (setq *goma* (make-instance 'gophermap :item-specifier '(:map) :item-description "Test gophermap"))
 (spawn *goma* 0 "Description" '(:item-specifier) "in-memory")
 (spawn *goma* 0 "Description" '(:item-specifier) "in-memory")
 (in-memory *goma*)
 (terpri))

(defun test3 ()
 (setq *goma* (make-instance 'gophermap :item-specifier '(:map) :item-description "Test gophermap"))
 (spawn *goma* 0 "Description" '(:item-specifier) "in-memory")
 (spawn *goma* 0 "Description" '(:item-specifier) "in-memory")
 (add-thread *goma*))

(defun test4 ()
 (let ((goma (make-instance 'gophermap :item-specifier '(:map) :item-description "test gophermap"
        :filename "test.txt")))
  (multiple-value-bind (a b) (make-load-form-saving-slots goma)
   (print a)
   (print b)
   (terpri))))

(defun test5 ()
 (let ((goma (make-instance 'gophermap :item-specifier '(:map) :item-description "test gophermap"
        :filename "test.txt")))
  (print (make-load-form goma))))

(defun test6 ()
 (let ((goma (make-instance 'gophermap :item-specifier '(:map) :item-description "test gophermap"
        :filename "test.txt")))
  (spawn goma 0 "Description" '(:item-specifier) "in-memory")
  (print (make-load-form goma)))
 (values))