major update

botcore.rkt

@@ -1,36 +1,117 @@
 #lang racket
- 
+(require "irclib.rkt")
-;;TCP
+(require "commands.rkt")
-;;print-from-port : port -> void
+(require "database.rkt")
-;;prints out lines from the port until there are no more lines to print.
+(require "config.rkt")
-(define (print-from-port port)
+
-  (if (char-ready? port)
+;Here is how the connection flow has to go
-      (let ([nextchar (read-char port)])
+;First send the NICK and USER commands to the server
-        (printf (if (char=? #\~ nextchar)
+;Wait a few seconds for a PING, if no PING increase
-                    "~~"
+;the wait time by the last time * 1.5 to a maximum of n seconds
-                    (string nextchar)))
+
-        (print-from-port port))
+;; CALLBACK FUNCTIONS
-      (printf "~n")))
+(define (privmsg-handler send userinfo content join part)
- 
+  (match (parse-exclamation content)
-;;send-to-port : port -> void
+   ['nil 'nil]
-;;sends direct input from the user to the port.
+    
-(define (send-to-port port)
+   ; joining a channel
-  (let ([input (read-line)])
+   [(list-rest "join" args) 
-    (if (not (string=? input "n"))
+    (match (admin-info (first userinfo)) ; check to see if we have privileges, 0 = highest privs
-        (begin (display (string-append input "\r\n") port)
+    [0 (join (car (first args)))]
-               (flush-output port)
+    [_ 'nil])]
-               (printf "Sending ~a~n" input))
+    
-        (printf "Not sending anything.~n"))))
+   [(list-rest "quit" (list message))
- 
+    (match (admin-info (first userinfo))
-;;irc-connect : string number (port port -> void) -> void
+    [0 (quit (first message))]
-;;connects to an IRC network, and begins running the provided irc handler.
+    [_ 'nil])]
-(define (irc-connect server port handler)
+    
-         (call-with-values (lambda () (tcp-connect server port))
+   [result (send (format "~a is ~a" (first result) (dispatch userinfo content)))]))
-                  (lambda (arguments) (handler (first arguments) (second arguments)))))
+
- 
+;; Callback for join messages
-(define (irc-handle in out)
+(define (join-handler privmsg userinfo)
-  (print-from-port in)
+  userinfo)
-  (send-to-port out)
+;; Callback for quit messages
-  (irc-handle in out))
+(define (quit-handler userinfo)
- 
+  userinfo)
-;(irc-connect "localhost" 6667 irc-handle)
+
+;; Timeout combinator, tries to get output and times out if there is none
+(define ((timeout-check max-wait) input?)
+  (letrec ([matcher 
+         (lambda (acc)
+           (sleep acc)
+           (match (input?)
+             ['nil 
+              (cond
+                     [(> acc max-wait) 'nil]
+                     [else (matcher (* acc 1.5))])]
+             [result
+              (display result) ;; display each line being received
+              result]))])
+    (matcher 0.000015)))
+;; create a timeout function
+(define check (timeout-check 3))
+
+;; Base input stuff
+;; raw input getter
+(define ((get-raw-input port))
+  (check
+   (λ () 
+     (let ([result (read-line port 'return)])
+       (match result
+         [(? eof-object?) "done"]
+         [_ result])))))
+;; Gets input and parses it
+(define (get-input parse inport)
+   (let ([result ((get-raw-input inport))])
+     (match result
+       ["done" "done"]
+       [_ (parse-input result)])))
+
+(define (input? port)
+   (get-input parse-input port))
+
+;; Sends raw text to the irc server
+(define ((put-raw-output text port))
+  (display (format "trying to send ~a\n" text))
+  (display (format "~a\r\n" text) port)
+  (flush-output port))
+
+;; Setting the callbacks
+(define parse-input (register-callbacks privmsg-handler
+                                   quit-handler
+                                   join-handler))
+
+;; The actual setup of the connection
+;; Initial startup commands
+(define (initial-work in out)
+  (let* ([nickname irc-username]
+         [username irc-username]
+         [realname irc-username])
+  (display (format "NICK ~a\r\n" nickname) out)
+  (display (format "USER ~a 8 * ~a\r\n" username realname) out))
+  (flush-output out))
+
+;; The main loop that the bot runs in
+(define (ircloop in out)
+  (letrec ([inner-loop 
+  (λ ()
+    (match in
+    ['nil 'nil]
+      [_ (match (input? in)
+           ["done" 'nil]
+           ['nil (inner-loop)]
+           [result
+            ((put-raw-output result out))
+            (inner-loop)])]))])
+    (initial-work in out)
+    (display "done initial work\n")
+    (inner-loop)))
+
+;; The connector, connects to a network and then passes control to the main loop
+(define (connect hostname port)
+  (let-values ([(input output) (tcp-connect hostname port)])
+    (file-stream-buffer-mode output 'line)
+    (values input output)))
+
+(call-with-values (λ () (connect "irc.freenode.org" 6667))
+                  ircloop)

config.rkt

@@ -1,5 +1,6 @@
 #lang racket
 ; Config stuff
+;; This module is everything to do with grabbing info from the config file
 (define inp-port
   (open-input-file "./config.sexp"))
 
@@ -24,6 +25,9 @@
   (update (make-hash)
           (read inp-port)))
 
+; get username
+(define irc-username (hash-ref config "username"))
+
 ; get database info
 (define database-info
   (let* [(database

config.sexp

@@ -3,11 +3,12 @@
  ("database"
  (("hostname" "localhost")
  ("port" 5984)
- ("user" "foo")
+ ("user" "")
- ("pass" "bar")))
+ ("pass" "")))
  ; bot administrators
  ("admins"
   (
-   ("foo" 0)
+   ("Nisstyre" 0)
    )
- ))
+ )
+ ("username" "wisdumb"))

database.rkt

@@ -5,6 +5,9 @@
 (require "redis.rkt")
 (require "config.rkt")
 
+;; This module is all of the database stuff
+;; as well as the ratelimiting function
+
 ; Couch Database operations
 ; object used to connect to the database
 (define (database-connection database-name)
@@ -46,7 +49,9 @@
 
 ; strips all newlines
 (define (strip-newlines text)
-  (regexp-replace* #rx"\n" text ""))
+  (match text
+    ['nil 'nil]
+    [_ (regexp-replace* #rx"[\n\r]" text "")]))
 
 ; Redis Database Operations
 
@@ -112,9 +117,9 @@
     (let* ([hC-Current (time-magnitude (second counter) current-time)])
       (rate-check-helper hC-Current (first counter) n k))))
 
-; Allows no more than 20 commands every 5 minutes
+; Allows no more than 6 commands every 45 seconds
 ; resets after 5 minutes have passed from the last time it was reset
-(define allowed? (rate-check 20 (* 5 60000)))
+(define allowed? (rate-check 10 (* 2 60000)))
 ;; Admin Stuff
 
 (provide (all-defined-out))

irclib.rkt

@@ -1,6 +1,9 @@
 #lang racket
 
-; This module builds strings for requisite IRC commands
+;; These functions build strings for requisite IRC commands
+(require "commands.rkt")
+(require "database.rkt")
+(require "config.rkt")
 
 ; PRIVMSG command
 (define (privmsg target msg)
@@ -29,4 +32,96 @@
 (define (quit reason)
   (format "QUIT :~a"
           reason))
-  
+
+; NICK command
+(define (nick nickname)
+  (format "NICK ~a" nickname))
+
+; PING/PONG command
+(define (pingpong pingorpong message)
+  (match pingorpong
+    ["ping" (format "PING :~a" message)]
+    ["pong"
+     (format "PONG ~a" message)]))
+
+;; Parses IRC responses
+;; turns a list of words into a string
+;; and skips the first character
+(define content->string
+  (compose
+   string-tail
+   (lambda (words)
+     (string-join words " "))))
+
+(define (parse-hostmask hostmask)
+  (match (regexp-split #rx"!" hostmask)
+    [(list nick host)
+     (match (regexp-split #rx"@" host)
+       [(list username hostname) (list (string-tail nick)
+                                       username
+                                       hostname)])]))
+;; This function parses the raw IRC messages
+;; the output is intended to be used with the callback handler
+(define (parse-message message)
+  (match message
+    ['nil 'nil]
+    [_ (match (regexp-split #rx" " message)
+    ;; Matches a ping
+    [(list "PING" content) (list "PING" content)]
+    
+    ;; Matches a private message command
+    [(list-rest hostmask "PRIVMSG" channel content) 
+     (list "PRIVMSG" (parse-hostmask hostmask) channel 
+           (content->string content))]
+    
+    ;; Matches a Quit command
+    [(list-rest hostmask "QUIT" _) (list "QUIT" (parse-hostmask hostmask))]
+    
+    ;; Matches a Join command
+    [(list-rest hostmask "JOIN" (list channel)) 
+     (list "JOIN" (parse-hostmask hostmask) (string-tail channel))]
+    [_ 'nil])]))
+
+;; Callback handler
+;;This is how callback functions are chosen
+;;First we parse the IRC messages with parse-message
+;;then we use pattern matching to decide which callback
+;;function will be called
+;;It should be easy to add support for new IRC codes this way
+(define ((register-callbacks
+         privmsg-response
+         quit-response
+         join-response)
+         message)
+ 
+  (match message
+    ['nil 'nil]
+    [_ (match (parse-message (strip-newlines message)) ;MUST strip newlines and carriage returns
+    ; private message handler (called when we receive a private message)
+    ; First match to see if they are messaging us and not a channel! Or else we end up in an infinite loop
+    [(list "PRIVMSG" userinfo channel content)
+     (privmsg-response
+      ((curry privmsg) (me? channel (first userinfo)))
+      userinfo
+      content
+      join
+      ((curry part) (first userinfo)))]
+    ; JOIN handler (called when a user joins the channel)
+    [(list "JOIN" userinfo channel) (join-response
+                                     ((curry privmsg) 
+                                      channel)
+                                     userinfo)]
+    ; QUIT handler (called when a user quits)
+    [(list "QUIT" userinfo) (quit-response userinfo)]
+    ; PING handler (called when we receive a PING)
+    [(list "PING" message) 
+     (pingpong "pong" message)]
+    [_ 'nil])]))
+
+;; Check if a nick is the bot or not
+(define (me? channel recipient)
+  (cond
+  [(string=? irc-username channel) recipient]
+  (else channel)))
+
+(provide (all-defined-out))