loop/srv
1
0
Fork 0
Code Issues Pull requests Activity

Incorporates format-def, make-release into loop.nw.

Browse source
This commit is contained in:
Circling Skies 2024-12-21 16:35:49 -03:00
parent 3850c72b6d
commit eb2bd3cb36
5 changed files with 158 additions and 81 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

16
Anyfile
View file

@ -12,13 +12,25 @@ loop.exe: scripts/build-exe.lisp loop.lisp loop.asd loop.nw
sbcl --script scripts/build-exe.lisp sbcl --script scripts/build-exe.lisp
(test -f loop.exe && cmp loop loop.exe) || cp loop loop.exe (test -f loop.exe && cmp loop loop.exe) || cp loop loop.exe
loop.lisp: loop.nw loop.lisp: loop.nw format-def
(any tangle -Rloop.lisp < loop.nw | sh format-def | \ (any tangle -Rloop.lisp < loop.nw | sh format-def | \
dos2unix > loop.tmp || \ dos2unix > loop.tmp || \
(rm loop.tmp && exit 1)) && \ (rm loop.tmp && exit 1)) && \
mv loop.tmp loop.lisp mv loop.tmp loop.lisp
release: format-def: loop.nw
(any tangle -Rformat-def < loop.nw | \
dos2unix > format-def.tmp || \
(rm format-def.tmp && exit 1)) && \
mv format-def.tmp format-def
make-release: loop.nw
(any tangle -Rmake-release < loop.nw | \
dos2unix > make-release.tmp || \
(rm make-release.tmp && exit 1)) && \
mv make-release.tmp make-release
release: make-release
./make-release $$(git log --oneline | head -1 | awk '{print $$1}') \ ./make-release $$(git log --oneline | head -1 | awk '{print $$1}') \
loop.nw > loop.tmp && mv loop.tmp loop.nw loop.nw > loop.tmp && mv loop.tmp loop.nw

18
format-def
View file

