Implements a shell to the loop package.
This commit is contained in:
parent
e8b57771f5
commit
181290f3ff
4 changed files with 110 additions and 51 deletions
8
Makefile
8
Makefile
|
@ -1,8 +1,12 @@
|
|||
default: loop
|
||||
default: loop shell
|
||||
|
||||
loop: loop.asd loop.lisp scripts/build-exe.lisp
|
||||
sbcl --script scripts/build-exe.lisp
|
||||
|
||||
shell: loop.asd loop.lisp scripts/build-shell.lisp
|
||||
sbcl --script scripts/build-shell.lisp
|
||||
|
||||
install: loop
|
||||
mkdir -p `head -1 conf-home` && \
|
||||
cp -R loop accounts.lisp groups scripts `head -1 conf-home`
|
||||
cp -R loop loop-shell accounts.lisp groups scripts \
|
||||
`head -1 conf-home`
|
||||
|
|
23
loop.lisp
23
loop.lisp
|
@ -12,7 +12,7 @@
|
|||
(:import-from :lisp-unit define-test)
|
||||
(:import-from :org.shirakumo.filesystem-utils
|
||||
directory-p list-directories list-files)
|
||||
(:export :main))
|
||||
(:export :main :shell))
|
||||
|
||||
(in-package #:loop)
|
||||
|
||||
|
@ -180,6 +180,25 @@
|
|||
|
||||
(defmacro mac (&rest body)
|
||||
`(macroexpand-1 ,@body))
|
||||
(defun print/finish (&rest args)
|
||||
(apply #'format (cons t args))
|
||||
(finish-output))
|
||||
|
||||
(defun shell ()
|
||||
(in-package :loop)
|
||||
(loop
|
||||
(handler-case
|
||||
(progn
|
||||
(print/finish "LOOP> ")
|
||||
(println "~a" (eval (read))))
|
||||
(sb-sys:interactive-interrupt (c)
|
||||
(declare (ignore c))
|
||||
(sb-ext:exit :code 0))
|
||||
(end-of-file (c)
|
||||
(declare (ignore c))
|
||||
(sb-ext:exit :code 0))
|
||||
(t (c)
|
||||
(println "~a" c)))))
|
||||
(defun empty-response () (make-response :code 400 :data "I beg your pardon?"))
|
||||
(defun prepend-response-with (message r)
|
||||
(make-response
|
||||
|
@ -1120,7 +1139,7 @@
|
|||
(let ((u (get-account username)))
|
||||
(when (not u)
|
||||
(error "I could not find account ~a." username))
|
||||
(setf (account-pass u) (string->sha256 newpass))
|
||||
(setf (account-pass u) (string->sha256 (str:upcase newpass)))
|
||||
(write-accounts!)))
|
||||
|
||||
(defun cmd-list-users (r)
|
||||
|
|
120
loop.nw
120
loop.nw
|
@ -88,10 +88,10 @@ But \lp\ has nothing to do with e-mail. \Lp\ uses a communication
|
|||
strategy---called a ``protocol''---that is even older than the web
|
||||
itself. The web started out around 1989--1990 and the protocol
|
||||
\lp\ uses begins its history in 1979, the year in which AT\&T released
|
||||
UNIX V7, which was UUCP-ready. The name UUCP stands for [U]NIX to
|
||||
[U]NIX [c]o[p]y. It's both a protocol and a set of programs for
|
||||
copying files between UNIX systems. People begun exchanging messages
|
||||
by copying files between machines. The idea eventually evolved into a
|
||||
UNIX V7, which was UUCP-ready, an acronym that stands for for UNIX to
|
||||
UNIX copy. It's both a protocol and a set of programs for copying
|
||||
files between UNIX systems. People begun exchanging messages by
|
||||
copying files between machines. The idea eventually evolved into a
|
||||
protocol called NNTP---Network News Transfer Protocol---, which is the
|
||||
protocol used by \lp. (The protocol used to be called Netnews
|
||||
Transfer Protocol.) Since e-mail was already daily practice of
|
||||
|
@ -136,7 +136,7 @@ network news via NNTP.
|
|||
\label{fg:sylpheed}
|
||||
\end{figure}
|
||||
|
||||
{\bf Principles for a discussion group}. We believe a discussion group
|
||||
\noindent{\bf Principles for a discussion group}. We believe a discussion group
|
||||
should be small and grow slowly. By ``slowly'', we mean that each
|
||||
member comes in through an invitation. This way, the group being
|
||||
closed by definition, we keep spam out and give members a certain
|
||||
|
@ -185,7 +185,7 @@ just want to use the system, you probably should stop right here.
|
|||
|
||||
See \href{https://git.antartida.xyz/loop/srv/raw/branch/main/README}{[[README]]}.
|
||||
|
||||
\section{The implementation strategy}\label{sec:design}
|
||||
\section{Implementation strategy}\label{sec:design}
|
||||
|
||||
Anything a user sends to the \lp\ is wrapped in a [[request]] and
|
||||
any command processing must produce a [[response]]:
|
||||
|
@ -322,21 +322,19 @@ specific such number is determined by the NNTP protocol. But, despite
|
|||
the protocol being made for machines to talk to each other, it's
|
||||
perfectly possible for a user to interact with \lp\ directly using a
|
||||
keyboard and a command-line tool such as {\tt nc} or {\tt telnet}. In
|
||||
fact, \lp\ takes advantage of that to be hackable. \Lp\ was written
|
||||
so that it can talk to NNTP clients---such as Gnus, Sylpheed {\em et
|
||||
cetera}---but also to users directly. Commands such as
|
||||
fact, \lp\ takes advantage of that to be hackable. Commands such as
|
||||
[[CREATE-ACCOUNT]], [[CREATE-GROUP]], [[PASSWD]] are not part of the
|
||||
NNTP protocol, so users need to know how to use {\tt nc} or {\tt
|
||||
telnet} to take advantage of all of \lp's capabilities.
|
||||
|
||||
\section{The NNTP protocol}
|
||||
\section{NNTP protocol}
|
||||
|
||||
An Internet protocol is usually defined by a document whose tradition
|
||||
calls RFC---for ``[r]equest [f]or [c]omments''. The NNTP protocol is
|
||||
defined by RFCs 977, 2980, 3977, 4643 and 5536. RFC 977 was the first
|
||||
and replaced by 3977. Still, reading RFC 977 is interesting precisely
|
||||
because it gives us a historical account of the protocol, making it
|
||||
easier to understanding the evolution of the system. The objective of
|
||||
easier to understand the evolution of the system. The objective of
|
||||
RFC 2980 was to implement new ideas to the NNTP protocol---to extend
|
||||
the protocol. RFC 3977 adopts some of these extensions. RFC 4643
|
||||
also extends RFC 2980---addressing concerns with authentication.
|
||||
|
@ -370,7 +368,42 @@ way, they work together. And \lp\ handles only a text stream, which
|
|||
is why it's so easy to connect a keyboard to it and interact with it
|
||||
through the command line as illustrated in Section~\ref{sec:design}.
|
||||
|
||||
\section{The description of the package}
|
||||
\section{Shell interface to \lp}
|
||||
|
||||
We have a shell to \lp's procedures, but not to a running \lp, though.
|
||||
|
||||
<<build-shell.lisp>>=
|
||||
<<Quicklisp loading preamble>>
|
||||
(ql:quickload :loop)
|
||||
(sb-ext:save-lisp-and-die #P"shell"
|
||||
:toplevel #'loop:shell
|
||||
:executable t
|
||||
:save-runtime-options t)
|
||||
@
|
||||
|
||||
<<Loop's shell>>=
|
||||
(defun print/finish (&rest args)
|
||||
(apply #'format (cons t args))
|
||||
(finish-output))
|
||||
|
||||
(defun shell ()
|
||||
(in-package :loop)
|
||||
(loop
|
||||
(handler-case
|
||||
(progn
|
||||
(print/finish "LOOP> ")
|
||||
(println "~a" (eval (read))))
|
||||
(sb-sys:interactive-interrupt (c)
|
||||
(declare (ignore c))
|
||||
(sb-ext:exit :code 0))
|
||||
(end-of-file (c)
|
||||
(declare (ignore c))
|
||||
(sb-ext:exit :code 0))
|
||||
(t (c)
|
||||
(println "~a" c)))))
|
||||
@
|
||||
|
||||
\section{Description of the package}
|
||||
|
||||
<<Description>>=
|
||||
An NNTP server for a circle of friends.
|
||||
|
@ -382,7 +415,7 @@ An NNTP server for a circle of friends.
|
|||
|
||||
These chunks are used in [[loop.asd]].
|
||||
|
||||
\section{The representation of a client}
|
||||
\section{Representation of a client}
|
||||
|
||||
How do we represent a client? A client is typically reading a group
|
||||
and an article; it's has authenticated itself or not yet. So we need
|
||||
|
@ -394,7 +427,7 @@ a global structure to annonate the client's state.
|
|||
@ %def client *client*
|
||||
|
||||
|
||||
\section{The representation of a command}
|
||||
\section{Representation of a command}
|
||||
|
||||
What does a client typically tell \lp? A client typically sends
|
||||
commands. Commands typically need arguments. Each command is
|
||||
|
@ -461,7 +494,7 @@ commands, which is essentially what the user sees when ask for
|
|||
(or (cdr cmd) (unrecognized-command)))))
|
||||
@ %def *commands-assoc* set-up-tables! get-command
|
||||
|
||||
\section{The representation of requests and responses}
|
||||
\section{Representation of requests and responses}
|
||||
|
||||
Each command is given through a text line written by the user. Let's
|
||||
call this text line the [[request]]. When \lp\ parses the request, it
|
||||
|
@ -538,7 +571,7 @@ else should we handle this?
|
|||
(write-sequence ls-of-bytes s)))
|
||||
@ %def my-write
|
||||
|
||||
\section{The parsing of requests}
|
||||
\section{Parsing of requests}
|
||||
|
||||
The commands themselves we call {\tt verbs} and everything else the
|
||||
user types we call {\tt args}. Observe that upper and lower case
|
||||
|
@ -557,7 +590,7 @@ letters are equivalent in request verbs.
|
|||
:args args))))))
|
||||
@ %def parse-request
|
||||
|
||||
\section{The main loop}
|
||||
\section{Main loop}
|
||||
|
||||
Every command consumes a [[request]] and produces a [[response]]. If
|
||||
any procedure always produces a [[response]], then delivering a
|
||||
|
@ -722,7 +755,7 @@ Now let's write the main procedure in command-line parsing.
|
|||
:handler #'cli/main))
|
||||
@ %def cli/options cli/command
|
||||
|
||||
\section{The request dispatching mechanism}
|
||||
\section{Request dispatching mechanism}
|
||||
|
||||
Dispatching requests means consuming one and invoking the correct
|
||||
procedure that will process the request. The invoked procedure must
|
||||
|
@ -743,7 +776,7 @@ has issued {\tt QUIT}, in which case we terminate [[main-loop]].
|
|||
(dispatch (parse-request (make-request :said ln))))
|
||||
@ %def dispatch dispatch-line
|
||||
|
||||
\section{The representation and parsing of articles}
|
||||
\section{Representation and parsing of articles}
|
||||
|
||||
An article is made of two parts, the head and the body. We do need to
|
||||
parse the head, but we never parse the body: we don't want to
|
||||
|
@ -872,7 +905,7 @@ using [[lookup]]. I need to seek out all such places and organize. %% TODO
|
|||
(cdr (assoc key table :test #'string=)))
|
||||
@ %def extract-mid lookup
|
||||
|
||||
\section{The commands}
|
||||
\section{Commands}
|
||||
|
||||
\subsection{{\tt HELP}}
|
||||
|
||||
|
@ -1969,7 +2002,7 @@ all or it has been discussed with the community beforehand.
|
|||
(values nil "must match <<Form of newsgroup names>>"))))
|
||||
@ %def CREATE-GROUP group-name-conforms?
|
||||
|
||||
\section{The publication of news}
|
||||
\section{Publication of news}
|
||||
|
||||
If you're interested in being notified about what's going on in the
|
||||
\lp, then subscribe to {\tt local.control.news}. Group creation,
|
||||
|
@ -2010,7 +2043,7 @@ invitations {\em et cetera} are published there.
|
|||
:body (data body)))
|
||||
@ %def notify-group-created notify-user-created
|
||||
|
||||
\section{The algorithm of {\tt split-vector}}
|
||||
\section{Algorithm of {\tt split-vector}}
|
||||
|
||||
How should we describe the algorithm of [[split-vector]]? The
|
||||
objective is to consume lists of bytes such as
|
||||
|
@ -2041,7 +2074,7 @@ searching for the next line.
|
|||
(+ pos (length delim))))))))
|
||||
@ %def split-vector
|
||||
|
||||
\section{The index article}\label{sec:index}
|
||||
\section{Article index}\label{sec:index}
|
||||
|
||||
Every NNTP server needs to have an index of articles. Each article is
|
||||
indexed by its message-id. For example, the article
|
||||
|
@ -2185,7 +2218,7 @@ doesn't really support symbolic links.
|
|||
(values grp art))))
|
||||
@ %def insert-index lookup-index
|
||||
|
||||
\section{A procedure to import the index from the file system}
|
||||
\section{Procedure to import the index from the file system}
|
||||
|
||||
%% get group:
|
||||
%% (first (last (pathname-directory (car (in-groups (directory "**/*"))))))
|
||||
|
@ -2224,11 +2257,7 @@ we need to index it.
|
|||
Here's a program to build the index from a UNIX shell.
|
||||
|
||||
<<build-index-from-fs.lisp>>=
|
||||
#-quicklisp
|
||||
(let ((quicklisp-init (merge-pathnames "quicklisp/setup.lisp"
|
||||
(user-homedir-pathname))))
|
||||
(when (probe-file quicklisp-init)
|
||||
(load quicklisp-init)))
|
||||
<<Quicklisp loading preamble>>
|
||||
(ql:quickload :loop :silent t)
|
||||
(in-package #:loop)
|
||||
(connect-index! "message-id.db")
|
||||
|
@ -2266,11 +2295,7 @@ The program [[cron-remove-inactive-users.lisp]] can be executed every
|
|||
day at midnight, say.
|
||||
|
||||
<<cron-remove-inactive-users.lisp>>=
|
||||
#-quicklisp
|
||||
(let ((quicklisp-init (merge-pathnames "quicklisp/setup.lisp"
|
||||
(user-homedir-pathname))))
|
||||
(when (probe-file quicklisp-init)
|
||||
(load quicklisp-init)))
|
||||
<<Quicklisp loading preamble>>
|
||||
(ql:quickload :loop :silent t)
|
||||
(in-package #:loop)
|
||||
(read-accounts!)
|
||||
|
@ -2358,11 +2383,7 @@ New system administrators of \Lp\ will never need to run this.
|
|||
Here's a program to run the migration in a UNIX shell.
|
||||
|
||||
<<migrate-add-creation-date.lisp>>=
|
||||
#-quicklisp
|
||||
(let ((quicklisp-init (merge-pathnames "quicklisp/setup.lisp"
|
||||
(user-homedir-pathname))))
|
||||
(when (probe-file quicklisp-init)
|
||||
(load quicklisp-init)))
|
||||
<<Quicklisp loading preamble>>
|
||||
(ql:quickload :loop :silent t)
|
||||
(in-package #:loop)
|
||||
(migrate-add-creation-and-post-date!)
|
||||
|
@ -2429,7 +2450,7 @@ Now we write the procedures that discover what accounts are inactive.
|
|||
(user-inactive? (account-username u)))))
|
||||
@ %def list-inactive-users
|
||||
|
||||
\section{A special-purpose language to ease writing}\label{sec:dsl}
|
||||
\section{Macros to ease writing}\label{sec:dsl}
|
||||
|
||||
These macros make up a tiny language to ease the writing of \lp. For
|
||||
example, when we need to access the group database, we use
|
||||
|
@ -2587,11 +2608,7 @@ the code.
|
|||
Just say {\tt make loop} to your shell.
|
||||
|
||||
<<build-exe.lisp>>=
|
||||
#-quicklisp
|
||||
(let ((quicklisp-init (merge-pathnames "quicklisp/setup.lisp"
|
||||
(user-homedir-pathname))))
|
||||
(when (probe-file quicklisp-init)
|
||||
(load quicklisp-init)))
|
||||
<<Quicklisp loading preamble>>
|
||||
(ql:quickload :loop)
|
||||
(sb-ext:save-lisp-and-die #P"loop"
|
||||
:toplevel #'loop:main
|
||||
|
@ -2599,6 +2616,14 @@ Just say {\tt make loop} to your shell.
|
|||
:save-runtime-options t)
|
||||
@
|
||||
|
||||
<<Quicklisp loading preamble>>=
|
||||
#-quicklisp
|
||||
(let ((quicklisp-init (merge-pathnames "quicklisp/setup.lisp"
|
||||
(user-homedir-pathname))))
|
||||
(when (probe-file quicklisp-init)
|
||||
(load quicklisp-init)))
|
||||
@ %def quicklisp
|
||||
|
||||
\section{How to get a log of \lp's communication}
|
||||
|
||||
If you invoke \lxxp\ with option [[--logging]], you get logging on
|
||||
|
@ -2636,7 +2661,7 @@ specify in {\tt syslog.conf} the selector {\tt user.notice} and
|
|||
specify a log file such as {\tt /var/log/loop.log}. See {\tt
|
||||
syslog.conf(5)} and {\tt newsyslog(1)} for more information.
|
||||
|
||||
\section{The package {\tt loop.lisp} as the compiler needs it}
|
||||
\section{Package {\tt loop.lisp} as the compiler needs it}
|
||||
|
||||
We now put together all source code chunks in the order the compiler
|
||||
needs to read it. One thing to keep in mind here is---I wonder if
|
||||
|
@ -2665,7 +2690,7 @@ something to think about.
|
|||
(:import-from :lisp-unit define-test)
|
||||
(:import-from :org.shirakumo.filesystem-utils
|
||||
directory-p list-directories list-files)
|
||||
(:export :main))
|
||||
(:export :main :shell))
|
||||
|
||||
(in-package #:loop)
|
||||
|
||||
|
@ -2673,6 +2698,7 @@ something to think about.
|
|||
<<Table of commands>>
|
||||
<<Macros>>
|
||||
<<Little procedures>>
|
||||
<<Loop's shell>>
|
||||
<<Procedures for requests and responses>>
|
||||
<<Essential operations relative to the index>>
|
||||
<<How to create and connect to the index>>
|
||||
|
|
10
scripts/build-shell.lisp
Normal file
10
scripts/build-shell.lisp
Normal file
|
@ -0,0 +1,10 @@
|
|||
#-quicklisp
|
||||
(let ((quicklisp-init (merge-pathnames "quicklisp/setup.lisp"
|
||||
(user-homedir-pathname))))
|
||||
(when (probe-file quicklisp-init)
|
||||
(load quicklisp-init)))
|
||||
(ql:quickload :loop)
|
||||
(sb-ext:save-lisp-and-die #P"shell"
|
||||
:toplevel #'loop:shell
|
||||
:executable t
|
||||
:save-runtime-options t)
|
Loading…
Reference in a new issue