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

README to learn to install it.

Browse source
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
Show stats Download patch file Download diff file Expand all files Collapse all files

13
Makefile
View file

@ -10,16 +10,21 @@ scripts/migrate-add-creation-date.lisp
clean:
rm -f *.pdf *.out *.aux *.log *.fls *.fdb_latexmk loop loop.tex
build:
mkdir -p ~/quicklisp/local-projects/loop
cp loop.asd loop.lisp ~/quicklisp/local-projects/loop
build: loop.lisp loop.asd scripts/build-exe.lisp
# mkdir -p ~/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
install: loop
mkdir -p `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
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
because it's the only one we support at the moment.
(*) Introduction
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
We assume you have Quicklisp installed. If not, visit
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
LOOP is not in the Quicklisp repository, so we'll instruct you to
install it as a local project. Go to
~/quicklisp/local-projects/
Each directory inside local-projects is a Quicklisp package. The
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
and say
cd ~/quicklisp/local-projects/
git clone https://git.antartida.xyz/loop/srv
cd srv
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

31
accounts.lisp
View file

@ -1,9 +1,36 @@
(#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"
:SEEN 3935609919
:LAST-POST NIL
:FRIENDS NIL
:FRIENDS ("TOIS" "ME" "YOU")
:PASS 2335603191554807875
:PASS-LOCKED NIL
:PASS-LOCKED-WHY NIL
:CREATION 3913066800))
:CREATION 3913066800))

10
build-exe.lisp
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)

37
loop.lisp
View file

@ -1,8 +1,8 @@
;;; -*- mode: LISP; syntax: COMMON-LISP; package: LOOP; -*-
(eval-when (:compile-toplevel :load-toplevel :execute)
(ql:quickload
'(:lisp-unit :str :uiop :cl-fad :cl-ppcre :local-time :iterate :clsql-sqlite3
:clingon)
'(:lisp-unit :str :uiop :cl-ppcre :local-time :clsql-sqlite3 :clingon
:filesystem-utils)
:silent t))
(clsql:enable-sql-reader-syntax)
@ -10,7 +10,7 @@
(defpackage #:loop
(:use :common-lisp :local-time)
(:import-from :lisp-unit define-test)
(:import-from :iterate iter)
(:import-from :org.shirakumo.filesystem-utils directory-p list-directories)
(:export :main))
(in-package #:loop)
@ -61,23 +61,22 @@
:long-name "logging"
:key :logging)))
(defun cli/list-accounts ()
(read-accounts!)
(println (str:join (crlf-string) (list-users))))
(defun cli/create-account (username args)
(let ((invited-by (car args)))
(cond ((null invited-by)
(println "Must specify who invites the new account."))
((get-account create-account)
(println "Username account ``~a'' already exists." create-account))
((get-account username)
(println "Username account ``~a'' already exists." username))
((not (get-account invited-by))
(println "Invited-by account ``~a'' doesn't exist." invited-by))
(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?
(progn (println "Okay, account ``~a'' created with password ``~a''."
create-account pass-or-error)
(notify-user-created create-account))
username pass-or-error)
(notify-user-created username))
(println "Sorry, ~a." pass-or-error)))))))
(defun cli/change-passwd (username args)
@ -92,18 +91,21 @@
(println "Sorry, could not change password: ~a." problem))))))
(defvar *debug* nil)
(defun cli/main (cmd)
(read-accounts!)
(connect-index! "message-id.db")
(create-index!)
(let ((args (clingon:command-arguments cmd))
(repl (clingon:getopt cmd :repl))
(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))
(list-accounts (clingon:getopt cmd :list-accounts))
(logging (clingon:getopt cmd :logging)))
(setf *debug* logging)
(when list-accounts
(cli/list-accounts))
(when create-account
(cli/create-account create-account args))
(when ca
(cli/create-account ca args))
(when change-passwd-account
(cli/change-passwd change-passwd-account args))
(when repl
@ -461,9 +463,6 @@
(defun response-quit? (r) (and r (request-quit? (response-request r))))
(defun server-start ()
(read-accounts!)
(connect-index! "message-id.db")
(create-index!)
(set-up-tables!)
(send-banner!)
(main-loop))
@ -725,10 +724,10 @@
(defun group? (g)
(in-groups
(cl-fad:directory-exists-p g)))
(directory-p g)))
(defun xgroup? (g)
(cl-fad:directory-exists-p g))
(directory-p g))
(defun set-group! (g)
(setf (client-group *client*) g))
@ -778,7 +777,7 @@
;; though, we'll not be using directories. That's a
;; problem to be studied.
(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
#'(lambda (x) (between? x (or from x) (or to x)))
as)
@ -799,7 +798,7 @@
ls)))
(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)
#'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 server-start ()
(read-accounts!)
(connect-index! "message-id.db")
(create-index!)
(set-up-tables!)
(send-banner!)
(main-loop))
@ -651,23 +648,22 @@ to do that yet.
<<Command-line parsing>>=
(defun cli/list-accounts ()
(read-accounts!)
(println (str:join (crlf-string) (list-users))))
(defun cli/create-account (username args)
(let ((invited-by (car args)))
(cond ((null invited-by)
(println "Must specify who invites the new account."))
((get-account create-account)
(println "Username account ``~a'' already exists." create-account))
((get-account username)
(println "Username account ``~a'' already exists." username))
((not (get-account invited-by))
(println "Invited-by account ``~a'' doesn't exist." invited-by))
(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?
(progn (println "Okay, account ``~a'' created with password ``~a''."
create-account pass-or-error)
(notify-user-created create-account))
username pass-or-error)
(notify-user-created username))
(println "Sorry, ~a." pass-or-error)))))))
(defun cli/change-passwd (username args)
@ -687,18 +683,21 @@ Now let's write the main procedure in command-line parsing.
<<Command-line parsing>>=
(defvar *debug* nil)
(defun cli/main (cmd)
(read-accounts!)
(connect-index! "message-id.db")
(create-index!)
(let ((args (clingon:command-arguments cmd))
(repl (clingon:getopt cmd :repl))
(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))
(list-accounts (clingon:getopt cmd :list-accounts))
(logging (clingon:getopt cmd :logging)))
(setf *debug* logging)
(when list-accounts
(cli/list-accounts))
(when create-account
(cli/create-account create-account args))
(when ca
(cli/create-account ca args))
(when change-passwd-account
(cli/change-passwd change-passwd-account args))
(when repl
@ -1231,7 +1230,7 @@ even cache the overview of the group.) %% TODO
;; though, we'll not be using directories. That's a
;; problem to be studied.
(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
#'(lambda (x) (between? x (or from x) (or to x)))
as)
@ -1252,7 +1251,7 @@ even cache the overview of the group.) %% TODO
ls)))
(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)
#'string-lessp)))
@ -1289,10 +1288,10 @@ We just need to verify if the group exists and modify [[*client*]].
(defun group? (g)
(in-groups
(cl-fad:directory-exists-p g)))
(directory-p g)))
(defun xgroup? (g)
(cl-fad:directory-exists-p g))
(directory-p g))
(defun set-group! (g)
(setf (client-group *client*) g))
@ -2590,8 +2589,8 @@ global variables at the top of the file. That's something to think
about.
<<List of packages to be loaded>>=
:lisp-unit :str :uiop :cl-fad :cl-ppcre :local-time :iterate :clsql-sqlite3
:clingon
:lisp-unit :str :uiop :cl-ppcre :local-time :clsql-sqlite3 :clingon
:filesystem-utils
@
<<loop.lisp>>=
@ -2606,7 +2605,7 @@ about.
(defpackage #:loop
(:use :common-lisp :local-time)
(:import-from :lisp-unit define-test)
(:import-from :iterate iter)
(:import-from :org.shirakumo.filesystem-utils directory-p list-directories)
(:export :main))
(in-package #:loop)

2
scripts/build-index-from-fs.lisp
View file

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