-#!/usr/bin/guile \
--e main -s
-!#
-
;;; 8sync --- Asynchronous programming for Guile
-;;; Copyright (C) 2015 Christopher Allan Webber <cwebber@dustycloud.org>
+;;; Copyright © 2015, 2016, 2017 Christopher Allan Webber <cwebber@dustycloud.org>
+;;; Copyright © 2023 Janneke Nieuwenhuizen <janneke@gnu.org>
;;;
;;; This file is part of 8sync.
;;;
#:use-module (8sync repl)
#:use-module (8sync agenda)
#:use-module (8sync actors)
+ #:use-module (8sync contrib irc)
#:use-module (srfi srfi-9)
+ #:use-module (srfi srfi-26)
#:use-module (ice-9 getopt-long)
#:use-module (ice-9 format)
#:use-module (ice-9 receive)
#:export (<irc-bot>
irc-bot-username irc-bot-server irc-bot-channels irc-bot-port
- handle-line handle-misc-input
- handle-user-join handle-user-quit
+ irc-bot-init irc-bot-cleanup
+ dispatch-message handle-message
+
+ default-irc-port ;REMOVEME compat
+ irc-bot-send-line ;REMOVEME compat
+ handle-line handle-misc-input)) ;REMOVEME compat
+
+;;; A goofy default handler.
+(define* (echo-message irc-bot speaker channel-name
+ line-text emote? #:key (port (current-output-port)))
+ "Simply echoes the message to the PORT."
+ (if emote?
+ (format port "~a emoted ~s in channel ~a\n"
+ speaker line-text channel-name)
+ (format port "~a said ~s in channel ~a\n"
+ speaker line-text channel-name)))
+
+\f
+;;; Bot
+;;; ===
+
+(define-class <irc-bot> (<actor>)
+ (username #:init-keyword #:username
+ #:getter irc-bot-username)
+ (realname #:init-keyword #:realname
+ #:init-value #f)
+ (server #:init-keyword #:server
+ #:getter irc-bot-server)
+ (channels #:init-keyword #:channels
+ #:getter irc-bot-channels)
+ (port #:init-keyword #:port
+ #:init-value %irc:default-port
+ #:getter irc-bot-port)
+ (socket #:accessor irc-bot-socket)
+ (actions #:allocation #:each-subclass
+ #:init-thunk (build-actions
+ (*init* irc-bot-init)
+ (*cleanup* irc-bot-cleanup)
+ (main-loop irc-bot-main-loop)
+ (dispatch-message dispatch-message)
+ (handle-line handle-line) ;REMOVEME compat
+ (send-line irc-bot-send-line-action))))
+
+(define (irc-bot-realname irc-bot)
+ (or (slot-ref irc-bot 'realname)
+ (irc-bot-username irc-bot)))
+
+(define-method (irc-bot-init (irc-bot <irc-bot>) message)
+ "Initialize the IRC bot"
+ (define socket (irc:listen (irc-bot-server irc-bot)
+ #:port (irc-bot-port irc-bot)
+ #:sleep 8sleep))
+ (define flags (fcntl socket F_GETFL))
+
+ (fcntl socket F_SETFL (logior O_NONBLOCK flags))
+ (set! (irc-bot-socket irc-bot) socket)
+
+ (irc:user socket (irc-bot-username irc-bot)
+ #:real (irc-bot-realname irc-bot))
+ (irc:nick socket (irc-bot-username irc-bot))
+
+ (for-each (cute irc:join socket <>) (irc-bot-channels irc-bot))
+
+ (<- (actor-id irc-bot) 'main-loop))
+
+(define-method (irc-bot-cleanup (irc-bot <irc-bot>) message)
+ (close (irc-bot-socket irc-bot)))
+
+(define (irc-bot-main-loop irc-bot message)
+ (define socket (irc-bot-socket irc-bot))
+ (define line (irc:receive socket))
+ (define message (or (false-if-exception (irc:line->message line))
+ line))
+ (<- (actor-id irc-bot) 'dispatch-message message)
+ (cond
+ ;; The port's been closed for some reason, so stop looping
+ ((port-closed? socket)
+ 'done)
+ ;; We've reached the EOF object, which means we should close
+ ;; the port ourselves and stop looping
+ ((eof-object? (peek-char socket))
+ (close socket)
+ 'done)
+ ;; ;; Looks like we've been killed somehow... well, stop running
+ ;; ;; then!
+ ;; ((actor-am-i-dead? irc-bot)
+ ;; (if (not (port-closed? socket))
+ ;; (close socket))
+ ;; 'done)
+ ;; Otherwise, let's read till the next line!
+ (else
+ (<- (actor-id irc-bot) 'main-loop))))
+
+(define* (irc-bot-send-line-action irc-bot message
+ channel line #:key emote?)
+ "Action handler for sending lines. Real behavior happens in
+irc:send-line."
+ (define socket (irc-bot-socket irc-bot))
+ (irc:send-line socket channel line #:emote? emote?))
+
+\f
+;;;
+;;; Likely-to-be-overridden generic methods
+;;;
+(define-method (dispatch-message (irc-bot <irc-bot>) 8sync-message message)
+ "Dispatch an <irc:message>."
+ (match message
+ ((and ($ <irc:message>)
+ (= irc:message-command 'PING)
+ (= irc:message-message message))
+ (irc:pong (irc-bot-socket irc-bot) message))
+ (_ (handle-message irc-bot message))))
- default-irc-port))
+(define-method (handle-message (irc-bot <irc-bot>) message)
+ (match message
+ ((and ($ <irc:message>)
+ (= irc:message-line line)
+ (= irc:message-command command)
+ (= irc:message-speaker speaker)
+ (= irc:message-channel channel)
+ (= irc:message-message message)
+ (= irc:message-emote? emote?))
+ (or
+ (case command
+ ((PRIVMSG)
+ (handle-line irc-bot #f speaker channel message emote?)) ;REMOVEME compat
+ (else
+ (handle-misc-input irc-bot line))) ;REMOVEME compat
+ (echo-message irc-bot speaker channel message #f
+ #:port (current-error-port))))))
\f
-;;; Network stuff
-;;; =============
+;;;
+;;; Compatibility with 0.4.2.
+;;;
+(define default-irc-port %irc:default-port)
+(define irc-eol %irc:eol)
-(define default-irc-port 6665)
+(define* (irc-bot-send-line irc-bot channel line #:key emote?)
+ (define socket (irc-bot-socket irc-bot))
+ (irc:send-line socket channel line))
-(define* (irc-socket-setup hostname #:optional (inet-port default-irc-port))
- (let* ((s (socket PF_INET SOCK_STREAM 0))
- (flags (fcntl s F_GETFL))
- (ip-address (inet-ntop AF_INET (car (hostent:addr-list (gethost hostname))))))
- (fcntl s F_SETFL (logior O_NONBLOCK flags))
- (connect s AF_INET
- (inet-pton AF_INET ip-address)
- inet-port)
- s))
+(define-method (handle-line (irc-bot <irc-bot>) ;REMOVEME compat
+ 8sync-message
+ username channel-name line-text emote?)
+ "Keep compatibility with previous release."
+ #f)
-(define irc-eol "\r\n")
+(define-method (handle-misc-input (irc-bot <irc-bot>) ;REMOVEME compat
+ (line <string>))
+ "Keep compatibility with previous release."
+ #f)
(define (startswith-colon? str)
(and (> (string-length str) 0)
#\:)))
;; TODO: This needs a cleanup. Maybe even just using a regex is fine.
-(define (parse-line line)
+(define (parse-line line) ;REMOVEME compat
(define (parse-params pre-params)
;; This is stupid and imperative but I can't wrap my brain around
;; the right way to do it in a functional way :\
(values #f command
(parse-params pre-params)))))
-(define (strip-colon-if-necessary string)
+(define (strip-colon-if-necessary string) ;REMOVME compat
(if (and (> (string-length string) 0)
(string-ref string 0))
(substring/copy string 1)
string))
;; @@: Not sure if this works in all cases, like what about in a non-privmsg one?
-(define (irc-line-username irc-line-prefix)
+(define (irc-line-username irc-line-prefix) ;REMOVME compat
(let* ((prefix-name (strip-colon-if-necessary irc-line-prefix))
(exclaim-index (string-index prefix-name #\!)))
(if exclaim-index
(substring/copy prefix-name 0 exclaim-index)
prefix-name)))
-(define (condense-privmsg-line line)
+(define (condense-privmsg-line line) ;REMOVME compat
"Condense message line and do multiple value return of
(channel message emote?)"
(define (strip-last-char string)
(values channel-name
(string-join (cons first-word rest-message) " ")
#f)))))
-
-;;; A goofy default
-(define (echo-message irc-bot speaker channel-name
- line-text emote?)
- "Simply echoes the message to the current-output-port."
- (if emote?
- (format #t "~a emoted ~s in channel ~a\n"
- speaker line-text channel-name)
- (format #t "~a said ~s in channel ~a\n"
- speaker line-text channel-name)))
-
-\f
-;;; Bot
-;;; ===
-
-(define-class <irc-bot> (<actor>)
- (username #:init-keyword #:username
- #:getter irc-bot-username)
- (realname #:init-keyword #:realname
- #:init-value #f)
- (server #:init-keyword #:server
- #:getter irc-bot-server)
- (channels #:init-keyword #:channels
- #:getter irc-bot-channels)
- (port #:init-keyword #:port
- #:init-value default-irc-port
- #:getter irc-bot-port)
- (socket #:accessor irc-bot-socket)
- (actions #:allocation #:each-subclass
- #:init-value (build-actions
- (init irc-bot-init)
- (main-loop irc-bot-main-loop)
- (send-line irc-bot-send-line))))
-
-(define (irc-bot-realname irc-bot)
- (or (slot-ref irc-bot 'realname)
- (irc-bot-username irc-bot)))
-
-(define (irc-bot-init irc-bot message)
- "Initialize the IRC bot"
- (define socket
- (irc-socket-setup (irc-bot-server irc-bot)
- (irc-bot-port irc-bot)))
- (set! (irc-bot-socket irc-bot) socket)
- (format socket "USER ~a ~a ~a :~a~a"
- (irc-bot-username irc-bot)
- "*" "*" ; hostname and servername
- (irc-bot-realname irc-bot) irc-eol)
- (format socket "NICK ~a~a" (irc-bot-username irc-bot) irc-eol)
-
- (for-each
- (lambda (channel)
- (format socket "JOIN ~a~a" channel irc-eol))
- (irc-bot-channels irc-bot))
-
- (<- irc-bot (actor-id irc-bot) 'main-loop))
-
-(define (irc-bot-main-loop irc-bot message)
- (define socket (irc-bot-socket irc-bot))
- (define line (string-trim-right (read-line socket) #\return))
- (dispatch-raw-line irc-bot line)
- (cond
- ;; The port's been closed for some reason, so stop looping
- ((port-closed? socket)
- 'done)
- ;; We've reached the EOF object, which means we should close
- ;; the port ourselves and stop looping
- ((eof-object? (peek-char socket))
- (close socket)
- 'done)
- ;; ;; Looks like we've been killed somehow... well, stop running
- ;; ;; then!
- ;; ((actor-am-i-dead? irc-bot)
- ;; (if (not (port-closed? socket))
- ;; (close socket))
- ;; 'done)
- ;; Otherwise, let's read till the next line!
- (else
- (<- irc-bot (actor-id irc-bot) 'main-loop))))
-
-(define* (irc-bot-send-line irc-bot message
- channel line #:key emote?)
- ;; TODO: emote? handling
- (format (irc-bot-socket irc-bot) "PRIVMSG ~a :~a~a"
- channel line irc-eol))
-
-;;; Likely-to-be-overridden generic methods
-
-(define-method (dispatch-raw-line (irc-bot <irc-bot>) raw-line)
- "Dispatch a raw line of input"
- (receive (line-prefix line-command line-params)
- (parse-line raw-line)
- (match line-command
- ("PING"
- (display (string-append "PONG" irc-eol)
- (irc-bot-socket irc-bot)))
- ("PRIVMSG"
- (receive (channel-name line-text emote?)
- (condense-privmsg-line line-params)
- (let ((username (irc-line-username line-prefix)))
- (handle-line irc-bot username channel-name
- line-text emote?))))
- (_ (handle-misc-input irc-bot raw-line)))))
-
-(define-method (handle-line (irc-bot <irc-bot>) username channel-name
- line-text emote?)
- (echo-message irc-bot username channel-name line-text emote?))
-
-(define-method (handle-misc-input (irc-bot <irc-bot>) raw-line)
- (display raw-line)
- (newline))
-
-(define-method (handle-user-join (irc-bot <irc-bot>) user channel)
- 'TODO)
-
-(define-method (handle-user-quit (irc-bot <irc-bot>) user channel)
- 'TODO)
-
projects / 8sync.git / blobdiff