Replaces tail-call with loop.

README

@@ -65,47 +65,17 @@ at /usr/lib/x86_64-linux-gnu.
 
 First, try it out.
 
---8<-------------------------------------------------------->8---
 $ cd /path/to/loop/home
-$ ./loop --help
+$ ./loop
-NAME:
-  loop - An NNTP server for a circle of friends.
-
-USAGE:
-  loop [options] [arguments ...]
-
-OPTIONS:
-      --change-passwd <VALUE>   <username> <new-password> changes password
-      --create-account <VALUE>  <username> <invited-by> creates a new account
-      --help                    display usage information and exit
-      --logging                 turn on debug logging on stderr
-      --version                 display version and exit
-  -l, --list-accounts           lists accounts
-  -r, --repl                    run a REPL on port 4006
-  -s, --server                  runs NNTP server reading from stdout
-
-AUTHORS:
-  Circling Skies <loop@antartida.xyz>
-
-LICENSE:
-  GPL v3
---8<-------------------------------------------------------->8---
-
-You can talk to the NNTP server with -s:
-
---8<-------------------------------------------------------->8---
-$ ./loop -s
 200 Welcome! Say ``help'' for a menu.
 quit
 205 Good-bye.
---8<-------------------------------------------------------->8---
 
-It's time to create an account for you.  Whenever you run loop, make
+It runs.  Whenever you run loop, make sure you're in its home
-sure you're in its home directory because it will look for the file
+directory because it will look for the file accounts.lisp always
-accounts.lisp always relatively to the current working directory of
+relatively to the current working directory of the process.  The same
-the process.  The same applies if you set up a cron job later
+applies if you set up a cron job later on---make sure the job, too,
-on---make sure the job, too, sets LOOP's home directory as its current
+sets LOOP's home directory as its current working directory.
-working directory.
 
 (*) Create your account
 
@@ -151,6 +121,28 @@ never done this, it will be better education if you learn to use
 daemontools and ucspi-tcp before going live with a LOOP community.
 It's easy and fun.
 
+(*) LOOP's REPL
+
+LOOP is totally hackable.  Even if you're remotely connected, you can
+have total control over the loop process with the repl command:
+
+$ telnet example.com 119
+Trying example.com...
+Connected to example.com.
+Escape character is '^]'.
+200 Welcome! Say ``help'' for a menu.
+login you <secret>
+200 Welcome, YOU.
+repl
+LOOP> *client*
+#S(CLIENT :GROUP NIL :ARTICLE 1 :USERNAME YOU :AUTH? YES)
+LOOP> (list-groups)
+(comp.editors.emacs comp.lisp comp.programming comp.unix
+       humanities.poetry local.control.news local.havoc local.system.reports
+       local.test local.users.evalu math.calculus math.havoc)
+LOOP> quit
+200 Okay, no more REPL hacking.
+
 (*) Cron jobs
 
 If you'd like to remove inactive accounts, we wrote

loop.lisp

@@ -12,6 +12,7 @@
   (:import-from :lisp-unit define-test)
   (:import-from :org.shirakumo.filesystem-utils 
                 directory-p list-directories list-files)
+  (:import-from :sb-sys interactive-interrupt)
   (:export :main))
 
 (in-package #:loop)
@@ -190,13 +191,27 @@
   (in-package :loop)
   (loop
     (print/finish "LOOP> ")
-    (let ((expr (read)))
+    (handler-case     
-      (if (eq 'quit expr)
+        (let ((expr (read)))
-          (return 
+          (if (eq 'quit expr)
-            (make-response 
+              (progn
-             :code 200 :request r 
+                ;; At this point, there's a newline still in the stdin due
-             :data "Okay, no more REPL hacking."))
+                ;; to read having returned an expression, so we must wipe
-          (println "~a" (eval expr))))))
+                ;; that out.
+                (clear-input)
+                (return 
+                  (make-response 
+                   :code 200 :request r 
+                   :data "Okay, no more REPL hacking.")))
+              (println "~a" (eval expr))))
+      (end-of-file () 
+        (print/finish "^D~%")
+        (uiop:quit 0))
+      (interactive-interrupt () 
+        (print/finish "^C~%")
+      (uiop:quit 0))
+      (t (c) 
+        (print/finish "Oops: ~a~%" c)))))
 (defun empty-response () (make-response :code 400 :data "I beg your pardon?"))
 (defun prepend-response-with (message r)
   (make-response 
@@ -1278,6 +1293,16 @@
           (if okay?
               (println "Okay, account ~a now has password ``~a''." username new-passwd)
               (println "Sorry, could not change password: ~a." problem))))))
