Browse Source

add the STATS command

master
Epi Morphism 3 months ago
parent
commit
f428297a5f
5 changed files with 40 additions and 9 deletions
  1. +2
    -3
      README.md
  2. +3
    -2
      chat.rkt
  3. +5
    -2
      ircd.rkt
  4. +1
    -1
      private/irc-functions.rkt
  5. +29
    -1
      unheck-html.rkt

+ 2
- 3
README.md View File

@@ -17,10 +17,9 @@ The command line option `--url` specifies the URL for the MovieNight chat server
To produce logs set the env variables PLTSTDOUT or PLTSTDERR to "warning" or "info".
See the [Racket docs on loggers](https://docs.racket-lang.org/reference/logging.html) for details.

## Special commands

# Prebuilt binaries

Coming soon...
- `/STATS` provide some basic statistics about the stream

# Requirements & building



+ 3
- 2
chat.rkt View File

@@ -1,7 +1,8 @@
#lang typed/racket
(provide (all-defined-out))
(require/typed "unheck-html.rkt"
[unheck-html (-> String String)])
[unheck-html (-> String String)]
[unheck-all-html (-> String String)])
(require typed/net/url
"private/ws-typed.rkt" ;; web sockets
typed/json
@@ -58,7 +59,7 @@
[(chat-message message from color type)
(match type
['chat (on-chat from (unheck-html message))]
['response (on-response (unheck-html message))]
['response (on-response (unheck-all-html message))]
[_
(log-warning
(format "chat.rkt/handl-evt: cannot handle message type in ~s" msg))])]))]


+ 5
- 2
ircd.rkt View File

@@ -264,12 +264,15 @@
[(irc-message _ "PRIVMSG" (list chan msg))
#:when (equal? chan channel)
(send-ws-message conn msg)]
[(irc-message _ "STATS" '())
(send-ws-message conn "/STATS")]
[(or (? eof-object?)
(irc-message _ "QUIT" _))
;; somehow attach this to a custodian?
(log-warning (format "ircd.rkt: Closing socket for ~a" (irc-connection-nick conn)))
(custodian-shutdown-all custodian)]
[#f (void)]
[#f ;;; were unable to parse the string correctly
(void)]
[(var msg)
(log-warning (format "ircd.rkt/handle-user-message: unknown message: ~a" msg))])
(handle-user-messages conn custodian))
@@ -289,7 +292,7 @@
(irc-message "lolcathost" "002" (list nick msg))))
;; "001" has to be a string, otherwise it's converted to 1
(send-to-client conn (irc-message "lolcathost" "001" (list nick "[OwO]")))
(notify-nick ":[Mar 2020] NEW! timeouts for broken connections")
(notify-nick ":[Mar 2020] NEW! /STATS command & timeouts for broken connections")
(notify-nick ":[Mar 2020] bug fixes (erc support), displaying correct topic")
(notify-nick ":[Feb 2020] support for HexChat, JOIN & PARTs, html encoding of symbols")
(notify-nick ":-----------------------------------------------------------------------------")


+ 1
- 1
private/irc-functions.rkt View File

@@ -70,7 +70,7 @@
(cond [(> (length parts) (if prefix 1 0))
(define command (list-ref parts (if prefix 1 0)))
(define param-parts (list-tail parts (if prefix 2 1)))
(irc-message (or prefix "") command (parse-params param-parts))]
(irc-message prefix (string-upcase command) (parse-params param-parts))]
[(empty? parts) #f ;; the message is entirely empty
;; don't log this as a warning
;; this happens on erc because it ends messages


+ 29
- 1
unheck-html.rkt View File

@@ -1,5 +1,7 @@
#lang racket
(provide unheck-html)
(provide unheck-html unheck-all-html)
(require (prefix-in h: html)
(prefix-in x: xml))

;; copied from somewhere tbh

@@ -30,3 +32,29 @@
(string-append "&" mtch)))]))
(regexp-replace* #px"&(#?[\\w\\d]+);?" str unheck))

;; TODO: use this instead of unheck-html
(define (unheck-all-html str)
(let* ([html (h:read-html (open-input-string str))]
[contents (extract-pcdata html)])
(string-join contents " ")))

;; copied from the html-lib example
; extract-pcdata: html-content/c -> (listof string)
; Pulls out the pcdata strings from some-content.
(define (extract-pcdata some-content)
(cond [(x:pcdata? some-content)
(list (x:pcdata-string some-content))]
[(x:entity? some-content)
(list)]
[else
(extract-pcdata-from-element some-content)]))

; extract-pcdata-from-element: html-element -> (listof string)
; Pulls out the pcdata strings from an-html-element.
(define (extract-pcdata-from-element an-html-element)
(match an-html-element
[(struct h:html-full (attributes content))
(apply append (map extract-pcdata content))]
[(struct h:html-element (attributes))
'()]))

Loading…
Cancel
Save