Name: Anonymous 2011-02-16 17:39
telnet 98.255.132.66 9099
Come join the fun!
Come join the fun!
using Socket; //socket io
using Thread; //threads are good
using AtomicVector; //each operation locks entire vector
var sock = Socket.listen(Socket.TCP4, 9999);
var clients = AtomicVector[Socket]();
fun broadcast(message, ignore) {
clients.each { |client|
try{
client.send(message + "\n") unless client == ignore
} except { /*NO EXCEPTIONS*/ }
}
println(message);
}
//
// main loop
//
while(true){
var newUser = sock.accept();
clients.add(newUser)
Thread.runLoop {
try{
var input = newUser.readBlocked().stripped()
if input == EOF or input == "/quit"
clients.delete(newUser)
else
broadcast(input, newUser);
} except {
clients.delete(newUser)
}
}
}#lang racket
(require racket/tcp
(only-in srfi/43 vector-for-each))
(define clients (make-vector 255 #f)) ; fixed length vector because I'm evil.
(define listener (tcp-listen 9999))
(struct client (id in out))
(define (broadcast message ignore-id)
(vector-for-each
(λ (cl)
(unless (= ignore-id (client-id cl))
(fprintf (client-out cl) "~a~n" message)))
clients))
(define (add-client! in out)
(with-handlers ((exn:fail:contract? (λ x (fprintf out "*** Exception: monadic pointer stack overflow")
(close-output-port out) '|monadic pointer stack overflow|)))
(let loop ((i 0))
(if (vector-ref clients i) (loop (add1 i))
(let ((cl (client i in out)))
(vector-set! clients i cl) cl)))))
(define (delete-client! cl)
(close-output-port (client-out cl))
(vector-set! clients (client-id cl) #f))
(let loop ()
(let ((client (call-with-values (lambda () (tcp-accept listener)) add-client!)))
(unless (eq? client '|monadic pointer stack overflow|)
(thread
(lambda ()
(let loop ((x (read-line (client-in client))))
(cond ((or (eof-object? x)
(string-ci=? x "/quit"))
(delete-client! client))
(else
(broadcast x (client-id client))
(loop (read-line (client-in client))))))))))
(loop))
#!/usr/bin/perl
use 5.008001;
use base 'Net::Server::Multiplex';
sub mux_input {
my ($self, $mux, $fh, $inbuf) = @_;
while ($$inbuf =~ s/^(.*?)\r?\n//) {
if ($1 eq "/quit") {
$mux->close($fh);
} else {
my $bcast = $self->{peeraddr}.': '.$1."\r\n";
for my $client ($mux->handles) {
$mux->write($client, $bcast) unless $client == $fh;
}
}
}
}
run main port => 9099
$_, one character long varibles when they are strictly needed and expr while cond should be preferred to while cond expr.
$_ because it will be defaulted to when no argument is given. I like that.
#lang racket
(require racket/tcp
(only-in srfi/43 vector-for-each))
(define clients (make-vector 255 #f)) ; fixed length vector because I'm evil.
(define listener (tcp-listen 9999))
(define users (make-parameter 0))
(struct client (id in out))
(define (broadcast message ignore-id)
(vector-for-each
(λ (cl)
(unless (= ignore-id (client-id cl))
(fprintf (client-out cl) "~a~n" message)))
clients))
(define (add-client! in out)
(with-handlers ((exn:fail:contract? (λ x (fprintf out "*** Exception: monadic pointer stack overflow~n")
(close-output-port out) '|monadic pointer stack overflow|)))
(let loop ((i 0))
(if (vector-ref clients i) (loop (add1 i))
(let ((cl (client i in out)))
(users (add1 users))
(vector-set! clients i cl) cl)))))
(define (delete-client! cl)
(close-output-port (client-out cl))
(users (sub1 users))
(vector-set! clients (client-id cl) #f))
(let loop ()
(let ((client (call-with-values (lambda () (tcp-accept listener)) add-client!)))
(unless (eq? client '|monadic pointer stack overflow|)
(fprintf (client-out client) "Hello!\r\nYou have successfully joined to the conversation,\r\n\
please remember to be respectful and polite by sageing your posts.\r\nThere are ~a people connected.\r\n" users)
(broadcast "Someone joined.\r\n" (client-id client))
(thread
(lambda ()
(let loop ((x (read-line (client-in client))))
(cond ((or (eof-object? x)
(string-ci=? (substring x 0 5) "/quit"))
(broadcast "Someone quitted. :(((((\r\n" (client-id))
(delete-client! client))
((string-ci=? (substring x 0 6) "/users")
(fprintf (client-out client) "There are ~a people connected.\r\n" users))
(else
(broadcast x (client-id client))
(loop (read-line (client-in client))))))))))
(loop))