jadedctrl/ chicken-ircc
Archived
1
0
Disbranĉigi 0
Fontkodo Tirpetoj Activity

Don't error out on read timeout; pass tags to on-[reply|command] hooks

This commit is contained in:
Jaidyn Ann 2023-01-11 16:33:38 -06:00
parent ffa32241f7
commit 4ea3228684
1 changed files with 15 additions and 9 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

24
ircc.scm
View File

@ -27,7 +27,8 @@
;; irc:user-is-self?) ;; irc:user-is-self?)
(import scheme (import scheme
(chicken base) (chicken io) (chicken module) (chicken string) (chicken tcp) (chicken base) (chicken condition) (chicken io) (chicken module)
(chicken string) (chicken tcp)
srfi-1 srfi-19 srfi-69 srfi-130 srfi-1 srfi-19 srfi-69 srfi-130
openssl) openssl)
@ -145,9 +146,9 @@
[(eq? reply RPL_NAMREPLY) [(eq? reply RPL_NAMREPLY)
(let ([channel (third params)] (let ([channel (third params)]
[chan-symbol (second params)] [chan-symbol (second params)]
[users (cdddr params)]) [users (string-split (cadddr params) " ")])
(irc:channel-set! conn channel 'symbol chan-symbol) (irc:channel-set! conn channel 'symbol chan-symbol)
(apply (map
(lambda (user) (lambda (user)
(irc:channel-user-add! conn channel (irc:hostmask-nick user)) (irc:channel-user-add! conn channel (irc:hostmask-nick user))
(irc:user-add! conn (irc:hostmask-nick user)) (irc:user-add! conn (irc:hostmask-nick user))
@ -416,7 +417,11 @@
;; Read a single line from the IRC server ;; Read a single line from the IRC server
(define (irc:read-line conn) (define (irc:read-line conn)
(read-line (hash-table-ref conn 'out))) (handle-exceptions exn
(if (member '(timeout) (condition->list exn))
(irc:read-line conn)
(abort exn))
(read-line (hash-table-ref conn 'out))))
;; Send a specific command to the server. ;; Send a specific command to the server.
@ -458,18 +463,19 @@
;; Basic loop for using an IRC connection, using two hook functions: ;; Basic loop for using an IRC connection, using two hook functions:
;; (on-command connection command params sender) ;; (on-command connection command params sender tags)
;; (on-reply connection reply-code params sender) ;; (on-reply connection reply-code params sender tags)
(define (irc:loop connection on-command on-reply) (define (irc:loop connection on-command on-reply)
(let* ([output (irc:read-alist connection)] (let* ([output (irc:read-alist connection)]
[command (alist-ref 'command output)] [command (alist-ref 'command output)]
[reply (alist-ref 'reply output)] [reply (alist-ref 'reply output)]
[params (alist-ref 'params output)] [params (alist-ref 'params output)]
[sender (alist-ref 'sender output)]) [sender (alist-ref 'sender output)]
[tags (alist-ref 'tags output)])
(if (and on-command command) (if (and on-command command)
(apply on-command (list connection command params sender))) (apply on-command (list connection command params sender tags)))
(if (and on-reply reply) (if (and on-reply reply)
(apply on-reply (list connection reply params sender))) (apply on-reply (list connection reply params sender tags)))
(irc:loop connection on-command on-reply))) (irc:loop connection on-command on-reply)))