@ -4,24 +4,12 @@ usage()
printf 'usage: %s [file.lisp]\n' $0 printf 'usage: %s [file.lisp]\n' $0
exit 1 exit 1
} }
## The first program finds certain definitions and inserts a new blank
## line *before* the definition. Such action makes function
## definitions separated by two blank lines in some cases. We then
## remove the excess with the second program. Notice we need the -E
## option because we're using the | metacharacter that is only
## supported by popular sed programs with the -E option. This
## violates POSIX sed, but keep in mind that we only run this when
## releasing the package. This is a building tool, not part of the
## service.
sed -E '/^\(defun |\(defmacro /{ sed -E '/^\(defun |\(defmacro /{
i\ i\
}' "$@" | sed '/^[ \t]*$/{ }' "$@" | \
sed '/^[ \t]*$/{
N N
/^[ \t]*\n$/D /^[ \t]*\n$/D
}' }'
## We first find a blank line. Then we say N to expand the pattern
## space to include the next line. Then we delete the *first* blank
## line and not the second---that's what the D command does. This
## strategy is explained by Dale Dougherty and Arnold Robbins in ``sed
## & awk'' second edition, pages 112--114.

2
loop.lisp
View file

@ -324,7 +324,6 @@
(defun remove-inactive-users! () (defun remove-inactive-users! ()
(loop for u in *accounts* do (loop for u in *accounts* do
(let ((username (account-username u))) (let ((username (account-username u)))
(format t "Username: ~a~%" username)
(cond ((and (not (locked? username)) (cond ((and (not (locked? username))
(inactive-from-never-logged-in? username)) (inactive-from-never-logged-in? username))
(post-notification (post-notification
@ -1463,7 +1462,6 @@
(make-response (make-response
:code 200 :code 200
:data "Welcome! I am LOOP a89e088. Say ``help'' for a menu."))) :data "Welcome! I am LOOP a89e088. Say ``help'' for a menu.")))
(setq lisp-unit:*print-failures* t) (setq lisp-unit:*print-failures* t)
(define-test dispatching (define-test dispatching
(assert-true (equalp (empty-response) (dispatch (make-request))))) (assert-true (equalp (empty-response) (dispatch (make-request)))))

196
loop.nw
View file

@ -75,23 +75,23 @@ the list of destinaries. So long as everyone replies to everyone,
John, too, will start getting all the messages. If anyone violates John, too, will start getting all the messages. If anyone violates
this rule of replying to everyone involved, the loop is broken. this rule of replying to everyone involved, the loop is broken.
%% \begin{figure}[!htb] \begin{figure}[!htb]
%% \centering \includegraphics[width=0.8\linewidth]{images/gnus-summary.png} \centering \includegraphics[width=0.8\linewidth]{images/gnus-summary.png}
%% \caption{Gnus, a news reader embedded in the GNU EMACS text editor.} \caption{Gnus, a news reader embedded in the GNU EMACS text editor.}
%% \label{fg:gnus} \label{fg:gnus}
%% \end{figure} \end{figure}
%%
%% \begin{figure}[!htb] \begin{figure}[!htb]
%% \centering \includegraphics[width=0.8\linewidth]{images/tbird-summary.png} \centering \includegraphics[width=0.8\linewidth]{images/tbird-summary.png}
%% \caption{Thunderbird, a news reader produced by the Mozilla Foundation.} \caption{Thunderbird, a news reader produced by the Mozilla Foundation.}
%% \label{fg:bird} \label{fg:bird}
%% \end{figure} \end{figure}
%%
%% \begin{figure}[!htb] \begin{figure}[!htb]
%% \centering \includegraphics[width=0.8\linewidth]{images/sylpheed-summary.png} \centering \includegraphics[width=0.8\linewidth]{images/sylpheed-summary.png}
%% \caption{Sylpheed, a news reader produced by Hiroyuki Yamamoto.} \caption{Sylpheed, a news reader produced by Hiroyuki Yamamoto.}
%% \label{fg:sylpheed} \label{fg:sylpheed}
%% \end{figure} \end{figure}
There are surely inconveniences in using e-mail as conference medium. There are surely inconveniences in using e-mail as conference medium.
For example, after John has been added to the loop, he is not able to For example, after John has been added to the loop, he is not able to
@ -137,23 +137,22 @@ NNTP-aware programs. You could write your own. Figures
\ref{fg:gnus}--\ref{fg:sylpheed} show a few programs for reading \ref{fg:gnus}--\ref{fg:sylpheed} show a few programs for reading
network news via NNTP. network news via NNTP.
\pdfbookmark[1]{Principles for a discussion group}{principles} \section*{Principles for a discussion group}\label{principles}
\label{principles} \pdfbookmark[1]{Principles for a discussion group}{principles} We
{\bf Principles for a discussion group}. We believe a discussion group believe a discussion group should be small and grow slowly. By
should be small and grow slowly. By ``slowly'', we mean that each ``slowly'', we mean that each member comes in through an invitation.
member comes in through an invitation. This way, the group being This way, the group being closed by definition, we keep spam out and
closed by definition, we keep spam out and give members a certain give members a certain sense of privilege. A discussion group should
sense of privilege. A discussion group should be formed by interested be formed by interested people. If a participant doesn't log-in for a
people. If a participant doesn't log-in for a certain period of time, certain period of time, \lp\ locks the participant's account---see
\lp locks the participant's account---see Section Section \ref{sec:inactive-users}. The account can be reactivated, but
\ref{sec:inactive-users}. The account can be reactivated, but it will it will take asking another participant (with an active account) to do
take asking another participant (with an active account) to do so. In so. In other words, there's an encouragement for an uninterested
other words, there's an encouragement for an uninterested member not member not to come back to the \lp. The idea is to keep a certain
to come back to the \lp. The idea is to keep a certain cohesion in cohesion in the discussion groups. When an account is locked or
the discussion groups. When an account is locked or unlocked, an unlocked, an article is posted to the group {\tt local.control.news},
article is posted to the group {\tt local.control.news}, so everyone so everyone knows who is leaving and arriving. This way, participants
knows who is leaving and arriving. This way, participants get to have get to have an idea of who is reading them.
an idea of who is reading them.
Each invitation comes with a certain responsibility: it's possible to Each invitation comes with a certain responsibility: it's possible to
see who invited who. If {\tt BOB} misbehaves, everyone gets to see see who invited who. If {\tt BOB} misbehaves, everyone gets to see
@ -182,9 +181,11 @@ Hereafter, our conversation continues in Lisp. Understanding how
\lp\ is made is only necessary if you intend to modify it. If you \lp\ is made is only necessary if you intend to modify it. If you
just want to use the system, you probably should stop right here. just want to use the system, you probably should stop right here.
\section{How to install} \section*{How to install}
See \href{https://git.antartida.xyz/loop/srv/raw/branch/main/README}{[[README]]}. See
\href{https://git.antartida.xyz/loop/srv/raw/branch/main/README}{[[README]]}
in \lp's source code.
\section{Implementation strategy}\label{sec:design} \section{Implementation strategy}\label{sec:design}
@ -1296,23 +1297,24 @@ invited who.
maximizing (length (account-username u)))) maximizing (length (account-username u))))
(defun list-users () (defun list-users ()
(read-accounts!) (mapcar
(mapcar #'(lambda (row) (cadr row)) #'(lambda (row) (cadr row))
(sort (sort
(loop for u in *accounts* (loop for u in *accounts*
collect (list (account-username u) collect (list
(fmt "~v@a~a, ~a, invited ~a" (account-username u)
(size-of-longest-username) (fmt "~v@a~a, ~a, invited ~a"
(account-username u) (size-of-longest-username)
(if (locked? (account-username u)) (account-username u)
(fmt " (account locked: ~a)" (if (locked? (account-username u))
(account-pass-locked-why u)) (fmt " (account locked: ~a)"
"") (account-pass-locked-why u))
(if (last-time-seen (account-username u)) "")
(fmt "last seen on ~a" (last-time-seen (account-username u))) (if (last-time-seen (account-username u))
"never logged in") (fmt "last seen on ~a" (last-time-seen (account-username u)))
(or (account-friends u) "nobody")))) "never logged in")
#'string<= :key #'(lambda (row) (car row))))) (or (account-friends u) "nobody"))))
#'string<= :key #'(lambda (row) (car row)))))
(defun universal-to-human (s) (defun universal-to-human (s)
(format-timestring (format-timestring
@ -2424,8 +2426,8 @@ Index built.
\section{Deletion and locking of inactive accounts}\label{sec:inactive-users} \section{Deletion and locking of inactive accounts}\label{sec:inactive-users}
We now implement some of the principles exposed earlier on We now implement some of the \hyperref[principles]{principles} exposed
page~\pageref{principles}. The program earlier on page~\pageref{principles}. The program
@<<cron-remove-inactive-users.lisp@>> would be run by {\tt cron} every @<<cron-remove-inactive-users.lisp@>> would be run by {\tt cron} every
day (at midnight, say). It checks all accounts that are inactive and day (at midnight, say). It checks all accounts that are inactive and
either locks them (to be deleted later) or deletes them {\em for either locks them (to be deleted later) or deletes them {\em for
@ -2940,13 +2942,9 @@ something to think about.
<<Command users>> <<Command users>>
<<Command dd>> <<Command dd>>
<<Command repl>> <<Command repl>>
<<Broadcasting>> <<Broadcasting>>
<<Command-line parsing>> <<Command-line parsing>>
<<Main loop>> <<Main loop>>
<<Test procedures>> <<Test procedures>>
@ %def @ %def
@ -2980,6 +2978,86 @@ The \lp\ system definition:
:components ((:file "loop"))) :components ((:file "loop")))
@ @
\section{Other source code}
The shell script {\tt format-def} is invoked whenever we build any
lisp source code. That's to format the source code a bit better for
readers that will be reading it directly. It is not what we do. We
read the documentation in PDF format and we work on the NOWEB file
{\tt loop.nw}. But we know that potential readers will not do the
same and will hack {\tt loop.lisp} directly. Paying respect to these
readers, we try to format Lisp source code as best as possible. So we
do two things: first, we produce the final source code in an order
that should produce no warnings during compilation; second, we make
sure there's one and only one blank line between procedure or macro
definition. We don't add a blank line between global variables.
The following shell script does the job. The first {\tt sed} program
finds our definitions of interest and inserts a new blank line before
the definition. Such action makes function definitions separated by
two blank lines in some cases. We then remove the excess with the
second program. Notice we need the {\tt -E} option because we're
using the {\tt |} metacharacter.
The second program find a blank line as its first step. Then we say
{\tt N} to expand the pattern space to include the next line. Then we
delete the {\em first} blank line and not the second---that's what the
{\tt D} command does. This strategy is explained by Dale Dougherty
and Arnold Robbins in ``sed \& awk'' second edition, pages 112--114.
<<format-def>>=
#!/bin/sh
usage()
{
printf 'usage: %s [file.lisp]\n' $0
exit 1
}
sed -E '/^\(defun |\(defmacro /{
i\
}' "$@" | \
sed '/^[ \t]*$/{
N
/^[ \t]*\n$/D
}'
@
When we make a new release of \lp, we like to name its version as the
tip of the source code repository. We get the information usually
with a command line such as
%
\begin{verbatim}
$ git log --oneline | head -1 | awk '{print $1}'
52663d1
\end{verbatim}
%
To include this version string in the executable, we need to make it
part of the source code. We get help from {\tt sed} once again. As
the usage explains, we invoke it as {\tt ./make-release 52663d1
loop.nw}. The script then rewrites {\tt loop.nw} with the string in
the body of the chunk @<<Version@>>. The {\tt sed} program is
straightforward: locate the chunk definition, move down a line, change
that line and that's all.
<<make-release>>=
#!/bin/sh
usage()
{
printf 'usage: %s tag file\n' $0
exit 1
}
test $# -lt 2 && usage
tag="$1"; shift
sed "/<<Version>>=/ {
n;
c\\
$tag
}" "$@"
@
\section*{Index of chunks} \section*{Index of chunks}
\nowebchunks \nowebchunks

7
make-release
View file

@ -4,10 +4,11 @@ usage()
printf 'usage: %s tag file\n' $0 printf 'usage: %s tag file\n' $0
exit 1 exit 1
} }
test $# -lt 2 && usage test $# -lt 2 && usage
tag="$1"
shift tag="$1"; shift
sed "/<<Version>>=/ { sed "/a89e088=/ {
n; n;
c\\ c\\
$tag $tag