You cannot select more than 25 topics
Topics must start with a letter or number, can include dashes ('-') and can be up to 35 characters long.
118 lines
3.3 KiB
Plaintext
118 lines
3.3 KiB
Plaintext
#! /usr/bin/env slope
|
|
; prattle - small realtime chat for localhost
|
|
; author: samhunter@rawtext.club
|
|
; https://git.rawtext.club/samhunter/prattle
|
|
;
|
|
; server
|
|
;
|
|
(define get-cln
|
|
(lambda ()
|
|
(define fh (file-open-read (append (env "HOME") "/bin/client.slo")))
|
|
(define code (list->string (read-all-lines fh) "\n"))
|
|
(close fh)
|
|
code))
|
|
|
|
(define get-srv
|
|
(lambda ()
|
|
(define fh (file-open-read (append (env "HOME") "/bin/server.slo")))
|
|
(define code (list->string (read-all-lines fh) "\n"))
|
|
(close fh)
|
|
code))
|
|
|
|
(define register-user
|
|
(lambda (username handle)
|
|
(assoc q handle username)))
|
|
|
|
(define de-register-user
|
|
(lambda (username handle)
|
|
(close handle)
|
|
(filter (lambda (i) (open? (car i))) q)))
|
|
|
|
(define get-users
|
|
(lambda ()
|
|
(map
|
|
(lambda (u) (string-format "- %v" u))
|
|
(filter
|
|
(lambda (u) (not (regex-match? "^[-0-9]" u)))
|
|
(map car
|
|
(map cdr q))))))
|
|
|
|
(define broadcast
|
|
(lambda (l q)
|
|
(for-each
|
|
(lambda (fh)
|
|
(begin
|
|
(if (equal? fh ioh)
|
|
(write (string-format "%v %v\r\n" "<-" l) fh)
|
|
(write (string-format "%v %v\r\n" "->" l) fh))))
|
|
(filter open? (map car q)))))
|
|
|
|
(define log (file-open-write (string-format "%v/tmp/chat-%v.log" (env "HOME") (timestamp))))
|
|
|
|
(define q (assoc [] log "-logger"))
|
|
|
|
(define scroll (list-seed 10 #f))
|
|
|
|
(define l #f)
|
|
|
|
(define handler
|
|
(lambda (ioh)
|
|
(set! q (assoc q ioh (length q)))
|
|
(for () (run) ; endless loop
|
|
(begin
|
|
(set! l #f)
|
|
(if (open? ioh)
|
|
(set! l (read-line ioh))
|
|
(close ioh))
|
|
(if (~bool l)
|
|
(begin
|
|
(cond
|
|
((regex-match? "^/join.*" l)
|
|
(begin
|
|
; announce to everybody else
|
|
(broadcast (string-format "### %v joined the chat" (ref (string->list l " ") -1)) q)
|
|
; then register
|
|
(set! q (register-user (ref (string->list l " ") -1) ioh))
|
|
(write (append "Users online:\n" (list->string (get-users) "\r\n") "\r\n") ioh)
|
|
(write (append (list->string (filter (lambda (i) i) scroll) "\r\n") "\r\n") ioh)
|
|
))
|
|
((regex-match? "^/leave.*" l)
|
|
(set! q (de-register-user (ref (string->list l " ") -1) ioh)))
|
|
((equal? l "/exit")
|
|
(close ioh))
|
|
((equal? l "/users")
|
|
(write (append "Users online:\n" (list->string (get-users) "\r\n") "\r\n") ioh))
|
|
((equal? l "/clear")
|
|
(write "\27[0;0H\27[2J" ioh))
|
|
((equal? l "/get-server")
|
|
(write (get-srv) ioh))
|
|
((equal? l "/get-client")
|
|
(write (get-cln) ioh))
|
|
((equal? l "/shutdown")
|
|
(begin
|
|
(set! run #f)
|
|
(exit)))
|
|
(else
|
|
(begin
|
|
(if (not (regex-match? "^ */" l))
|
|
(set! scroll (cdr (append scroll (string-format "%v" l)))))
|
|
(broadcast l q))))))
|
|
(sleep 200)))))
|
|
|
|
(close stdin)
|
|
(close stdout)
|
|
(close stderr)
|
|
(exception-mode-pass)
|
|
|
|
(define run #t)
|
|
|
|
(for () (run) ; endless loop
|
|
(begin
|
|
(net-listen
|
|
"tcp4"
|
|
"127.0.0.1:1168"
|
|
handler
|
|
)
|
|
(begin
|
|
(sleep 1000))))
|