Changeset 16431 in project


Ignore:
Timestamp:
11/13/09 20:07:09 (11 years ago)
Author:
felix winkelmann
Message:

sends server PING, allows to specify logfile

Location:
release/4/irc
Files:
2 edited

Legend:

Unmodified
Added
Removed
  • release/4/irc/irc.scm

    r15663 r16431  
    11;;;; irc.scm
    22;
    3 ; Copyright (c) 2000-2004, Felix L. Winkelmann
     3; Copyright (c) 2000-2009, Felix L. Winkelmann
    44; All rights reserved.
    55;
     
    3838             irc:connection-in irc:connection-out irc:connection-server irc:connection-nick
    3939             irc:connection-user irc:connection-real-name irc:connection-port irc:connection
     40             irc:connection-log-traffic
    4041             irc:connected? irc:connection-password irc:connection? irc:connection-channel
    4142             irc:message-prefix irc:message-command irc:message-timestamp irc:message-code
     
    4849             irc:wait irc:notice)
    4950  (import scheme chicken matchable)
    50   (use tcp extras srfi-1 regex data-structures)
     51  (use tcp extras srfi-1 regex data-structures posix)
    5152
    5253(define-constant default-port 6667)
    5354(define-constant default-user "nobody")
     55(define-constant default-server-ping-timeout 3600000) ; 1 hour
    5456
    5557(define-record irc:connection
     
    6163  real-name                             ; string
    6264  port                                  ; int
     65  ping-timeout                          ; ms
     66  log-traffic                           ; port | #f
    6367  connected?                            ; bool
    6468  handlers                              ; (handler | (tag handler) ...)
     
    7175
    7276(define (irc:connection #!key password server (nick (gensym)) (user default-user) (real-name user)
    73                         (port default-port) )
     77                        (port default-port) (ping-timeout default-server-ping-timeout)
     78                        log-traffic)
    7479  (make-irc:connection
    7580   0
    7681   password
    7782   (or server (error "no server specified"))
    78    nick user real-name port
     83   nick user real-name port ping-timeout log-traffic
    7984   #f '() '() #f #f #f) )
    8085
    8186(define (send con fstr . args)
    82   (let ([e (current-error-port)]
    83         [msg (apply sprintf fstr args)] )
     87  (let ((msg (apply sprintf fstr args)))
    8488    (unless (irc:connection-connected? con)
    8589      (error "not connected" con) )
    86     (fprintf (irc:connection-out con) "~A\r\n" msg) ) )
     90    (fprintf (irc:connection-out con) "~A\r\n" msg)
     91    (and-let* ((log (irc:connection-log-traffic con)))
     92      (fprintf log "~a > ~a~%~!" (seconds->string (current-seconds)) msg) ) ) )
    8793
    8894(define (irc:connect . args)
     
    9298              con
    9399              (apply irc:connection args) ) ] )
    94     (parameterize ((tcp-read-timeout #f))
     100    (parameterize ((tcp-read-timeout (irc:connection-ping-timeout con)))
    95101      (let-values ([(i o)
    96102                    (tcp-connect (irc:connection-server con)
     
    159165  (let ([p (irc:connection-in con)])
    160166    (and (char-ready? p)
    161          (parse-reply (read-line p) con) ) ) )
     167         (parse-reply (read-input con) con) ) ) )
     168
     169(define (read-input con)
     170  (let ((input (read-line (irc:connection-in con))))
     171    (and-let* ((log (irc:connection-log-traffic con)))
     172      (fprintf log "~a < ~a~%~!" (seconds->string (current-seconds)) input) )
     173    input))
    162174
    163175(define-record irc:message
     
    227239  (unless (irc:connection-connected? con)
    228240    (error "not connected" con) )
    229   (parse-reply (read-line (irc:connection-in con)) con) )
     241  (parse-reply
     242   (let loop ()
     243     (or (condition-case (read-input con)
     244           (ex (exn net timeout)
     245               (send con "PING ~a" (irc:connection-server con))
     246               #f) )
     247         (loop)))
     248   con))
    230249
    231250(define (irc:action con msg . dest)
     
    237256     con
    238257     (lambda (msg)
    239        (when debug
    240          (print ">>> PING - PONG <<<"))
    241258       (irc:command con (string-append "PONG :" (car (irc:message-parameters msg)))) )
    242259     tag: 'ping
     
    251268        [command (irc:message-command msg)]
    252269        [params (irc:message-parameters msg)] )
    253     (when verbose?
    254       (printf ">>> ~a <<<~%" (irc:message-body msg)) )
    255270    (any
    256271     (lambda (h) ((if (procedure? h) h (cdr h)) msg))
  • release/4/irc/irc.setup

    r15663 r16431  
    55 'irc
    66 '("irc.so" "irc.import.so")
    7  '((version 1.8) (documentation "irc.html")))
     7 '((version 1.9) (documentation "irc.html")))
Note: See TracChangeset for help on using the changeset viewer.