+(defun cli/main-with-handlers (cmd)
+  (handler-case 
+      (cli/main cmd)
+    (end-of-file ()
+      (print/finish "^D~%")
+      (uiop:quit 0))
+    (interactive-interrupt ()
+      (print/finish "^C~%")
+      (uiop:quit 0))))
+
 (defun cli/main (cmd)
   (read-accounts!)
   (connect-index! "message-id.db")
@@ -1296,25 +1321,26 @@
     (when pa
       (cli/change-passwd pa args))
     (when repl
-      (repl))
+      (repl (make-request :verb "repl" :args '(command-line))))
-    (when (and (not la) (not ca) (not pa))
+    (when (and (not la) (not ca) (not pa) (not repl))
       (server-start))))
 
 (defun cli/command ()
   (clingon:make-command
    :name "loop"
    :description "An NNTP server for a circle of friends."
-   :version "0.1" ;; :authors '("Circling Skies <loop@antartida.xyz>")
+   :version "0.1"
    :license "GPL v3"
    :options (cli/options)
-   :handler #'cli/main))
+   :handler #'cli/main-with-handlers))
 
 (defun main-loop ()
-  (let* ((bs (nntp-read-line))
+  (loop
-         (ln (bytes->string (ucs-2->ascii bs))))
+    (let* ((bs (nntp-read-line))
-    (let ((r (send-response! (dispatch-line ln))))
+           (ln (bytes->string (ucs-2->ascii bs))))
-      (when (not (response-quit? r))
+      (let ((r (send-response! (dispatch-line ln))))
-        (main-loop)))))
+        (when (response-quit? r)
+          (return))))))
 
 (defun request-quit? (r) (and r (string= 'quit (request-verb r))))
 (defun response-quit? (r) (and r (request-quit? (response-request r))))

loop.nw

@@ -377,21 +377,54 @@ LOOP> (list-groups)
 (local.control.news local.test)
 \end{verbatim}
 
-We implement it by creating a [[repl]] procedure in \lp's package with
+The REPL can also be use in the middle of an NNTP conversation, which
-an option handled by [[cli/command]].
+is useful for debugging.  All authenticated users can use it, making
+passwords only a barrier to spammers, not to your circle of friends,
+since everyone can find a way to log in with anyone's account, change
+their passwords or just do whatever they want to \lxxp\ process or
+databases.
+
+As the comment below explains, we need to [[clear-output]] in the
+[[*standard-input*]] to avoid the following problem:
+%
+\begin{verbatim}
+repl
+LOOP> quit
+200 Okay, no more REPL hacking.
+400 I beg your pardon?
+\end{verbatim}
+%
+What happens is that [[read]] consumes just the symbol \verb|quit|, so
+there remains a \verb|\n| or \verb|\r\n| in the [[*standard-input*]],
+which we need to wipe out, or [[nntp-read-line]] will consume an empty
+line, which is what causes that 400 response.
 
 <<Loop's REPL>>=
 (defun repl (r)
   (in-package :loop)
   (loop
     (print/finish "LOOP> ")
-    (let ((expr (read)))
+    (handler-case     
-      (if (eq 'quit expr)
+        (let ((expr (read)))
-          (return 
+          (if (eq 'quit expr)
-            (make-response 
+              (progn
-             :code 200 :request r 
+                ;; At this point, there's a newline still in the stdin due
-             :data "Okay, no more REPL hacking."))
+                ;; to read having returned an expression, so we must wipe
-          (println "~a" (eval expr))))))
+                ;; that out.
+                (clear-input)
+                (return 
+                  (make-response 
+                   :code 200 :request r 
+                   :data "Okay, no more REPL hacking.")))
+              (println "~a" (eval expr))))
+      (end-of-file () 
+        (print/finish "^D~%")
+        (uiop:quit 0))
+      (interactive-interrupt () 
+        (print/finish "^C~%")
+      (uiop:quit 0))
+      (t (c) 
+        (print/finish "Oops: ~a~%" c)))))
 @ %def repl
 
 \section{Description of the package}
@@ -598,11 +631,12 @@ itself---so we can cascade actions based on a user's request.
 
 <<Main loop>>=
 (defun main-loop ()
-  (let* ((bs (nntp-read-line))
+  (loop
-         (ln (bytes->string (ucs-2->ascii bs))))
+    (let* ((bs (nntp-read-line))
-    (let ((r (send-response! (dispatch-line ln))))
+           (ln (bytes->string (ucs-2->ascii bs))))
-      (when (not (response-quit? r))
+      (let ((r (send-response! (dispatch-line ln))))
-        (main-loop)))))
+        (when (response-quit? r)
+          (return))))))
 
 (defun request-quit? (r) (and r (string= 'quit (request-verb r))))
 (defun response-quit? (r) (and r (request-quit? (response-request r))))
@@ -702,6 +736,16 @@ to do that yet.
 Now let's write the main procedure in command-line parsing.
 
 <<Command-line parsing>>=
+(defun cli/main-with-handlers (cmd)
+  (handler-case 
+      (cli/main cmd)
+    (end-of-file ()
+      (print/finish "^D~%")
+      (uiop:quit 0))
+    (interactive-interrupt ()
+      (print/finish "^C~%")
+      (uiop:quit 0))))
+
 (defun cli/main (cmd)
   (read-accounts!)
   (connect-index! "message-id.db")
@@ -720,18 +764,18 @@ Now let's write the main procedure in command-line parsing.
     (when pa
       (cli/change-passwd pa args))
     (when repl
-      (repl))
+      (repl (make-request :verb "repl" :args '(command-line))))
-    (when (and (not la) (not ca) (not pa))
+    (when (and (not la) (not ca) (not pa) (not repl))
       (server-start))))
 
 (defun cli/command ()
   (clingon:make-command
    :name "loop"
    :description "<<Description>>"
-   :version "<<Version>>" ;; :authors '("Circling Skies <loop@antartida.xyz>")
+   :version "<<Version>>"
    :license "GPL v3"
    :options (cli/options)
-   :handler #'cli/main))
+   :handler #'cli/main-with-handlers))
 @ %def cli/options cli/command
 
 \section{Request dispatching mechanism}
@@ -1982,11 +2026,10 @@ all or it has been discussed with the community beforehand.
 
 \subsection{{\tt REPL}}
 
-Opens a REPL for the pleasure of hacking \lp.  The only thing we
+\lp\ is totally {\em hackable}.  Users can say {\tt repl} to have
-require is that the user be authenticated.  This means that any user
+complete control over their \lxxp\ process.  XXX: we should implement
-has total control over \lp. XXX: implement an option
+an option [[--disable-repl]] so that REPL hacking is turned off.
-[[--disable-repl]] so that REPL hacking is turned off.  (This would
+(This would mean your users are not true hackers.)
-mean your users are not true hackers.)
 
 <<Command repl>>=
 (defun cmd-repl (r)
@@ -2687,6 +2730,7 @@ something to think about.
   (:import-from :lisp-unit define-test)
   (:import-from :org.shirakumo.filesystem-utils 
                 directory-p list-directories list-files)
+  (:import-from :sb-sys interactive-interrupt)
   (:export :main))
 
 (in-package #:loop)