Add user management

1 files changed, 13 insertions, 6 deletions

diff --git a/irc/core.rkt b/irc/core.rkt
index fa5edce..342cb78 100644
--- a/irc/core.rkt
+++ b/irc/core.rkt
@@ -1,12 +1,14 @@
 #lang racket/base
 (require (for-syntax racket/provide) racket/provide
-         racket/string
+         racket/string racket/list
          racket/function racket/promise racket/exn
          racket/tcp openssl
          (only-in srfi/13 string-index string-index-right))
 (provide current-connection current-message current-hook-fail-handler
-         connect hook-add hook-process
+         connect hook-add hook-process hook-abort
          msg send listen
+         connection-storage set-connection-storage!
+         (matching-identifiers-out #rx"^log-irc-" (all-defined-out))
          (matching-identifiers-out #rx"^message-" (all-defined-out)))
 
 (define-logger irc)
@@ -18,7 +20,7 @@
   (make-parameter (λ (x) (displayln (exn->string x)))))
 
 (struct connection
-  (input output hooks output-lock)
+  (input output hooks output-lock storage)
   #:mutable)
 
 (struct message
@@ -29,15 +31,20 @@
 
 (define (connect host port #:ssl (ssl #f))
   (define-values (i o) ((if ssl ssl-connect tcp-connect) host port))
-  (connection i o '() (make-semaphore 1)))
+  (connection i o '() (make-semaphore 1) #f))
 
 (define (hook-add conn fn)
   (set-connection-hooks! conn (cons fn (connection-hooks conn))))
 
+(define hook-abort (string->uninterned-symbol "abort"))
 (define (hook-process msg)
+  (define conn (current-connection))
+  ; TODO add synchronisation
   (with-handlers ([exn:fail? (current-hook-fail-handler)])
     (parameterize ([current-message msg])
-      (for-each (λ (h) (h)) (connection-hooks (current-connection))))))
+      (set-connection-hooks! conn
+        (filter-not (λ (h) (eq? (h) hook-abort))
+                    (connection-hooks conn))))))
 
 (define (msg-print-raw msg out)
   (define (clean s)
@@ -90,7 +97,7 @@
 
   (message tags prefix (string->symbol command) (reverse args) suffix))
 
-(define (message-params msg) (append (message-args msg) (message-suffix msg)))
+(define (message-params msg) (append (message-args msg) (list (message-suffix msg))))
 
 (define (message-prefix-nick msg)
   (let* ([prefix (message-prefix msg)]