README to learn to install it.

This commit is contained in:
Circling Skies 2024-12-09 13:37:39 -03:00
parent 27040c50da
commit f245e520be
7 changed files with 167 additions and 70 deletions

View file

@ -10,16 +10,21 @@ scripts/migrate-add-creation-date.lisp
clean: clean:
rm -f *.pdf *.out *.aux *.log *.fls *.fdb_latexmk loop loop.tex rm -f *.pdf *.out *.aux *.log *.fls *.fdb_latexmk loop loop.tex
build: build: loop.lisp loop.asd scripts/build-exe.lisp
mkdir -p ~/quicklisp/local-projects/loop # mkdir -p ~/quicklisp/local-projects/loop
cp loop.asd loop.lisp ~/quicklisp/local-projects/loop # cmp loop.asd ~/quicklisp/local-projects/loop/loop.asd || \
# cp loop.asd ~/quicklisp/local-projects/loop
# cmp loop.lisp ~/quicklisp/local-projects/loop/loop.lisp || \
# cp loop.lisp ~/quicklisp/local-projects/loop
# cp loop.asd ~/quicklisp/local-projects/loop
# cp loop.lisp ~/quicklisp/local-projects/loop
sbcl --script scripts/build-exe.lisp sbcl --script scripts/build-exe.lisp
install: loop install: loop
mkdir -p `head -1 conf-home` && \ mkdir -p `head -1 conf-home` && \
cp -R loop accounts.lisp groups scripts `head -1 conf-home` cp -R loop accounts.lisp groups scripts `head -1 conf-home`
loop: scripts/build-exe.lisp loop: loop.lisp scripts/build-exe.lisp
sbcl --script scripts/build-exe.lisp sbcl --script scripts/build-exe.lisp
loop.lisp: loop.nw loop.lisp: loop.nw

107
README
View file

@ -1,26 +1,103 @@
LOOP is an NNTP server written in Common Lisp. We assume you run SBCL (*) Introduction
because it's the only one we support at the moment.
LOOP is an NNTP server written in Common Lisp.
(*) Assumptions
We assume
- you run SBCL
- you have Quicklisp installed and knows how to use it
- you know how to use a TCP server such as
https://cr.yp.to/ucspi-tcp.html
- you know how to manage a daemon with
https://cr.yp.to/daemontools.html
- you have git and knows how to use it
(*) How to install it (*) How to install it
We assume you have Quicklisp installed. If not, visit LOOP is not in the Quicklisp repository, so we'll instruct you to
install it as a local project. Go to
https://www.quicklisp.org/
and install it. LOOP is not present in Quicklisp archive, so we'll
direct you to install LOOP as a local project. After you install
Quicklisp, you will have a directory named
~/quicklisp/local-projects/ ~/quicklisp/local-projects/
Each directory inside local-projects is a Quicklisp package. The and say
steps below are not going to copy anything to your file system. It
builds the executable on LOOP's source code directory. To build LOOP,
tell your shell
cd ~/quicklisp/local-projects/
git clone https://git.antartida.xyz/loop/srv git clone https://git.antartida.xyz/loop/srv
cd srv cd srv
make build make build
Omg, I gotta think about the installation! I need to /decide/. Now you have the executable loop. Try it out:
--8<-------------------------------------------------------->8---
$ ./loop --help
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---
So now have your system run your TCP server of choice. For instance,
if you're using djb's tcpserver and would like LOOP to listen on port
1024, say
--8<-------------------------------------------------------->8---
$ tcpserver -v -HR 0.0.0.0 1024 ./loop -s
tcpserver: status: 0/40
--8<-------------------------------------------------------->8---
Using another terminal, telnet to your host on port 1024:
--8<-------------------------------------------------------->8---
$ telnet localhost 1024
Trying 127.0.0.1...
Connected to antartida.xyz.
Escape character is '^]'.
200 Welcome! Say ``help'' for a menu.
quit
205 Good-bye.
Connection closed by foreign host.
--8<-------------------------------------------------------->8---
Directory daemon/ in LOOP's source code has sample scripts to use with
djb's tcpserver and daemontools. If you never done this, it will be
better education if you learn to use daemontools and ucspi-tcp before
going live with LOOP community. It's easy and fun.
(*) Create your account
Accounts are kept in accounts.lisp. Create a first account with
./loop --create-account you

View file

