initial

fezbot.scm

@@ -0,0 +1,73 @@
+#!/usr/bin/guile
+!#
+
+(use-modules (ice-9 rdelim)
+             (ice-9 textual-ports))
+
+(define *channel* "#bots")
+
+(define (scdr lst)
+  "Safe CDR which will return the empty list if it is passed the empty list instead of throwing an error."
+  (if (null? lst)
+      lst
+      (cdr lst)))
+
+(define (slist-ref lst index)
+  "Safe list-ref, see scdr"
+  (if (< (length lst) (+ index 1))
+      '()
+      (list-ref lst index)))
+
+(define (slist-tail lst index)
+  "Safe list-tail, see scdr"
+  (if (< (length lst) (+ index 1))
+      '()
+      (list-tail lst index)))
+
+(define (make-connection host port)
+  "Connect to irc server on host:port, returns a socket for reading and writing."
+  (let* ((sock (socket PF_INET SOCK_STREAM 0))
+         (con (connect sock
+                       AF_INET
+                       (car (vector-ref (gethost host) 4))
+                       port)))
+      sock))
+
+(define (send-nick stream)
+  (put-string stream "NICK fezbot\r\n"))
+
+(define (send-user stream)
+  (put-string stream "USER fezbot 0.0.0.0 fezbot :Fez Bottingson\r\n"))
+
+(define (join-channel stream)
+  (put-string stream (string-append "JOIN " *channel* "\r\n")))
+
+(define (send-message stream chn msg)
+  (put-string stream (string-append "PRIVMSG " chn " :" msg "\r\n")))
+
+(define (send-action stream chn action)
+  (put-string stream (string-append "PRIVMSG " chn " :\x01ACTION " action "\x01\r\n")))
+
+(define (main-loop stream)
+  (let* ((inl (read-line stream))
+         (data (string-tokenize inl)))
+   (display data)
+   (newline)
+   (cond
+     ((equal? (car data) "PING")
+      (send-message stream *channel* "PONG :foo"))
+     ((equal? ":hello" (slist-ref data 3))
+      (send-message stream *channel* "hello, world"))
+     ((and (= 7 (length data))
+           (equal? (list-tail data 4) '("ACTION" "shoots" "fezbot")))
+      (send-action stream *channel* "dies")
+      (close-port stream)
+      (exit)))
+  (main-loop stream)))
+
+(let* ((io (make-connection "127.0.0.1" 6667)))
+  (send-nick io)
+  (send-user io)
+  (join-channel io)
+
+  (main-loop io))