@ -1,8 +1,35 @@
(#S(LOOP::ACCOUNT (#S(LOOP::ACCOUNT
:USERNAME "TOIS"
:SEEN NIL
:LAST-POST NIL
:FRIENDS NIL
:PASS 2668758003445446799
:PASS-LOCKED NIL
:PASS-LOCKED-WHY NIL
:CREATION 3942774377)
#S(LOOP::ACCOUNT
:USERNAME "ME"
:SEEN NIL
:LAST-POST NIL
:FRIENDS NIL
:PASS 4516159621457714044
:PASS-LOCKED NIL
:PASS-LOCKED-WHY NIL
:CREATION 3942774136)
#S(LOOP::ACCOUNT
:USERNAME "YOU"
:SEEN NIL
:LAST-POST NIL
:FRIENDS NIL
:PASS 619654876836234945
:PASS-LOCKED NIL
:PASS-LOCKED-WHY NIL
:CREATION 3942774072)
#S(LOOP::ACCOUNT
:USERNAME "ANONYMOUS" :USERNAME "ANONYMOUS"
:SEEN 3935609919 :SEEN 3935609919
:LAST-POST NIL :LAST-POST NIL
:FRIENDS NIL :FRIENDS ("TOIS" "ME" "YOU")
:PASS 2335603191554807875 :PASS 2335603191554807875
:PASS-LOCKED NIL :PASS-LOCKED NIL
:PASS-LOCKED-WHY NIL :PASS-LOCKED-WHY NIL

View file

@ -1,10 +0,0 @@
#-quicklisp
(let ((quicklisp-init (merge-pathnames "quicklisp/setup.lisp"
(user-homedir-pathname))))
(when (probe-file quicklisp-init)
(load quicklisp-init)))
(ql:quickload :loop :silent t)
(sb-ext:save-lisp-and-die #P"loop"
:toplevel #'loop:main
:executable t
:save-runtime-options t)

View file

@ -1,8 +1,8 @@
;;; -*- mode: LISP; syntax: COMMON-LISP; package: LOOP; -*- ;;; -*- mode: LISP; syntax: COMMON-LISP; package: LOOP; -*-
(eval-when (:compile-toplevel :load-toplevel :execute) (eval-when (:compile-toplevel :load-toplevel :execute)
(ql:quickload (ql:quickload
'(:lisp-unit :str :uiop :cl-fad :cl-ppcre :local-time :iterate :clsql-sqlite3 '(:lisp-unit :str :uiop :cl-ppcre :local-time :clsql-sqlite3 :clingon
:clingon) :filesystem-utils)
:silent t)) :silent t))
(clsql:enable-sql-reader-syntax) (clsql:enable-sql-reader-syntax)
@ -10,7 +10,7 @@
(defpackage #:loop (defpackage #:loop
(:use :common-lisp :local-time) (:use :common-lisp :local-time)
(:import-from :lisp-unit define-test) (:import-from :lisp-unit define-test)
(:import-from :iterate iter) (:import-from :org.shirakumo.filesystem-utils directory-p list-directories)
(:export :main)) (:export :main))
(in-package #:loop) (in-package #:loop)
@ -61,23 +61,22 @@
:long-name "logging" :long-name "logging"
:key :logging))) :key :logging)))
(defun cli/list-accounts () (defun cli/list-accounts ()
(read-accounts!)
(println (str:join (crlf-string) (list-users)))) (println (str:join (crlf-string) (list-users))))
(defun cli/create-account (username args) (defun cli/create-account (username args)
(let ((invited-by (car args))) (let ((invited-by (car args)))
(cond ((null invited-by) (cond ((null invited-by)
(println "Must specify who invites the new account.")) (println "Must specify who invites the new account."))
((get-account create-account) ((get-account username)
(println "Username account ``~a'' already exists." create-account)) (println "Username account ``~a'' already exists." username))
((not (get-account invited-by)) ((not (get-account invited-by))
(println "Invited-by account ``~a'' doesn't exist." invited-by)) (println "Invited-by account ``~a'' doesn't exist." invited-by))
(t (t
(multiple-value-bind (okay? pass-or-error) (new-account! create-account invited-by) (multiple-value-bind (okay? pass-or-error) (new-account! username invited-by)
(if okay? (if okay?
(progn (println "Okay, account ``~a'' created with password ``~a''." (progn (println "Okay, account ``~a'' created with password ``~a''."
create-account pass-or-error) username pass-or-error)
(notify-user-created create-account)) (notify-user-created username))
(println "Sorry, ~a." pass-or-error))))))) (println "Sorry, ~a." pass-or-error)))))))
(defun cli/change-passwd (username args) (defun cli/change-passwd (username args)
@ -92,18 +91,21 @@
(println "Sorry, could not change password: ~a." problem)))))) (println "Sorry, could not change password: ~a." problem))))))
(defvar *debug* nil) (defvar *debug* nil)
(defun cli/main (cmd) (defun cli/main (cmd)
(read-accounts!)
(connect-index! "message-id.db")
(create-index!)
(let ((args (clingon:command-arguments cmd)) (let ((args (clingon:command-arguments cmd))
(repl (clingon:getopt cmd :repl)) (repl (clingon:getopt cmd :repl))
(server (clingon:getopt cmd :server)) (server (clingon:getopt cmd :server))
(create-account (clingon:getopt cmd :create-account)) (ca (clingon:getopt cmd :create-account))
(change-passwd-account (clingon:getopt cmd :change-passwd)) (change-passwd-account (clingon:getopt cmd :change-passwd))
(list-accounts (clingon:getopt cmd :list-accounts)) (list-accounts (clingon:getopt cmd :list-accounts))
(logging (clingon:getopt cmd :logging))) (logging (clingon:getopt cmd :logging)))
(setf *debug* logging) (setf *debug* logging)
(when list-accounts (when list-accounts
(cli/list-accounts)) (cli/list-accounts))
(when create-account (when ca
(cli/create-account create-account args)) (cli/create-account ca args))
(when change-passwd-account (when change-passwd-account
(cli/change-passwd change-passwd-account args)) (cli/change-passwd change-passwd-account args))
(when repl (when repl
@ -461,9 +463,6 @@
(defun response-quit? (r) (and r (request-quit? (response-request r)))) (defun response-quit? (r) (and r (request-quit? (response-request r))))
(defun server-start () (defun server-start ()
(read-accounts!)
(connect-index! "message-id.db")
(create-index!)
(set-up-tables!) (set-up-tables!)
(send-banner!) (send-banner!)
(main-loop)) (main-loop))
@ -725,10 +724,10 @@
(defun group? (g) (defun group? (g)
(in-groups (in-groups
(cl-fad:directory-exists-p g))) (directory-p g)))
(defun xgroup? (g) (defun xgroup? (g)
(cl-fad:directory-exists-p g)) (directory-p g))
(defun set-group! (g) (defun set-group! (g)
(setf (client-group *client*) g)) (setf (client-group *client*) g))
@ -778,7 +777,7 @@
;; though, we'll not be using directories. That's a ;; though, we'll not be using directories. That's a
;; problem to be studied. ;; problem to be studied.
(let ((as (articles->integers (let ((as (articles->integers
(remove-if #'temporary-article? (cl-fad:list-directory g))))) (remove-if #'temporary-article? (list-directories (truename g))))))
(sort (remove-if-not (sort (remove-if-not
#'(lambda (x) (between? x (or from x) (or to x))) #'(lambda (x) (between? x (or from x) (or to x)))
as) as)
@ -799,7 +798,7 @@
ls))) ls)))
(defun list-groups () (defun list-groups ()
(let ((groups (in-groups (cl-fad:list-directory ".")))) (let ((groups (in-groups (list-directories (truename ".")))))
(sort (mapcar #'(lambda (g) (basename (uiop:unix-namestring g))) groups) (sort (mapcar #'(lambda (g) (basename (uiop:unix-namestring g))) groups)
#'string-lessp))) #'string-lessp)))

37
loop.nw
View file

@ -570,9 +570,6 @@ itself---so we can cascade actions based on a user's request.
(defun response-quit? (r) (and r (request-quit? (response-request r)))) (defun response-quit? (r) (and r (request-quit? (response-request r))))
(defun server-start () (defun server-start ()
(read-accounts!)
(connect-index! "message-id.db")
(create-index!)
(set-up-tables!) (set-up-tables!)
(send-banner!) (send-banner!)
(main-loop)) (main-loop))
@ -651,23 +648,22 @@ to do that yet.
<<Command-line parsing>>= <<Command-line parsing>>=
(defun cli/list-accounts () (defun cli/list-accounts ()
(read-accounts!)
(println (str:join (crlf-string) (list-users)))) (println (str:join (crlf-string) (list-users))))
(defun cli/create-account (username args) (defun cli/create-account (username args)
(let ((invited-by (car args))) (let ((invited-by (car args)))
(cond ((null invited-by) (cond ((null invited-by)
(println "Must specify who invites the new account.")) (println "Must specify who invites the new account."))
((get-account create-account) ((get-account username)
(println "Username account ``~a'' already exists." create-account)) (println "Username account ``~a'' already exists." username))
((not (get-account invited-by)) ((not (get-account invited-by))
(println "Invited-by account ``~a'' doesn't exist." invited-by)) (println "Invited-by account ``~a'' doesn't exist." invited-by))
(t (t
(multiple-value-bind (okay? pass-or-error) (new-account! create-account invited-by) (multiple-value-bind (okay? pass-or-error) (new-account! username invited-by)
(if okay? (if okay?
(progn (println "Okay, account ``~a'' created with password ``~a''." (progn (println "Okay, account ``~a'' created with password ``~a''."
create-account pass-or-error) username pass-or-error)
(notify-user-created create-account)) (notify-user-created username))
(println "Sorry, ~a." pass-or-error))))))) (println "Sorry, ~a." pass-or-error)))))))
(defun cli/change-passwd (username args) (defun cli/change-passwd (username args)
@ -687,18 +683,21 @@ Now let's write the main procedure in command-line parsing.
<<Command-line parsing>>= <<Command-line parsing>>=
(defvar *debug* nil) (defvar *debug* nil)
(defun cli/main (cmd) (defun cli/main (cmd)
(read-accounts!)
(connect-index! "message-id.db")
(create-index!)
(let ((args (clingon:command-arguments cmd)) (let ((args (clingon:command-arguments cmd))
(repl (clingon:getopt cmd :repl)) (repl (clingon:getopt cmd :repl))
(server (clingon:getopt cmd :server)) (server (clingon:getopt cmd :server))
(create-account (clingon:getopt cmd :create-account)) (ca (clingon:getopt cmd :create-account))
(change-passwd-account (clingon:getopt cmd :change-passwd)) (change-passwd-account (clingon:getopt cmd :change-passwd))
(list-accounts (clingon:getopt cmd :list-accounts)) (list-accounts (clingon:getopt cmd :list-accounts))
(logging (clingon:getopt cmd :logging))) (logging (clingon:getopt cmd :logging)))
(setf *debug* logging) (setf *debug* logging)
(when list-accounts (when list-accounts
(cli/list-accounts)) (cli/list-accounts))
(when create-account (when ca
(cli/create-account create-account args)) (cli/create-account ca args))
(when change-passwd-account (when change-passwd-account
(cli/change-passwd change-passwd-account args)) (cli/change-passwd change-passwd-account args))
(when repl (when repl
@ -1231,7 +1230,7 @@ even cache the overview of the group.) %% TODO
;; though, we'll not be using directories. That's a ;; though, we'll not be using directories. That's a
;; problem to be studied. ;; problem to be studied.
(let ((as (articles->integers (let ((as (articles->integers
(remove-if #'temporary-article? (cl-fad:list-directory g))))) (remove-if #'temporary-article? (list-directories (truename g))))))
(sort (remove-if-not (sort (remove-if-not
#'(lambda (x) (between? x (or from x) (or to x))) #'(lambda (x) (between? x (or from x) (or to x)))
as) as)
@ -1252,7 +1251,7 @@ even cache the overview of the group.) %% TODO
ls))) ls)))
(defun list-groups () (defun list-groups ()
(let ((groups (in-groups (cl-fad:list-directory ".")))) (let ((groups (in-groups (list-directories (truename ".")))))
(sort (mapcar #'(lambda (g) (basename (uiop:unix-namestring g))) groups) (sort (mapcar #'(lambda (g) (basename (uiop:unix-namestring g))) groups)
#'string-lessp))) #'string-lessp)))
@ -1289,10 +1288,10 @@ We just need to verify if the group exists and modify [[*client*]].
(defun group? (g) (defun group? (g)
(in-groups (in-groups
(cl-fad:directory-exists-p g))) (directory-p g)))
(defun xgroup? (g) (defun xgroup? (g)
(cl-fad:directory-exists-p g)) (directory-p g))
(defun set-group! (g) (defun set-group! (g)
(setf (client-group *client*) g)) (setf (client-group *client*) g))
@ -2590,8 +2589,8 @@ global variables at the top of the file. That's something to think
about. about.
<<List of packages to be loaded>>= <<List of packages to be loaded>>=
:lisp-unit :str :uiop :cl-fad :cl-ppcre :local-time :iterate :clsql-sqlite3 :lisp-unit :str :uiop :cl-ppcre :local-time :clsql-sqlite3 :clingon
:clingon :filesystem-utils
@ @
<<loop.lisp>>= <<loop.lisp>>=
@ -2606,7 +2605,7 @@ about.
(defpackage #:loop (defpackage #:loop
(:use :common-lisp :local-time) (:use :common-lisp :local-time)
(:import-from :lisp-unit define-test) (:import-from :lisp-unit define-test)
(:import-from :iterate iter) (:import-from :org.shirakumo.filesystem-utils directory-p list-directories)
(:export :main)) (:export :main))
(in-package #:loop) (in-package #:loop)

View file

@ -6,6 +6,6 @@
(ql:quickload :loop :silent t) (ql:quickload :loop :silent t)
(in-package #:loop) (in-package #:loop)
(connect-index! "message-id.db") (connect-index! "message-id.db")
(remake-index!) (drop-create-index!)
(index-from-fs!) (index-from-fs!)
(format t "Index built.~%") (format t "Index built.~%")